commit | author | age
|
76bbd0
|
1 |
;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*- |
C |
2 |
|
|
3 |
;; Copyright (C) 2004-2018 Free Software Foundation, Inc. |
|
4 |
|
|
5 |
;; Author: Carsten Dominik <carsten at orgmode dot org> |
|
6 |
;; Keywords: outlines, hypermedia, calendar, wp |
|
7 |
;; Homepage: https://orgmode.org |
|
8 |
;; |
|
9 |
;; This file is part of GNU Emacs. |
|
10 |
;; |
|
11 |
;; GNU Emacs is free software: you can redistribute it and/or modify |
|
12 |
;; it under the terms of the GNU General Public License as published by |
|
13 |
;; the Free Software Foundation, either version 3 of the License, or |
|
14 |
;; (at your option) any later version. |
|
15 |
|
|
16 |
;; GNU Emacs is distributed in the hope that it will be useful, |
|
17 |
;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
18 |
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
19 |
;; GNU General Public License for more details. |
|
20 |
|
|
21 |
;; You should have received a copy of the GNU General Public License |
|
22 |
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. |
|
23 |
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
|
24 |
;; |
|
25 |
;;; Commentary: |
|
26 |
|
|
27 |
;; This file contains the table editor and spreadsheet for Org mode. |
|
28 |
|
|
29 |
;; Watch out: Here we are talking about two different kind of tables. |
|
30 |
;; Most of the code is for the tables created with the Org mode table editor. |
|
31 |
;; Sometimes, we talk about tables created and edited with the table.el |
|
32 |
;; Emacs package. We call the former org-type tables, and the latter |
|
33 |
;; table.el-type tables. |
|
34 |
|
|
35 |
;;; Code: |
|
36 |
|
|
37 |
(require 'cl-lib) |
|
38 |
(require 'org) |
|
39 |
|
|
40 |
(declare-function org-element-at-point "org-element" ()) |
|
41 |
(declare-function org-element-contents "org-element" (element)) |
|
42 |
(declare-function org-element-extract-element "org-element" (element)) |
|
43 |
(declare-function org-element-interpret-data "org-element" (data)) |
|
44 |
(declare-function org-element-lineage "org-element" |
|
45 |
(blob &optional types with-self)) |
|
46 |
(declare-function org-element-map "org-element" |
|
47 |
(data types fun |
|
48 |
&optional info first-match no-recursion with-affiliated)) |
|
49 |
(declare-function org-element-parse-buffer "org-element" |
|
50 |
(&optional granularity visible-only)) |
|
51 |
(declare-function org-element-property "org-element" (property element)) |
|
52 |
(declare-function org-element-type "org-element" (element)) |
|
53 |
|
|
54 |
(declare-function org-export-create-backend "ox" (&rest rest) t) |
|
55 |
(declare-function org-export-data-with-backend "ox" (data backend info)) |
|
56 |
(declare-function org-export-filter-apply-functions "ox" |
|
57 |
(filters value info)) |
|
58 |
(declare-function org-export-first-sibling-p "ox" (blob info)) |
|
59 |
(declare-function org-export-get-backend "ox" (name)) |
|
60 |
(declare-function org-export-get-environment "ox" |
|
61 |
(&optional backend subtreep ext-plist)) |
|
62 |
(declare-function org-export-install-filters "ox" (info)) |
|
63 |
(declare-function org-export-table-has-special-column-p "ox" (table)) |
|
64 |
(declare-function org-export-table-row-is-special-p "ox" (table-row info)) |
|
65 |
|
|
66 |
(declare-function calc-eval "calc" (str &optional separator &rest args)) |
|
67 |
|
|
68 |
(defvar constants-unit-system) |
|
69 |
(defvar org-element-use-cache) |
|
70 |
(defvar org-export-filters-alist) |
|
71 |
(defvar org-table-follow-field-mode) |
|
72 |
(defvar orgtbl-mode) ; defined below |
|
73 |
(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized |
|
74 |
(defvar sort-fold-case) |
|
75 |
|
|
76 |
(defvar orgtbl-after-send-table-hook nil |
|
77 |
"Hook for functions attaching to `C-c C-c', if the table is sent. |
|
78 |
This can be used to add additional functionality after the table is sent |
|
79 |
to the receiver position, otherwise, if table is not sent, the functions |
|
80 |
are not run.") |
|
81 |
|
|
82 |
(defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ") |
|
83 |
|
|
84 |
(defcustom orgtbl-optimized t |
|
85 |
"Non-nil means use the optimized table editor version for `orgtbl-mode'. |
|
86 |
|
|
87 |
In the optimized version, the table editor takes over all simple keys that |
|
88 |
normally just insert a character. In tables, the characters are inserted |
|
89 |
in a way to minimize disturbing the table structure (i.e. in overwrite mode |
|
90 |
for empty fields). Outside tables, the correct binding of the keys is |
|
91 |
restored. |
|
92 |
|
|
93 |
Changing this variable requires a restart of Emacs to become |
|
94 |
effective." |
|
95 |
:group 'org-table |
|
96 |
:type 'boolean) |
|
97 |
|
|
98 |
(defcustom orgtbl-radio-table-templates |
|
99 |
'((latex-mode "% BEGIN RECEIVE ORGTBL %n |
|
100 |
% END RECEIVE ORGTBL %n |
|
101 |
\\begin{comment} |
|
102 |
#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 |
|
103 |
| | | |
|
104 |
\\end{comment}\n") |
|
105 |
(texinfo-mode "@c BEGIN RECEIVE ORGTBL %n |
|
106 |
@c END RECEIVE ORGTBL %n |
|
107 |
@ignore |
|
108 |
#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 |
|
109 |
| | | |
|
110 |
@end ignore\n") |
|
111 |
(html-mode "<!-- BEGIN RECEIVE ORGTBL %n --> |
|
112 |
<!-- END RECEIVE ORGTBL %n --> |
|
113 |
<!-- |
|
114 |
#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 |
|
115 |
| | | |
|
116 |
-->\n") |
|
117 |
(org-mode "#+ BEGIN RECEIVE ORGTBL %n |
|
118 |
#+ END RECEIVE ORGTBL %n |
|
119 |
|
|
120 |
#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0 |
|
121 |
| | | |
|
122 |
")) |
|
123 |
"Templates for radio tables in different major modes. |
|
124 |
Each template must define lines that will be treated as a comment and that |
|
125 |
must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" |
|
126 |
lines where \"%n\" will be replaced with the name of the table during |
|
127 |
insertion of the template. The transformed table will later be inserted |
|
128 |
between these lines. |
|
129 |
|
|
130 |
The template should also contain a minimal table in a multiline comment. |
|
131 |
If multiline comments are not possible in the buffer language, |
|
132 |
you can pack it into a string that will not be used when the code |
|
133 |
is compiled or executed. Above the table will you need a line with |
|
134 |
the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to |
|
135 |
convert the table into a data structure useful in the |
|
136 |
language of the buffer. Check the manual for the section on |
|
137 |
\"Translator functions\", and more generally check out |
|
138 |
the Info node `(org)Tables in arbitrary syntax'. |
|
139 |
|
|
140 |
All occurrences of %n in a template will be replaced with the name of the |
|
141 |
table, obtained by prompting the user." |
|
142 |
:group 'org-table |
|
143 |
:type '(repeat |
|
144 |
(list (symbol :tag "Major mode") |
|
145 |
(string :tag "Format")))) |
|
146 |
|
|
147 |
(defgroup org-table-settings nil |
|
148 |
"Settings for tables in Org mode." |
|
149 |
:tag "Org Table Settings" |
|
150 |
:group 'org-table) |
|
151 |
|
|
152 |
(defcustom org-table-default-size "5x2" |
|
153 |
"The default size for newly created tables, Columns x Rows." |
|
154 |
:group 'org-table-settings |
|
155 |
:type 'string) |
|
156 |
|
|
157 |
(defcustom org-table-number-regexp |
|
158 |
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$" |
|
159 |
"Regular expression for recognizing numbers in table columns. |
|
160 |
If a table column contains mostly numbers, it will be aligned to the |
|
161 |
right. If not, it will be aligned to the left. |
|
162 |
|
|
163 |
The default value of this option is a regular expression which allows |
|
164 |
anything which looks remotely like a number as used in scientific |
|
165 |
context. For example, all of the following will be considered a |
|
166 |
number: |
|
167 |
12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 |
|
168 |
|
|
169 |
Other options offered by the customize interface are more restrictive." |
|
170 |
:group 'org-table-settings |
|
171 |
:type '(choice |
|
172 |
(const :tag "Positive Integers" |
|
173 |
"^[0-9]+$") |
|
174 |
(const :tag "Integers" |
|
175 |
"^[-+]?[0-9]+$") |
|
176 |
(const :tag "Floating Point Numbers" |
|
177 |
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") |
|
178 |
(const :tag "Floating Point Number or Integer" |
|
179 |
"^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") |
|
180 |
(const :tag "Exponential, Floating point, Integer" |
|
181 |
"^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") |
|
182 |
(const :tag "Very General Number-Like, including hex and Calc radix" |
|
183 |
"^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") |
|
184 |
(const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" |
|
185 |
"^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") |
|
186 |
(string :tag "Regexp:"))) |
|
187 |
|
|
188 |
(defcustom org-table-number-fraction 0.5 |
|
189 |
"Fraction of numbers in a column required to make the column align right. |
|
190 |
In a column all non-white fields are considered. If at least |
|
191 |
this fraction of fields is matched by `org-table-number-regexp', |
|
192 |
alignment to the right border applies." |
|
193 |
:group 'org-table-settings |
|
194 |
:type 'number) |
|
195 |
|
|
196 |
(defgroup org-table-editing nil |
|
197 |
"Behavior of tables during editing in Org mode." |
|
198 |
:tag "Org Table Editing" |
|
199 |
:group 'org-table) |
|
200 |
|
|
201 |
(defcustom org-table-automatic-realign t |
|
202 |
"Non-nil means automatically re-align table when pressing TAB or RETURN. |
|
203 |
When nil, aligning is only done with `\\[org-table-align]', or after column |
|
204 |
removal/insertion." |
|
205 |
:group 'org-table-editing |
|
206 |
:type 'boolean) |
|
207 |
|
|
208 |
(defcustom org-table-auto-blank-field t |
|
209 |
"Non-nil means automatically blank table field when starting to type into it. |
|
210 |
This only happens when typing immediately after a field motion |
|
211 |
command (TAB, S-TAB or RET)." |
|
212 |
:group 'org-table-editing |
|
213 |
:type 'boolean) |
|
214 |
|
|
215 |
(defcustom org-table-exit-follow-field-mode-when-leaving-table t |
|
216 |
"Non-nil means automatically exit the follow mode. |
|
217 |
When nil, the follow mode will stay on and be active in any table |
|
218 |
the cursor enters. Since the table follow filed mode messes with the |
|
219 |
window configuration, it is not recommended to set this variable to nil, |
|
220 |
except maybe locally in a special file that has mostly tables with long |
|
221 |
fields." |
|
222 |
:group 'org-table |
|
223 |
:version "24.1" |
|
224 |
:type 'boolean) |
|
225 |
|
|
226 |
(defcustom org-table-fix-formulas-confirm nil |
|
227 |
"Whether the user should confirm when Org fixes formulas." |
|
228 |
:group 'org-table-editing |
|
229 |
:version "24.1" |
|
230 |
:type '(choice |
|
231 |
(const :tag "with yes-or-no" yes-or-no-p) |
|
232 |
(const :tag "with y-or-n" y-or-n-p) |
|
233 |
(const :tag "no confirmation" nil))) |
|
234 |
(put 'org-table-fix-formulas-confirm |
|
235 |
'safe-local-variable |
|
236 |
#'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) |
|
237 |
|
|
238 |
(defcustom org-table-tab-jumps-over-hlines t |
|
239 |
"Non-nil means tab in the last column of a table with jump over a hline. |
|
240 |
If a horizontal separator line is following the current line, |
|
241 |
`org-table-next-field' can either create a new row before that line, or jump |
|
242 |
over the line. When this option is nil, a new line will be created before |
|
243 |
this line." |
|
244 |
:group 'org-table-editing |
|
245 |
:type 'boolean) |
|
246 |
|
|
247 |
(defgroup org-table-calculation nil |
|
248 |
"Options concerning tables in Org mode." |
|
249 |
:tag "Org Table Calculation" |
|
250 |
:group 'org-table) |
|
251 |
|
|
252 |
(defcustom org-table-use-standard-references 'from |
|
253 |
"Non-nil means using table references like B3 instead of @3$2. |
|
254 |
Possible values are: |
|
255 |
nil never use them |
|
256 |
from accept as input, do not present for editing |
|
257 |
t accept as input and present for editing" |
|
258 |
:group 'org-table-calculation |
|
259 |
:type '(choice |
|
260 |
(const :tag "Never, don't even check user input for them" nil) |
|
261 |
(const :tag "Always, both as user input, and when editing" t) |
|
262 |
(const :tag "Convert user input, don't offer during editing" from))) |
|
263 |
|
|
264 |
(defcustom org-table-copy-increment t |
|
265 |
"Non-nil means increment when copying current field with \ |
|
266 |
`\\[org-table-copy-down]'." |
|
267 |
:group 'org-table-calculation |
|
268 |
:version "26.1" |
|
269 |
:package-version '(Org . "8.3") |
|
270 |
:type '(choice |
|
271 |
(const :tag "Use the difference between the current and the above fields" t) |
|
272 |
(integer :tag "Use a number" 1) |
|
273 |
(const :tag "Don't increment the value when copying a field" nil))) |
|
274 |
|
|
275 |
(defcustom org-calc-default-modes |
|
276 |
'(calc-internal-prec 12 |
|
277 |
calc-float-format (float 8) |
|
278 |
calc-angle-mode deg |
|
279 |
calc-prefer-frac nil |
|
280 |
calc-symbolic-mode nil |
|
281 |
calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) |
|
282 |
calc-display-working-message t |
|
283 |
) |
|
284 |
"List with Calc mode settings for use in `calc-eval' for table formulas. |
|
285 |
The list must contain alternating symbols (Calc modes variables and values). |
|
286 |
Don't remove any of the default settings, just change the values. Org mode |
|
287 |
relies on the variables to be present in the list." |
|
288 |
:group 'org-table-calculation |
|
289 |
:type 'plist) |
|
290 |
|
|
291 |
(defcustom org-table-duration-custom-format 'hours |
|
292 |
"Format for the output of calc computations like $1+$2;t. |
|
293 |
The default value is `hours', and will output the results as a |
|
294 |
number of hours. Other allowed values are `seconds', `minutes' and |
|
295 |
`days', and the output will be a fraction of seconds, minutes or |
|
296 |
days. `hh:mm' selects to use hours and minutes, ignoring seconds. |
|
297 |
The `U' flag in a table formula will select this specific format for |
|
298 |
a single formula." |
|
299 |
:group 'org-table-calculation |
|
300 |
:version "24.1" |
|
301 |
:type '(choice (symbol :tag "Seconds" 'seconds) |
|
302 |
(symbol :tag "Minutes" 'minutes) |
|
303 |
(symbol :tag "Hours " 'hours) |
|
304 |
(symbol :tag "Days " 'days) |
|
305 |
(symbol :tag "HH:MM " 'hh:mm))) |
|
306 |
|
|
307 |
(defcustom org-table-duration-hour-zero-padding t |
|
308 |
"Non-nil means hours in table duration computations should be zero-padded. |
|
309 |
So this is about 08:32:34 versus 8:33:34." |
|
310 |
:group 'org-table-calculation |
|
311 |
:version "26.1" |
|
312 |
:package-version '(Org . "9.1") |
|
313 |
:type 'boolean |
|
314 |
:safe #'booleanp) |
|
315 |
|
|
316 |
(defcustom org-table-formula-field-format "%s" |
|
317 |
"Format for fields which contain the result of a formula. |
|
318 |
For example, using \"~%s~\" will display the result within tilde |
|
319 |
characters. Beware that modifying the display can prevent the |
|
320 |
field from being used in another formula." |
|
321 |
:group 'org-table-settings |
|
322 |
:version "24.1" |
|
323 |
:type 'string) |
|
324 |
|
|
325 |
(defcustom org-table-formula-evaluate-inline t |
|
326 |
"Non-nil means TAB and RET evaluate a formula in current table field. |
|
327 |
If the current field starts with an equal sign, it is assumed to be a formula |
|
328 |
which should be evaluated as described in the manual and in the documentation |
|
329 |
string of the command `org-table-eval-formula'. This feature requires the |
|
330 |
Emacs calc package. |
|
331 |
When this variable is nil, formula calculation is only available through |
|
332 |
the command `\\[org-table-eval-formula]'." |
|
333 |
:group 'org-table-calculation |
|
334 |
:type 'boolean) |
|
335 |
|
|
336 |
(defcustom org-table-formula-use-constants t |
|
337 |
"Non-nil means interpret constants in formulas in tables. |
|
338 |
A constant looks like `$c' or `$Grav' and will be replaced before evaluation |
|
339 |
by the value given in `org-table-formula-constants', or by a value obtained |
|
340 |
from the `constants.el' package." |
|
341 |
:group 'org-table-calculation |
|
342 |
:type 'boolean) |
|
343 |
|
|
344 |
(defcustom org-table-formula-constants nil |
|
345 |
"Alist with constant names and values, for use in table formulas. |
|
346 |
The car of each element is a name of a constant, without the `$' before it. |
|
347 |
The cdr is the value as a string. For example, if you'd like to use the |
|
348 |
speed of light in a formula, you would configure |
|
349 |
|
|
350 |
(setq org-table-formula-constants \\='((\"c\" . \"299792458.\"))) |
|
351 |
|
|
352 |
and then use it in an equation like `$1*$c'. |
|
353 |
|
|
354 |
Constants can also be defined on a per-file basis using a line like |
|
355 |
|
|
356 |
#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" |
|
357 |
:group 'org-table-calculation |
|
358 |
:type '(repeat |
|
359 |
(cons (string :tag "name") |
|
360 |
(string :tag "value")))) |
|
361 |
|
|
362 |
(defcustom org-table-allow-automatic-line-recalculation t |
|
363 |
"Non-nil means lines marked with |#| or |*| will be recomputed automatically. |
|
364 |
\\<org-mode-map>\ |
|
365 |
Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \ |
|
366 |
are pressed in the line." |
|
367 |
:group 'org-table-calculation |
|
368 |
:type 'boolean) |
|
369 |
|
|
370 |
(defcustom org-table-relative-ref-may-cross-hline t |
|
371 |
"Non-nil means relative formula references may cross hlines. |
|
372 |
Here are the allowed values: |
|
373 |
|
|
374 |
nil Relative references may not cross hlines. They will reference the |
|
375 |
field next to the hline instead. Coming from below, the reference |
|
376 |
will be to the field below the hline. Coming from above, it will be |
|
377 |
to the field above. |
|
378 |
t Relative references may cross hlines. |
|
379 |
error An attempt to cross a hline will throw an error. |
|
380 |
|
|
381 |
It is probably good to never set this variable to nil, for the sake of |
|
382 |
portability of tables." |
|
383 |
:group 'org-table-calculation |
|
384 |
:type '(choice |
|
385 |
(const :tag "Allow to cross" t) |
|
386 |
(const :tag "Stick to hline" nil) |
|
387 |
(const :tag "Error on attempt to cross" error))) |
|
388 |
|
|
389 |
(defcustom org-table-formula-create-columns nil |
|
390 |
"Non-nil means evaluation of formula can add new columns. |
|
391 |
When non-nil, evaluating an out-of-bounds field can insert as |
|
392 |
many columns as needed. When set to `warn', issue a warning when |
|
393 |
doing so. When set to `prompt', ask user before creating a new |
|
394 |
column. Otherwise, throw an error." |
|
395 |
:group 'org-table-calculation |
|
396 |
:version "26.1" |
|
397 |
:package-version '(Org . "8.3") |
|
398 |
:type '(choice |
|
399 |
(const :tag "Out-of-bounds field generates an error (default)" nil) |
|
400 |
(const :tag "Out-of-bounds field silently adds columns as needed" t) |
|
401 |
(const :tag "Out-of-bounds field adds columns, but issues a warning" warn) |
|
402 |
(const :tag "Prompt user when setting an out-of-bounds field" prompt))) |
|
403 |
|
|
404 |
(defgroup org-table-import-export nil |
|
405 |
"Options concerning table import and export in Org mode." |
|
406 |
:tag "Org Table Import Export" |
|
407 |
:group 'org-table) |
|
408 |
|
|
409 |
(defcustom org-table-export-default-format "orgtbl-to-tsv" |
|
410 |
"Default export parameters for `org-table-export'. |
|
411 |
These can be overridden for a specific table by setting the |
|
412 |
TABLE_EXPORT_FORMAT property. See the manual section on orgtbl |
|
413 |
radio tables for the different export transformations and |
|
414 |
available parameters." |
|
415 |
:group 'org-table-import-export |
|
416 |
:type 'string) |
|
417 |
|
|
418 |
(defcustom org-table-convert-region-max-lines 999 |
|
419 |
"Max lines that `org-table-convert-region' will attempt to process. |
|
420 |
|
|
421 |
The function can be slow on larger regions; this safety feature |
|
422 |
prevents it from hanging emacs." |
|
423 |
:group 'org-table-import-export |
|
424 |
:type 'integer |
|
425 |
:version "26.1" |
|
426 |
:package-version '(Org . "8.3")) |
|
427 |
|
|
428 |
(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" |
|
429 |
"Regexp matching a line marked for automatic recalculation.") |
|
430 |
|
|
431 |
(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" |
|
432 |
"Regexp matching a line marked for recalculation.") |
|
433 |
|
|
434 |
(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" |
|
435 |
"Regexp matching a line marked for calculation.") |
|
436 |
|
|
437 |
(defconst org-table-border-regexp "^[ \t]*[^| \t]" |
|
438 |
"Regexp matching any line outside an Org table.") |
|
439 |
|
|
440 |
(defvar org-table-last-highlighted-reference nil) |
|
441 |
|
|
442 |
(defvar org-table-formula-history nil) |
|
443 |
|
|
444 |
(defvar org-table-column-names nil |
|
445 |
"Alist with column names, derived from the `!' line. |
|
446 |
This variable is initialized with `org-table-analyze'.") |
|
447 |
|
|
448 |
(defvar org-table-column-name-regexp nil |
|
449 |
"Regular expression matching the current column names. |
|
450 |
This variable is initialized with `org-table-analyze'.") |
|
451 |
|
|
452 |
(defvar org-table-local-parameters nil |
|
453 |
"Alist with parameter names, derived from the `$' line. |
|
454 |
This variable is initialized with `org-table-analyze'.") |
|
455 |
|
|
456 |
(defvar org-table-named-field-locations nil |
|
457 |
"Alist with locations of named fields. |
|
458 |
Associations follow the pattern (NAME LINE COLUMN) where |
|
459 |
NAME is the name of the field as a string, |
|
460 |
LINE is the number of lines from the beginning of the table, |
|
461 |
COLUMN is the column of the field, as an integer. |
|
462 |
This variable is initialized with `org-table-analyze'.") |
|
463 |
|
|
464 |
(defvar org-table-current-line-types nil |
|
465 |
"Table row types in current table. |
|
466 |
This variable is initialized with `org-table-analyze'.") |
|
467 |
|
|
468 |
(defvar org-table-current-begin-pos nil |
|
469 |
"Current table begin position, as a marker. |
|
470 |
This variable is initialized with `org-table-analyze'.") |
|
471 |
|
|
472 |
(defvar org-table-current-ncol nil |
|
473 |
"Number of columns in current table. |
|
474 |
This variable is initialized with `org-table-analyze'.") |
|
475 |
|
|
476 |
(defvar org-table-dlines nil |
|
477 |
"Vector of data line line numbers in the current table. |
|
478 |
Line numbers are counted from the beginning of the table. This |
|
479 |
variable is initialized with `org-table-analyze'.") |
|
480 |
|
|
481 |
(defvar org-table-hlines nil |
|
482 |
"Vector of hline line numbers in the current table. |
|
483 |
Line numbers are counted from the beginning of the table. This |
|
484 |
variable is initialized with `org-table-analyze'.") |
|
485 |
|
|
486 |
(defconst org-table-range-regexp |
|
487 |
"@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" |
|
488 |
;; 1 2 3 4 5 |
|
489 |
"Regular expression for matching ranges in formulas.") |
|
490 |
|
|
491 |
(defconst org-table-range-regexp2 |
|
492 |
(concat |
|
493 |
"\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" |
|
494 |
"\\.\\." |
|
495 |
"\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") |
|
496 |
"Match a range for reference display.") |
|
497 |
|
|
498 |
(defconst org-table-translate-regexp |
|
499 |
(concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") |
|
500 |
"Match a reference that needs translation, for reference display.") |
|
501 |
|
|
502 |
(defmacro org-table-save-field (&rest body) |
|
503 |
"Save current field; execute BODY; restore field. |
|
504 |
Field is restored even in case of abnormal exit." |
|
505 |
(declare (debug (body))) |
|
506 |
(org-with-gensyms (line column) |
|
507 |
`(let ((,line (copy-marker (line-beginning-position))) |
|
508 |
(,column (org-table-current-column))) |
|
509 |
(unwind-protect |
|
510 |
(progn ,@body) |
|
511 |
(goto-char ,line) |
|
512 |
(org-table-goto-column ,column) |
|
513 |
(set-marker ,line nil))))) |
|
514 |
|
|
515 |
;;;###autoload |
|
516 |
(defun org-table-create-with-table.el () |
|
517 |
"Use the table.el package to insert a new table. |
|
518 |
If there is already a table at point, convert between Org tables |
|
519 |
and table.el tables." |
|
520 |
(interactive) |
|
521 |
(require 'table) |
|
522 |
(cond |
|
523 |
((org-at-table.el-p) |
|
524 |
(if (y-or-n-p "Convert table to Org table? ") |
|
525 |
(org-table-convert))) |
|
526 |
((org-at-table-p) |
|
527 |
(when (y-or-n-p "Convert table to table.el table? ") |
|
528 |
(org-table-align) |
|
529 |
(org-table-convert))) |
|
530 |
(t (call-interactively 'table-insert)))) |
|
531 |
|
|
532 |
;;;###autoload |
|
533 |
(defun org-table-create-or-convert-from-region (arg) |
|
534 |
"Convert region to table, or create an empty table. |
|
535 |
If there is an active region, convert it to a table, using the function |
|
536 |
`org-table-convert-region'. See the documentation of that function |
|
537 |
to learn how the prefix argument is interpreted to determine the field |
|
538 |
separator. |
|
539 |
If there is no such region, create an empty table with `org-table-create'." |
|
540 |
(interactive "P") |
|
541 |
(if (org-region-active-p) |
|
542 |
(org-table-convert-region (region-beginning) (region-end) arg) |
|
543 |
(org-table-create arg))) |
|
544 |
|
|
545 |
;;;###autoload |
|
546 |
(defun org-table-create (&optional size) |
|
547 |
"Query for a size and insert a table skeleton. |
|
548 |
SIZE is a string Columns x Rows like for example \"3x2\"." |
|
549 |
(interactive "P") |
|
550 |
(unless size |
|
551 |
(setq size (read-string |
|
552 |
(concat "Table size Columns x Rows [e.g. " |
|
553 |
org-table-default-size "]: ") |
|
554 |
"" nil org-table-default-size))) |
|
555 |
|
|
556 |
(let* ((pos (point)) |
|
557 |
(indent (make-string (current-column) ?\ )) |
|
558 |
(split (org-split-string size " *x *")) |
|
559 |
(rows (string-to-number (nth 1 split))) |
|
560 |
(columns (string-to-number (car split))) |
|
561 |
(line (concat (apply 'concat indent "|" (make-list columns " |")) |
|
562 |
"\n"))) |
|
563 |
(if (string-match "^[ \t]*$" (buffer-substring-no-properties |
|
564 |
(point-at-bol) (point))) |
|
565 |
(beginning-of-line 1) |
|
566 |
(newline)) |
|
567 |
;; (mapcar (lambda (x) (insert line)) (make-list rows t)) |
|
568 |
(dotimes (_ rows) (insert line)) |
|
569 |
(goto-char pos) |
|
570 |
(if (> rows 1) |
|
571 |
;; Insert a hline after the first row. |
|
572 |
(progn |
|
573 |
(end-of-line 1) |
|
574 |
(insert "\n|-") |
|
575 |
(goto-char pos))) |
|
576 |
(org-table-align))) |
|
577 |
|
|
578 |
;;;###autoload |
|
579 |
(defun org-table-convert-region (beg0 end0 &optional separator) |
|
580 |
"Convert region to a table. |
|
581 |
|
|
582 |
The region goes from BEG0 to END0, but these borders will be moved |
|
583 |
slightly, to make sure a beginning of line in the first line is included. |
|
584 |
|
|
585 |
SEPARATOR specifies the field separator in the lines. It can have the |
|
586 |
following values: |
|
587 |
|
|
588 |
(4) Use the comma as a field separator |
|
589 |
(16) Use a TAB as field separator |
|
590 |
(64) Prompt for a regular expression as field separator |
|
591 |
integer When a number, use that many spaces, or a TAB, as field separator |
|
592 |
regexp When a regular expression, use it to match the separator |
|
593 |
nil When nil, the command tries to be smart and figure out the |
|
594 |
separator in the following way: |
|
595 |
- when each line contains a TAB, assume TAB-separated material |
|
596 |
- when each line contains a comma, assume CSV material |
|
597 |
- else, assume one or more SPACE characters as separator." |
|
598 |
(interactive "r\nP") |
|
599 |
(let* ((beg (min beg0 end0)) |
|
600 |
(end (max beg0 end0)) |
|
601 |
re) |
|
602 |
(if (> (count-lines beg end) org-table-convert-region-max-lines) |
|
603 |
(user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting" |
|
604 |
org-table-convert-region-max-lines) |
|
605 |
(if (equal separator '(64)) |
|
606 |
(setq separator (read-regexp "Regexp for field separator"))) |
|
607 |
(goto-char beg) |
|
608 |
(beginning-of-line 1) |
|
609 |
(setq beg (point-marker)) |
|
610 |
(goto-char end) |
|
611 |
(if (bolp) (backward-char 1) (end-of-line 1)) |
|
612 |
(setq end (point-marker)) |
|
613 |
;; Get the right field separator |
|
614 |
(unless separator |
|
615 |
(goto-char beg) |
|
616 |
(setq separator |
|
617 |
(cond |
|
618 |
((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) |
|
619 |
((not (re-search-forward "^[^\n,]+$" end t)) '(4)) |
|
620 |
(t 1)))) |
|
621 |
(goto-char beg) |
|
622 |
(if (equal separator '(4)) |
|
623 |
(while (< (point) end) |
|
624 |
;; parse the csv stuff |
|
625 |
(cond |
|
626 |
((looking-at "^") (insert "| ")) |
|
627 |
((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) |
|
628 |
((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") |
|
629 |
(replace-match "\\1") |
|
630 |
(if (looking-at "\"") (insert "\""))) |
|
631 |
((looking-at "[^,\n]+") (goto-char (match-end 0))) |
|
632 |
((looking-at "[ \t]*,") (replace-match " | ")) |
|
633 |
(t (beginning-of-line 2)))) |
|
634 |
(setq re (cond |
|
635 |
((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") |
|
636 |
((equal separator '(16)) "^\\|\t") |
|
637 |
((integerp separator) |
|
638 |
(if (< separator 1) |
|
639 |
(user-error "Number of spaces in separator must be >= 1") |
|
640 |
(format "^ *\\| *\t *\\| \\{%d,\\}" separator))) |
|
641 |
((stringp separator) |
|
642 |
(format "^ *\\|%s" separator)) |
|
643 |
(t (error "This should not happen")))) |
|
644 |
(while (re-search-forward re end t) |
|
645 |
(replace-match "| " t t))) |
|
646 |
(goto-char beg) |
|
647 |
(org-table-align)))) |
|
648 |
|
|
649 |
;;;###autoload |
|
650 |
(defun org-table-import (file separator) |
|
651 |
"Import FILE as a table. |
|
652 |
|
|
653 |
The command tries to be smart and figure out the separator in the |
|
654 |
following way: |
|
655 |
|
|
656 |
- when each line contains a TAB, assume TAB-separated material |
|
657 |
- when each line contains a comma, assume CSV material |
|
658 |
- else, assume one or more SPACE characters as separator. |
|
659 |
|
|
660 |
When non-nil, SEPARATOR specifies the field separator in the |
|
661 |
lines. It can have the following values: |
|
662 |
|
|
663 |
(4) Use the comma as a field separator |
|
664 |
(16) Use a TAB as field separator |
|
665 |
(64) Prompt for a regular expression as field separator |
|
666 |
integer When a number, use that many spaces, or a TAB, as field separator |
|
667 |
regexp When a regular expression, use it to match the separator." |
|
668 |
(interactive "f\nP") |
|
669 |
(unless (bolp) (insert "\n")) |
|
670 |
(let ((beg (point)) |
|
671 |
(pm (point-max))) |
|
672 |
(insert-file-contents file) |
|
673 |
(org-table-convert-region beg (+ (point) (- (point-max) pm)) separator))) |
|
674 |
|
|
675 |
|
|
676 |
;;;###autoload |
|
677 |
(defun org-table-export (&optional file format) |
|
678 |
"Export table to a file, with configurable format. |
|
679 |
Such a file can be imported into usual spreadsheet programs. |
|
680 |
|
|
681 |
FILE can be the output file name. If not given, it will be taken |
|
682 |
from a TABLE_EXPORT_FILE property in the current entry or higher |
|
683 |
up in the hierarchy, or the user will be prompted for a file |
|
684 |
name. FORMAT can be an export format, of the same kind as it |
|
685 |
used when `orgtbl-mode' sends a table in a different format. |
|
686 |
|
|
687 |
The command suggests a format depending on TABLE_EXPORT_FORMAT, |
|
688 |
whether it is set locally or up in the hierarchy, then on the |
|
689 |
extension of the given file name, and finally on the variable |
|
690 |
`org-table-export-default-format'." |
|
691 |
(interactive) |
|
692 |
(unless (org-at-table-p) (user-error "No table at point")) |
|
693 |
(org-table-align) ; Make sure we have everything we need. |
|
694 |
(let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t)))) |
|
695 |
(unless file |
|
696 |
(setq file (read-file-name "Export table to: ")) |
|
697 |
(unless (or (not (file-exists-p file)) |
|
698 |
(y-or-n-p (format "Overwrite file %s? " file))) |
|
699 |
(user-error "File not written"))) |
|
700 |
(when (file-directory-p file) |
|
701 |
(user-error "This is a directory path, not a file")) |
|
702 |
(when (and (buffer-file-name (buffer-base-buffer)) |
|
703 |
(file-equal-p |
|
704 |
(file-truename file) |
|
705 |
(file-truename (buffer-file-name (buffer-base-buffer))))) |
|
706 |
(user-error "Please specify a file name that is different from current")) |
|
707 |
(let ((fileext (concat (file-name-extension file) "$")) |
|
708 |
(format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t)))) |
|
709 |
(unless format |
|
710 |
(let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex" |
|
711 |
"orgtbl-to-html" "orgtbl-to-generic" |
|
712 |
"orgtbl-to-texinfo" "orgtbl-to-orgtbl" |
|
713 |
"orgtbl-to-unicode")) |
|
714 |
(deffmt-readable |
|
715 |
(replace-regexp-in-string |
|
716 |
"\t" "\\t" |
|
717 |
(replace-regexp-in-string |
|
718 |
"\n" "\\n" |
|
719 |
(or (car (delq nil |
|
720 |
(mapcar |
|
721 |
(lambda (f) |
|
722 |
(and (string-match-p fileext f) f)) |
|
723 |
formats))) |
|
724 |
org-table-export-default-format) |
|
725 |
t t) t t))) |
|
726 |
(setq format |
|
727 |
(org-completing-read |
|
728 |
"Format: " formats nil nil deffmt-readable)))) |
|
729 |
(if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) |
|
730 |
(let ((transform (intern (match-string 1 format))) |
|
731 |
(params (and (match-end 2) |
|
732 |
(read (concat "(" (match-string 2 format) ")")))) |
|
733 |
(table (org-table-to-lisp |
|
734 |
(buffer-substring-no-properties |
|
735 |
(org-table-begin) (org-table-end))))) |
|
736 |
(unless (fboundp transform) |
|
737 |
(user-error "No such transformation function %s" transform)) |
|
738 |
(let (buf) |
|
739 |
(with-current-buffer (find-file-noselect file) |
|
740 |
(setq buf (current-buffer)) |
|
741 |
(erase-buffer) |
|
742 |
(fundamental-mode) |
|
743 |
(insert (funcall transform table params) "\n") |
|
744 |
(save-buffer)) |
|
745 |
(kill-buffer buf)) |
|
746 |
(message "Export done.")) |
|
747 |
(user-error "TABLE_EXPORT_FORMAT invalid"))))) |
|
748 |
|
|
749 |
(defvar org-table-aligned-begin-marker (make-marker) |
|
750 |
"Marker at the beginning of the table last aligned. |
|
751 |
Used to check if cursor still is in that table, to minimize realignment.") |
|
752 |
(defvar org-table-aligned-end-marker (make-marker) |
|
753 |
"Marker at the end of the table last aligned. |
|
754 |
Used to check if cursor still is in that table, to minimize realignment.") |
|
755 |
(defvar org-table-last-alignment nil |
|
756 |
"List of flags for flushright alignment, from the last re-alignment. |
|
757 |
This is being used to correctly align a single field after TAB or RET.") |
|
758 |
(defvar org-table-last-column-widths nil |
|
759 |
"List of max width of fields in each column. |
|
760 |
This is being used to correctly align a single field after TAB or RET.") |
|
761 |
(defvar-local org-table-formula-debug nil |
|
762 |
"Non-nil means debug table formulas. |
|
763 |
When nil, simply write \"#ERROR\" in corrupted fields.") |
|
764 |
(defvar-local org-table-overlay-coordinates nil |
|
765 |
"Overlay coordinates after each align of a table.") |
|
766 |
|
|
767 |
(defvar org-last-recalc-line nil) |
|
768 |
(defvar org-table-do-narrow t) ; for dynamic scoping |
|
769 |
(defconst org-narrow-column-arrow "=>" |
|
770 |
"Used as display property in narrowed table columns.") |
|
771 |
|
|
772 |
;;;###autoload |
|
773 |
(defun org-table-align () |
|
774 |
"Align the table at point by aligning all vertical bars." |
|
775 |
(interactive) |
|
776 |
(let* ((beg (org-table-begin)) |
|
777 |
(end (copy-marker (org-table-end)))) |
|
778 |
(org-table-save-field |
|
779 |
;; Make sure invisible characters in the table are at the right |
|
780 |
;; place since column widths take them into account. |
|
781 |
(font-lock-fontify-region beg end) |
|
782 |
(move-marker org-table-aligned-begin-marker beg) |
|
783 |
(move-marker org-table-aligned-end-marker end) |
|
784 |
(goto-char beg) |
|
785 |
(let* ((indent (progn (looking-at "[ \t]*") (match-string 0))) |
|
786 |
;; Table's rows. Separators are replaced by nil. Trailing |
|
787 |
;; spaces are also removed. |
|
788 |
(lines (mapcar (lambda (l) |
|
789 |
(and (not (string-match-p "\\`[ \t]*|-" l)) |
|
790 |
(let ((l (org-trim l))) |
|
791 |
(remove-text-properties |
|
792 |
0 (length l) '(display t org-cwidth t) l) |
|
793 |
l))) |
|
794 |
(org-split-string (buffer-substring beg end) "\n"))) |
|
795 |
;; Get the data fields by splitting the lines. |
|
796 |
(fields (mapcar (lambda (l) (org-split-string l " *| *")) |
|
797 |
(remq nil lines))) |
|
798 |
;; Compute number of fields in the longest line. If the |
|
799 |
;; table contains no field, create a default table. |
|
800 |
(maxfields (if fields (apply #'max (mapcar #'length fields)) |
|
801 |
(kill-region beg end) |
|
802 |
(org-table-create org-table-default-size) |
|
803 |
(user-error "Empty table - created default table"))) |
|
804 |
;; A list of empty strings to fill any short rows on output. |
|
805 |
(emptycells (make-list maxfields "")) |
|
806 |
lengths typenums) |
|
807 |
;; Check for special formatting. |
|
808 |
(dotimes (i maxfields) |
|
809 |
(let ((column (mapcar (lambda (x) (or (nth i x) "")) fields)) |
|
810 |
fmax falign) |
|
811 |
;; Look for an explicit width or alignment. |
|
812 |
(when (save-excursion |
|
813 |
(or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t) |
|
814 |
(and org-table-do-narrow |
|
815 |
(re-search-forward |
|
816 |
"| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t)))) |
|
817 |
(catch :exit |
|
818 |
(dolist (cell column) |
|
819 |
(when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell) |
|
820 |
(when (match-end 1) (setq falign (match-string 1 cell))) |
|
821 |
(when (and org-table-do-narrow (match-end 2)) |
|
822 |
(setq fmax (string-to-number (match-string 2 cell)))) |
|
823 |
(when (or falign fmax) (throw :exit nil))))) |
|
824 |
;; Find fields that are wider than FMAX, and shorten them. |
|
825 |
(when fmax |
|
826 |
(dolist (x column) |
|
827 |
(when (> (org-string-width x) fmax) |
|
828 |
(org-add-props x nil |
|
829 |
'help-echo |
|
830 |
(concat |
|
831 |
"Clipped table field, use `\\[org-table-edit-field]' to \ |
|
832 |
edit. Full value is:\n" |
|
833 |
(substring-no-properties x))) |
|
834 |
(let ((l (length x)) |
|
835 |
(f1 (min fmax |
|
836 |
(or (string-match org-bracket-link-regexp x) |
|
837 |
fmax))) |
|
838 |
(f2 1)) |
|
839 |
(unless (> f1 1) |
|
840 |
(user-error |
|
841 |
"Cannot narrow field starting with wide link \"%s\"" |
|
842 |
(match-string 0 x))) |
|
843 |
(if (= (org-string-width x) l) (setq f2 f1) |
|
844 |
(setq f2 1) |
|
845 |
(while (< (org-string-width (substring x 0 f2)) f1) |
|
846 |
(cl-incf f2))) |
|
847 |
(add-text-properties f2 l (list 'org-cwidth t) x) |
|
848 |
(add-text-properties |
|
849 |
(if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2) |
|
850 |
(- f2 2)) |
|
851 |
f2 |
|
852 |
(list 'display org-narrow-column-arrow) |
|
853 |
x)))))) |
|
854 |
;; Get the maximum width for each column |
|
855 |
(push (or fmax (apply #'max 1 (mapcar #'org-string-width column))) |
|
856 |
lengths) |
|
857 |
;; Get the fraction of numbers among non-empty cells to |
|
858 |
;; decide about alignment of the column. |
|
859 |
(if falign (push (equal (downcase falign) "r") typenums) |
|
860 |
(let ((cnt 0) |
|
861 |
(frac 0.0)) |
|
862 |
(dolist (x column) |
|
863 |
(unless (equal x "") |
|
864 |
(setq frac |
|
865 |
(/ (+ (* frac cnt) |
|
866 |
(if (string-match-p org-table-number-regexp x) |
|
867 |
1 |
|
868 |
0)) |
|
869 |
(cl-incf cnt))))) |
|
870 |
(push (>= frac org-table-number-fraction) typenums))))) |
|
871 |
(setq lengths (nreverse lengths)) |
|
872 |
(setq typenums (nreverse typenums)) |
|
873 |
;; Store alignment of this table, for later editing of single |
|
874 |
;; fields. |
|
875 |
(setq org-table-last-alignment typenums) |
|
876 |
(setq org-table-last-column-widths lengths) |
|
877 |
;; With invisible characters, `format' does not get the field |
|
878 |
;; width right So we need to make these fields wide by hand. |
|
879 |
;; Invisible characters may be introduced by fontified links, |
|
880 |
;; emphasis, macros or sub/superscripts. |
|
881 |
(when (or (text-property-any beg end 'invisible 'org-link) |
|
882 |
(text-property-any beg end 'invisible t)) |
|
883 |
(dotimes (i maxfields) |
|
884 |
(let ((len (nth i lengths))) |
|
885 |
(dotimes (j (length fields)) |
|
886 |
(let* ((c (nthcdr i (nth j fields))) |
|
887 |
(cell (car c))) |
|
888 |
(when (and |
|
889 |
(stringp cell) |
|
890 |
(let ((l (length cell))) |
|
891 |
(or (text-property-any 0 l 'invisible 'org-link cell) |
|
892 |
(text-property-any beg end 'invisible t))) |
|
893 |
(< (org-string-width cell) len)) |
|
894 |
(let ((s (make-string (- len (org-string-width cell)) ?\s))) |
|
895 |
(setcar c (if (nth i typenums) (concat s cell) |
|
896 |
(concat cell s)))))))))) |
|
897 |
|
|
898 |
;; Compute the formats needed for output of the table. |
|
899 |
(let ((hfmt (concat indent "|")) |
|
900 |
(rfmt (concat indent "|")) |
|
901 |
(rfmt1 " %%%s%ds |") |
|
902 |
(hfmt1 "-%s-+")) |
|
903 |
(dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|"))) |
|
904 |
(let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right. |
|
905 |
(setq rfmt (concat rfmt (format rfmt1 ty l))) |
|
906 |
(setq hfmt (concat hfmt (format hfmt1 (make-string l ?-)))))) |
|
907 |
;; Replace modified lines only. Check not only contents, but |
|
908 |
;; also columns' width. |
|
909 |
(dolist (l lines) |
|
910 |
(let ((line |
|
911 |
(if l (apply #'format rfmt (append (pop fields) emptycells)) |
|
912 |
hfmt)) |
|
913 |
(previous (buffer-substring (point) (line-end-position)))) |
|
914 |
(if (and (equal previous line) |
|
915 |
(let ((a 0) |
|
916 |
(b 0)) |
|
917 |
(while (and (progn |
|
918 |
(setq a (next-single-property-change |
|
919 |
a 'org-cwidth previous)) |
|
920 |
(setq b (next-single-property-change |
|
921 |
b 'org-cwidth line))) |
|
922 |
(eq a b))) |
|
923 |
(eq a b))) |
|
924 |
(forward-line) |
|
925 |
(insert line "\n") |
|
926 |
(delete-region (point) (line-beginning-position 2)))))) |
|
927 |
(when (and orgtbl-mode (not (derived-mode-p 'org-mode))) |
|
928 |
(goto-char org-table-aligned-begin-marker) |
|
929 |
(while (org-hide-wide-columns org-table-aligned-end-marker))) |
|
930 |
(set-marker end nil) |
|
931 |
(when org-table-overlay-coordinates (org-table-overlay-coordinates)) |
|
932 |
(setq org-table-may-need-update nil))))) |
|
933 |
|
|
934 |
;;;###autoload |
|
935 |
(defun org-table-begin (&optional table-type) |
|
936 |
"Find the beginning of the table and return its position. |
|
937 |
With a non-nil optional argument TABLE-TYPE, return the beginning |
|
938 |
of a table.el-type table. This function assumes point is on |
|
939 |
a table." |
|
940 |
(cond (table-type |
|
941 |
(org-element-property :post-affiliated (org-element-at-point))) |
|
942 |
((save-excursion |
|
943 |
(and (re-search-backward org-table-border-regexp nil t) |
|
944 |
(line-beginning-position 2)))) |
|
945 |
(t (point-min)))) |
|
946 |
|
|
947 |
;;;###autoload |
|
948 |
(defun org-table-end (&optional table-type) |
|
949 |
"Find the end of the table and return its position. |
|
950 |
With a non-nil optional argument TABLE-TYPE, return the end of |
|
951 |
a table.el-type table. This function assumes point is on |
|
952 |
a table." |
|
953 |
(save-excursion |
|
954 |
(cond (table-type |
|
955 |
(goto-char (org-element-property :end (org-element-at-point))) |
|
956 |
(skip-chars-backward " \t\n") |
|
957 |
(line-beginning-position 2)) |
|
958 |
((re-search-forward org-table-border-regexp nil t) |
|
959 |
(match-beginning 0)) |
|
960 |
;; When the line right after the table is the last line in |
|
961 |
;; the buffer with trailing spaces but no final newline |
|
962 |
;; character, be sure to catch the correct ending at its |
|
963 |
;; beginning. In any other case, ending is expected to be |
|
964 |
;; at point max. |
|
965 |
(t (goto-char (point-max)) |
|
966 |
(skip-chars-backward " \t") |
|
967 |
(if (bolp) (point) (line-end-position)))))) |
|
968 |
|
|
969 |
;;;###autoload |
|
970 |
(defun org-table-justify-field-maybe (&optional new) |
|
971 |
"Justify the current field, text to left, number to right. |
|
972 |
Optional argument NEW may specify text to replace the current field content." |
|
973 |
(cond |
|
974 |
((and (not new) org-table-may-need-update)) ; Realignment will happen anyway |
|
975 |
((org-at-table-hline-p)) |
|
976 |
((and (not new) |
|
977 |
(or (not (eq (marker-buffer org-table-aligned-begin-marker) |
|
978 |
(current-buffer))) |
|
979 |
(< (point) org-table-aligned-begin-marker) |
|
980 |
(>= (point) org-table-aligned-end-marker))) |
|
981 |
;; This is not the same table, force a full re-align. |
|
982 |
(setq org-table-may-need-update t)) |
|
983 |
(t |
|
984 |
;; Realign the current field, based on previous full realign. |
|
985 |
(let ((pos (point)) |
|
986 |
(col (org-table-current-column))) |
|
987 |
(when (> col 0) |
|
988 |
(skip-chars-backward "^|") |
|
989 |
(if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)")) |
|
990 |
(setq org-table-may-need-update t) |
|
991 |
(let* ((numbers? (nth (1- col) org-table-last-alignment)) |
|
992 |
(cell (match-string 0)) |
|
993 |
(field (match-string 1)) |
|
994 |
(len (max 1 (- (org-string-width cell) 3))) |
|
995 |
(properly-closed? (/= (match-beginning 2) (match-end 2))) |
|
996 |
(fmt (format (if numbers? " %%%ds %s" " %%-%ds %s") |
|
997 |
len |
|
998 |
(if properly-closed? "|" |
|
999 |
(setq org-table-may-need-update t) |
|
1000 |
""))) |
|
1001 |
(new-cell |
|
1002 |
(cond ((not new) (format fmt field)) |
|
1003 |
((<= (org-string-width new) len) (format fmt new)) |
|
1004 |
(t |
|
1005 |
(setq org-table-may-need-update t) |
|
1006 |
(format " %s |" new))))) |
|
1007 |
(unless (equal new-cell cell) |
|
1008 |
(let (org-table-may-need-update) |
|
1009 |
(replace-match new-cell t t))) |
|
1010 |
(goto-char pos)))))))) |
|
1011 |
|
|
1012 |
;;;###autoload |
|
1013 |
(defun org-table-next-field () |
|
1014 |
"Go to the next field in the current table, creating new lines as needed. |
|
1015 |
Before doing so, re-align the table if necessary." |
|
1016 |
(interactive) |
|
1017 |
(org-table-maybe-eval-formula) |
|
1018 |
(org-table-maybe-recalculate-line) |
|
1019 |
(if (and org-table-automatic-realign |
|
1020 |
org-table-may-need-update) |
|
1021 |
(org-table-align)) |
|
1022 |
(let ((end (org-table-end))) |
|
1023 |
(if (org-at-table-hline-p) |
|
1024 |
(end-of-line 1)) |
|
1025 |
(condition-case nil |
|
1026 |
(progn |
|
1027 |
(re-search-forward "|" end) |
|
1028 |
(if (looking-at "[ \t]*$") |
|
1029 |
(re-search-forward "|" end)) |
|
1030 |
(if (and (looking-at "-") |
|
1031 |
org-table-tab-jumps-over-hlines |
|
1032 |
(re-search-forward "^[ \t]*|\\([^-]\\)" end t)) |
|
1033 |
(goto-char (match-beginning 1))) |
|
1034 |
(if (looking-at "-") |
|
1035 |
(progn |
|
1036 |
(beginning-of-line 0) |
|
1037 |
(org-table-insert-row 'below)) |
|
1038 |
(if (looking-at " ") (forward-char 1)))) |
|
1039 |
(error |
|
1040 |
(org-table-insert-row 'below))))) |
|
1041 |
|
|
1042 |
;;;###autoload |
|
1043 |
(defun org-table-previous-field () |
|
1044 |
"Go to the previous field in the table. |
|
1045 |
Before doing so, re-align the table if necessary." |
|
1046 |
(interactive) |
|
1047 |
(org-table-justify-field-maybe) |
|
1048 |
(org-table-maybe-recalculate-line) |
|
1049 |
(when (and org-table-automatic-realign |
|
1050 |
org-table-may-need-update) |
|
1051 |
(org-table-align)) |
|
1052 |
(when (org-at-table-hline-p) |
|
1053 |
(end-of-line)) |
|
1054 |
(let ((start (org-table-begin)) |
|
1055 |
(origin (point))) |
|
1056 |
(condition-case nil |
|
1057 |
(progn |
|
1058 |
(search-backward "|" start nil 2) |
|
1059 |
(while (looking-at-p "|\\(?:-\\|[ \t]*$\\)") |
|
1060 |
(search-backward "|" start))) |
|
1061 |
(error |
|
1062 |
(goto-char origin) |
|
1063 |
(user-error "Cannot move to previous table field")))) |
|
1064 |
(when (looking-at "| ?") |
|
1065 |
(goto-char (match-end 0)))) |
|
1066 |
|
|
1067 |
(defun org-table-beginning-of-field (&optional n) |
|
1068 |
"Move to the beginning of the current table field. |
|
1069 |
If already at or before the beginning, move to the beginning of the |
|
1070 |
previous field. |
|
1071 |
With numeric argument N, move N-1 fields backward first." |
|
1072 |
(interactive "p") |
|
1073 |
(let ((pos (point))) |
|
1074 |
(while (> n 1) |
|
1075 |
(setq n (1- n)) |
|
1076 |
(org-table-previous-field)) |
|
1077 |
(if (not (re-search-backward "|" (point-at-bol 0) t)) |
|
1078 |
(user-error "No more table fields before the current") |
|
1079 |
(goto-char (match-end 0)) |
|
1080 |
(and (looking-at " ") (forward-char 1))) |
|
1081 |
(if (>= (point) pos) (org-table-beginning-of-field 2)))) |
|
1082 |
|
|
1083 |
(defun org-table-end-of-field (&optional n) |
|
1084 |
"Move to the end of the current table field. |
|
1085 |
If already at or after the end, move to the end of the next table field. |
|
1086 |
With numeric argument N, move N-1 fields forward first." |
|
1087 |
(interactive "p") |
|
1088 |
(let ((pos (point))) |
|
1089 |
(while (> n 1) |
|
1090 |
(setq n (1- n)) |
|
1091 |
(org-table-next-field)) |
|
1092 |
(when (re-search-forward "|" (point-at-eol 1) t) |
|
1093 |
(backward-char 1) |
|
1094 |
(skip-chars-backward " ") |
|
1095 |
(if (and (equal (char-before (point)) ?|) (looking-at " ")) |
|
1096 |
(forward-char 1))) |
|
1097 |
(if (<= (point) pos) (org-table-end-of-field 2)))) |
|
1098 |
|
|
1099 |
;;;###autoload |
|
1100 |
(defun org-table-next-row () |
|
1101 |
"Go to the next row (same column) in the current table. |
|
1102 |
Before doing so, re-align the table if necessary." |
|
1103 |
(interactive) |
|
1104 |
(org-table-maybe-eval-formula) |
|
1105 |
(org-table-maybe-recalculate-line) |
|
1106 |
(if (and org-table-automatic-realign |
|
1107 |
org-table-may-need-update) |
|
1108 |
(org-table-align)) |
|
1109 |
(let ((col (org-table-current-column))) |
|
1110 |
(beginning-of-line 2) |
|
1111 |
(when (or (not (org-at-table-p)) |
|
1112 |
(org-at-table-hline-p)) |
|
1113 |
(beginning-of-line 0) |
|
1114 |
(org-table-insert-row 'below)) |
|
1115 |
(org-table-goto-column col) |
|
1116 |
(skip-chars-backward "^|\n\r") |
|
1117 |
(when (looking-at " ") (forward-char)))) |
|
1118 |
|
|
1119 |
;;;###autoload |
|
1120 |
(defun org-table-copy-down (n) |
|
1121 |
"Copy the value of the current field one row below. |
|
1122 |
|
|
1123 |
If the field at the cursor is empty, copy the content of the |
|
1124 |
nearest non-empty field above. With argument N, use the Nth |
|
1125 |
non-empty field. |
|
1126 |
|
|
1127 |
If the current field is not empty, it is copied down to the next |
|
1128 |
row, and the cursor is moved with it. Therefore, repeating this |
|
1129 |
command causes the column to be filled row-by-row. |
|
1130 |
|
|
1131 |
If the variable `org-table-copy-increment' is non-nil and the |
|
1132 |
field is an integer or a timestamp, it will be incremented while |
|
1133 |
copying. By default, increment by the difference between the |
|
1134 |
value in the current field and the one in the field above. To |
|
1135 |
increment using a fixed integer, set `org-table-copy-increment' |
|
1136 |
to a number. In the case of a timestamp, increment by days." |
|
1137 |
(interactive "p") |
|
1138 |
(let* ((colpos (org-table-current-column)) |
|
1139 |
(col (current-column)) |
|
1140 |
(field (save-excursion (org-table-get-field))) |
|
1141 |
(field-up (or (save-excursion |
|
1142 |
(org-table-get (1- (org-table-current-line)) |
|
1143 |
(org-table-current-column))) "")) |
|
1144 |
(non-empty (string-match "[^ \t]" field)) |
|
1145 |
(non-empty-up (string-match "[^ \t]" field-up)) |
|
1146 |
(beg (org-table-begin)) |
|
1147 |
(orig-n n) |
|
1148 |
txt txt-up inc) |
|
1149 |
(org-table-check-inside-data-field) |
|
1150 |
(if (not non-empty) |
|
1151 |
(save-excursion |
|
1152 |
(setq txt |
|
1153 |
(catch 'exit |
|
1154 |
(while (progn (beginning-of-line 1) |
|
1155 |
(re-search-backward org-table-dataline-regexp |
|
1156 |
beg t)) |
|
1157 |
(org-table-goto-column colpos t) |
|
1158 |
(if (and (looking-at |
|
1159 |
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") |
|
1160 |
(<= (setq n (1- n)) 0)) |
|
1161 |
(throw 'exit (match-string 1)))))) |
|
1162 |
(setq field-up |
|
1163 |
(catch 'exit |
|
1164 |
(while (progn (beginning-of-line 1) |
|
1165 |
(re-search-backward org-table-dataline-regexp |
|
1166 |
beg t)) |
|
1167 |
(org-table-goto-column colpos t) |
|
1168 |
(if (and (looking-at |
|
1169 |
"|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") |
|
1170 |
(<= (setq n (1- n)) 0)) |
|
1171 |
(throw 'exit (match-string 1)))))) |
|
1172 |
(setq non-empty-up (and field-up (string-match "[^ \t]" field-up)))) |
|
1173 |
;; Above field was not empty, go down to the next row |
|
1174 |
(setq txt (org-trim field)) |
|
1175 |
(org-table-next-row) |
|
1176 |
(org-table-blank-field)) |
|
1177 |
(if non-empty-up (setq txt-up (org-trim field-up))) |
|
1178 |
(setq inc (cond |
|
1179 |
((numberp org-table-copy-increment) org-table-copy-increment) |
|
1180 |
(txt-up (cond ((and (string-match org-ts-regexp3 txt-up) |
|
1181 |
(string-match org-ts-regexp3 txt)) |
|
1182 |
(- (org-time-string-to-absolute txt) |
|
1183 |
(org-time-string-to-absolute txt-up))) |
|
1184 |
((string-match org-ts-regexp3 txt) 1) |
|
1185 |
((string-match "\\([-+]\\)?\\(?:[0-9]+\\)?\\(?:\.[0-9]+\\)?" txt-up) |
|
1186 |
(- (string-to-number txt) |
|
1187 |
(string-to-number (match-string 0 txt-up)))) |
|
1188 |
(t 1))) |
|
1189 |
(t 1))) |
|
1190 |
(if (not txt) |
|
1191 |
(user-error "No non-empty field found") |
|
1192 |
(if (and org-table-copy-increment |
|
1193 |
(not (equal orig-n 0)) |
|
1194 |
(string-match-p "^[-+^/*0-9eE.]+$" txt) |
|
1195 |
(< (string-to-number txt) 100000000)) |
|
1196 |
(setq txt (calc-eval (concat txt "+" (number-to-string inc))))) |
|
1197 |
(insert txt) |
|
1198 |
(org-move-to-column col) |
|
1199 |
(if (and org-table-copy-increment (org-at-timestamp-p 'lax)) |
|
1200 |
(org-timestamp-up-day inc) |
|
1201 |
(org-table-maybe-recalculate-line)) |
|
1202 |
(org-table-align) |
|
1203 |
(org-move-to-column col)))) |
|
1204 |
|
|
1205 |
(defun org-table-check-inside-data-field (&optional noerror) |
|
1206 |
"Is point inside a table data field? |
|
1207 |
I.e. not on a hline or before the first or after the last column? |
|
1208 |
This actually throws an error, so it aborts the current command." |
|
1209 |
(cond ((and (org-at-table-p) |
|
1210 |
(not (save-excursion (skip-chars-backward " \t") (bolp))) |
|
1211 |
(not (org-at-table-hline-p)) |
|
1212 |
(not (looking-at "[ \t]*$")))) |
|
1213 |
(noerror nil) |
|
1214 |
(t (user-error "Not in table data field")))) |
|
1215 |
|
|
1216 |
(defvar org-table-clip nil |
|
1217 |
"Clipboard for table regions.") |
|
1218 |
|
|
1219 |
(defun org-table-get (line column) |
|
1220 |
"Get the field in table line LINE, column COLUMN. |
|
1221 |
If LINE is larger than the number of data lines in the table, the function |
|
1222 |
returns nil. However, if COLUMN is too large, we will simply return an |
|
1223 |
empty string. |
|
1224 |
If LINE is nil, use the current line. |
|
1225 |
If COLUMN is nil, use the current column." |
|
1226 |
(setq column (or column (org-table-current-column))) |
|
1227 |
(save-excursion |
|
1228 |
(and (or (not line) (org-table-goto-line line)) |
|
1229 |
(org-trim (org-table-get-field column))))) |
|
1230 |
|
|
1231 |
(defun org-table-put (line column value &optional align) |
|
1232 |
"Put VALUE into line LINE, column COLUMN. |
|
1233 |
When ALIGN is set, also realign the table." |
|
1234 |
(setq column (or column (org-table-current-column))) |
|
1235 |
(prog1 (save-excursion |
|
1236 |
(and (or (not line) (org-table-goto-line line)) |
|
1237 |
(progn (org-table-goto-column column nil 'force) t) |
|
1238 |
(org-table-get-field column value))) |
|
1239 |
(and align (org-table-align)))) |
|
1240 |
|
|
1241 |
(defun org-table-current-line () |
|
1242 |
"Return the index of the current data line." |
|
1243 |
(let ((pos (point)) (end (org-table-end)) (cnt 0)) |
|
1244 |
(save-excursion |
|
1245 |
(goto-char (org-table-begin)) |
|
1246 |
(while (and (re-search-forward org-table-dataline-regexp end t) |
|
1247 |
(setq cnt (1+ cnt)) |
|
1248 |
(< (point-at-eol) pos)))) |
|
1249 |
cnt)) |
|
1250 |
|
|
1251 |
(defun org-table-goto-line (N) |
|
1252 |
"Go to the Nth data line in the current table. |
|
1253 |
Return t when the line exists, nil if it does not exist." |
|
1254 |
(goto-char (org-table-begin)) |
|
1255 |
(let ((end (org-table-end)) (cnt 0)) |
|
1256 |
(while (and (re-search-forward org-table-dataline-regexp end t) |
|
1257 |
(< (setq cnt (1+ cnt)) N))) |
|
1258 |
(= cnt N))) |
|
1259 |
|
|
1260 |
;;;###autoload |
|
1261 |
(defun org-table-blank-field () |
|
1262 |
"Blank the current table field or active region." |
|
1263 |
(interactive) |
|
1264 |
(org-table-check-inside-data-field) |
|
1265 |
(if (and (called-interactively-p 'any) (org-region-active-p)) |
|
1266 |
(let (org-table-clip) |
|
1267 |
(org-table-cut-region (region-beginning) (region-end))) |
|
1268 |
(skip-chars-backward "^|") |
|
1269 |
(backward-char 1) |
|
1270 |
(if (looking-at "|[^|\n]+") |
|
1271 |
(let* ((pos (match-beginning 0)) |
|
1272 |
(match (match-string 0)) |
|
1273 |
(len (org-string-width match))) |
|
1274 |
(replace-match (concat "|" (make-string (1- len) ?\ ))) |
|
1275 |
(goto-char (+ 2 pos)) |
|
1276 |
(substring match 1))))) |
|
1277 |
|
|
1278 |
(defun org-table-get-field (&optional n replace) |
|
1279 |
"Return the value of the field in column N of current row. |
|
1280 |
N defaults to current column. If REPLACE is a string, replace |
|
1281 |
field with this value. The return value is always the old |
|
1282 |
value." |
|
1283 |
(when n (org-table-goto-column n)) |
|
1284 |
(skip-chars-backward "^|\n") |
|
1285 |
(if (or (bolp) (looking-at-p "[ \t]*$")) |
|
1286 |
;; Before first column or after last one. |
|
1287 |
"" |
|
1288 |
(looking-at "[^|\r\n]*") |
|
1289 |
(let* ((pos (match-beginning 0)) |
|
1290 |
(val (buffer-substring pos (match-end 0)))) |
|
1291 |
(when replace |
|
1292 |
(replace-match (if (equal replace "") " " replace) t t)) |
|
1293 |
(goto-char (min (line-end-position) (1+ pos))) |
|
1294 |
val))) |
|
1295 |
|
|
1296 |
;;;###autoload |
|
1297 |
(defun org-table-field-info (_arg) |
|
1298 |
"Show info about the current field, and highlight any reference at point." |
|
1299 |
(interactive "P") |
|
1300 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
1301 |
(org-table-analyze) |
|
1302 |
(save-excursion |
|
1303 |
(let* ((pos (point)) |
|
1304 |
(col (org-table-current-column)) |
|
1305 |
(cname (car (rassoc (int-to-string col) org-table-column-names))) |
|
1306 |
(name (car (rassoc (list (count-lines org-table-current-begin-pos |
|
1307 |
(line-beginning-position)) |
|
1308 |
col) |
|
1309 |
org-table-named-field-locations))) |
|
1310 |
(eql (org-table-expand-lhs-ranges |
|
1311 |
(mapcar |
|
1312 |
(lambda (e) |
|
1313 |
(cons (org-table-formula-handle-first/last-rc (car e)) |
|
1314 |
(cdr e))) |
|
1315 |
(org-table-get-stored-formulas)))) |
|
1316 |
(dline (org-table-current-dline)) |
|
1317 |
(ref (format "@%d$%d" dline col)) |
|
1318 |
(ref1 (org-table-convert-refs-to-an ref)) |
|
1319 |
;; Prioritize field formulas over column formulas. |
|
1320 |
(fequation (or (assoc name eql) (assoc ref eql))) |
|
1321 |
(cequation (assoc (format "$%d" col) eql)) |
|
1322 |
(eqn (or fequation cequation))) |
|
1323 |
(let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn))))) |
|
1324 |
(when p (setq eqn p))) |
|
1325 |
(goto-char pos) |
|
1326 |
(ignore-errors (org-table-show-reference 'local)) |
|
1327 |
(message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" |
|
1328 |
dline col |
|
1329 |
(if cname (concat " or $" cname) "") |
|
1330 |
dline col ref1 |
|
1331 |
(if name (concat " or $" name) "") |
|
1332 |
;; FIXME: formula info not correct if special table line |
|
1333 |
(if eqn |
|
1334 |
(concat ", formula: " |
|
1335 |
(org-table-formula-to-user |
|
1336 |
(concat |
|
1337 |
(if (or (string-prefix-p "$" (car eqn)) |
|
1338 |
(string-prefix-p "@" (car eqn))) |
|
1339 |
"" |
|
1340 |
"$") |
|
1341 |
(car eqn) "=" (cdr eqn)))) |
|
1342 |
""))))) |
|
1343 |
|
|
1344 |
(defun org-table-current-column () |
|
1345 |
"Find out which column we are in." |
|
1346 |
(interactive) |
|
1347 |
(save-excursion |
|
1348 |
(let ((column 0) (pos (point))) |
|
1349 |
(beginning-of-line) |
|
1350 |
(while (search-forward "|" pos t) (cl-incf column)) |
|
1351 |
column))) |
|
1352 |
|
|
1353 |
(defun org-table-current-dline () |
|
1354 |
"Find out what table data line we are in. |
|
1355 |
Only data lines count for this." |
|
1356 |
(save-excursion |
|
1357 |
(let ((c 0) |
|
1358 |
(pos (line-beginning-position))) |
|
1359 |
(goto-char (org-table-begin)) |
|
1360 |
(while (<= (point) pos) |
|
1361 |
(when (looking-at org-table-dataline-regexp) (cl-incf c)) |
|
1362 |
(forward-line)) |
|
1363 |
c))) |
|
1364 |
|
|
1365 |
;;;###autoload |
|
1366 |
(defun org-table-goto-column (n &optional on-delim force) |
|
1367 |
"Move the cursor to the Nth column in the current table line. |
|
1368 |
With optional argument ON-DELIM, stop with point before the left delimiter |
|
1369 |
of the field. |
|
1370 |
If there are less than N fields, just go to after the last delimiter. |
|
1371 |
However, when FORCE is non-nil, create new columns if necessary." |
|
1372 |
(interactive "p") |
|
1373 |
(beginning-of-line 1) |
|
1374 |
(when (> n 0) |
|
1375 |
(while (and (> (setq n (1- n)) -1) |
|
1376 |
(or (search-forward "|" (point-at-eol) t) |
|
1377 |
(and force |
|
1378 |
(progn (end-of-line 1) |
|
1379 |
(skip-chars-backward "^|") |
|
1380 |
(insert " | ") |
|
1381 |
t))))) |
|
1382 |
(when (and force (not (looking-at ".*|"))) |
|
1383 |
(save-excursion (end-of-line 1) (insert " | "))) |
|
1384 |
(if on-delim |
|
1385 |
(backward-char 1) |
|
1386 |
(if (looking-at " ") (forward-char 1))))) |
|
1387 |
|
|
1388 |
;;;###autoload |
|
1389 |
(defun org-table-insert-column () |
|
1390 |
"Insert a new column into the table." |
|
1391 |
(interactive) |
|
1392 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
1393 |
(org-table-find-dataline) |
|
1394 |
(let* ((col (max 1 (org-table-current-column))) |
|
1395 |
(beg (org-table-begin)) |
|
1396 |
(end (copy-marker (org-table-end)))) |
|
1397 |
(org-table-save-field |
|
1398 |
(goto-char beg) |
|
1399 |
(while (< (point) end) |
|
1400 |
(unless (org-at-table-hline-p) |
|
1401 |
(org-table-goto-column col t) |
|
1402 |
(insert "| ")) |
|
1403 |
(forward-line))) |
|
1404 |
(set-marker end nil) |
|
1405 |
(org-table-align) |
|
1406 |
(when (or (not org-table-fix-formulas-confirm) |
|
1407 |
(funcall org-table-fix-formulas-confirm "Fix formulas? ")) |
|
1408 |
(org-table-fix-formulas "$" nil (1- col) 1) |
|
1409 |
(org-table-fix-formulas "$LR" nil (1- col) 1)))) |
|
1410 |
|
|
1411 |
(defun org-table-find-dataline () |
|
1412 |
"Find a data line in the current table, which is needed for column commands." |
|
1413 |
(if (and (org-at-table-p) |
|
1414 |
(not (org-at-table-hline-p))) |
|
1415 |
t |
|
1416 |
(let ((col (current-column)) |
|
1417 |
(end (org-table-end))) |
|
1418 |
(org-move-to-column col) |
|
1419 |
(while (and (< (point) end) |
|
1420 |
(or (not (= (current-column) col)) |
|
1421 |
(org-at-table-hline-p))) |
|
1422 |
(beginning-of-line 2) |
|
1423 |
(org-move-to-column col)) |
|
1424 |
(if (and (org-at-table-p) |
|
1425 |
(not (org-at-table-hline-p))) |
|
1426 |
t |
|
1427 |
(user-error |
|
1428 |
"Please position cursor in a data line for column operations"))))) |
|
1429 |
|
|
1430 |
(defun org-table-line-to-dline (line &optional above) |
|
1431 |
"Turn a buffer line number into a data line number. |
|
1432 |
|
|
1433 |
If there is no data line in this line, return nil. |
|
1434 |
|
|
1435 |
If there is no matching dline (most likely the reference was |
|
1436 |
a hline), the first dline below it is used. When ABOVE is |
|
1437 |
non-nil, the one above is used." |
|
1438 |
(let ((min 1) |
|
1439 |
(max (1- (length org-table-dlines)))) |
|
1440 |
(cond ((or (> (aref org-table-dlines min) line) |
|
1441 |
(< (aref org-table-dlines max) line)) |
|
1442 |
nil) |
|
1443 |
((= (aref org-table-dlines max) line) max) |
|
1444 |
(t (catch 'exit |
|
1445 |
(while (> (- max min) 1) |
|
1446 |
(let* ((mean (/ (+ max min) 2)) |
|
1447 |
(v (aref org-table-dlines mean))) |
|
1448 |
(cond ((= v line) (throw 'exit mean)) |
|
1449 |
((> v line) (setq max mean)) |
|
1450 |
(t (setq min mean))))) |
|
1451 |
(if above min max)))))) |
|
1452 |
|
|
1453 |
;;;###autoload |
|
1454 |
(defun org-table-delete-column () |
|
1455 |
"Delete a column from the table." |
|
1456 |
(interactive) |
|
1457 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
1458 |
(org-table-find-dataline) |
|
1459 |
(org-table-check-inside-data-field) |
|
1460 |
(let ((col (org-table-current-column)) |
|
1461 |
(beg (org-table-begin)) |
|
1462 |
(end (copy-marker (org-table-end)))) |
|
1463 |
(org-table-save-field |
|
1464 |
(goto-char beg) |
|
1465 |
(while (< (point) end) |
|
1466 |
(if (org-at-table-hline-p) |
|
1467 |
nil |
|
1468 |
(org-table-goto-column col t) |
|
1469 |
(and (looking-at "|[^|\n]+|") |
|
1470 |
(replace-match "|"))) |
|
1471 |
(forward-line))) |
|
1472 |
(set-marker end nil) |
|
1473 |
(org-table-goto-column (max 1 (1- col))) |
|
1474 |
(org-table-align) |
|
1475 |
(when (or (not org-table-fix-formulas-confirm) |
|
1476 |
(funcall org-table-fix-formulas-confirm "Fix formulas? ")) |
|
1477 |
(org-table-fix-formulas |
|
1478 |
"$" (list (cons (number-to-string col) "INVALID")) col -1 col) |
|
1479 |
(org-table-fix-formulas |
|
1480 |
"$LR" (list (cons (number-to-string col) "INVALID")) col -1 col)))) |
|
1481 |
|
|
1482 |
;;;###autoload |
|
1483 |
(defun org-table-move-column-right () |
|
1484 |
"Move column to the right." |
|
1485 |
(interactive) |
|
1486 |
(org-table-move-column nil)) |
|
1487 |
;;;###autoload |
|
1488 |
(defun org-table-move-column-left () |
|
1489 |
"Move column to the left." |
|
1490 |
(interactive) |
|
1491 |
(org-table-move-column 'left)) |
|
1492 |
|
|
1493 |
;;;###autoload |
|
1494 |
(defun org-table-move-column (&optional left) |
|
1495 |
"Move the current column to the right. With arg LEFT, move to the left." |
|
1496 |
(interactive "P") |
|
1497 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
1498 |
(org-table-find-dataline) |
|
1499 |
(org-table-check-inside-data-field) |
|
1500 |
(let* ((col (org-table-current-column)) |
|
1501 |
(col1 (if left (1- col) col)) |
|
1502 |
(colpos (if left (1- col) (1+ col))) |
|
1503 |
(beg (org-table-begin)) |
|
1504 |
(end (copy-marker (org-table-end)))) |
|
1505 |
(when (and left (= col 1)) |
|
1506 |
(user-error "Cannot move column further left")) |
|
1507 |
(when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) |
|
1508 |
(user-error "Cannot move column further right")) |
|
1509 |
(org-table-save-field |
|
1510 |
(goto-char beg) |
|
1511 |
(while (< (point) end) |
|
1512 |
(unless (org-at-table-hline-p) |
|
1513 |
(org-table-goto-column col1 t) |
|
1514 |
(when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") |
|
1515 |
(transpose-regions |
|
1516 |
(match-beginning 1) (match-end 1) |
|
1517 |
(match-beginning 2) (match-end 2)))) |
|
1518 |
(forward-line))) |
|
1519 |
(set-marker end nil) |
|
1520 |
(org-table-goto-column colpos) |
|
1521 |
(org-table-align) |
|
1522 |
(when (or (not org-table-fix-formulas-confirm) |
|
1523 |
(funcall org-table-fix-formulas-confirm "Fix formulas? ")) |
|
1524 |
(org-table-fix-formulas |
|
1525 |
"$" (list (cons (number-to-string col) (number-to-string colpos)) |
|
1526 |
(cons (number-to-string colpos) (number-to-string col)))) |
|
1527 |
(org-table-fix-formulas |
|
1528 |
"$LR" (list (cons (number-to-string col) (number-to-string colpos)) |
|
1529 |
(cons (number-to-string colpos) (number-to-string col))))))) |
|
1530 |
|
|
1531 |
;;;###autoload |
|
1532 |
(defun org-table-move-row-down () |
|
1533 |
"Move table row down." |
|
1534 |
(interactive) |
|
1535 |
(org-table-move-row nil)) |
|
1536 |
;;;###autoload |
|
1537 |
(defun org-table-move-row-up () |
|
1538 |
"Move table row up." |
|
1539 |
(interactive) |
|
1540 |
(org-table-move-row 'up)) |
|
1541 |
|
|
1542 |
;;;###autoload |
|
1543 |
(defun org-table-move-row (&optional up) |
|
1544 |
"Move the current table line down. With arg UP, move it up." |
|
1545 |
(interactive "P") |
|
1546 |
(let* ((col (current-column)) |
|
1547 |
(pos (point)) |
|
1548 |
(hline1p (save-excursion (beginning-of-line 1) |
|
1549 |
(looking-at org-table-hline-regexp))) |
|
1550 |
(dline1 (org-table-current-dline)) |
|
1551 |
(dline2 (+ dline1 (if up -1 1))) |
|
1552 |
(tonew (if up 0 2)) |
|
1553 |
hline2p) |
|
1554 |
(when (and up (= (point-min) (line-beginning-position))) |
|
1555 |
(user-error "Cannot move row further")) |
|
1556 |
(beginning-of-line tonew) |
|
1557 |
(when (or (and (not up) (eobp)) (not (org-at-table-p))) |
|
1558 |
(goto-char pos) |
|
1559 |
(user-error "Cannot move row further")) |
|
1560 |
(setq hline2p (looking-at org-table-hline-regexp)) |
|
1561 |
(goto-char pos) |
|
1562 |
(let ((row (delete-and-extract-region (line-beginning-position) |
|
1563 |
(line-beginning-position 2)))) |
|
1564 |
(beginning-of-line tonew) |
|
1565 |
(unless (bolp) (insert "\n")) ;at eob without a newline |
|
1566 |
(insert row) |
|
1567 |
(unless (bolp) (insert "\n")) ;missing final newline in ROW |
|
1568 |
(beginning-of-line 0) |
|
1569 |
(org-move-to-column col) |
|
1570 |
(unless (or hline1p hline2p |
|
1571 |
(not (or (not org-table-fix-formulas-confirm) |
|
1572 |
(funcall org-table-fix-formulas-confirm |
|
1573 |
"Fix formulas? ")))) |
|
1574 |
(org-table-fix-formulas |
|
1575 |
"@" (list |
|
1576 |
(cons (number-to-string dline1) (number-to-string dline2)) |
|
1577 |
(cons (number-to-string dline2) (number-to-string dline1)))))))) |
|
1578 |
|
|
1579 |
;;;###autoload |
|
1580 |
(defun org-table-insert-row (&optional arg) |
|
1581 |
"Insert a new row above the current line into the table. |
|
1582 |
With prefix ARG, insert below the current line." |
|
1583 |
(interactive "P") |
|
1584 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
1585 |
(let* ((line (buffer-substring (line-beginning-position) (line-end-position))) |
|
1586 |
(new (org-table-clean-line line))) |
|
1587 |
;; Fix the first field if necessary |
|
1588 |
(if (string-match "^[ \t]*| *[#$] *|" line) |
|
1589 |
(setq new (replace-match (match-string 0 line) t t new))) |
|
1590 |
(beginning-of-line (if arg 2 1)) |
|
1591 |
;; Buffer may not end of a newline character, so ensure |
|
1592 |
;; (beginning-of-line 2) moves point to a new line. |
|
1593 |
(unless (bolp) (insert "\n")) |
|
1594 |
(let (org-table-may-need-update) (insert-before-markers new "\n")) |
|
1595 |
(beginning-of-line 0) |
|
1596 |
(re-search-forward "| ?" (line-end-position) t) |
|
1597 |
(when (or org-table-may-need-update org-table-overlay-coordinates) |
|
1598 |
(org-table-align)) |
|
1599 |
(when (or (not org-table-fix-formulas-confirm) |
|
1600 |
(funcall org-table-fix-formulas-confirm "Fix formulas? ")) |
|
1601 |
(org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))) |
|
1602 |
|
|
1603 |
;;;###autoload |
|
1604 |
(defun org-table-insert-hline (&optional above) |
|
1605 |
"Insert a horizontal-line below the current line into the table. |
|
1606 |
With prefix ABOVE, insert above the current line." |
|
1607 |
(interactive "P") |
|
1608 |
(if (not (org-at-table-p)) |
|
1609 |
(user-error "Not at a table")) |
|
1610 |
(when (eobp) (insert "\n") (backward-char 1)) |
|
1611 |
(if (not (string-match-p "|[ \t]*$" (org-current-line-string))) |
|
1612 |
(org-table-align)) |
|
1613 |
(let ((line (org-table-clean-line |
|
1614 |
(buffer-substring (point-at-bol) (point-at-eol)))) |
|
1615 |
(col (current-column))) |
|
1616 |
(while (string-match "|\\( +\\)|" line) |
|
1617 |
(setq line (replace-match |
|
1618 |
(concat "+" (make-string (- (match-end 1) (match-beginning 1)) |
|
1619 |
?-) "|") t t line))) |
|
1620 |
(and (string-match "\\+" line) (setq line (replace-match "|" t t line))) |
|
1621 |
(beginning-of-line (if above 1 2)) |
|
1622 |
(insert line "\n") |
|
1623 |
(beginning-of-line (if above 1 -1)) |
|
1624 |
(org-move-to-column col) |
|
1625 |
(and org-table-overlay-coordinates (org-table-align)))) |
|
1626 |
|
|
1627 |
;;;###autoload |
|
1628 |
(defun org-table-hline-and-move (&optional same-column) |
|
1629 |
"Insert a hline and move to the row below that line." |
|
1630 |
(interactive "P") |
|
1631 |
(let ((col (org-table-current-column))) |
|
1632 |
(org-table-maybe-eval-formula) |
|
1633 |
(org-table-maybe-recalculate-line) |
|
1634 |
(org-table-insert-hline) |
|
1635 |
(end-of-line 2) |
|
1636 |
(if (looking-at "\n[ \t]*|-") |
|
1637 |
(progn (insert "\n|") (org-table-align)) |
|
1638 |
(org-table-next-field)) |
|
1639 |
(if same-column (org-table-goto-column col)))) |
|
1640 |
|
|
1641 |
(defun org-table-clean-line (s) |
|
1642 |
"Convert a table line S into a string with only \"|\" and space. |
|
1643 |
In particular, this does handle wide and invisible characters." |
|
1644 |
(if (string-match "^[ \t]*|-" s) |
|
1645 |
;; It's a hline, just map the characters |
|
1646 |
(setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) |
|
1647 |
(while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) |
|
1648 |
(setq s (replace-match |
|
1649 |
(concat "|" (make-string (org-string-width (match-string 1 s)) |
|
1650 |
?\ ) "|") |
|
1651 |
t t s))) |
|
1652 |
s)) |
|
1653 |
|
|
1654 |
;;;###autoload |
|
1655 |
(defun org-table-kill-row () |
|
1656 |
"Delete the current row or horizontal line from the table." |
|
1657 |
(interactive) |
|
1658 |
(if (not (org-at-table-p)) |
|
1659 |
(user-error "Not at a table")) |
|
1660 |
(let ((col (current-column)) |
|
1661 |
(dline (and (not (org-match-line org-table-hline-regexp)) |
|
1662 |
(org-table-current-dline)))) |
|
1663 |
(kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) |
|
1664 |
(if (not (org-at-table-p)) (beginning-of-line 0)) |
|
1665 |
(org-move-to-column col) |
|
1666 |
(when (and dline |
|
1667 |
(or (not org-table-fix-formulas-confirm) |
|
1668 |
(funcall org-table-fix-formulas-confirm "Fix formulas? "))) |
|
1669 |
(org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) |
|
1670 |
dline -1 dline)))) |
|
1671 |
|
|
1672 |
;;;###autoload |
|
1673 |
(defun org-table-sort-lines |
|
1674 |
(&optional with-case sorting-type getkey-func compare-func interactive?) |
|
1675 |
"Sort table lines according to the column at point. |
|
1676 |
|
|
1677 |
The position of point indicates the column to be used for |
|
1678 |
sorting, and the range of lines is the range between the nearest |
|
1679 |
horizontal separator lines, or the entire table of no such lines |
|
1680 |
exist. If point is before the first column, you will be prompted |
|
1681 |
for the sorting column. If there is an active region, the mark |
|
1682 |
specifies the first line and the sorting column, while point |
|
1683 |
should be in the last line to be included into the sorting. |
|
1684 |
|
|
1685 |
The command then prompts for the sorting type which can be |
|
1686 |
alphabetically, numerically, or by time (as given in a time stamp |
|
1687 |
in the field, or as a HH:MM value). Sorting in reverse order is |
|
1688 |
also possible. |
|
1689 |
|
|
1690 |
With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. |
|
1691 |
|
|
1692 |
If SORTING-TYPE is specified when this function is called from a Lisp |
|
1693 |
program, no prompting will take place. SORTING-TYPE must be a character, |
|
1694 |
any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that |
|
1695 |
sorting should be done in reverse order. |
|
1696 |
|
|
1697 |
If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies |
|
1698 |
a function to be called to extract the key. It must return a value |
|
1699 |
that is compatible with COMPARE-FUNC, the function used to compare |
|
1700 |
entries. |
|
1701 |
|
|
1702 |
A non-nil value for INTERACTIVE? is used to signal that this |
|
1703 |
function is being called interactively." |
|
1704 |
(interactive (list current-prefix-arg nil nil nil t)) |
|
1705 |
(when (org-region-active-p) (goto-char (region-beginning))) |
|
1706 |
;; Point must be either within a field or before a data line. |
|
1707 |
(save-excursion |
|
1708 |
(skip-chars-backward " \t") |
|
1709 |
(when (bolp) (search-forward "|" (line-end-position) t)) |
|
1710 |
(org-table-check-inside-data-field)) |
|
1711 |
;; Set appropriate case sensitivity and column used for sorting. |
|
1712 |
(let ((column (let ((c (org-table-current-column))) |
|
1713 |
(cond ((> c 0) c) |
|
1714 |
(interactive? |
|
1715 |
(read-number "Use column N for sorting: ")) |
|
1716 |
(t 1)))) |
|
1717 |
(sorting-type |
|
1718 |
(or sorting-type |
|
1719 |
(read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \ |
|
1720 |
\[t]ime, [f]unc. A/N/T/F means reversed: ")))) |
|
1721 |
(save-restriction |
|
1722 |
;; Narrow buffer to appropriate sorting area. |
|
1723 |
(if (org-region-active-p) |
|
1724 |
(progn (goto-char (region-beginning)) |
|
1725 |
(narrow-to-region |
|
1726 |
(point) |
|
1727 |
(save-excursion (goto-char (region-end)) |
|
1728 |
(line-beginning-position 2)))) |
|
1729 |
(let ((start (org-table-begin)) |
|
1730 |
(end (org-table-end))) |
|
1731 |
(narrow-to-region |
|
1732 |
(save-excursion |
|
1733 |
(if (re-search-backward org-table-hline-regexp start t) |
|
1734 |
(line-beginning-position 2) |
|
1735 |
start)) |
|
1736 |
(if (save-excursion (re-search-forward org-table-hline-regexp end t)) |
|
1737 |
(match-beginning 0) |
|
1738 |
end)))) |
|
1739 |
;; Determine arguments for `sort-subr'. Also record original |
|
1740 |
;; position. `org-table-save-field' cannot help here since |
|
1741 |
;; sorting is too much destructive. |
|
1742 |
(let* ((sort-fold-case (not with-case)) |
|
1743 |
(coordinates |
|
1744 |
(cons (count-lines (point-min) (line-beginning-position)) |
|
1745 |
(current-column))) |
|
1746 |
(extract-key-from-field |
|
1747 |
;; Function to be called on the contents of the field |
|
1748 |
;; used for sorting in the current row. |
|
1749 |
(cl-case sorting-type |
|
1750 |
((?n ?N) #'string-to-number) |
|
1751 |
((?a ?A) #'org-sort-remove-invisible) |
|
1752 |
((?t ?T) |
|
1753 |
(lambda (f) |
|
1754 |
(cond ((string-match org-ts-regexp-both f) |
|
1755 |
(float-time |
|
1756 |
(org-time-string-to-time (match-string 0 f)))) |
|
1757 |
((org-duration-p f) (org-duration-to-minutes f)) |
|
1758 |
((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f) |
|
1759 |
(org-duration-to-minutes (match-string 0 f))) |
|
1760 |
(t 0)))) |
|
1761 |
((?f ?F) |
|
1762 |
(or getkey-func |
|
1763 |
(and interactive? |
|
1764 |
(org-read-function "Function for extracting keys: ")) |
|
1765 |
(error "Missing key extractor to sort rows"))) |
|
1766 |
(t (user-error "Invalid sorting type `%c'" sorting-type)))) |
|
1767 |
(predicate |
|
1768 |
(cl-case sorting-type |
|
1769 |
((?n ?N ?t ?T) #'<) |
|
1770 |
((?a ?A) #'string<) |
|
1771 |
((?f ?F) |
|
1772 |
(or compare-func |
|
1773 |
(and interactive? |
|
1774 |
(org-read-function |
|
1775 |
(concat "Function for comparing keys " |
|
1776 |
"(empty for default `sort-subr' predicate): ") |
|
1777 |
'allow-empty))))))) |
|
1778 |
(goto-char (point-min)) |
|
1779 |
(sort-subr (memq sorting-type '(?A ?N ?T ?F)) |
|
1780 |
(lambda () |
|
1781 |
(forward-line) |
|
1782 |
(while (and (not (eobp)) |
|
1783 |
(not (looking-at org-table-dataline-regexp))) |
|
1784 |
(forward-line))) |
|
1785 |
#'end-of-line |
|
1786 |
(lambda () |
|
1787 |
(funcall extract-key-from-field |
|
1788 |
(org-trim (org-table-get-field column)))) |
|
1789 |
nil |
|
1790 |
predicate) |
|
1791 |
;; Move back to initial field. |
|
1792 |
(forward-line (car coordinates)) |
|
1793 |
(move-to-column (cdr coordinates)))))) |
|
1794 |
|
|
1795 |
;;;###autoload |
|
1796 |
(defun org-table-cut-region (beg end) |
|
1797 |
"Copy region in table to the clipboard and blank all relevant fields. |
|
1798 |
If there is no active region, use just the field at point." |
|
1799 |
(interactive (list |
|
1800 |
(if (org-region-active-p) (region-beginning) (point)) |
|
1801 |
(if (org-region-active-p) (region-end) (point)))) |
|
1802 |
(org-table-copy-region beg end 'cut)) |
|
1803 |
|
|
1804 |
;;;###autoload |
|
1805 |
(defun org-table-copy-region (beg end &optional cut) |
|
1806 |
"Copy rectangular region in table to clipboard. |
|
1807 |
A special clipboard is used which can only be accessed |
|
1808 |
with `org-table-paste-rectangle'." |
|
1809 |
(interactive (list |
|
1810 |
(if (org-region-active-p) (region-beginning) (point)) |
|
1811 |
(if (org-region-active-p) (region-end) (point)) |
|
1812 |
current-prefix-arg)) |
|
1813 |
(goto-char (min beg end)) |
|
1814 |
(org-table-check-inside-data-field) |
|
1815 |
(let ((beg (line-beginning-position)) |
|
1816 |
(c01 (org-table-current-column)) |
|
1817 |
region) |
|
1818 |
(goto-char (max beg end)) |
|
1819 |
(org-table-check-inside-data-field) |
|
1820 |
(let* ((end (copy-marker (line-end-position))) |
|
1821 |
(c02 (org-table-current-column)) |
|
1822 |
(column-start (min c01 c02)) |
|
1823 |
(column-end (max c01 c02)) |
|
1824 |
(column-number (1+ (- column-end column-start))) |
|
1825 |
(rpl (and cut " "))) |
|
1826 |
(goto-char beg) |
|
1827 |
(while (< (point) end) |
|
1828 |
(unless (org-at-table-hline-p) |
|
1829 |
;; Collect every cell between COLUMN-START and COLUMN-END. |
|
1830 |
(let (cols) |
|
1831 |
(dotimes (c column-number) |
|
1832 |
(push (org-table-get-field (+ c column-start) rpl) cols)) |
|
1833 |
(push (nreverse cols) region))) |
|
1834 |
(forward-line)) |
|
1835 |
(set-marker end nil)) |
|
1836 |
(when cut (org-table-align)) |
|
1837 |
(setq org-table-clip (nreverse region)))) |
|
1838 |
|
|
1839 |
;;;###autoload |
|
1840 |
(defun org-table-paste-rectangle () |
|
1841 |
"Paste a rectangular region into a table. |
|
1842 |
The upper right corner ends up in the current field. All involved fields |
|
1843 |
will be overwritten. If the rectangle does not fit into the present table, |
|
1844 |
the table is enlarged as needed. The process ignores horizontal separator |
|
1845 |
lines." |
|
1846 |
(interactive) |
|
1847 |
(unless (consp org-table-clip) |
|
1848 |
(user-error "First cut/copy a region to paste!")) |
|
1849 |
(org-table-check-inside-data-field) |
|
1850 |
(let* ((column (org-table-current-column)) |
|
1851 |
(org-table-automatic-realign nil)) |
|
1852 |
(org-table-save-field |
|
1853 |
(dolist (row org-table-clip) |
|
1854 |
(while (org-at-table-hline-p) (forward-line)) |
|
1855 |
;; If we left the table, create a new row. |
|
1856 |
(when (and (bolp) (not (looking-at "[ \t]*|"))) |
|
1857 |
(end-of-line 0) |
|
1858 |
(org-table-next-field)) |
|
1859 |
(let ((c column)) |
|
1860 |
(dolist (field row) |
|
1861 |
(org-table-goto-column c nil 'force) |
|
1862 |
(org-table-get-field nil field) |
|
1863 |
(cl-incf c))) |
|
1864 |
(forward-line))) |
|
1865 |
(org-table-align))) |
|
1866 |
|
|
1867 |
;;;###autoload |
|
1868 |
(defun org-table-convert () |
|
1869 |
"Convert from `org-mode' table to table.el and back. |
|
1870 |
Obviously, this only works within limits. When an Org table is converted |
|
1871 |
to table.el, all horizontal separator lines get lost, because table.el uses |
|
1872 |
these as cell boundaries and has no notion of horizontal lines. A table.el |
|
1873 |
table can be converted to an Org table only if it does not do row or column |
|
1874 |
spanning. Multiline cells will become multiple cells. Beware, Org mode |
|
1875 |
does not test if the table can be successfully converted - it blindly |
|
1876 |
applies a recipe that works for simple tables." |
|
1877 |
(interactive) |
|
1878 |
(require 'table) |
|
1879 |
(if (org-at-table.el-p) |
|
1880 |
;; convert to Org table |
|
1881 |
(let ((beg (copy-marker (org-table-begin t))) |
|
1882 |
(end (copy-marker (org-table-end t)))) |
|
1883 |
(table-unrecognize-region beg end) |
|
1884 |
(goto-char beg) |
|
1885 |
(while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) |
|
1886 |
(replace-match "")) |
|
1887 |
(goto-char beg)) |
|
1888 |
(if (org-at-table-p) |
|
1889 |
;; convert to table.el table |
|
1890 |
(let ((beg (copy-marker (org-table-begin))) |
|
1891 |
(end (copy-marker (org-table-end)))) |
|
1892 |
;; first, get rid of all horizontal lines |
|
1893 |
(goto-char beg) |
|
1894 |
(while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) |
|
1895 |
(replace-match "")) |
|
1896 |
;; insert a hline before first |
|
1897 |
(goto-char beg) |
|
1898 |
(org-table-insert-hline 'above) |
|
1899 |
(beginning-of-line -1) |
|
1900 |
;; insert a hline after each line |
|
1901 |
(while (progn (beginning-of-line 3) (< (point) end)) |
|
1902 |
(org-table-insert-hline)) |
|
1903 |
(goto-char beg) |
|
1904 |
(setq end (move-marker end (org-table-end))) |
|
1905 |
;; replace "+" at beginning and ending of hlines |
|
1906 |
(while (re-search-forward "^\\([ \t]*\\)|-" end t) |
|
1907 |
(replace-match "\\1+-")) |
|
1908 |
(goto-char beg) |
|
1909 |
(while (re-search-forward "-|[ \t]*$" end t) |
|
1910 |
(replace-match "-+")) |
|
1911 |
(goto-char beg))))) |
|
1912 |
|
|
1913 |
(defun org-table-transpose-table-at-point () |
|
1914 |
"Transpose Org table at point and eliminate hlines. |
|
1915 |
So a table like |
|
1916 |
|
|
1917 |
| 1 | 2 | 4 | 5 | |
|
1918 |
|---+---+---+---| |
|
1919 |
| a | b | c | d | |
|
1920 |
| e | f | g | h | |
|
1921 |
|
|
1922 |
will be transposed as |
|
1923 |
|
|
1924 |
| 1 | a | e | |
|
1925 |
| 2 | b | f | |
|
1926 |
| 4 | c | g | |
|
1927 |
| 5 | d | h | |
|
1928 |
|
|
1929 |
Note that horizontal lines disappear." |
|
1930 |
(interactive) |
|
1931 |
(let* ((table (delete 'hline (org-table-to-lisp))) |
|
1932 |
(dline_old (org-table-current-line)) |
|
1933 |
(col_old (org-table-current-column)) |
|
1934 |
(contents (mapcar (lambda (_) |
|
1935 |
(let ((tp table)) |
|
1936 |
(mapcar |
|
1937 |
(lambda (_) |
|
1938 |
(prog1 |
|
1939 |
(pop (car tp)) |
|
1940 |
(setq tp (cdr tp)))) |
|
1941 |
table))) |
|
1942 |
(car table)))) |
|
1943 |
(goto-char (org-table-begin)) |
|
1944 |
(re-search-forward "|") |
|
1945 |
(backward-char) |
|
1946 |
(delete-region (point) (org-table-end)) |
|
1947 |
(insert (mapconcat |
|
1948 |
(lambda(x) |
|
1949 |
(concat "| " (mapconcat 'identity x " | " ) " |\n" )) |
|
1950 |
contents "")) |
|
1951 |
(org-table-goto-line col_old) |
|
1952 |
(org-table-goto-column dline_old)) |
|
1953 |
(org-table-align)) |
|
1954 |
|
|
1955 |
;;;###autoload |
|
1956 |
(defun org-table-wrap-region (arg) |
|
1957 |
"Wrap several fields in a column like a paragraph. |
|
1958 |
This is useful if you'd like to spread the contents of a field over several |
|
1959 |
lines, in order to keep the table compact. |
|
1960 |
|
|
1961 |
If there is an active region, and both point and mark are in the same column, |
|
1962 |
the text in the column is wrapped to minimum width for the given number of |
|
1963 |
lines. Generally, this makes the table more compact. A prefix ARG may be |
|
1964 |
used to change the number of desired lines. For example, \ |
|
1965 |
`C-2 \\[org-table-wrap-region]' |
|
1966 |
formats the selected text to two lines. If the region was longer than two |
|
1967 |
lines, the remaining lines remain empty. A negative prefix argument reduces |
|
1968 |
the current number of lines by that amount. The wrapped text is pasted back |
|
1969 |
into the table. If you formatted it to more lines than it was before, fields |
|
1970 |
further down in the table get overwritten - so you might need to make space in |
|
1971 |
the table first. |
|
1972 |
|
|
1973 |
If there is no region, the current field is split at the cursor position and |
|
1974 |
the text fragment to the right of the cursor is prepended to the field one |
|
1975 |
line down. |
|
1976 |
|
|
1977 |
If there is no region, but you specify a prefix ARG, the current field gets |
|
1978 |
blank, and the content is appended to the field above." |
|
1979 |
(interactive "P") |
|
1980 |
(org-table-check-inside-data-field) |
|
1981 |
(if (org-region-active-p) |
|
1982 |
;; There is a region: fill as a paragraph. |
|
1983 |
(let ((start (region-beginning))) |
|
1984 |
(org-table-cut-region (region-beginning) (region-end)) |
|
1985 |
(when (> (length (car org-table-clip)) 1) |
|
1986 |
(user-error "Region must be limited to single column")) |
|
1987 |
(let ((nlines (cond ((not arg) (length org-table-clip)) |
|
1988 |
((< arg 1) (+ (length org-table-clip) arg)) |
|
1989 |
(t arg)))) |
|
1990 |
(setq org-table-clip |
|
1991 |
(mapcar #'list |
|
1992 |
(org-wrap (mapconcat #'car org-table-clip " ") |
|
1993 |
nil |
|
1994 |
nlines)))) |
|
1995 |
(goto-char start) |
|
1996 |
(org-table-paste-rectangle)) |
|
1997 |
;; No region, split the current field at point. |
|
1998 |
(unless (org-get-alist-option org-M-RET-may-split-line 'table) |
|
1999 |
(skip-chars-forward "^\r\n|")) |
|
2000 |
(cond |
|
2001 |
(arg ; Combine with field above. |
|
2002 |
(let ((s (org-table-blank-field)) |
|
2003 |
(col (org-table-current-column))) |
|
2004 |
(forward-line -1) |
|
2005 |
(while (org-at-table-hline-p) (forward-line -1)) |
|
2006 |
(org-table-goto-column col) |
|
2007 |
(skip-chars-forward "^|") |
|
2008 |
(skip-chars-backward " ") |
|
2009 |
(insert " " (org-trim s)) |
|
2010 |
(org-table-align))) |
|
2011 |
((looking-at "\\([^|]+\\)+|") ; Split field. |
|
2012 |
(let ((s (match-string 1))) |
|
2013 |
(replace-match " |") |
|
2014 |
(goto-char (match-beginning 0)) |
|
2015 |
(org-table-next-row) |
|
2016 |
(insert (org-trim s) " ") |
|
2017 |
(org-table-align))) |
|
2018 |
(t (org-table-next-row))))) |
|
2019 |
|
|
2020 |
(defvar org-field-marker nil) |
|
2021 |
|
|
2022 |
;;;###autoload |
|
2023 |
(defun org-table-edit-field (arg) |
|
2024 |
"Edit table field in a different window. |
|
2025 |
This is mainly useful for fields that contain hidden parts. |
|
2026 |
|
|
2027 |
When called with a `\\[universal-argument]' prefix, just make the full field |
|
2028 |
visible so that it can be edited in place. |
|
2029 |
|
|
2030 |
When called with a `\\[universal-argument] \\[universal-argument]' prefix, \ |
|
2031 |
toggle `org-table-follow-field-mode'." |
|
2032 |
(interactive "P") |
|
2033 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
2034 |
(cond |
|
2035 |
((equal arg '(16)) |
|
2036 |
(org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) |
|
2037 |
(arg |
|
2038 |
(let ((b (save-excursion (skip-chars-backward "^|") (point))) |
|
2039 |
(e (save-excursion (skip-chars-forward "^|\r\n") (point)))) |
|
2040 |
(remove-text-properties b e '(org-cwidth t invisible t |
|
2041 |
display t intangible t)) |
|
2042 |
(if (and (boundp 'font-lock-mode) font-lock-mode) |
|
2043 |
(font-lock-fontify-block)))) |
|
2044 |
(t |
|
2045 |
(let ((pos (point-marker)) |
|
2046 |
(coord |
|
2047 |
(if (eq org-table-use-standard-references t) |
|
2048 |
(concat (org-number-to-letters (org-table-current-column)) |
|
2049 |
(int-to-string (org-table-current-dline))) |
|
2050 |
(concat "@" (int-to-string (org-table-current-dline)) |
|
2051 |
"$" (int-to-string (org-table-current-column))))) |
|
2052 |
(field (org-table-get-field)) |
|
2053 |
(cw (current-window-configuration)) |
|
2054 |
p) |
|
2055 |
(goto-char pos) |
|
2056 |
(org-switch-to-buffer-other-window "*Org Table Edit Field*") |
|
2057 |
(when (and (local-variable-p 'org-field-marker) |
|
2058 |
(markerp org-field-marker)) |
|
2059 |
(move-marker org-field-marker nil)) |
|
2060 |
(erase-buffer) |
|
2061 |
(insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n") |
|
2062 |
(let ((org-inhibit-startup t)) (org-mode)) |
|
2063 |
(auto-fill-mode -1) |
|
2064 |
(setq truncate-lines nil) |
|
2065 |
(setq word-wrap t) |
|
2066 |
(goto-char (setq p (point-max))) |
|
2067 |
(insert (org-trim field)) |
|
2068 |
(remove-text-properties p (point-max) |
|
2069 |
'(invisible t org-cwidth t display t |
|
2070 |
intangible t)) |
|
2071 |
(goto-char p) |
|
2072 |
(setq-local org-finish-function 'org-table-finish-edit-field) |
|
2073 |
(setq-local org-window-configuration cw) |
|
2074 |
(setq-local org-field-marker pos) |
|
2075 |
(message "Edit and finish with C-c C-c"))))) |
|
2076 |
|
|
2077 |
(defun org-table-finish-edit-field () |
|
2078 |
"Finish editing a table data field. |
|
2079 |
Remove all newline characters, insert the result into the table, realign |
|
2080 |
the table and kill the editing buffer." |
|
2081 |
(let ((pos org-field-marker) |
|
2082 |
(cw org-window-configuration) |
|
2083 |
(cb (current-buffer)) |
|
2084 |
text) |
|
2085 |
(goto-char (point-min)) |
|
2086 |
(while (re-search-forward "^#.*\n?" nil t) (replace-match "")) |
|
2087 |
(while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) |
|
2088 |
(replace-match " ")) |
|
2089 |
(setq text (org-trim (buffer-string))) |
|
2090 |
(set-window-configuration cw) |
|
2091 |
(kill-buffer cb) |
|
2092 |
(select-window (get-buffer-window (marker-buffer pos))) |
|
2093 |
(goto-char pos) |
|
2094 |
(move-marker pos nil) |
|
2095 |
(org-table-check-inside-data-field) |
|
2096 |
(org-table-get-field nil text) |
|
2097 |
(org-table-align) |
|
2098 |
(message "New field value inserted"))) |
|
2099 |
|
|
2100 |
(define-minor-mode org-table-follow-field-mode |
|
2101 |
"Minor mode to make the table field editor window follow the cursor. |
|
2102 |
When this mode is active, the field editor window will always show the |
|
2103 |
current field. The mode exits automatically when the cursor leaves the |
|
2104 |
table (but see `org-table-exit-follow-field-mode-when-leaving-table')." |
|
2105 |
nil " TblFollow" nil |
|
2106 |
(if org-table-follow-field-mode |
|
2107 |
(add-hook 'post-command-hook 'org-table-follow-fields-with-editor |
|
2108 |
'append 'local) |
|
2109 |
(remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local) |
|
2110 |
(let* ((buf (get-buffer "*Org Table Edit Field*")) |
|
2111 |
(win (and buf (get-buffer-window buf)))) |
|
2112 |
(when win (delete-window win)) |
|
2113 |
(when buf |
|
2114 |
(with-current-buffer buf |
|
2115 |
(move-marker org-field-marker nil)) |
|
2116 |
(kill-buffer buf))))) |
|
2117 |
|
|
2118 |
(defun org-table-follow-fields-with-editor () |
|
2119 |
(if (and org-table-exit-follow-field-mode-when-leaving-table |
|
2120 |
(not (org-at-table-p))) |
|
2121 |
;; We have left the table, exit the follow mode |
|
2122 |
(org-table-follow-field-mode -1) |
|
2123 |
(when (org-table-check-inside-data-field 'noerror) |
|
2124 |
(let ((win (selected-window))) |
|
2125 |
(org-table-edit-field nil) |
|
2126 |
(org-fit-window-to-buffer) |
|
2127 |
(select-window win))))) |
|
2128 |
|
|
2129 |
(defvar org-timecnt) ; dynamically scoped parameter |
|
2130 |
|
|
2131 |
;;;###autoload |
|
2132 |
(defun org-table-sum (&optional beg end nlast) |
|
2133 |
"Sum numbers in region of current table column. |
|
2134 |
The result will be displayed in the echo area, and will be available |
|
2135 |
as kill to be inserted with \\[yank]. |
|
2136 |
|
|
2137 |
If there is an active region, it is interpreted as a rectangle and all |
|
2138 |
numbers in that rectangle will be summed. If there is no active |
|
2139 |
region and point is located in a table column, sum all numbers in that |
|
2140 |
column. |
|
2141 |
|
|
2142 |
If at least one number looks like a time HH:MM or HH:MM:SS, all other |
|
2143 |
numbers are assumed to be times as well (in decimal hours) and the |
|
2144 |
numbers are added as such. |
|
2145 |
|
|
2146 |
If NLAST is a number, only the NLAST fields will actually be summed." |
|
2147 |
(interactive) |
|
2148 |
(save-excursion |
|
2149 |
(let (col (org-timecnt 0) diff h m s org-table-clip) |
|
2150 |
(cond |
|
2151 |
((and beg end)) ; beg and end given explicitly |
|
2152 |
((org-region-active-p) |
|
2153 |
(setq beg (region-beginning) end (region-end))) |
|
2154 |
(t |
|
2155 |
(setq col (org-table-current-column)) |
|
2156 |
(goto-char (org-table-begin)) |
|
2157 |
(unless (re-search-forward "^[ \t]*|[^-]" nil t) |
|
2158 |
(user-error "No table data")) |
|
2159 |
(org-table-goto-column col) |
|
2160 |
(setq beg (point)) |
|
2161 |
(goto-char (org-table-end)) |
|
2162 |
(unless (re-search-backward "^[ \t]*|[^-]" nil t) |
|
2163 |
(user-error "No table data")) |
|
2164 |
(org-table-goto-column col) |
|
2165 |
(setq end (point)))) |
|
2166 |
(let* ((items (apply 'append (org-table-copy-region beg end))) |
|
2167 |
(items1 (cond ((not nlast) items) |
|
2168 |
((>= nlast (length items)) items) |
|
2169 |
(t (setq items (reverse items)) |
|
2170 |
(setcdr (nthcdr (1- nlast) items) nil) |
|
2171 |
(nreverse items)))) |
|
2172 |
(numbers (delq nil (mapcar 'org-table-get-number-for-summing |
|
2173 |
items1))) |
|
2174 |
(res (apply '+ numbers)) |
|
2175 |
(sres (if (= org-timecnt 0) |
|
2176 |
(number-to-string res) |
|
2177 |
(setq diff (* 3600 res) |
|
2178 |
h (floor (/ diff 3600)) diff (mod diff 3600) |
|
2179 |
m (floor (/ diff 60)) diff (mod diff 60) |
|
2180 |
s diff) |
|
2181 |
(format "%.0f:%02.0f:%02.0f" h m s)))) |
|
2182 |
(kill-new sres) |
|
2183 |
(when (called-interactively-p 'interactive) |
|
2184 |
(message "%s" (substitute-command-keys |
|
2185 |
(format "Sum of %d items: %-20s \ |
|
2186 |
\(\\[yank] will insert result into buffer)" (length numbers) sres)))) |
|
2187 |
sres)))) |
|
2188 |
|
|
2189 |
(defun org-table-get-number-for-summing (s) |
|
2190 |
(let (n) |
|
2191 |
(if (string-match "^ *|? *" s) |
|
2192 |
(setq s (replace-match "" nil nil s))) |
|
2193 |
(if (string-match " *|? *$" s) |
|
2194 |
(setq s (replace-match "" nil nil s))) |
|
2195 |
(setq n (string-to-number s)) |
|
2196 |
(cond |
|
2197 |
((and (string-match "0" s) |
|
2198 |
(string-match "\\`[-+ \t0.edED]+\\'" s)) 0) |
|
2199 |
((string-match "\\`[ \t]+\\'" s) nil) |
|
2200 |
((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) |
|
2201 |
(let ((h (string-to-number (or (match-string 1 s) "0"))) |
|
2202 |
(m (string-to-number (or (match-string 2 s) "0"))) |
|
2203 |
(s (string-to-number (or (match-string 4 s) "0")))) |
|
2204 |
(if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) |
|
2205 |
(* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) |
|
2206 |
((equal n 0) nil) |
|
2207 |
(t n)))) |
|
2208 |
|
|
2209 |
(defun org-table-current-field-formula (&optional key noerror) |
|
2210 |
"Return the formula active for the current field. |
|
2211 |
|
|
2212 |
Assumes that table is already analyzed. If KEY is given, return |
|
2213 |
the key to this formula. Otherwise return the formula preceded |
|
2214 |
with \"=\" or \":=\"." |
|
2215 |
(let* ((line (count-lines org-table-current-begin-pos |
|
2216 |
(line-beginning-position))) |
|
2217 |
(row (org-table-line-to-dline line))) |
|
2218 |
(cond |
|
2219 |
(row |
|
2220 |
(let* ((col (org-table-current-column)) |
|
2221 |
(name (car (rassoc (list line col) |
|
2222 |
org-table-named-field-locations))) |
|
2223 |
(scol (format "$%d" col)) |
|
2224 |
(ref (format "@%d$%d" (org-table-current-dline) col)) |
|
2225 |
(stored-list (org-table-get-stored-formulas noerror)) |
|
2226 |
(ass (or (assoc name stored-list) |
|
2227 |
(assoc ref stored-list) |
|
2228 |
(assoc scol stored-list)))) |
|
2229 |
(cond (key (car ass)) |
|
2230 |
(ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=") |
|
2231 |
(cdr ass)))))) |
|
2232 |
(noerror nil) |
|
2233 |
(t (error "No formula active for the current field"))))) |
|
2234 |
|
|
2235 |
(defun org-table-get-formula (&optional equation named) |
|
2236 |
"Read a formula from the minibuffer, offer stored formula as default. |
|
2237 |
When NAMED is non-nil, look for a named equation." |
|
2238 |
(let* ((stored-list (org-table-get-stored-formulas)) |
|
2239 |
(name (car (rassoc (list (count-lines org-table-current-begin-pos |
|
2240 |
(line-beginning-position)) |
|
2241 |
(org-table-current-column)) |
|
2242 |
org-table-named-field-locations))) |
|
2243 |
(ref (format "@%d$%d" |
|
2244 |
(org-table-current-dline) |
|
2245 |
(org-table-current-column))) |
|
2246 |
(scol (cond |
|
2247 |
((not named) (format "$%d" (org-table-current-column))) |
|
2248 |
((and name (not (string-match "\\`LR[0-9]+\\'" name))) name) |
|
2249 |
(t ref))) |
|
2250 |
(name (or name ref)) |
|
2251 |
(org-table-may-need-update nil) |
|
2252 |
(stored (cdr (assoc scol stored-list))) |
|
2253 |
(eq (cond |
|
2254 |
((and stored equation (string-match-p "^ *=? *$" equation)) |
|
2255 |
stored) |
|
2256 |
((stringp equation) |
|
2257 |
equation) |
|
2258 |
(t (org-table-formula-from-user |
|
2259 |
(read-string |
|
2260 |
(org-table-formula-to-user |
|
2261 |
(format "%s formula %s=" |
|
2262 |
(if named "Field" "Column") |
|
2263 |
scol)) |
|
2264 |
(if stored (org-table-formula-to-user stored) "") |
|
2265 |
'org-table-formula-history |
|
2266 |
))))) |
|
2267 |
mustsave) |
|
2268 |
(when (not (string-match "\\S-" eq)) |
|
2269 |
;; remove formula |
|
2270 |
(setq stored-list (delq (assoc scol stored-list) stored-list)) |
|
2271 |
(org-table-store-formulas stored-list) |
|
2272 |
(user-error "Formula removed")) |
|
2273 |
(if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) |
|
2274 |
(if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) |
|
2275 |
(if (and name (not named)) |
|
2276 |
;; We set the column equation, delete the named one. |
|
2277 |
(setq stored-list (delq (assoc name stored-list) stored-list) |
|
2278 |
mustsave t)) |
|
2279 |
(if stored |
|
2280 |
(setcdr (assoc scol stored-list) eq) |
|
2281 |
(setq stored-list (cons (cons scol eq) stored-list))) |
|
2282 |
(if (or mustsave (not (equal stored eq))) |
|
2283 |
(org-table-store-formulas stored-list)) |
|
2284 |
eq)) |
|
2285 |
|
|
2286 |
(defun org-table-store-formulas (alist &optional location) |
|
2287 |
"Store the list of formulas below the current table. |
|
2288 |
If optional argument LOCATION is a buffer position, insert it at |
|
2289 |
LOCATION instead." |
|
2290 |
(save-excursion |
|
2291 |
(if location |
|
2292 |
(progn (goto-char location) (beginning-of-line)) |
|
2293 |
(goto-char (org-table-end))) |
|
2294 |
(let ((case-fold-search t)) |
|
2295 |
(if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)") |
|
2296 |
(progn |
|
2297 |
;; Don't overwrite TBLFM, we might use text properties to |
|
2298 |
;; store stuff. |
|
2299 |
(goto-char (match-beginning 3)) |
|
2300 |
(delete-region (match-beginning 3) (match-end 0))) |
|
2301 |
(org-indent-line) |
|
2302 |
(insert (or (match-string 2) "#+TBLFM:"))) |
|
2303 |
(insert " " |
|
2304 |
(mapconcat (lambda (x) (concat (car x) "=" (cdr x))) |
|
2305 |
(sort alist #'org-table-formula-less-p) |
|
2306 |
"::") |
|
2307 |
"\n")))) |
|
2308 |
|
|
2309 |
(defsubst org-table-formula-make-cmp-string (a) |
|
2310 |
(when (string-match "\\`$[<>]" a) |
|
2311 |
(let ((arrow (string-to-char (substring a 1)))) |
|
2312 |
;; Fake a high number to make sure this is sorted at the end. |
|
2313 |
(setq a (org-table-formula-handle-first/last-rc a)) |
|
2314 |
(setq a (format "$%d" (+ 10000 |
|
2315 |
(if (= arrow ?<) -1000 0) |
|
2316 |
(string-to-number (substring a 1))))))) |
|
2317 |
(when (string-match |
|
2318 |
"^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" |
|
2319 |
a) |
|
2320 |
(concat |
|
2321 |
(if (match-end 2) |
|
2322 |
(format "@%05d" (string-to-number (match-string 2 a))) "") |
|
2323 |
(if (match-end 4) |
|
2324 |
(format "$%05d" (string-to-number (match-string 4 a))) "") |
|
2325 |
(if (match-end 5) |
|
2326 |
(concat "@@" (match-string 5 a)))))) |
|
2327 |
|
|
2328 |
(defun org-table-formula-less-p (a b) |
|
2329 |
"Compare two formulas for sorting." |
|
2330 |
(let ((as (org-table-formula-make-cmp-string (car a))) |
|
2331 |
(bs (org-table-formula-make-cmp-string (car b)))) |
|
2332 |
(and as bs (string< as bs)))) |
|
2333 |
|
|
2334 |
;;;###autoload |
|
2335 |
(defun org-table-get-stored-formulas (&optional noerror location) |
|
2336 |
"Return an alist with the stored formulas directly after current table. |
|
2337 |
By default, only return active formulas, i.e., formulas located |
|
2338 |
on the first line after the table. However, if optional argument |
|
2339 |
LOCATION is a buffer position, consider the formulas there." |
|
2340 |
(save-excursion |
|
2341 |
(if location |
|
2342 |
(progn (goto-char location) (beginning-of-line)) |
|
2343 |
(goto-char (org-table-end))) |
|
2344 |
(let ((case-fold-search t)) |
|
2345 |
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)") |
|
2346 |
(let ((strings (org-split-string (match-string-no-properties 2) |
|
2347 |
" *:: *")) |
|
2348 |
eq-alist seen) |
|
2349 |
(dolist (string strings (nreverse eq-alist)) |
|
2350 |
(when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|\\$\\([_a-zA-Z0-9]+\\|\ |
|
2351 |
[<>]+\\)\\) *= *\\(.*[^ \t]\\)" |
|
2352 |
string) |
|
2353 |
(let ((lhs |
|
2354 |
(let ((m (match-string 1 string))) |
|
2355 |
(cond |
|
2356 |
((not (match-end 2)) m) |
|
2357 |
;; Is it a column reference? |
|
2358 |
((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m) |
|
2359 |
;; Since named columns are not possible in |
|
2360 |
;; LHS, assume this is a named field. |
|
2361 |
(t (match-string 2 string))))) |
|
2362 |
(rhs (match-string 3 string))) |
|
2363 |
(push (cons lhs rhs) eq-alist) |
|
2364 |
(cond |
|
2365 |
((not (member lhs seen)) (push lhs seen)) |
|
2366 |
(noerror |
|
2367 |
(message |
|
2368 |
"Double definition `%s=' in TBLFM line, please fix by hand" |
|
2369 |
lhs) |
|
2370 |
(ding) |
|
2371 |
(sit-for 2)) |
|
2372 |
(t |
|
2373 |
(user-error |
|
2374 |
"Double definition `%s=' in TBLFM line, please fix by hand" |
|
2375 |
lhs))))))))))) |
|
2376 |
|
|
2377 |
(defun org-table-fix-formulas (key replace &optional limit delta remove) |
|
2378 |
"Modify the equations after the table structure has been edited. |
|
2379 |
KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. |
|
2380 |
For all numbers larger than LIMIT, shift them by DELTA." |
|
2381 |
(save-excursion |
|
2382 |
(goto-char (org-table-end)) |
|
2383 |
(while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) |
|
2384 |
(let ((msg "The formulas in #+TBLFM have been updated") |
|
2385 |
(re (concat key "\\([0-9]+\\)")) |
|
2386 |
(re2 |
|
2387 |
(when remove |
|
2388 |
(if (or (equal key "$") (equal key "$LR")) |
|
2389 |
(format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" |
|
2390 |
(regexp-quote key) remove) |
|
2391 |
(format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) |
|
2392 |
s n a) |
|
2393 |
(when remove |
|
2394 |
(while (re-search-forward re2 (point-at-eol) t) |
|
2395 |
(unless (save-match-data (org-in-regexp "remote([^)]+?)")) |
|
2396 |
(if (equal (char-before (match-beginning 0)) ?.) |
|
2397 |
(user-error |
|
2398 |
"Change makes TBLFM term %s invalid, use undo to recover" |
|
2399 |
(match-string 0)) |
|
2400 |
(replace-match ""))))) |
|
2401 |
(while (re-search-forward re (point-at-eol) t) |
|
2402 |
(unless (save-match-data (org-in-regexp "remote([^)]+?)")) |
|
2403 |
(setq s (match-string 1) n (string-to-number s)) |
|
2404 |
(cond |
|
2405 |
((setq a (assoc s replace)) |
|
2406 |
(replace-match (concat key (cdr a)) t t) |
|
2407 |
(message msg)) |
|
2408 |
((and limit (> n limit)) |
|
2409 |
(replace-match (concat key (int-to-string (+ n delta))) t t) |
|
2410 |
(message msg)))))) |
|
2411 |
(forward-line)))) |
|
2412 |
|
|
2413 |
;;;###autoload |
|
2414 |
(defun org-table-maybe-eval-formula () |
|
2415 |
"Check if the current field starts with \"=\" or \":=\". |
|
2416 |
If yes, store the formula and apply it." |
|
2417 |
;; We already know we are in a table. Get field will only return a formula |
|
2418 |
;; when appropriate. It might return a separator line, but no problem. |
|
2419 |
(when org-table-formula-evaluate-inline |
|
2420 |
(let* ((field (org-trim (or (org-table-get-field) ""))) |
|
2421 |
named eq) |
|
2422 |
(when (string-match "^:?=\\(.*[^=]\\)$" field) |
|
2423 |
(setq named (equal (string-to-char field) ?:) |
|
2424 |
eq (match-string 1 field)) |
|
2425 |
(org-table-eval-formula (and named '(4)) |
|
2426 |
(org-table-formula-from-user eq)))))) |
|
2427 |
|
|
2428 |
(defvar org-recalc-commands nil |
|
2429 |
"List of commands triggering the recalculation of a line. |
|
2430 |
Will be filled automatically during use.") |
|
2431 |
|
|
2432 |
(defvar org-recalc-marks |
|
2433 |
'((" " . "Unmarked: no special line, no automatic recalculation") |
|
2434 |
("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") |
|
2435 |
("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") |
|
2436 |
("!" . "Column name definition line. Reference in formula as $name.") |
|
2437 |
("$" . "Parameter definition line name=value. Reference in formula as $name.") |
|
2438 |
("_" . "Names for values in row below this one.") |
|
2439 |
("^" . "Names for values in row above this one."))) |
|
2440 |
|
|
2441 |
;;;###autoload |
|
2442 |
(defun org-table-rotate-recalc-marks (&optional newchar) |
|
2443 |
"Rotate the recalculation mark in the first column. |
|
2444 |
If in any row, the first field is not consistent with a mark, |
|
2445 |
insert a new column for the markers. |
|
2446 |
When there is an active region, change all the lines in the region, |
|
2447 |
after prompting for the marking character. |
|
2448 |
After each change, a message will be displayed indicating the meaning |
|
2449 |
of the new mark." |
|
2450 |
(interactive) |
|
2451 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
2452 |
(let* ((region (org-region-active-p)) |
|
2453 |
(l1 (and region |
|
2454 |
(save-excursion (goto-char (region-beginning)) |
|
2455 |
(copy-marker (line-beginning-position))))) |
|
2456 |
(l2 (and region |
|
2457 |
(save-excursion (goto-char (region-end)) |
|
2458 |
(copy-marker (line-beginning-position))))) |
|
2459 |
(l (copy-marker (line-beginning-position))) |
|
2460 |
(col (org-table-current-column)) |
|
2461 |
(newchar (if region |
|
2462 |
(char-to-string |
|
2463 |
(read-char-exclusive |
|
2464 |
"Change region to what mark? Type # * ! $ or SPC: ")) |
|
2465 |
newchar)) |
|
2466 |
(no-special-column |
|
2467 |
(save-excursion |
|
2468 |
(goto-char (org-table-begin)) |
|
2469 |
(re-search-forward |
|
2470 |
"^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" (org-table-end) t)))) |
|
2471 |
(when (and newchar (not (assoc newchar org-recalc-marks))) |
|
2472 |
(user-error "Invalid character `%s' in `org-table-rotate-recalc-marks'" |
|
2473 |
newchar)) |
|
2474 |
(when l1 (goto-char l1)) |
|
2475 |
(save-excursion |
|
2476 |
(beginning-of-line) |
|
2477 |
(unless (looking-at org-table-dataline-regexp) |
|
2478 |
(user-error "Not at a table data line"))) |
|
2479 |
(when no-special-column |
|
2480 |
(org-table-goto-column 1) |
|
2481 |
(org-table-insert-column)) |
|
2482 |
(let ((previous-line-end (line-end-position)) |
|
2483 |
(newchar |
|
2484 |
(save-excursion |
|
2485 |
(beginning-of-line) |
|
2486 |
(cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#") |
|
2487 |
(newchar) |
|
2488 |
(t (cadr (member (match-string 1) |
|
2489 |
(append (mapcar #'car org-recalc-marks) |
|
2490 |
'(" "))))))))) |
|
2491 |
;; Rotate mark in first row. |
|
2492 |
(org-table-get-field 1 (format " %s " newchar)) |
|
2493 |
;; Rotate marks in additional rows if a region is active. |
|
2494 |
(when region |
|
2495 |
(save-excursion |
|
2496 |
(forward-line) |
|
2497 |
(while (<= (point) l2) |
|
2498 |
(when (looking-at org-table-dataline-regexp) |
|
2499 |
(org-table-get-field 1 (format " %s " newchar))) |
|
2500 |
(forward-line)))) |
|
2501 |
;; Only align if rotation actually changed lines' length. |
|
2502 |
(when (/= previous-line-end (line-end-position)) (org-table-align))) |
|
2503 |
(goto-char l) |
|
2504 |
(org-table-goto-column (if no-special-column (1+ col) col)) |
|
2505 |
(when l1 (set-marker l1 nil)) |
|
2506 |
(when l2 (set-marker l2 nil)) |
|
2507 |
(set-marker l nil) |
|
2508 |
(when (called-interactively-p 'interactive) |
|
2509 |
(message "%s" (cdr (assoc newchar org-recalc-marks)))))) |
|
2510 |
|
|
2511 |
;;;###autoload |
|
2512 |
(defun org-table-analyze () |
|
2513 |
"Analyze table at point and store results. |
|
2514 |
|
|
2515 |
This function sets up the following dynamically scoped variables: |
|
2516 |
|
|
2517 |
`org-table-column-name-regexp', |
|
2518 |
`org-table-column-names', |
|
2519 |
`org-table-current-begin-pos', |
|
2520 |
`org-table-current-line-types', |
|
2521 |
`org-table-current-ncol', |
|
2522 |
`org-table-dlines', |
|
2523 |
`org-table-hlines', |
|
2524 |
`org-table-local-parameters', |
|
2525 |
`org-table-named-field-locations'." |
|
2526 |
(let ((beg (org-table-begin)) |
|
2527 |
(end (org-table-end))) |
|
2528 |
(save-excursion |
|
2529 |
(goto-char beg) |
|
2530 |
;; Extract column names. |
|
2531 |
(setq org-table-column-names nil) |
|
2532 |
(when (save-excursion |
|
2533 |
(re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)) |
|
2534 |
(let ((c 1)) |
|
2535 |
(dolist (name (org-split-string (match-string 1) " *| *")) |
|
2536 |
(cl-incf c) |
|
2537 |
(when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name) |
|
2538 |
(push (cons name (int-to-string c)) org-table-column-names))))) |
|
2539 |
(setq org-table-column-names (nreverse org-table-column-names)) |
|
2540 |
(setq org-table-column-name-regexp |
|
2541 |
(format "\\$\\(%s\\)\\>" |
|
2542 |
(regexp-opt (mapcar #'car org-table-column-names) t))) |
|
2543 |
;; Extract local parameters. |
|
2544 |
(setq org-table-local-parameters nil) |
|
2545 |
(save-excursion |
|
2546 |
(while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) |
|
2547 |
(dolist (field (org-split-string (match-string 1) " *| *")) |
|
2548 |
(when (string-match |
|
2549 |
"\\`\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) |
|
2550 |
(push (cons (match-string 1 field) (match-string 2 field)) |
|
2551 |
org-table-local-parameters))))) |
|
2552 |
;; Update named fields locations. We minimize `count-lines' |
|
2553 |
;; processing by storing last known number of lines in LAST. |
|
2554 |
(setq org-table-named-field-locations nil) |
|
2555 |
(save-excursion |
|
2556 |
(let ((last (cons (point) 0))) |
|
2557 |
(while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) |
|
2558 |
(let ((c (match-string 1)) |
|
2559 |
(fields (org-split-string (match-string 2) " *| *"))) |
|
2560 |
(save-excursion |
|
2561 |
(forward-line (if (equal c "_") 1 -1)) |
|
2562 |
(let ((fields1 |
|
2563 |
(and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") |
|
2564 |
(org-split-string (match-string 1) " *| *"))) |
|
2565 |
(line (cl-incf (cdr last) (count-lines (car last) (point)))) |
|
2566 |
(col 1)) |
|
2567 |
(setcar last (point)) ; Update last known position. |
|
2568 |
(while (and fields fields1) |
|
2569 |
(let ((field (pop fields)) |
|
2570 |
(v (pop fields1))) |
|
2571 |
(cl-incf col) |
|
2572 |
(when (and (stringp field) |
|
2573 |
(stringp v) |
|
2574 |
(string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" |
|
2575 |
field)) |
|
2576 |
(push (cons field v) org-table-local-parameters) |
|
2577 |
(push (list field line col) |
|
2578 |
org-table-named-field-locations)))))))))) |
|
2579 |
;; Re-use existing markers when possible. |
|
2580 |
(if (markerp org-table-current-begin-pos) |
|
2581 |
(move-marker org-table-current-begin-pos (point)) |
|
2582 |
(setq org-table-current-begin-pos (point-marker))) |
|
2583 |
;; Analyze the line types. |
|
2584 |
(let ((l 0) hlines dlines types) |
|
2585 |
(while (looking-at "[ \t]*|\\(-\\)?") |
|
2586 |
(push (if (match-end 1) 'hline 'dline) types) |
|
2587 |
(if (match-end 1) (push l hlines) (push l dlines)) |
|
2588 |
(forward-line) |
|
2589 |
(cl-incf l)) |
|
2590 |
(push 'hline types) ; Add an imaginary extra hline to the end. |
|
2591 |
(setq org-table-current-line-types (apply #'vector (nreverse types))) |
|
2592 |
(setq org-table-dlines (apply #'vector (cons nil (nreverse dlines)))) |
|
2593 |
(setq org-table-hlines (apply #'vector (cons nil (nreverse hlines))))) |
|
2594 |
;; Get the number of columns from the first data line in table. |
|
2595 |
(goto-char beg) |
|
2596 |
(forward-line (aref org-table-dlines 1)) |
|
2597 |
(let* ((fields |
|
2598 |
(org-split-string |
|
2599 |
(buffer-substring (line-beginning-position) (line-end-position)) |
|
2600 |
"[ \t]*|[ \t]*")) |
|
2601 |
(nfields (length fields)) |
|
2602 |
al al2) |
|
2603 |
(setq org-table-current-ncol nfields) |
|
2604 |
(let ((last-dline |
|
2605 |
(aref org-table-dlines (1- (length org-table-dlines))))) |
|
2606 |
(dotimes (i nfields) |
|
2607 |
(let ((column (1+ i))) |
|
2608 |
(push (list (format "LR%d" column) last-dline column) al) |
|
2609 |
(push (cons (format "LR%d" column) (nth i fields)) al2)))) |
|
2610 |
(setq org-table-named-field-locations |
|
2611 |
(append org-table-named-field-locations al)) |
|
2612 |
(setq org-table-local-parameters |
|
2613 |
(append org-table-local-parameters al2)))))) |
|
2614 |
|
|
2615 |
(defun org-table-goto-field (ref &optional create-column-p) |
|
2616 |
"Move point to a specific field in the current table. |
|
2617 |
|
|
2618 |
REF is either the name of a field its absolute reference, as |
|
2619 |
a string. No column is created unless CREATE-COLUMN-P is |
|
2620 |
non-nil. If it is a function, it is called with the column |
|
2621 |
number as its argument as is used as a predicate to know if the |
|
2622 |
column can be created. |
|
2623 |
|
|
2624 |
This function assumes the table is already analyzed (i.e., using |
|
2625 |
`org-table-analyze')." |
|
2626 |
(let* ((coordinates |
|
2627 |
(cond |
|
2628 |
((cdr (assoc ref org-table-named-field-locations))) |
|
2629 |
((string-match "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" ref) |
|
2630 |
(list (condition-case nil |
|
2631 |
(aref org-table-dlines |
|
2632 |
(string-to-number (match-string 1 ref))) |
|
2633 |
(error (user-error "Invalid row number in %s" ref))) |
|
2634 |
(string-to-number (match-string 2 ref)))) |
|
2635 |
(t (user-error "Unknown field: %s" ref)))) |
|
2636 |
(line (car coordinates)) |
|
2637 |
(column (nth 1 coordinates)) |
|
2638 |
(create-new-column (if (functionp create-column-p) |
|
2639 |
(funcall create-column-p column) |
|
2640 |
create-column-p))) |
|
2641 |
(when coordinates |
|
2642 |
(goto-char org-table-current-begin-pos) |
|
2643 |
(forward-line line) |
|
2644 |
(org-table-goto-column column nil create-new-column)))) |
|
2645 |
|
|
2646 |
;;;###autoload |
|
2647 |
(defun org-table-maybe-recalculate-line () |
|
2648 |
"Recompute the current line if marked for it, and if we haven't just done it." |
|
2649 |
(interactive) |
|
2650 |
(and org-table-allow-automatic-line-recalculation |
|
2651 |
(not (and (memq last-command org-recalc-commands) |
|
2652 |
(eq org-last-recalc-line (line-beginning-position)))) |
|
2653 |
(save-excursion (beginning-of-line 1) |
|
2654 |
(looking-at org-table-auto-recalculate-regexp)) |
|
2655 |
(org-table-recalculate) t)) |
|
2656 |
|
|
2657 |
(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula' |
|
2658 |
(defsubst org-set-calc-mode (var &optional value) |
|
2659 |
(if (stringp var) |
|
2660 |
(setq var (assoc var '(("D" calc-angle-mode deg) |
|
2661 |
("R" calc-angle-mode rad) |
|
2662 |
("F" calc-prefer-frac t) |
|
2663 |
("S" calc-symbolic-mode t))) |
|
2664 |
value (nth 2 var) var (nth 1 var))) |
|
2665 |
(if (memq var org-tbl-calc-modes) |
|
2666 |
(setcar (cdr (memq var org-tbl-calc-modes)) value) |
|
2667 |
(cons var (cons value org-tbl-calc-modes))) |
|
2668 |
org-tbl-calc-modes) |
|
2669 |
|
|
2670 |
;;;###autoload |
|
2671 |
(defun org-table-eval-formula (&optional arg equation |
|
2672 |
suppress-align suppress-const |
|
2673 |
suppress-store suppress-analysis) |
|
2674 |
"Replace the table field value at the cursor by the result of a calculation. |
|
2675 |
|
|
2676 |
In a table, this command replaces the value in the current field with the |
|
2677 |
result of a formula. It also installs the formula as the \"current\" column |
|
2678 |
formula, by storing it in a special line below the table. When called |
|
2679 |
with a `\\[universal-argument]' prefix the formula is installed as a \ |
|
2680 |
field formula. |
|
2681 |
|
|
2682 |
When called with a `\\[universal-argument] \\[universal-argument]' prefix, \ |
|
2683 |
insert the active equation for the field |
|
2684 |
back into the current field, so that it can be edited there. This is \ |
|
2685 |
useful |
|
2686 |
in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to \ |
|
2687 |
check the referenced fields. |
|
2688 |
|
|
2689 |
When called, the command first prompts for a formula, which is read in |
|
2690 |
the minibuffer. Previously entered formulas are available through the |
|
2691 |
history list, and the last used formula is offered as a default. |
|
2692 |
These stored formulas are adapted correctly when moving, inserting, or |
|
2693 |
deleting columns with the corresponding commands. |
|
2694 |
|
|
2695 |
The formula can be any algebraic expression understood by the Calc package. |
|
2696 |
For details, see the Org mode manual. |
|
2697 |
|
|
2698 |
This function can also be called from Lisp programs and offers |
|
2699 |
additional arguments: EQUATION can be the formula to apply. If this |
|
2700 |
argument is given, the user will not be prompted. |
|
2701 |
|
|
2702 |
SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing |
|
2703 |
unnecessary aligns. |
|
2704 |
|
|
2705 |
SUPPRESS-CONST suppresses the interpretation of constants in the |
|
2706 |
formula, assuming that this has been done already outside the |
|
2707 |
function. |
|
2708 |
|
|
2709 |
SUPPRESS-STORE means the formula should not be stored, either |
|
2710 |
because it is already stored, or because it is a modified |
|
2711 |
equation that should not overwrite the stored one. |
|
2712 |
|
|
2713 |
SUPPRESS-ANALYSIS prevents analyzing the table and checking |
|
2714 |
location of point." |
|
2715 |
(interactive "P") |
|
2716 |
(unless suppress-analysis |
|
2717 |
(org-table-check-inside-data-field) |
|
2718 |
(org-table-analyze)) |
|
2719 |
(if (equal arg '(16)) |
|
2720 |
(let ((eq (org-table-current-field-formula))) |
|
2721 |
(org-table-get-field nil eq) |
|
2722 |
(org-table-align) |
|
2723 |
(setq org-table-may-need-update t)) |
|
2724 |
(let* (fields |
|
2725 |
(ndown (if (integerp arg) arg 1)) |
|
2726 |
(org-table-automatic-realign nil) |
|
2727 |
(case-fold-search nil) |
|
2728 |
(down (> ndown 1)) |
|
2729 |
(formula (if (and equation suppress-store) |
|
2730 |
equation |
|
2731 |
(org-table-get-formula equation (equal arg '(4))))) |
|
2732 |
(n0 (org-table-current-column)) |
|
2733 |
(org-tbl-calc-modes (copy-sequence org-calc-default-modes)) |
|
2734 |
(numbers nil) ; was a variable, now fixed default |
|
2735 |
(keep-empty nil) |
|
2736 |
n form form0 formrpl formrg bw fmt x ev orig c lispp literal |
|
2737 |
duration duration-output-format) |
|
2738 |
;; Parse the format string. Since we have a lot of modes, this is |
|
2739 |
;; a lot of work. However, I think calc still uses most of the time. |
|
2740 |
(if (string-match ";" formula) |
|
2741 |
(let ((tmp (org-split-string formula ";"))) |
|
2742 |
(setq formula (car tmp) |
|
2743 |
fmt (concat (cdr (assoc "%" org-table-local-parameters)) |
|
2744 |
(nth 1 tmp))) |
|
2745 |
(while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) |
|
2746 |
(setq c (string-to-char (match-string 1 fmt)) |
|
2747 |
n (string-to-number (match-string 2 fmt))) |
|
2748 |
(if (= c ?p) |
|
2749 |
(setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n)) |
|
2750 |
(setq org-tbl-calc-modes |
|
2751 |
(org-set-calc-mode |
|
2752 |
'calc-float-format |
|
2753 |
(list (cdr (assoc c '((?n . float) (?f . fix) |
|
2754 |
(?s . sci) (?e . eng)))) |
|
2755 |
n)))) |
|
2756 |
(setq fmt (replace-match "" t t fmt))) |
|
2757 |
(if (string-match "[tTU]" fmt) |
|
2758 |
(let ((ff (match-string 0 fmt))) |
|
2759 |
(setq duration t numbers t |
|
2760 |
duration-output-format |
|
2761 |
(cond ((equal ff "T") nil) |
|
2762 |
((equal ff "t") org-table-duration-custom-format) |
|
2763 |
((equal ff "U") 'hh:mm)) |
|
2764 |
fmt (replace-match "" t t fmt)))) |
|
2765 |
(if (string-match "N" fmt) |
|
2766 |
(setq numbers t |
|
2767 |
fmt (replace-match "" t t fmt))) |
|
2768 |
(if (string-match "L" fmt) |
|
2769 |
(setq literal t |
|
2770 |
fmt (replace-match "" t t fmt))) |
|
2771 |
(if (string-match "E" fmt) |
|
2772 |
(setq keep-empty t |
|
2773 |
fmt (replace-match "" t t fmt))) |
|
2774 |
(while (string-match "[DRFS]" fmt) |
|
2775 |
(setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt))) |
|
2776 |
(setq fmt (replace-match "" t t fmt))) |
|
2777 |
(unless (string-match "\\S-" fmt) |
|
2778 |
(setq fmt nil)))) |
|
2779 |
(when (and (not suppress-const) org-table-formula-use-constants) |
|
2780 |
(setq formula (org-table-formula-substitute-names formula))) |
|
2781 |
(setq orig (or (get-text-property 1 :orig-formula formula) "?")) |
|
2782 |
(setq formula (org-table-formula-handle-first/last-rc formula)) |
|
2783 |
(while (> ndown 0) |
|
2784 |
(setq fields (org-split-string |
|
2785 |
(org-trim |
|
2786 |
(buffer-substring-no-properties |
|
2787 |
(line-beginning-position) (line-end-position))) |
|
2788 |
" *| *")) |
|
2789 |
;; replace fields with duration values if relevant |
|
2790 |
(if duration |
|
2791 |
(setq fields |
|
2792 |
(mapcar (lambda (x) (org-table-time-string-to-seconds x)) |
|
2793 |
fields))) |
|
2794 |
(if (eq numbers t) |
|
2795 |
(setq fields (mapcar |
|
2796 |
(lambda (x) |
|
2797 |
(if (string-match "\\S-" x) |
|
2798 |
(number-to-string (string-to-number x)) |
|
2799 |
x)) |
|
2800 |
fields))) |
|
2801 |
(setq ndown (1- ndown)) |
|
2802 |
(setq form (copy-sequence formula) |
|
2803 |
lispp (and (> (length form) 2) (equal (substring form 0 2) "'("))) |
|
2804 |
(if (and lispp literal) (setq lispp 'literal)) |
|
2805 |
|
|
2806 |
;; Insert row and column number of formula result field |
|
2807 |
(while (string-match "[@$]#" form) |
|
2808 |
(setq form |
|
2809 |
(replace-match |
|
2810 |
(format "%d" |
|
2811 |
(save-match-data |
|
2812 |
(if (equal (substring form (match-beginning 0) |
|
2813 |
(1+ (match-beginning 0))) |
|
2814 |
"@") |
|
2815 |
(org-table-current-dline) |
|
2816 |
(org-table-current-column)))) |
|
2817 |
t t form))) |
|
2818 |
|
|
2819 |
;; Check for old vertical references |
|
2820 |
(org-table--error-on-old-row-references form) |
|
2821 |
;; Insert remote references |
|
2822 |
(setq form (org-table-remote-reference-indirection form)) |
|
2823 |
(while (string-match "\\<remote([ \t]*\\([^,)]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form) |
|
2824 |
(setq form |
|
2825 |
(replace-match |
|
2826 |
(save-match-data |
|
2827 |
(org-table-make-reference |
|
2828 |
(let ((rmtrng (org-table-get-remote-range |
|
2829 |
(match-string 1 form) (match-string 2 form)))) |
|
2830 |
(if duration |
|
2831 |
(if (listp rmtrng) |
|
2832 |
(mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng) |
|
2833 |
(org-table-time-string-to-seconds rmtrng)) |
|
2834 |
rmtrng)) |
|
2835 |
keep-empty numbers lispp)) |
|
2836 |
t t form))) |
|
2837 |
;; Insert complex ranges |
|
2838 |
(while (and (string-match org-table-range-regexp form) |
|
2839 |
(> (length (match-string 0 form)) 1)) |
|
2840 |
(setq formrg |
|
2841 |
(save-match-data |
|
2842 |
(org-table-get-range |
|
2843 |
(match-string 0 form) org-table-current-begin-pos n0))) |
|
2844 |
(setq formrpl |
|
2845 |
(save-match-data |
|
2846 |
(org-table-make-reference |
|
2847 |
;; possibly handle durations |
|
2848 |
(if duration |
|
2849 |
(if (listp formrg) |
|
2850 |
(mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg) |
|
2851 |
(org-table-time-string-to-seconds formrg)) |
|
2852 |
formrg) |
|
2853 |
keep-empty numbers lispp))) |
|
2854 |
(if (not (save-match-data |
|
2855 |
(string-match (regexp-quote form) formrpl))) |
|
2856 |
(setq form (replace-match formrpl t t form)) |
|
2857 |
(user-error "Spreadsheet error: invalid reference \"%s\"" form))) |
|
2858 |
;; Insert simple ranges, i.e. included in the current row. |
|
2859 |
(while (string-match |
|
2860 |
"\\$\\(\\([-+]\\)?[0-9]+\\)\\.\\.\\$\\(\\([-+]\\)?[0-9]+\\)" |
|
2861 |
form) |
|
2862 |
(setq form |
|
2863 |
(replace-match |
|
2864 |
(save-match-data |
|
2865 |
(org-table-make-reference |
|
2866 |
(cl-subseq fields |
|
2867 |
(+ (if (match-end 2) n0 0) |
|
2868 |
(string-to-number (match-string 1 form)) |
|
2869 |
-1) |
|
2870 |
(+ (if (match-end 4) n0 0) |
|
2871 |
(string-to-number (match-string 3 form)))) |
|
2872 |
keep-empty numbers lispp)) |
|
2873 |
t t form))) |
|
2874 |
(setq form0 form) |
|
2875 |
;; Insert the references to fields in same row |
|
2876 |
(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form) |
|
2877 |
(setq n (+ (string-to-number (match-string 1 form)) |
|
2878 |
(if (match-end 2) n0 0)) |
|
2879 |
x (nth (1- (if (= n 0) n0 (max n 1))) fields) |
|
2880 |
formrpl (save-match-data |
|
2881 |
(org-table-make-reference |
|
2882 |
x keep-empty numbers lispp))) |
|
2883 |
(when (or (not x) |
|
2884 |
(save-match-data |
|
2885 |
(string-match (regexp-quote formula) formrpl))) |
|
2886 |
(user-error "Invalid field specifier \"%s\"" |
|
2887 |
(match-string 0 form))) |
|
2888 |
(setq form (replace-match formrpl t t form))) |
|
2889 |
|
|
2890 |
(if lispp |
|
2891 |
(setq ev (condition-case nil |
|
2892 |
(eval (eval (read form))) |
|
2893 |
(error "#ERROR")) |
|
2894 |
ev (if (numberp ev) (number-to-string ev) ev) |
|
2895 |
ev (if duration (org-table-time-seconds-to-string |
|
2896 |
(string-to-number ev) |
|
2897 |
duration-output-format) ev)) |
|
2898 |
|
|
2899 |
;; Use <...> time-stamps so that Calc can handle them. |
|
2900 |
(setq form |
|
2901 |
(replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form)) |
|
2902 |
;; Internationalize local time-stamps by setting locale to |
|
2903 |
;; "C". |
|
2904 |
(setq form |
|
2905 |
(replace-regexp-in-string |
|
2906 |
org-ts-regexp |
|
2907 |
(lambda (ts) |
|
2908 |
(let ((system-time-locale "C")) |
|
2909 |
(format-time-string |
|
2910 |
(org-time-stamp-format |
|
2911 |
(string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) |
|
2912 |
(apply #'encode-time |
|
2913 |
(save-match-data (org-parse-time-string ts)))))) |
|
2914 |
form t t)) |
|
2915 |
|
|
2916 |
(setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) |
|
2917 |
form |
|
2918 |
(calc-eval (cons form org-tbl-calc-modes) |
|
2919 |
(when (and (not keep-empty) numbers) 'num))) |
|
2920 |
ev (if duration (org-table-time-seconds-to-string |
|
2921 |
(if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) |
|
2922 |
(string-to-number (org-table-time-string-to-seconds ev)) |
|
2923 |
(string-to-number ev)) |
|
2924 |
duration-output-format) |
|
2925 |
ev))) |
|
2926 |
|
|
2927 |
(when org-table-formula-debug |
|
2928 |
(with-output-to-temp-buffer "*Substitution History*" |
|
2929 |
(princ (format "Substitution history of formula |
|
2930 |
Orig: %s |
|
2931 |
$xyz-> %s |
|
2932 |
@r$c-> %s |
|
2933 |
$1-> %s\n" orig formula form0 form)) |
|
2934 |
(if (consp ev) |
|
2935 |
(princ (format " %s^\nError: %s" |
|
2936 |
(make-string (car ev) ?\-) (nth 1 ev))) |
|
2937 |
(princ (format "Result: %s\nFormat: %s\nFinal: %s" |
|
2938 |
ev (or fmt "NONE") |
|
2939 |
(if fmt (format fmt (string-to-number ev)) ev))))) |
|
2940 |
(setq bw (get-buffer-window "*Substitution History*")) |
|
2941 |
(org-fit-window-to-buffer bw) |
|
2942 |
(unless (and (called-interactively-p 'any) (not ndown)) |
|
2943 |
(unless (let (inhibit-redisplay) |
|
2944 |
(y-or-n-p "Debugging Formula. Continue to next? ")) |
|
2945 |
(org-table-align) |
|
2946 |
(user-error "Abort")) |
|
2947 |
(delete-window bw) |
|
2948 |
(message ""))) |
|
2949 |
(when (consp ev) (setq fmt nil ev "#ERROR")) |
|
2950 |
(org-table-justify-field-maybe |
|
2951 |
(format org-table-formula-field-format |
|
2952 |
(cond |
|
2953 |
((not (stringp ev)) ev) |
|
2954 |
(fmt (format fmt (string-to-number ev))) |
|
2955 |
;; Replace any active time stamp in the result with |
|
2956 |
;; an inactive one. Dates in tables are likely |
|
2957 |
;; piece of regular data, not meant to appear in the |
|
2958 |
;; agenda. |
|
2959 |
(t (replace-regexp-in-string org-ts-regexp "[\\1]" ev))))) |
|
2960 |
(if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) |
|
2961 |
(call-interactively 'org-return) |
|
2962 |
(setq ndown 0))) |
|
2963 |
(and down (org-table-maybe-recalculate-line)) |
|
2964 |
(or suppress-align (and org-table-may-need-update |
|
2965 |
(org-table-align)))))) |
|
2966 |
|
|
2967 |
(defun org-table-put-field-property (prop value) |
|
2968 |
(save-excursion |
|
2969 |
(put-text-property (progn (skip-chars-backward "^|") (point)) |
|
2970 |
(progn (skip-chars-forward "^|") (point)) |
|
2971 |
prop value))) |
|
2972 |
|
|
2973 |
(defun org-table-get-range (desc &optional tbeg col highlight corners-only) |
|
2974 |
"Get a calc vector from a column, according to descriptor DESC. |
|
2975 |
|
|
2976 |
Optional arguments TBEG and COL can give the beginning of the table and |
|
2977 |
the current column, to avoid unnecessary parsing. |
|
2978 |
|
|
2979 |
HIGHLIGHT means just highlight the range. |
|
2980 |
|
|
2981 |
When CORNERS-ONLY is set, only return the corners of the range as |
|
2982 |
a list (line1 column1 line2 column2) where line1 and line2 are |
|
2983 |
line numbers relative to beginning of table, or TBEG, and column1 |
|
2984 |
and column2 are table column numbers." |
|
2985 |
(let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc) |
|
2986 |
(replace-regexp-in-string "\\$" "@0$" desc) |
|
2987 |
desc)) |
|
2988 |
(col (or col (org-table-current-column))) |
|
2989 |
(tbeg (or tbeg (org-table-begin))) |
|
2990 |
(thisline (count-lines tbeg (line-beginning-position)))) |
|
2991 |
(unless (string-match org-table-range-regexp desc) |
|
2992 |
(user-error "Invalid table range specifier `%s'" desc)) |
|
2993 |
(let ((rangep (match-end 3)) |
|
2994 |
(r1 (let ((r (and (match-end 1) (match-string 1 desc)))) |
|
2995 |
(or (save-match-data |
|
2996 |
(and (org-string-nw-p r) |
|
2997 |
(org-table--descriptor-line r thisline))) |
|
2998 |
thisline))) |
|
2999 |
(r2 (let ((r (and (match-end 4) (match-string 4 desc)))) |
|
3000 |
(or (save-match-data |
|
3001 |
(and (org-string-nw-p r) |
|
3002 |
(org-table--descriptor-line r thisline))) |
|
3003 |
thisline))) |
|
3004 |
(c1 (let ((c (and (match-end 2) (substring (match-string 2 desc) 1)))) |
|
3005 |
(if (or (not c) (= (string-to-number c) 0)) col |
|
3006 |
(+ (string-to-number c) |
|
3007 |
(if (memq (string-to-char c) '(?- ?+)) col 0))))) |
|
3008 |
(c2 (let ((c (and (match-end 5) (substring (match-string 5 desc) 1)))) |
|
3009 |
(if (or (not c) (= (string-to-number c) 0)) col |
|
3010 |
(+ (string-to-number c) |
|
3011 |
(if (memq (string-to-char c) '(?- ?+)) col 0)))))) |
|
3012 |
(save-excursion |
|
3013 |
(if (and (not corners-only) |
|
3014 |
(or (not rangep) (and (= r1 r2) (= c1 c2)))) |
|
3015 |
;; Just one field. |
|
3016 |
(progn |
|
3017 |
(forward-line (- r1 thisline)) |
|
3018 |
(while (not (looking-at org-table-dataline-regexp)) |
|
3019 |
(forward-line)) |
|
3020 |
(prog1 (org-trim (org-table-get-field c1)) |
|
3021 |
(when highlight (org-table-highlight-rectangle)))) |
|
3022 |
;; A range, return a vector. First sort the numbers to get |
|
3023 |
;; a regular rectangle. |
|
3024 |
(let ((first-row (min r1 r2)) |
|
3025 |
(last-row (max r1 r2)) |
|
3026 |
(first-column (min c1 c2)) |
|
3027 |
(last-column (max c1 c2))) |
|
3028 |
(if corners-only (list first-row first-column last-row last-column) |
|
3029 |
;; Copy the range values into a list. |
|
3030 |
(forward-line (- first-row thisline)) |
|
3031 |
(while (not (looking-at org-table-dataline-regexp)) |
|
3032 |
(forward-line) |
|
3033 |
(cl-incf first-row)) |
|
3034 |
(org-table-goto-column first-column) |
|
3035 |
(let ((beg (point))) |
|
3036 |
(forward-line (- last-row first-row)) |
|
3037 |
(while (not (looking-at org-table-dataline-regexp)) |
|
3038 |
(forward-line -1)) |
|
3039 |
(org-table-goto-column last-column) |
|
3040 |
(let ((end (point))) |
|
3041 |
(when highlight |
|
3042 |
(org-table-highlight-rectangle |
|
3043 |
beg (progn (skip-chars-forward "^|\n") (point)))) |
|
3044 |
;; Return string representation of calc vector. |
|
3045 |
(mapcar #'org-trim |
|
3046 |
(apply #'append |
|
3047 |
(org-table-copy-region beg end)))))))))))) |
|
3048 |
|
|
3049 |
(defun org-table--descriptor-line (desc cline) |
|
3050 |
"Return relative line number corresponding to descriptor DESC. |
|
3051 |
The cursor is currently in relative line number CLINE." |
|
3052 |
(if (string-match "\\`[0-9]+\\'" desc) |
|
3053 |
(aref org-table-dlines (string-to-number desc)) |
|
3054 |
(when (or (not (string-match |
|
3055 |
"^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" |
|
3056 |
;; 1 2 3 4 5 6 |
|
3057 |
desc)) |
|
3058 |
(and (not (match-end 3)) (not (match-end 6))) |
|
3059 |
(and (match-end 3) (match-end 6) (not (match-end 5)))) |
|
3060 |
(user-error "Invalid row descriptor `%s'" desc)) |
|
3061 |
(let* ((hn (and (match-end 3) (- (match-end 3) (match-beginning 3)))) |
|
3062 |
(hdir (match-string 2 desc)) |
|
3063 |
(odir (match-string 5 desc)) |
|
3064 |
(on (and (match-end 6) (string-to-number (match-string 6 desc)))) |
|
3065 |
(rel (and (match-end 6) |
|
3066 |
(or (and (match-end 1) (not (match-end 3))) |
|
3067 |
(match-end 5))))) |
|
3068 |
(when (and hn (not hdir)) |
|
3069 |
(setq cline 0) |
|
3070 |
(setq hdir "+") |
|
3071 |
(when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn))) |
|
3072 |
(when (and (not hn) on (not odir)) (user-error "Should never happen")) |
|
3073 |
(when hn |
|
3074 |
(setq cline |
|
3075 |
(org-table--row-type 'hline hn cline (equal hdir "-") nil desc))) |
|
3076 |
(when on |
|
3077 |
(setq cline |
|
3078 |
(org-table--row-type 'dline on cline (equal odir "-") rel desc))) |
|
3079 |
cline))) |
|
3080 |
|
|
3081 |
(defun org-table--row-type (type n i backwards relative desc) |
|
3082 |
"Return relative line of Nth row with type TYPE. |
|
3083 |
Search starts from relative line I. When BACKWARDS in non-nil, |
|
3084 |
look before I. When RELATIVE is non-nil, the reference is |
|
3085 |
relative. DESC is the original descriptor that started the |
|
3086 |
search, as a string." |
|
3087 |
(let ((l (length org-table-current-line-types))) |
|
3088 |
(catch :exit |
|
3089 |
(dotimes (_ n) |
|
3090 |
(while (and (cl-incf i (if backwards -1 1)) |
|
3091 |
(>= i 0) |
|
3092 |
(< i l) |
|
3093 |
(not (eq (aref org-table-current-line-types i) type)) |
|
3094 |
;; We are going to cross a hline. Check if this is |
|
3095 |
;; an authorized move. |
|
3096 |
(cond |
|
3097 |
((not relative)) |
|
3098 |
((not (eq (aref org-table-current-line-types i) 'hline))) |
|
3099 |
((eq org-table-relative-ref-may-cross-hline t)) |
|
3100 |
((eq org-table-relative-ref-may-cross-hline 'error) |
|
3101 |
(user-error "Row descriptor %s crosses hline" desc)) |
|
3102 |
(t (cl-decf i (if backwards -1 1)) ; Step back. |
|
3103 |
(throw :exit nil))))))) |
|
3104 |
(cond ((or (< i 0) (>= i l)) |
|
3105 |
(user-error "Row descriptor %s leads outside table" desc)) |
|
3106 |
;; The last hline doesn't exist. Instead, point to last row |
|
3107 |
;; in table. |
|
3108 |
((= i (1- l)) (1- i)) |
|
3109 |
(t i)))) |
|
3110 |
|
|
3111 |
(defun org-table--error-on-old-row-references (s) |
|
3112 |
(when (string-match "&[-+0-9I]" s) |
|
3113 |
(user-error "Formula contains old &row reference, please rewrite using @-syntax"))) |
|
3114 |
|
|
3115 |
(defun org-table-make-reference (elements keep-empty numbers lispp) |
|
3116 |
"Convert list ELEMENTS to something appropriate to insert into formula. |
|
3117 |
KEEP-EMPTY indicated to keep empty fields, default is to skip them. |
|
3118 |
NUMBERS indicates that everything should be converted to numbers. |
|
3119 |
LISPP non-nil means to return something appropriate for a Lisp |
|
3120 |
list, `literal' is for the format specifier L." |
|
3121 |
;; Calc nan (not a number) is used for the conversion of the empty |
|
3122 |
;; field to a reference for several reasons: (i) It is accepted in a |
|
3123 |
;; Calc formula (e. g. "" or "()" would result in a Calc error). |
|
3124 |
;; (ii) In a single field (not in range) it can be distinguished |
|
3125 |
;; from "(nan)" which is the reference made from a single field |
|
3126 |
;; containing "nan". |
|
3127 |
(if (stringp elements) |
|
3128 |
;; field reference |
|
3129 |
(if lispp |
|
3130 |
(if (eq lispp 'literal) |
|
3131 |
elements |
|
3132 |
(if (and (eq elements "") (not keep-empty)) |
|
3133 |
"" |
|
3134 |
(prin1-to-string |
|
3135 |
(if numbers (string-to-number elements) elements)))) |
|
3136 |
(if (string-match "\\S-" elements) |
|
3137 |
(progn |
|
3138 |
(when numbers (setq elements (number-to-string |
|
3139 |
(string-to-number elements)))) |
|
3140 |
(concat "(" elements ")")) |
|
3141 |
(if (or (not keep-empty) numbers) "(0)" "nan"))) |
|
3142 |
;; range reference |
|
3143 |
(unless keep-empty |
|
3144 |
(setq elements |
|
3145 |
(delq nil |
|
3146 |
(mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) |
|
3147 |
elements)))) |
|
3148 |
(setq elements (or elements '())) ; if delq returns nil then we need '() |
|
3149 |
(if lispp |
|
3150 |
(mapconcat |
|
3151 |
(lambda (x) |
|
3152 |
(if (eq lispp 'literal) |
|
3153 |
x |
|
3154 |
(prin1-to-string (if numbers (string-to-number x) x)))) |
|
3155 |
elements " ") |
|
3156 |
(concat "[" (mapconcat |
|
3157 |
(lambda (x) |
|
3158 |
(if (string-match "\\S-" x) |
|
3159 |
(if numbers |
|
3160 |
(number-to-string (string-to-number x)) |
|
3161 |
x) |
|
3162 |
(if (or (not keep-empty) numbers) "0" "nan"))) |
|
3163 |
elements |
|
3164 |
",") "]")))) |
|
3165 |
|
|
3166 |
(defun org-table-message-once-per-second (t1 &rest args) |
|
3167 |
"If there has been more than one second since T1, display message. |
|
3168 |
ARGS are passed as arguments to the `message' function. Returns |
|
3169 |
current time if a message is printed, otherwise returns T1. If |
|
3170 |
T1 is nil, always messages." |
|
3171 |
(let ((curtime (current-time))) |
|
3172 |
(if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1)))) |
|
3173 |
(progn (apply 'message args) |
|
3174 |
curtime) |
|
3175 |
t1))) |
|
3176 |
|
|
3177 |
;;;###autoload |
|
3178 |
(defun org-table-recalculate (&optional all noalign) |
|
3179 |
"Recalculate the current table line by applying all stored formulas. |
|
3180 |
|
|
3181 |
With prefix arg ALL, do this for all lines in the table. |
|
3182 |
|
|
3183 |
When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \ |
|
3184 |
if ALL is the symbol `iterate', |
|
3185 |
recompute the table until it no longer changes. |
|
3186 |
|
|
3187 |
If NOALIGN is not nil, do not re-align the table after the computations |
|
3188 |
are done. This is typically used internally to save time, if it is |
|
3189 |
known that the table will be realigned a little later anyway." |
|
3190 |
(interactive "P") |
|
3191 |
(unless (memq this-command org-recalc-commands) |
|
3192 |
(push this-command org-recalc-commands)) |
|
3193 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
3194 |
(if (or (eq all 'iterate) (equal all '(16))) |
|
3195 |
(org-table-iterate) |
|
3196 |
(org-table-analyze) |
|
3197 |
(let* ((eqlist (sort (org-table-get-stored-formulas) |
|
3198 |
(lambda (a b) (string< (car a) (car b))))) |
|
3199 |
(inhibit-redisplay (not debug-on-error)) |
|
3200 |
(line-re org-table-dataline-regexp) |
|
3201 |
(log-first-time (current-time)) |
|
3202 |
(log-last-time log-first-time) |
|
3203 |
(cnt 0) |
|
3204 |
beg end eqlcol eqlfield) |
|
3205 |
;; Insert constants in all formulas. |
|
3206 |
(when eqlist |
|
3207 |
(org-table-save-field |
|
3208 |
;; Expand equations, then split the equation list between |
|
3209 |
;; column formulas and field formulas. |
|
3210 |
(dolist (eq eqlist) |
|
3211 |
(let* ((rhs (org-table-formula-substitute-names |
|
3212 |
(org-table-formula-handle-first/last-rc (cdr eq)))) |
|
3213 |
(old-lhs (car eq)) |
|
3214 |
(lhs |
|
3215 |
(org-table-formula-handle-first/last-rc |
|
3216 |
(cond |
|
3217 |
((string-match "\\`@-?I+" old-lhs) |
|
3218 |
(user-error "Can't assign to hline relative reference")) |
|
3219 |
((string-match "\\`$[<>]" old-lhs) |
|
3220 |
(let ((new (org-table-formula-handle-first/last-rc |
|
3221 |
old-lhs))) |
|
3222 |
(when (assoc new eqlist) |
|
3223 |
(user-error "\"%s=\" formula tries to overwrite \ |
|
3224 |
existing formula for column %s" |
|
3225 |
old-lhs |
|
3226 |
new)) |
|
3227 |
new)) |
|
3228 |
(t old-lhs))))) |
|
3229 |
(if (string-match-p "\\`\\$[0-9]+\\'" lhs) |
|
3230 |
(push (cons lhs rhs) eqlcol) |
|
3231 |
(push (cons lhs rhs) eqlfield)))) |
|
3232 |
(setq eqlcol (nreverse eqlcol)) |
|
3233 |
;; Expand ranges in lhs of formulas |
|
3234 |
(setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield))) |
|
3235 |
;; Get the correct line range to process. |
|
3236 |
(if all |
|
3237 |
(progn |
|
3238 |
(setq end (copy-marker (org-table-end))) |
|
3239 |
(goto-char (setq beg org-table-current-begin-pos)) |
|
3240 |
(cond |
|
3241 |
((re-search-forward org-table-calculate-mark-regexp end t) |
|
3242 |
;; This is a table with marked lines, compute selected |
|
3243 |
;; lines. |
|
3244 |
(setq line-re org-table-recalculate-regexp)) |
|
3245 |
;; Move forward to the first non-header line. |
|
3246 |
((and (re-search-forward org-table-dataline-regexp end t) |
|
3247 |
(re-search-forward org-table-hline-regexp end t) |
|
3248 |
(re-search-forward org-table-dataline-regexp end t)) |
|
3249 |
(setq beg (match-beginning 0))) |
|
3250 |
;; Just leave BEG at the start of the table. |
|
3251 |
(t nil))) |
|
3252 |
(setq beg (line-beginning-position) |
|
3253 |
end (copy-marker (line-beginning-position 2)))) |
|
3254 |
(goto-char beg) |
|
3255 |
;; Mark named fields untouchable. Also check if several |
|
3256 |
;; field/range formulas try to set the same field. |
|
3257 |
(remove-text-properties beg end '(:org-untouchable t)) |
|
3258 |
(let ((current-line (count-lines org-table-current-begin-pos |
|
3259 |
(line-beginning-position))) |
|
3260 |
seen-fields) |
|
3261 |
(dolist (eq eqlfield) |
|
3262 |
(let* ((name (car eq)) |
|
3263 |
(location (assoc name org-table-named-field-locations)) |
|
3264 |
(eq-line (or (nth 1 location) |
|
3265 |
(and (string-match "\\`@\\([0-9]+\\)" name) |
|
3266 |
(aref org-table-dlines |
|
3267 |
(string-to-number |
|
3268 |
(match-string 1 name)))))) |
|
3269 |
(reference |
|
3270 |
(if location |
|
3271 |
;; Turn field coordinates associated to NAME |
|
3272 |
;; into an absolute reference. |
|
3273 |
(format "@%d$%d" |
|
3274 |
(org-table-line-to-dline eq-line) |
|
3275 |
(nth 2 location)) |
|
3276 |
name))) |
|
3277 |
(when (member reference seen-fields) |
|
3278 |
(user-error "Several field/range formulas try to set %s" |
|
3279 |
reference)) |
|
3280 |
(push reference seen-fields) |
|
3281 |
(when (or all (eq eq-line current-line)) |
|
3282 |
(org-table-goto-field name) |
|
3283 |
(org-table-put-field-property :org-untouchable t))))) |
|
3284 |
;; Evaluate the column formulas, but skip fields covered by |
|
3285 |
;; field formulas. |
|
3286 |
(goto-char beg) |
|
3287 |
(while (re-search-forward line-re end t) |
|
3288 |
(unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1)) |
|
3289 |
;; Unprotected line, recalculate. |
|
3290 |
(cl-incf cnt) |
|
3291 |
(when all |
|
3292 |
(setq log-last-time |
|
3293 |
(org-table-message-once-per-second |
|
3294 |
log-last-time |
|
3295 |
"Re-applying formulas to full table...(line %d)" cnt))) |
|
3296 |
(if (markerp org-last-recalc-line) |
|
3297 |
(move-marker org-last-recalc-line (line-beginning-position)) |
|
3298 |
(setq org-last-recalc-line |
|
3299 |
(copy-marker (line-beginning-position)))) |
|
3300 |
(dolist (entry eqlcol) |
|
3301 |
(goto-char org-last-recalc-line) |
|
3302 |
(org-table-goto-column |
|
3303 |
(string-to-number (substring (car entry) 1)) nil 'force) |
|
3304 |
(unless (get-text-property (point) :org-untouchable) |
|
3305 |
(org-table-eval-formula |
|
3306 |
nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis))))) |
|
3307 |
;; Evaluate the field formulas. |
|
3308 |
(dolist (eq eqlfield) |
|
3309 |
(let ((reference (car eq)) |
|
3310 |
(formula (cdr eq))) |
|
3311 |
(setq log-last-time |
|
3312 |
(org-table-message-once-per-second |
|
3313 |
(and all log-last-time) |
|
3314 |
"Re-applying formula to field: %s" (car eq))) |
|
3315 |
(org-table-goto-field |
|
3316 |
reference |
|
3317 |
;; Possibly create a new column, as long as |
|
3318 |
;; `org-table-formula-create-columns' allows it. |
|
3319 |
(let ((column-count (progn (end-of-line) |
|
3320 |
(1- (org-table-current-column))))) |
|
3321 |
(lambda (column) |
|
3322 |
(when (> column 1000) |
|
3323 |
(user-error "Formula column target too large")) |
|
3324 |
(and (> column column-count) |
|
3325 |
(or (eq org-table-formula-create-columns t) |
|
3326 |
(and (eq org-table-formula-create-columns 'warn) |
|
3327 |
(progn |
|
3328 |
(org-display-warning |
|
3329 |
"Out-of-bounds formula added columns") |
|
3330 |
t)) |
|
3331 |
(and (eq org-table-formula-create-columns 'prompt) |
|
3332 |
(yes-or-no-p |
|
3333 |
"Out-of-bounds formula. Add columns? ")) |
|
3334 |
(user-error |
|
3335 |
"Missing columns in the table. Aborting")))))) |
|
3336 |
(org-table-eval-formula nil formula t t t t)))) |
|
3337 |
;; Clean up markers and internal text property. |
|
3338 |
(remove-text-properties (point-min) (point-max) '(org-untouchable t)) |
|
3339 |
(set-marker end nil) |
|
3340 |
(unless noalign |
|
3341 |
(when org-table-may-need-update (org-table-align)) |
|
3342 |
(when all |
|
3343 |
(org-table-message-once-per-second |
|
3344 |
log-first-time "Re-applying formulas to %d lines... done" cnt))) |
|
3345 |
(org-table-message-once-per-second |
|
3346 |
(and all log-first-time) "Re-applying formulas... done"))))) |
|
3347 |
|
|
3348 |
;;;###autoload |
|
3349 |
(defun org-table-iterate (&optional arg) |
|
3350 |
"Recalculate the table until it does not change anymore. |
|
3351 |
The maximum number of iterations is 10, but you can choose a different value |
|
3352 |
with the prefix ARG." |
|
3353 |
(interactive "P") |
|
3354 |
(let ((imax (if arg (prefix-numeric-value arg) 10)) |
|
3355 |
(i 0) |
|
3356 |
(lasttbl (buffer-substring (org-table-begin) (org-table-end))) |
|
3357 |
thistbl) |
|
3358 |
(catch 'exit |
|
3359 |
(while (< i imax) |
|
3360 |
(setq i (1+ i)) |
|
3361 |
(org-table-recalculate 'all) |
|
3362 |
(setq thistbl (buffer-substring (org-table-begin) (org-table-end))) |
|
3363 |
(if (not (string= lasttbl thistbl)) |
|
3364 |
(setq lasttbl thistbl) |
|
3365 |
(if (> i 1) |
|
3366 |
(message "Convergence after %d iterations" i) |
|
3367 |
(message "Table was already stable")) |
|
3368 |
(throw 'exit t))) |
|
3369 |
(user-error "No convergence after %d iterations" i)))) |
|
3370 |
|
|
3371 |
;;;###autoload |
|
3372 |
(defun org-table-recalculate-buffer-tables () |
|
3373 |
"Recalculate all tables in the current buffer." |
|
3374 |
(interactive) |
|
3375 |
(org-with-wide-buffer |
|
3376 |
(org-table-map-tables |
|
3377 |
(lambda () |
|
3378 |
;; Reason for separate `org-table-align': When repeating |
|
3379 |
;; (org-table-recalculate t) `org-table-may-need-update' gets in |
|
3380 |
;; the way. |
|
3381 |
(org-table-recalculate t t) |
|
3382 |
(org-table-align)) |
|
3383 |
t))) |
|
3384 |
|
|
3385 |
;;;###autoload |
|
3386 |
(defun org-table-iterate-buffer-tables () |
|
3387 |
"Iterate all tables in the buffer, to converge inter-table dependencies." |
|
3388 |
(interactive) |
|
3389 |
(let* ((imax 10) |
|
3390 |
(i imax) |
|
3391 |
(checksum (md5 (buffer-string))) |
|
3392 |
c1) |
|
3393 |
(org-with-wide-buffer |
|
3394 |
(catch 'exit |
|
3395 |
(while (> i 0) |
|
3396 |
(setq i (1- i)) |
|
3397 |
(org-table-map-tables (lambda () (org-table-recalculate t t)) t) |
|
3398 |
(if (equal checksum (setq c1 (md5 (buffer-string)))) |
|
3399 |
(progn |
|
3400 |
(org-table-map-tables #'org-table-align t) |
|
3401 |
(message "Convergence after %d iterations" (- imax i)) |
|
3402 |
(throw 'exit t)) |
|
3403 |
(setq checksum c1))) |
|
3404 |
(org-table-map-tables #'org-table-align t) |
|
3405 |
(user-error "No convergence after %d iterations" imax))))) |
|
3406 |
|
|
3407 |
(defun org-table-calc-current-TBLFM (&optional arg) |
|
3408 |
"Apply the #+TBLFM in the line at point to the table." |
|
3409 |
(interactive "P") |
|
3410 |
(unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) |
|
3411 |
(let ((formula (buffer-substring |
|
3412 |
(line-beginning-position) |
|
3413 |
(line-end-position)))) |
|
3414 |
(save-excursion |
|
3415 |
;; Insert a temporary formula at right after the table |
|
3416 |
(goto-char (org-table-TBLFM-begin)) |
|
3417 |
(let ((s (point-marker))) |
|
3418 |
(insert formula "\n") |
|
3419 |
(let ((e (point-marker))) |
|
3420 |
;; Recalculate the table. |
|
3421 |
(beginning-of-line 0) ; move to the inserted line |
|
3422 |
(skip-chars-backward " \r\n\t") |
|
3423 |
(unwind-protect |
|
3424 |
(org-call-with-arg #'org-table-recalculate (or arg t)) |
|
3425 |
;; Delete the formula inserted temporarily. |
|
3426 |
(delete-region s e) |
|
3427 |
(set-marker s nil) |
|
3428 |
(set-marker e nil))))))) |
|
3429 |
|
|
3430 |
(defun org-table-TBLFM-begin () |
|
3431 |
"Find the beginning of the TBLFM lines and return its position. |
|
3432 |
Return nil when the beginning of TBLFM line was not found." |
|
3433 |
(save-excursion |
|
3434 |
(when (progn (forward-line 1) |
|
3435 |
(re-search-backward org-table-TBLFM-begin-regexp nil t)) |
|
3436 |
(line-beginning-position 2)))) |
|
3437 |
|
|
3438 |
(defun org-table-expand-lhs-ranges (equations) |
|
3439 |
"Expand list of formulas. |
|
3440 |
If some of the RHS in the formulas are ranges or a row reference, |
|
3441 |
expand them to individual field equations for each field. This |
|
3442 |
function assumes the table is already analyzed (i.e., using |
|
3443 |
`org-table-analyze')." |
|
3444 |
(let (res) |
|
3445 |
(dolist (e equations (nreverse res)) |
|
3446 |
(let ((lhs (car e)) |
|
3447 |
(rhs (cdr e))) |
|
3448 |
(cond |
|
3449 |
((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs) |
|
3450 |
;; This just refers to one fixed field. |
|
3451 |
(push e res)) |
|
3452 |
((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs) |
|
3453 |
;; This just refers to one fixed named field. |
|
3454 |
(push e res)) |
|
3455 |
((string-match-p "\\`\\$[0-9]+\\'" lhs) |
|
3456 |
;; Column formulas are treated specially and are not |
|
3457 |
;; expanded. |
|
3458 |
(push e res)) |
|
3459 |
((string-match "\\`@[0-9]+\\'" lhs) |
|
3460 |
(dotimes (ic org-table-current-ncol) |
|
3461 |
(push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e) |
|
3462 |
rhs) |
|
3463 |
res))) |
|
3464 |
(t |
|
3465 |
(let* ((range (org-table-get-range |
|
3466 |
lhs org-table-current-begin-pos 1 nil 'corners)) |
|
3467 |
(r1 (org-table-line-to-dline (nth 0 range))) |
|
3468 |
(c1 (nth 1 range)) |
|
3469 |
(r2 (org-table-line-to-dline (nth 2 range) 'above)) |
|
3470 |
(c2 (nth 3 range))) |
|
3471 |
(cl-loop for ir from r1 to r2 do |
|
3472 |
(cl-loop for ic from c1 to c2 do |
|
3473 |
(push (cons (propertize |
|
3474 |
(format "@%d$%d" ir ic) :orig-eqn e) |
|
3475 |
rhs) |
|
3476 |
res)))))))))) |
|
3477 |
|
|
3478 |
(defun org-table-formula-handle-first/last-rc (s) |
|
3479 |
"Replace @<, @>, $<, $> with first/last row/column of the table. |
|
3480 |
So @< and $< will always be replaced with @1 and $1, respectively. |
|
3481 |
The advantage of these special markers are that structure editing of |
|
3482 |
the table will not change them, while @1 and $1 will be modified |
|
3483 |
when a line/row is swapped out of that privileged position. So for |
|
3484 |
formulas that use a range of rows or columns, it may often be better |
|
3485 |
to anchor the formula with \"I\" row markers, or to offset from the |
|
3486 |
borders of the table using the @< @> $< $> makers." |
|
3487 |
(let (n nmax len char (start 0)) |
|
3488 |
(while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^)]+)\\)" |
|
3489 |
s start) |
|
3490 |
(if (match-end 3) |
|
3491 |
(setq start (match-end 3)) |
|
3492 |
(setq nmax (if (equal (match-string 1 s) "@") |
|
3493 |
(1- (length org-table-dlines)) |
|
3494 |
org-table-current-ncol) |
|
3495 |
len (- (match-end 2) (match-beginning 2)) |
|
3496 |
char (string-to-char (match-string 2 s)) |
|
3497 |
n (if (= char ?<) |
|
3498 |
len |
|
3499 |
(- nmax len -1))) |
|
3500 |
(if (or (< n 1) (> n nmax)) |
|
3501 |
(user-error "Reference \"%s\" in expression \"%s\" points outside table" |
|
3502 |
(match-string 0 s) s)) |
|
3503 |
(setq start (match-beginning 0)) |
|
3504 |
(setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) |
|
3505 |
s) |
|
3506 |
|
|
3507 |
(defun org-table-formula-substitute-names (f) |
|
3508 |
"Replace $const with values in string F." |
|
3509 |
(let ((start 0) |
|
3510 |
(pp (/= (string-to-char f) ?')) |
|
3511 |
(duration (string-match-p ";.*[Tt].*\\'" f)) |
|
3512 |
(new (replace-regexp-in-string ; Check for column names. |
|
3513 |
org-table-column-name-regexp |
|
3514 |
(lambda (m) |
|
3515 |
(concat "$" (cdr (assoc (match-string 1 m) |
|
3516 |
org-table-column-names)))) |
|
3517 |
f t t))) |
|
3518 |
;; Parameters and constants. |
|
3519 |
(while (setq start |
|
3520 |
(string-match |
|
3521 |
"\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" |
|
3522 |
new start)) |
|
3523 |
(if (match-end 2) (setq start (match-end 2)) |
|
3524 |
(cl-incf start) |
|
3525 |
;; When a duration is expected, convert value on the fly. |
|
3526 |
(let ((value |
|
3527 |
(save-match-data |
|
3528 |
(let ((v (org-table-get-constant (match-string 1 new)))) |
|
3529 |
(if (and (org-string-nw-p v) duration) |
|
3530 |
(org-table-time-string-to-seconds v) |
|
3531 |
v))))) |
|
3532 |
(when value |
|
3533 |
(setq new (replace-match |
|
3534 |
(concat (and pp "(") value (and pp ")")) t t new)))))) |
|
3535 |
(if org-table-formula-debug (propertize new :orig-formula f) new))) |
|
3536 |
|
|
3537 |
(defun org-table-get-constant (const) |
|
3538 |
"Find the value for a parameter or constant in a formula. |
|
3539 |
Parameters get priority." |
|
3540 |
(or (cdr (assoc const org-table-local-parameters)) |
|
3541 |
(cdr (assoc const org-table-formula-constants-local)) |
|
3542 |
(cdr (assoc const org-table-formula-constants)) |
|
3543 |
(and (fboundp 'constants-get) (constants-get const)) |
|
3544 |
(and (string= (substring const 0 (min 5 (length const))) "PROP_") |
|
3545 |
(org-entry-get nil (substring const 5) 'inherit)) |
|
3546 |
"#UNDEFINED_NAME")) |
|
3547 |
|
|
3548 |
(defvar org-table-fedit-map |
|
3549 |
(let ((map (make-sparse-keymap))) |
|
3550 |
(org-defkey map "\C-x\C-s" 'org-table-fedit-finish) |
|
3551 |
(org-defkey map "\C-c\C-s" 'org-table-fedit-finish) |
|
3552 |
(org-defkey map "\C-c\C-c" 'org-table-fedit-finish) |
|
3553 |
(org-defkey map "\C-c'" 'org-table-fedit-finish) |
|
3554 |
(org-defkey map "\C-c\C-q" 'org-table-fedit-abort) |
|
3555 |
(org-defkey map "\C-c?" 'org-table-show-reference) |
|
3556 |
(org-defkey map [(meta shift up)] 'org-table-fedit-line-up) |
|
3557 |
(org-defkey map [(meta shift down)] 'org-table-fedit-line-down) |
|
3558 |
(org-defkey map [(shift up)] 'org-table-fedit-ref-up) |
|
3559 |
(org-defkey map [(shift down)] 'org-table-fedit-ref-down) |
|
3560 |
(org-defkey map [(shift left)] 'org-table-fedit-ref-left) |
|
3561 |
(org-defkey map [(shift right)] 'org-table-fedit-ref-right) |
|
3562 |
(org-defkey map [(meta up)] 'org-table-fedit-scroll-down) |
|
3563 |
(org-defkey map [(meta down)] 'org-table-fedit-scroll) |
|
3564 |
(org-defkey map [(meta tab)] 'lisp-complete-symbol) |
|
3565 |
(org-defkey map "\M-\C-i" 'lisp-complete-symbol) |
|
3566 |
(org-defkey map [(tab)] 'org-table-fedit-lisp-indent) |
|
3567 |
(org-defkey map "\C-i" 'org-table-fedit-lisp-indent) |
|
3568 |
(org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) |
|
3569 |
(org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) |
|
3570 |
map)) |
|
3571 |
|
|
3572 |
(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" |
|
3573 |
'("Edit-Formulas" |
|
3574 |
["Finish and Install" org-table-fedit-finish t] |
|
3575 |
["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] |
|
3576 |
["Abort" org-table-fedit-abort t] |
|
3577 |
"--" |
|
3578 |
["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] |
|
3579 |
["Complete Lisp Symbol" lisp-complete-symbol t] |
|
3580 |
"--" |
|
3581 |
"Shift Reference at Point" |
|
3582 |
["Up" org-table-fedit-ref-up t] |
|
3583 |
["Down" org-table-fedit-ref-down t] |
|
3584 |
["Left" org-table-fedit-ref-left t] |
|
3585 |
["Right" org-table-fedit-ref-right t] |
|
3586 |
"-" |
|
3587 |
"Change Test Row for Column Formulas" |
|
3588 |
["Up" org-table-fedit-line-up t] |
|
3589 |
["Down" org-table-fedit-line-down t] |
|
3590 |
"--" |
|
3591 |
["Scroll Table Window" org-table-fedit-scroll t] |
|
3592 |
["Scroll Table Window down" org-table-fedit-scroll-down t] |
|
3593 |
["Show Table Grid" org-table-fedit-toggle-coordinates |
|
3594 |
:style toggle :selected (with-current-buffer (marker-buffer org-pos) |
|
3595 |
org-table-overlay-coordinates)] |
|
3596 |
"--" |
|
3597 |
["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type |
|
3598 |
:style toggle :selected org-table-buffer-is-an])) |
|
3599 |
|
|
3600 |
(defvar org-pos) |
|
3601 |
(defvar org-table--fedit-source nil |
|
3602 |
"Position of the TBLFM line being edited.") |
|
3603 |
|
|
3604 |
;;;###autoload |
|
3605 |
(defun org-table-edit-formulas () |
|
3606 |
"Edit the formulas of the current table in a separate buffer." |
|
3607 |
(interactive) |
|
3608 |
(let ((at-tblfm (org-at-TBLFM-p))) |
|
3609 |
(unless (or at-tblfm (org-at-table-p)) |
|
3610 |
(user-error "Not at a table")) |
|
3611 |
(save-excursion |
|
3612 |
;; Move point within the table before analyzing it. |
|
3613 |
(when at-tblfm (re-search-backward "^[ \t]*|")) |
|
3614 |
(org-table-analyze)) |
|
3615 |
(let ((key (org-table-current-field-formula 'key 'noerror)) |
|
3616 |
(eql (sort (org-table-get-stored-formulas t (and at-tblfm (point))) |
|
3617 |
#'org-table-formula-less-p)) |
|
3618 |
(pos (point-marker)) |
|
3619 |
(source (copy-marker (line-beginning-position))) |
|
3620 |
(startline 1) |
|
3621 |
(wc (current-window-configuration)) |
|
3622 |
(sel-win (selected-window)) |
|
3623 |
(titles '((column . "# Column Formulas\n") |
|
3624 |
(field . "# Field and Range Formulas\n") |
|
3625 |
(named . "# Named Field Formulas\n")))) |
|
3626 |
(org-switch-to-buffer-other-window "*Edit Formulas*") |
|
3627 |
(erase-buffer) |
|
3628 |
;; Keep global-font-lock-mode from turning on font-lock-mode |
|
3629 |
(let ((font-lock-global-modes '(not fundamental-mode))) |
|
3630 |
(fundamental-mode)) |
|
3631 |
(setq-local font-lock-global-modes (list 'not major-mode)) |
|
3632 |
(setq-local org-pos pos) |
|
3633 |
(setq-local org-table--fedit-source source) |
|
3634 |
(setq-local org-window-configuration wc) |
|
3635 |
(setq-local org-selected-window sel-win) |
|
3636 |
(use-local-map org-table-fedit-map) |
|
3637 |
(add-hook 'post-command-hook #'org-table-fedit-post-command t t) |
|
3638 |
(easy-menu-add org-table-fedit-menu) |
|
3639 |
(setq startline (org-current-line)) |
|
3640 |
(dolist (entry eql) |
|
3641 |
(let* ((type (cond |
|
3642 |
((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry)) |
|
3643 |
'column) |
|
3644 |
((equal (string-to-char (car entry)) ?@) 'field) |
|
3645 |
(t 'named))) |
|
3646 |
(title (assq type titles))) |
|
3647 |
(when title |
|
3648 |
(unless (bobp) (insert "\n")) |
|
3649 |
(insert |
|
3650 |
(org-add-props (cdr title) nil 'face font-lock-comment-face)) |
|
3651 |
(setq titles (remove title titles))) |
|
3652 |
(when (equal key (car entry)) (setq startline (org-current-line))) |
|
3653 |
(let ((s (concat |
|
3654 |
(if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$") |
|
3655 |
(car entry) " = " (cdr entry) "\n"))) |
|
3656 |
(remove-text-properties 0 (length s) '(face nil) s) |
|
3657 |
(insert s)))) |
|
3658 |
(when (eq org-table-use-standard-references t) |
|
3659 |
(org-table-fedit-toggle-ref-type)) |
|
3660 |
(org-goto-line startline) |
|
3661 |
(message "%s" (substitute-command-keys "\\<org-mode-map>\ |
|
3662 |
Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \ |
|
3663 |
See menu for more commands."))))) |
|
3664 |
|
|
3665 |
(defun org-table-fedit-post-command () |
|
3666 |
(when (not (memq this-command '(lisp-complete-symbol))) |
|
3667 |
(let ((win (selected-window))) |
|
3668 |
(save-excursion |
|
3669 |
(ignore-errors (org-table-show-reference)) |
|
3670 |
(select-window win))))) |
|
3671 |
|
|
3672 |
(defun org-table-formula-to-user (s) |
|
3673 |
"Convert a formula from internal to user representation." |
|
3674 |
(if (eq org-table-use-standard-references t) |
|
3675 |
(org-table-convert-refs-to-an s) |
|
3676 |
s)) |
|
3677 |
|
|
3678 |
(defun org-table-formula-from-user (s) |
|
3679 |
"Convert a formula from user to internal representation." |
|
3680 |
(if org-table-use-standard-references |
|
3681 |
(org-table-convert-refs-to-rc s) |
|
3682 |
s)) |
|
3683 |
|
|
3684 |
(defun org-table-convert-refs-to-rc (s) |
|
3685 |
"Convert spreadsheet references from A7 to @7$28. |
|
3686 |
Works for single references, but also for entire formulas and even the |
|
3687 |
full TBLFM line." |
|
3688 |
(let ((start 0)) |
|
3689 |
(while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start) |
|
3690 |
(cond |
|
3691 |
((match-end 3) |
|
3692 |
;; format match, just advance |
|
3693 |
(setq start (match-end 0))) |
|
3694 |
((and (> (match-beginning 0) 0) |
|
3695 |
(equal ?. (aref s (max (1- (match-beginning 0)) 0))) |
|
3696 |
(not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) |
|
3697 |
;; 3.e5 or something like this. |
|
3698 |
(setq start (match-end 0))) |
|
3699 |
((or (> (- (match-end 1) (match-beginning 1)) 2) |
|
3700 |
;; (member (match-string 1 s) |
|
3701 |
;; '("arctan" "exp" "expm" "lnp" "log" "stir")) |
|
3702 |
) |
|
3703 |
;; function name, just advance |
|
3704 |
(setq start (match-end 0))) |
|
3705 |
(t |
|
3706 |
(setq start (match-beginning 0) |
|
3707 |
s (replace-match |
|
3708 |
(if (equal (match-string 2 s) "&") |
|
3709 |
(format "$%d" (org-letters-to-number (match-string 1 s))) |
|
3710 |
(format "@%d$%d" |
|
3711 |
(string-to-number (match-string 2 s)) |
|
3712 |
(org-letters-to-number (match-string 1 s)))) |
|
3713 |
t t s))))) |
|
3714 |
s)) |
|
3715 |
|
|
3716 |
(defun org-table-convert-refs-to-an (s) |
|
3717 |
"Convert spreadsheet references from to @7$28 to AB7. |
|
3718 |
Works for single references, but also for entire formulas and even the |
|
3719 |
full TBLFM line." |
|
3720 |
(while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) |
|
3721 |
(setq s (replace-match |
|
3722 |
(format "%s%d" |
|
3723 |
(org-number-to-letters |
|
3724 |
(string-to-number (match-string 2 s))) |
|
3725 |
(string-to-number (match-string 1 s))) |
|
3726 |
t t s))) |
|
3727 |
(while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) |
|
3728 |
(setq s (replace-match (concat "\\1" |
|
3729 |
(org-number-to-letters |
|
3730 |
(string-to-number (match-string 2 s))) "&") |
|
3731 |
t nil s))) |
|
3732 |
s) |
|
3733 |
|
|
3734 |
(defun org-letters-to-number (s) |
|
3735 |
"Convert a base 26 number represented by letters into an integer. |
|
3736 |
For example: AB -> 28." |
|
3737 |
(let ((n 0)) |
|
3738 |
(setq s (upcase s)) |
|
3739 |
(while (> (length s) 0) |
|
3740 |
(setq n (+ (* n 26) (string-to-char s) (- ?A) 1) |
|
3741 |
s (substring s 1))) |
|
3742 |
n)) |
|
3743 |
|
|
3744 |
(defun org-number-to-letters (n) |
|
3745 |
"Convert an integer into a base 26 number represented by letters. |
|
3746 |
For example: 28 -> AB." |
|
3747 |
(let ((s "")) |
|
3748 |
(while (> n 0) |
|
3749 |
(setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) |
|
3750 |
n (/ (1- n) 26))) |
|
3751 |
s)) |
|
3752 |
|
|
3753 |
(defun org-table-time-string-to-seconds (s) |
|
3754 |
"Convert a time string into numerical duration in seconds. |
|
3755 |
S can be a string matching either -?HH:MM:SS or -?HH:MM. |
|
3756 |
If S is a string representing a number, keep this number." |
|
3757 |
(if (equal s "") |
|
3758 |
s |
|
3759 |
(let (hour minus min sec res) |
|
3760 |
(cond |
|
3761 |
((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) |
|
3762 |
(setq minus (< 0 (length (match-string 1 s))) |
|
3763 |
hour (string-to-number (match-string 2 s)) |
|
3764 |
min (string-to-number (match-string 3 s)) |
|
3765 |
sec (string-to-number (match-string 4 s))) |
|
3766 |
(if minus |
|
3767 |
(setq res (- (+ (* hour 3600) (* min 60) sec))) |
|
3768 |
(setq res (+ (* hour 3600) (* min 60) sec)))) |
|
3769 |
((and (not (string-match org-ts-regexp-both s)) |
|
3770 |
(string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) |
|
3771 |
(setq minus (< 0 (length (match-string 1 s))) |
|
3772 |
hour (string-to-number (match-string 2 s)) |
|
3773 |
min (string-to-number (match-string 3 s))) |
|
3774 |
(if minus |
|
3775 |
(setq res (- (+ (* hour 3600) (* min 60)))) |
|
3776 |
(setq res (+ (* hour 3600) (* min 60))))) |
|
3777 |
(t (setq res (string-to-number s)))) |
|
3778 |
(number-to-string res)))) |
|
3779 |
|
|
3780 |
(defun org-table-time-seconds-to-string (secs &optional output-format) |
|
3781 |
"Convert a number of seconds to a time string. |
|
3782 |
If OUTPUT-FORMAT is non-nil, return a number of days, hours, |
|
3783 |
minutes or seconds." |
|
3784 |
(let* ((secs0 (abs secs)) |
|
3785 |
(res |
|
3786 |
(cond ((eq output-format 'days) |
|
3787 |
(format "%.3f" (/ (float secs0) 86400))) |
|
3788 |
((eq output-format 'hours) |
|
3789 |
(format "%.2f" (/ (float secs0) 3600))) |
|
3790 |
((eq output-format 'minutes) |
|
3791 |
(format "%.1f" (/ (float secs0) 60))) |
|
3792 |
((eq output-format 'seconds) |
|
3793 |
(format "%d" secs0)) |
|
3794 |
((eq output-format 'hh:mm) |
|
3795 |
;; Ignore seconds |
|
3796 |
(substring (format-seconds |
|
3797 |
(if org-table-duration-hour-zero-padding |
|
3798 |
"%.2h:%.2m:%.2s" "%h:%.2m:%.2s") |
|
3799 |
secs0) |
|
3800 |
0 -3)) |
|
3801 |
(t (format-seconds |
|
3802 |
(if org-table-duration-hour-zero-padding |
|
3803 |
"%.2h:%.2m:%.2s" "%h:%.2m:%.2s") |
|
3804 |
secs0))))) |
|
3805 |
(if (< secs 0) (concat "-" res) res))) |
|
3806 |
|
|
3807 |
(defun org-table-fedit-convert-buffer (function) |
|
3808 |
"Convert all references in this buffer, using FUNCTION." |
|
3809 |
(let ((origin (copy-marker (line-beginning-position)))) |
|
3810 |
(goto-char (point-min)) |
|
3811 |
(while (not (eobp)) |
|
3812 |
(insert (funcall function (buffer-substring (point) (line-end-position)))) |
|
3813 |
(delete-region (point) (line-end-position)) |
|
3814 |
(forward-line)) |
|
3815 |
(goto-char origin) |
|
3816 |
(set-marker origin nil))) |
|
3817 |
|
|
3818 |
(defun org-table-fedit-toggle-ref-type () |
|
3819 |
"Convert all references in the buffer from B3 to @3$2 and back." |
|
3820 |
(interactive) |
|
3821 |
(setq-local org-table-buffer-is-an (not org-table-buffer-is-an)) |
|
3822 |
(org-table-fedit-convert-buffer |
|
3823 |
(if org-table-buffer-is-an |
|
3824 |
'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) |
|
3825 |
(message "Reference type switched to %s" |
|
3826 |
(if org-table-buffer-is-an "A1 etc" "@row$column"))) |
|
3827 |
|
|
3828 |
(defun org-table-fedit-ref-up () |
|
3829 |
"Shift the reference at point one row/hline up." |
|
3830 |
(interactive) |
|
3831 |
(org-table-fedit-shift-reference 'up)) |
|
3832 |
(defun org-table-fedit-ref-down () |
|
3833 |
"Shift the reference at point one row/hline down." |
|
3834 |
(interactive) |
|
3835 |
(org-table-fedit-shift-reference 'down)) |
|
3836 |
(defun org-table-fedit-ref-left () |
|
3837 |
"Shift the reference at point one field to the left." |
|
3838 |
(interactive) |
|
3839 |
(org-table-fedit-shift-reference 'left)) |
|
3840 |
(defun org-table-fedit-ref-right () |
|
3841 |
"Shift the reference at point one field to the right." |
|
3842 |
(interactive) |
|
3843 |
(org-table-fedit-shift-reference 'right)) |
|
3844 |
|
|
3845 |
(defun org-table-fedit-shift-reference (dir) |
|
3846 |
(cond |
|
3847 |
((org-in-regexp "\\(\\<[a-zA-Z]\\)&") |
|
3848 |
(if (memq dir '(left right)) |
|
3849 |
(org-rematch-and-replace 1 (eq dir 'left)) |
|
3850 |
(user-error "Cannot shift reference in this direction"))) |
|
3851 |
((org-in-regexp "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") |
|
3852 |
;; A B3-like reference |
|
3853 |
(if (memq dir '(up down)) |
|
3854 |
(org-rematch-and-replace 2 (eq dir 'up)) |
|
3855 |
(org-rematch-and-replace 1 (eq dir 'left)))) |
|
3856 |
((org-in-regexp |
|
3857 |
"\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") |
|
3858 |
;; An internal reference |
|
3859 |
(if (memq dir '(up down)) |
|
3860 |
(org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) |
|
3861 |
(org-rematch-and-replace 5 (eq dir 'left)))))) |
|
3862 |
|
|
3863 |
(defun org-rematch-and-replace (n &optional decr hline) |
|
3864 |
"Re-match the group N, and replace it with the shifted reference." |
|
3865 |
(or (match-end n) (user-error "Cannot shift reference in this direction")) |
|
3866 |
(goto-char (match-beginning n)) |
|
3867 |
(and (looking-at (regexp-quote (match-string n))) |
|
3868 |
(replace-match (org-table-shift-refpart (match-string 0) decr hline) |
|
3869 |
t t))) |
|
3870 |
|
|
3871 |
(defun org-table-shift-refpart (ref &optional decr hline) |
|
3872 |
"Shift a reference part REF. |
|
3873 |
If DECR is set, decrease the references row/column, else increase. |
|
3874 |
If HLINE is set, this may be a hline reference, it certainly is not |
|
3875 |
a translation reference." |
|
3876 |
(save-match-data |
|
3877 |
(let* ((sign (string-match "^[-+]" ref)) n) |
|
3878 |
|
|
3879 |
(if sign (setq sign (substring ref 0 1) ref (substring ref 1))) |
|
3880 |
(cond |
|
3881 |
((and hline (string-match "^I+" ref)) |
|
3882 |
(setq n (string-to-number (concat sign (number-to-string (length ref))))) |
|
3883 |
(setq n (+ n (if decr -1 1))) |
|
3884 |
(if (= n 0) (setq n (+ n (if decr -1 1)))) |
|
3885 |
(if sign |
|
3886 |
(setq sign (if (< n 0) "-" "+") n (abs n)) |
|
3887 |
(setq n (max 1 n))) |
|
3888 |
(concat sign (make-string n ?I))) |
|
3889 |
|
|
3890 |
((string-match "^[0-9]+" ref) |
|
3891 |
(setq n (string-to-number (concat sign ref))) |
|
3892 |
(setq n (+ n (if decr -1 1))) |
|
3893 |
(if sign |
|
3894 |
(concat (if (< n 0) "-" "+") (number-to-string (abs n))) |
|
3895 |
(number-to-string (max 1 n)))) |
|
3896 |
|
|
3897 |
((string-match "^[a-zA-Z]+" ref) |
|
3898 |
(org-number-to-letters |
|
3899 |
(max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) |
|
3900 |
|
|
3901 |
(t (user-error "Cannot shift reference")))))) |
|
3902 |
|
|
3903 |
(defun org-table-fedit-toggle-coordinates () |
|
3904 |
"Toggle the display of coordinates in the referenced table." |
|
3905 |
(interactive) |
|
3906 |
(let ((pos (marker-position org-pos))) |
|
3907 |
(with-current-buffer (marker-buffer org-pos) |
|
3908 |
(save-excursion |
|
3909 |
(goto-char pos) |
|
3910 |
(org-table-toggle-coordinate-overlays))))) |
|
3911 |
|
|
3912 |
(defun org-table-fedit-finish (&optional arg) |
|
3913 |
"Parse the buffer for formula definitions and install them. |
|
3914 |
With prefix ARG, apply the new formulas to the table." |
|
3915 |
(interactive "P") |
|
3916 |
(org-table-remove-rectangle-highlight) |
|
3917 |
(when org-table-use-standard-references |
|
3918 |
(org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) |
|
3919 |
(setq org-table-buffer-is-an nil)) |
|
3920 |
(let ((pos org-pos) |
|
3921 |
(sel-win org-selected-window) |
|
3922 |
(source org-table--fedit-source) |
|
3923 |
eql) |
|
3924 |
(goto-char (point-min)) |
|
3925 |
(while (re-search-forward |
|
3926 |
"^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" |
|
3927 |
nil t) |
|
3928 |
(let ((var (match-string 1)) |
|
3929 |
(form (org-trim (match-string 3)))) |
|
3930 |
(unless (equal form "") |
|
3931 |
(while (string-match "[ \t]*\n[ \t]*" form) |
|
3932 |
(setq form (replace-match " " t t form))) |
|
3933 |
(when (assoc var eql) |
|
3934 |
(user-error "Double formulas for %s" var)) |
|
3935 |
(push (cons var form) eql)))) |
|
3936 |
(set-window-configuration org-window-configuration) |
|
3937 |
(select-window sel-win) |
|
3938 |
(goto-char source) |
|
3939 |
(org-table-store-formulas eql) |
|
3940 |
(set-marker pos nil) |
|
3941 |
(set-marker source nil) |
|
3942 |
(kill-buffer "*Edit Formulas*") |
|
3943 |
(if arg |
|
3944 |
(org-table-recalculate 'all) |
|
3945 |
(message "New formulas installed - press C-u C-c C-c to apply.")))) |
|
3946 |
|
|
3947 |
(defun org-table-fedit-abort () |
|
3948 |
"Abort editing formulas, without installing the changes." |
|
3949 |
(interactive) |
|
3950 |
(org-table-remove-rectangle-highlight) |
|
3951 |
(let ((pos org-pos) (sel-win org-selected-window)) |
|
3952 |
(set-window-configuration org-window-configuration) |
|
3953 |
(select-window sel-win) |
|
3954 |
(goto-char pos) |
|
3955 |
(move-marker pos nil) |
|
3956 |
(message "Formula editing aborted without installing changes"))) |
|
3957 |
|
|
3958 |
(defun org-table-fedit-lisp-indent () |
|
3959 |
"Pretty-print and re-indent Lisp expressions in the Formula Editor." |
|
3960 |
(interactive) |
|
3961 |
(let ((pos (point)) beg end ind) |
|
3962 |
(beginning-of-line 1) |
|
3963 |
(cond |
|
3964 |
((looking-at "[ \t]") |
|
3965 |
(goto-char pos) |
|
3966 |
(call-interactively 'lisp-indent-line)) |
|
3967 |
((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) |
|
3968 |
((not (fboundp 'pp-buffer)) |
|
3969 |
(user-error "Cannot pretty-print. Command `pp-buffer' is not available")) |
|
3970 |
((looking-at "[$&@0-9a-zA-Z]+ *= *'(") |
|
3971 |
(goto-char (- (match-end 0) 2)) |
|
3972 |
(setq beg (point)) |
|
3973 |
(setq ind (make-string (current-column) ?\ )) |
|
3974 |
(condition-case nil (forward-sexp 1) |
|
3975 |
(error |
|
3976 |
(user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) |
|
3977 |
(setq end (point)) |
|
3978 |
(save-restriction |
|
3979 |
(narrow-to-region beg end) |
|
3980 |
(if (eq last-command this-command) |
|
3981 |
(progn |
|
3982 |
(goto-char (point-min)) |
|
3983 |
(setq this-command nil) |
|
3984 |
(while (re-search-forward "[ \t]*\n[ \t]*" nil t) |
|
3985 |
(replace-match " "))) |
|
3986 |
(pp-buffer) |
|
3987 |
(untabify (point-min) (point-max)) |
|
3988 |
(goto-char (1+ (point-min))) |
|
3989 |
(while (re-search-forward "^." nil t) |
|
3990 |
(beginning-of-line 1) |
|
3991 |
(insert ind)) |
|
3992 |
(goto-char (point-max)) |
|
3993 |
(org-delete-backward-char 1))) |
|
3994 |
(goto-char beg)) |
|
3995 |
(t nil)))) |
|
3996 |
|
|
3997 |
(defvar org-show-positions nil) |
|
3998 |
|
|
3999 |
(defun org-table-show-reference (&optional local) |
|
4000 |
"Show the location/value of the $ expression at point. |
|
4001 |
When LOCAL is non-nil, show references for the table at point." |
|
4002 |
(interactive) |
|
4003 |
(org-table-remove-rectangle-highlight) |
|
4004 |
(when local (org-table-analyze)) |
|
4005 |
(catch 'exit |
|
4006 |
(let ((pos (if local (point) org-pos)) |
|
4007 |
(face2 'highlight) |
|
4008 |
(org-inhibit-highlight-removal t) |
|
4009 |
(win (selected-window)) |
|
4010 |
(org-show-positions nil) |
|
4011 |
var name e what match dest) |
|
4012 |
(setq what (cond |
|
4013 |
((org-in-regexp "^@[0-9]+[ \t=]") |
|
4014 |
(setq match (concat (substring (match-string 0) 0 -1) |
|
4015 |
"$1.." |
|
4016 |
(substring (match-string 0) 0 -1) |
|
4017 |
"$100")) |
|
4018 |
'range) |
|
4019 |
((or (org-in-regexp org-table-range-regexp2) |
|
4020 |
(org-in-regexp org-table-translate-regexp) |
|
4021 |
(org-in-regexp org-table-range-regexp)) |
|
4022 |
(setq match |
|
4023 |
(save-match-data |
|
4024 |
(org-table-convert-refs-to-rc (match-string 0)))) |
|
4025 |
'range) |
|
4026 |
((org-in-regexp "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) |
|
4027 |
((org-in-regexp "\\$[0-9]+") 'column) |
|
4028 |
((not local) nil) |
|
4029 |
(t (user-error "No reference at point"))) |
|
4030 |
match (and what (or match (match-string 0)))) |
|
4031 |
(when (and match (not (equal (match-beginning 0) (point-at-bol)))) |
|
4032 |
(org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) |
|
4033 |
'secondary-selection)) |
|
4034 |
(add-hook 'before-change-functions |
|
4035 |
#'org-table-remove-rectangle-highlight) |
|
4036 |
(when (eq what 'name) (setq var (substring match 1))) |
|
4037 |
(when (eq what 'range) |
|
4038 |
(unless (eq (string-to-char match) ?@) (setq match (concat "@" match))) |
|
4039 |
(setq match (org-table-formula-substitute-names match))) |
|
4040 |
(unless local |
|
4041 |
(save-excursion |
|
4042 |
(end-of-line) |
|
4043 |
(re-search-backward "^\\S-" nil t) |
|
4044 |
(beginning-of-line) |
|
4045 |
(when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\ |
|
4046 |
\\([0-9]+\\|&\\)\\) *=") |
|
4047 |
(setq dest |
|
4048 |
(save-match-data |
|
4049 |
(org-table-convert-refs-to-rc (match-string 1)))) |
|
4050 |
(org-table-add-rectangle-overlay |
|
4051 |
(match-beginning 1) (match-end 1) face2)))) |
|
4052 |
(if (and (markerp pos) (marker-buffer pos)) |
|
4053 |
(if (get-buffer-window (marker-buffer pos)) |
|
4054 |
(select-window (get-buffer-window (marker-buffer pos))) |
|
4055 |
(org-switch-to-buffer-other-window (get-buffer-window |
|
4056 |
(marker-buffer pos))))) |
|
4057 |
(goto-char pos) |
|
4058 |
(org-table-force-dataline) |
|
4059 |
(let ((table-start |
|
4060 |
(if local org-table-current-begin-pos (org-table-begin)))) |
|
4061 |
(when dest |
|
4062 |
(setq name (substring dest 1)) |
|
4063 |
(cond |
|
4064 |
((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest) |
|
4065 |
(org-table-goto-field dest)) |
|
4066 |
((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" |
|
4067 |
dest) |
|
4068 |
(org-table-goto-field dest)) |
|
4069 |
(t (org-table-goto-column (string-to-number name)))) |
|
4070 |
(move-marker pos (point)) |
|
4071 |
(org-table-highlight-rectangle nil nil face2)) |
|
4072 |
(cond |
|
4073 |
((equal dest match)) |
|
4074 |
((not match)) |
|
4075 |
((eq what 'range) |
|
4076 |
(ignore-errors (org-table-get-range match table-start nil 'highlight))) |
|
4077 |
((setq e (assoc var org-table-named-field-locations)) |
|
4078 |
(org-table-goto-field var) |
|
4079 |
(org-table-highlight-rectangle) |
|
4080 |
(message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) |
|
4081 |
((setq e (assoc var org-table-column-names)) |
|
4082 |
(org-table-goto-column (string-to-number (cdr e))) |
|
4083 |
(org-table-highlight-rectangle) |
|
4084 |
(goto-char table-start) |
|
4085 |
(if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") |
|
4086 |
(org-table-end) t) |
|
4087 |
(progn |
|
4088 |
(goto-char (match-beginning 1)) |
|
4089 |
(org-table-highlight-rectangle) |
|
4090 |
(message "Named column (column %s)" (cdr e))) |
|
4091 |
(user-error "Column name not found"))) |
|
4092 |
((eq what 'column) |
|
4093 |
;; Column number. |
|
4094 |
(org-table-goto-column (string-to-number (substring match 1))) |
|
4095 |
(org-table-highlight-rectangle) |
|
4096 |
(message "Column %s" (substring match 1))) |
|
4097 |
((setq e (assoc var org-table-local-parameters)) |
|
4098 |
(goto-char table-start) |
|
4099 |
(if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) |
|
4100 |
(progn |
|
4101 |
(goto-char (match-beginning 1)) |
|
4102 |
(org-table-highlight-rectangle) |
|
4103 |
(message "Local parameter.")) |
|
4104 |
(user-error "Parameter not found"))) |
|
4105 |
((not var) (user-error "No reference at point")) |
|
4106 |
((setq e (assoc var org-table-formula-constants-local)) |
|
4107 |
(message "Local Constant: $%s=%s in #+CONSTANTS line." |
|
4108 |
var (cdr e))) |
|
4109 |
((setq e (assoc var org-table-formula-constants)) |
|
4110 |
(message "Constant: $%s=%s in `org-table-formula-constants'." |
|
4111 |
var (cdr e))) |
|
4112 |
((setq e (and (fboundp 'constants-get) (constants-get var))) |
|
4113 |
(message "Constant: $%s=%s, from `constants.el'%s." |
|
4114 |
var e (format " (%s units)" constants-unit-system))) |
|
4115 |
(t (user-error "Undefined name $%s" var))) |
|
4116 |
(goto-char pos) |
|
4117 |
(when (and org-show-positions |
|
4118 |
(not (memq this-command '(org-table-fedit-scroll |
|
4119 |
org-table-fedit-scroll-down)))) |
|
4120 |
(push pos org-show-positions) |
|
4121 |
(push table-start org-show-positions) |
|
4122 |
(let ((min (apply 'min org-show-positions)) |
|
4123 |
(max (apply 'max org-show-positions))) |
|
4124 |
(set-window-start (selected-window) min) |
|
4125 |
(goto-char max) |
|
4126 |
(or (pos-visible-in-window-p max) |
|
4127 |
(set-window-start (selected-window) max))))) |
|
4128 |
(select-window win)))) |
|
4129 |
|
|
4130 |
(defun org-table-force-dataline () |
|
4131 |
"Make sure the cursor is in a dataline in a table." |
|
4132 |
(unless (save-excursion |
|
4133 |
(beginning-of-line 1) |
|
4134 |
(looking-at org-table-dataline-regexp)) |
|
4135 |
(let* ((re org-table-dataline-regexp) |
|
4136 |
(p1 (save-excursion (re-search-forward re nil 'move))) |
|
4137 |
(p2 (save-excursion (re-search-backward re nil 'move)))) |
|
4138 |
(cond ((and p1 p2) |
|
4139 |
(goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) |
|
4140 |
p1 p2))) |
|
4141 |
((or p1 p2) (goto-char (or p1 p2))) |
|
4142 |
(t (user-error "No table dataline around here")))))) |
|
4143 |
|
|
4144 |
(defun org-table-fedit-line-up () |
|
4145 |
"Move cursor one line up in the window showing the table." |
|
4146 |
(interactive) |
|
4147 |
(org-table-fedit-move 'previous-line)) |
|
4148 |
|
|
4149 |
(defun org-table-fedit-line-down () |
|
4150 |
"Move cursor one line down in the window showing the table." |
|
4151 |
(interactive) |
|
4152 |
(org-table-fedit-move 'next-line)) |
|
4153 |
|
|
4154 |
(defun org-table-fedit-move (command) |
|
4155 |
"Move the cursor in the window showing the table. |
|
4156 |
Use COMMAND to do the motion, repeat if necessary to end up in a data line." |
|
4157 |
(let ((org-table-allow-automatic-line-recalculation nil) |
|
4158 |
(pos org-pos) (win (selected-window)) p) |
|
4159 |
(select-window (get-buffer-window (marker-buffer org-pos))) |
|
4160 |
(setq p (point)) |
|
4161 |
(call-interactively command) |
|
4162 |
(while (and (org-at-table-p) |
|
4163 |
(org-at-table-hline-p)) |
|
4164 |
(call-interactively command)) |
|
4165 |
(or (org-at-table-p) (goto-char p)) |
|
4166 |
(move-marker pos (point)) |
|
4167 |
(select-window win))) |
|
4168 |
|
|
4169 |
(defun org-table-fedit-scroll (N) |
|
4170 |
(interactive "p") |
|
4171 |
(let ((other-window-scroll-buffer (marker-buffer org-pos))) |
|
4172 |
(scroll-other-window N))) |
|
4173 |
|
|
4174 |
(defun org-table-fedit-scroll-down (N) |
|
4175 |
(interactive "p") |
|
4176 |
(org-table-fedit-scroll (- N))) |
|
4177 |
|
|
4178 |
(defvar org-table-rectangle-overlays nil) |
|
4179 |
|
|
4180 |
(defun org-table-add-rectangle-overlay (beg end &optional face) |
|
4181 |
"Add a new overlay." |
|
4182 |
(let ((ov (make-overlay beg end))) |
|
4183 |
(overlay-put ov 'face (or face 'secondary-selection)) |
|
4184 |
(push ov org-table-rectangle-overlays))) |
|
4185 |
|
|
4186 |
(defun org-table-highlight-rectangle (&optional beg end face) |
|
4187 |
"Highlight rectangular region in a table. |
|
4188 |
When buffer positions BEG and END are provided, use them to |
|
4189 |
delimit the region to highlight. Otherwise, refer to point. Use |
|
4190 |
FACE, when non-nil, for the highlight." |
|
4191 |
(let* ((beg (or beg (point))) |
|
4192 |
(end (or end (point))) |
|
4193 |
(b (min beg end)) |
|
4194 |
(e (max beg end)) |
|
4195 |
(start-coordinates |
|
4196 |
(save-excursion |
|
4197 |
(goto-char b) |
|
4198 |
(cons (line-beginning-position) (org-table-current-column)))) |
|
4199 |
(end-coordinates |
|
4200 |
(save-excursion |
|
4201 |
(goto-char e) |
|
4202 |
(cons (line-beginning-position) (org-table-current-column))))) |
|
4203 |
(when (boundp 'org-show-positions) |
|
4204 |
(setq org-show-positions (cons b (cons e org-show-positions)))) |
|
4205 |
(goto-char (car start-coordinates)) |
|
4206 |
(let ((column-start (min (cdr start-coordinates) (cdr end-coordinates))) |
|
4207 |
(column-end (max (cdr start-coordinates) (cdr end-coordinates))) |
|
4208 |
(last-row (car end-coordinates))) |
|
4209 |
(while (<= (point) last-row) |
|
4210 |
(when (looking-at org-table-dataline-regexp) |
|
4211 |
(org-table-goto-column column-start) |
|
4212 |
(skip-chars-backward "^|\n") |
|
4213 |
(let ((p (point))) |
|
4214 |
(org-table-goto-column column-end) |
|
4215 |
(skip-chars-forward "^|\n") |
|
4216 |
(org-table-add-rectangle-overlay p (point) face))) |
|
4217 |
(forward-line))) |
|
4218 |
(goto-char (car start-coordinates))) |
|
4219 |
(add-hook 'before-change-functions #'org-table-remove-rectangle-highlight)) |
|
4220 |
|
|
4221 |
(defun org-table-remove-rectangle-highlight (&rest _ignore) |
|
4222 |
"Remove the rectangle overlays." |
|
4223 |
(unless org-inhibit-highlight-removal |
|
4224 |
(remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) |
|
4225 |
(mapc 'delete-overlay org-table-rectangle-overlays) |
|
4226 |
(setq org-table-rectangle-overlays nil))) |
|
4227 |
|
|
4228 |
(defvar-local org-table-coordinate-overlays nil |
|
4229 |
"Collects the coordinate grid overlays, so that they can be removed.") |
|
4230 |
|
|
4231 |
(defun org-table-overlay-coordinates () |
|
4232 |
"Add overlays to the table at point, to show row/column coordinates." |
|
4233 |
(interactive) |
|
4234 |
(mapc 'delete-overlay org-table-coordinate-overlays) |
|
4235 |
(setq org-table-coordinate-overlays nil) |
|
4236 |
(save-excursion |
|
4237 |
(let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) |
|
4238 |
(goto-char (org-table-begin)) |
|
4239 |
(while (org-at-table-p) |
|
4240 |
(setq eol (point-at-eol)) |
|
4241 |
(setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) |
|
4242 |
(push ov org-table-coordinate-overlays) |
|
4243 |
(setq hline (looking-at org-table-hline-regexp)) |
|
4244 |
(setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) |
|
4245 |
(format "%4d" (setq id (1+ id))))) |
|
4246 |
(org-overlay-before-string ov str 'org-special-keyword 'evaporate) |
|
4247 |
(when hline |
|
4248 |
(setq ic 0) |
|
4249 |
(while (re-search-forward "[+|]\\(-+\\)" eol t) |
|
4250 |
(setq beg (1+ (match-beginning 0)) |
|
4251 |
ic (1+ ic) |
|
4252 |
s1 (concat "$" (int-to-string ic)) |
|
4253 |
s2 (org-number-to-letters ic) |
|
4254 |
str (if (eq org-table-use-standard-references t) s2 s1)) |
|
4255 |
(setq ov (make-overlay beg (+ beg (length str)))) |
|
4256 |
(push ov org-table-coordinate-overlays) |
|
4257 |
(org-overlay-display ov str 'org-special-keyword 'evaporate))) |
|
4258 |
(beginning-of-line 2))))) |
|
4259 |
|
|
4260 |
;;;###autoload |
|
4261 |
(defun org-table-toggle-coordinate-overlays () |
|
4262 |
"Toggle the display of Row/Column numbers in tables." |
|
4263 |
(interactive) |
|
4264 |
(setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) |
|
4265 |
(message "Tables Row/Column numbers display turned %s" |
|
4266 |
(if org-table-overlay-coordinates "on" "off")) |
|
4267 |
(if (and (org-at-table-p) org-table-overlay-coordinates) |
|
4268 |
(org-table-align)) |
|
4269 |
(unless org-table-overlay-coordinates |
|
4270 |
(mapc 'delete-overlay org-table-coordinate-overlays) |
|
4271 |
(setq org-table-coordinate-overlays nil))) |
|
4272 |
|
|
4273 |
;;;###autoload |
|
4274 |
(defun org-table-toggle-formula-debugger () |
|
4275 |
"Toggle the formula debugger in tables." |
|
4276 |
(interactive) |
|
4277 |
(setq org-table-formula-debug (not org-table-formula-debug)) |
|
4278 |
(message "Formula debugging has been turned %s" |
|
4279 |
(if org-table-formula-debug "on" "off"))) |
|
4280 |
|
|
4281 |
;;; The orgtbl minor mode |
|
4282 |
|
|
4283 |
;; Define a minor mode which can be used in other modes in order to |
|
4284 |
;; integrate the Org table editor. |
|
4285 |
|
|
4286 |
;; This is really a hack, because the Org table editor uses several |
|
4287 |
;; keys which normally belong to the major mode, for example the TAB |
|
4288 |
;; and RET keys. Here is how it works: The minor mode defines all the |
|
4289 |
;; keys necessary to operate the table editor, but wraps the commands |
|
4290 |
;; into a function which tests if the cursor is currently inside |
|
4291 |
;; a table. If that is the case, the table editor command is |
|
4292 |
;; executed. However, when any of those keys is used outside a table, |
|
4293 |
;; the function uses `key-binding' to look up if the key has an |
|
4294 |
;; associated command in another currently active keymap (minor modes, |
|
4295 |
;; major mode, global), and executes that command. There might be |
|
4296 |
;; problems if any of the keys used by the table editor is otherwise |
|
4297 |
;; used as a prefix key. |
|
4298 |
|
|
4299 |
;; Another challenge is that the key binding for TAB can be tab or \C-i, |
|
4300 |
;; likewise the binding for RET can be return or \C-m. Orgtbl-mode |
|
4301 |
;; addresses this by checking explicitly for both bindings. |
|
4302 |
|
|
4303 |
;; The optimized version (see variable `orgtbl-optimized') takes over |
|
4304 |
;; all keys which are bound to `self-insert-command' in the *global map*. |
|
4305 |
;; Some modes bind other commands to simple characters, for example |
|
4306 |
;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode |
|
4307 |
;; active, this binding is ignored inside tables and replaced with a |
|
4308 |
;; modified self-insert. |
|
4309 |
|
|
4310 |
|
|
4311 |
(defvar orgtbl-mode-map (make-keymap) |
|
4312 |
"Keymap for `orgtbl-mode'.") |
|
4313 |
|
|
4314 |
(defvar org-old-auto-fill-inhibit-regexp nil |
|
4315 |
"Local variable used by `orgtbl-mode'.") |
|
4316 |
|
|
4317 |
(defconst orgtbl-line-start-regexp |
|
4318 |
"[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)" |
|
4319 |
"Matches a line belonging to an orgtbl.") |
|
4320 |
|
|
4321 |
(defconst orgtbl-extra-font-lock-keywords |
|
4322 |
(list (list (concat "^" orgtbl-line-start-regexp ".*") |
|
4323 |
0 (quote 'org-table) 'prepend)) |
|
4324 |
"Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.") |
|
4325 |
|
|
4326 |
;; Install it as a minor mode. |
|
4327 |
(put 'orgtbl-mode :included t) |
|
4328 |
(put 'orgtbl-mode :menu-tag "Org Table Mode") |
|
4329 |
|
|
4330 |
;;;###autoload |
|
4331 |
(define-minor-mode orgtbl-mode |
|
4332 |
"The Org mode table editor as a minor mode for use in other modes." |
|
4333 |
:lighter " OrgTbl" :keymap orgtbl-mode-map |
|
4334 |
(org-load-modules-maybe) |
|
4335 |
(cond |
|
4336 |
((derived-mode-p 'org-mode) |
|
4337 |
;; Exit without error, in case some hook functions calls this by |
|
4338 |
;; accident in Org mode. |
|
4339 |
(message "Orgtbl mode is not useful in Org mode, command ignored")) |
|
4340 |
(orgtbl-mode |
|
4341 |
(and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?! |
|
4342 |
;; Make sure we are first in minor-mode-map-alist |
|
4343 |
(let ((c (assq 'orgtbl-mode minor-mode-map-alist))) |
|
4344 |
;; FIXME: maybe it should use emulation-mode-map-alists? |
|
4345 |
(and c (setq minor-mode-map-alist |
|
4346 |
(cons c (delq c minor-mode-map-alist))))) |
|
4347 |
(setq-local org-table-may-need-update t) |
|
4348 |
(add-hook 'before-change-functions 'org-before-change-function |
|
4349 |
nil 'local) |
|
4350 |
(setq-local org-old-auto-fill-inhibit-regexp |
|
4351 |
auto-fill-inhibit-regexp) |
|
4352 |
(setq-local auto-fill-inhibit-regexp |
|
4353 |
(if auto-fill-inhibit-regexp |
|
4354 |
(concat orgtbl-line-start-regexp "\\|" |
|
4355 |
auto-fill-inhibit-regexp) |
|
4356 |
orgtbl-line-start-regexp)) |
|
4357 |
(add-to-invisibility-spec '(org-cwidth)) |
|
4358 |
(when (fboundp 'font-lock-add-keywords) |
|
4359 |
(font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) |
|
4360 |
(org-restart-font-lock)) |
|
4361 |
(easy-menu-add orgtbl-mode-menu)) |
|
4362 |
(t |
|
4363 |
(setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) |
|
4364 |
(org-table-cleanup-narrow-column-properties) |
|
4365 |
(org-remove-from-invisibility-spec '(org-cwidth)) |
|
4366 |
(remove-hook 'before-change-functions 'org-before-change-function t) |
|
4367 |
(when (fboundp 'font-lock-remove-keywords) |
|
4368 |
(font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) |
|
4369 |
(org-restart-font-lock)) |
|
4370 |
(easy-menu-remove orgtbl-mode-menu) |
|
4371 |
(force-mode-line-update 'all)))) |
|
4372 |
|
|
4373 |
(defun org-table-cleanup-narrow-column-properties () |
|
4374 |
"Remove all properties related to narrow-column invisibility." |
|
4375 |
(let ((s (point-min))) |
|
4376 |
(while (setq s (text-property-any s (point-max) |
|
4377 |
'display org-narrow-column-arrow)) |
|
4378 |
(remove-text-properties s (1+ s) '(display t))) |
|
4379 |
(setq s (point-min)) |
|
4380 |
(while (setq s (text-property-any s (point-max) 'org-cwidth 1)) |
|
4381 |
(remove-text-properties s (1+ s) '(org-cwidth t))) |
|
4382 |
(setq s (point-min)) |
|
4383 |
(while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) |
|
4384 |
(remove-text-properties s (1+ s) '(invisible t))))) |
|
4385 |
|
|
4386 |
(defun orgtbl-make-binding (fun n &rest keys) |
|
4387 |
"Create a function for binding in the table minor mode. |
|
4388 |
FUN is the command to call inside a table. N is used to create a unique |
|
4389 |
command name. KEYS are keys that should be checked in for a command |
|
4390 |
to execute outside of tables." |
|
4391 |
(eval |
|
4392 |
(list 'defun |
|
4393 |
(intern (concat "orgtbl-hijacker-command-" (int-to-string n))) |
|
4394 |
'(arg) |
|
4395 |
(concat "In tables, run `" (symbol-name fun) "'.\n" |
|
4396 |
"Outside of tables, run the binding of `" |
|
4397 |
(mapconcat #'key-description keys "' or `") |
|
4398 |
"'.") |
|
4399 |
'(interactive "p") |
|
4400 |
(list 'if |
|
4401 |
'(org-at-table-p) |
|
4402 |
(list 'call-interactively (list 'quote fun)) |
|
4403 |
(list 'let '(orgtbl-mode) |
|
4404 |
(list 'call-interactively |
|
4405 |
(append '(or) |
|
4406 |
(mapcar (lambda (k) |
|
4407 |
(list 'key-binding k)) |
|
4408 |
keys) |
|
4409 |
'('orgtbl-error)))))))) |
|
4410 |
|
|
4411 |
(defun orgtbl-error () |
|
4412 |
"Error when there is no default binding for a table key." |
|
4413 |
(interactive) |
|
4414 |
(user-error "This key has no function outside tables")) |
|
4415 |
|
|
4416 |
(defun orgtbl-setup () |
|
4417 |
"Setup orgtbl keymaps." |
|
4418 |
(let ((nfunc 0) |
|
4419 |
(bindings |
|
4420 |
'(([(meta shift left)] org-table-delete-column) |
|
4421 |
([(meta left)] org-table-move-column-left) |
|
4422 |
([(meta right)] org-table-move-column-right) |
|
4423 |
([(meta shift right)] org-table-insert-column) |
|
4424 |
([(meta shift up)] org-table-kill-row) |
|
4425 |
([(meta shift down)] org-table-insert-row) |
|
4426 |
([(meta up)] org-table-move-row-up) |
|
4427 |
([(meta down)] org-table-move-row-down) |
|
4428 |
("\C-c\C-w" org-table-cut-region) |
|
4429 |
("\C-c\M-w" org-table-copy-region) |
|
4430 |
("\C-c\C-y" org-table-paste-rectangle) |
|
4431 |
("\C-c\C-w" org-table-wrap-region) |
|
4432 |
("\C-c-" org-table-insert-hline) |
|
4433 |
("\C-c}" org-table-toggle-coordinate-overlays) |
|
4434 |
("\C-c{" org-table-toggle-formula-debugger) |
|
4435 |
("\C-m" org-table-next-row) |
|
4436 |
([(shift return)] org-table-copy-down) |
|
4437 |
("\C-c?" org-table-field-info) |
|
4438 |
("\C-c " org-table-blank-field) |
|
4439 |
("\C-c+" org-table-sum) |
|
4440 |
("\C-c=" org-table-eval-formula) |
|
4441 |
("\C-c'" org-table-edit-formulas) |
|
4442 |
("\C-c`" org-table-edit-field) |
|
4443 |
("\C-c*" org-table-recalculate) |
|
4444 |
("\C-c^" org-table-sort-lines) |
|
4445 |
("\M-a" org-table-beginning-of-field) |
|
4446 |
("\M-e" org-table-end-of-field) |
|
4447 |
([(control ?#)] org-table-rotate-recalc-marks))) |
|
4448 |
elt key fun cmd) |
|
4449 |
(while (setq elt (pop bindings)) |
|
4450 |
(setq nfunc (1+ nfunc)) |
|
4451 |
(setq key (org-key (car elt)) |
|
4452 |
fun (nth 1 elt) |
|
4453 |
cmd (orgtbl-make-binding fun nfunc key)) |
|
4454 |
(org-defkey orgtbl-mode-map key cmd)) |
|
4455 |
|
|
4456 |
;; Special treatment needed for TAB, RET and DEL |
|
4457 |
(org-defkey orgtbl-mode-map [(return)] |
|
4458 |
(orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) |
|
4459 |
(org-defkey orgtbl-mode-map "\C-m" |
|
4460 |
(orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) |
|
4461 |
(org-defkey orgtbl-mode-map [(tab)] |
|
4462 |
(orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) |
|
4463 |
(org-defkey orgtbl-mode-map "\C-i" |
|
4464 |
(orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) |
|
4465 |
(org-defkey orgtbl-mode-map [(shift tab)] |
|
4466 |
(orgtbl-make-binding 'org-table-previous-field 104 |
|
4467 |
[(shift tab)] [(tab)] "\C-i")) |
|
4468 |
(org-defkey orgtbl-mode-map [backspace] |
|
4469 |
(orgtbl-make-binding 'org-delete-backward-char 109 |
|
4470 |
[backspace] (kbd "DEL"))) |
|
4471 |
|
|
4472 |
(org-defkey orgtbl-mode-map [S-iso-lefttab] |
|
4473 |
(orgtbl-make-binding 'org-table-previous-field 107 |
|
4474 |
[S-iso-lefttab] [backtab] [(shift tab)] |
|
4475 |
[(tab)] "\C-i")) |
|
4476 |
|
|
4477 |
(org-defkey orgtbl-mode-map [backtab] |
|
4478 |
(orgtbl-make-binding 'org-table-previous-field 108 |
|
4479 |
[backtab] [S-iso-lefttab] [(shift tab)] |
|
4480 |
[(tab)] "\C-i")) |
|
4481 |
|
|
4482 |
(org-defkey orgtbl-mode-map "\M-\C-m" |
|
4483 |
(orgtbl-make-binding 'org-table-wrap-region 105 |
|
4484 |
"\M-\C-m" [(meta return)])) |
|
4485 |
(org-defkey orgtbl-mode-map [(meta return)] |
|
4486 |
(orgtbl-make-binding 'org-table-wrap-region 106 |
|
4487 |
[(meta return)] "\M-\C-m")) |
|
4488 |
|
|
4489 |
(org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) |
|
4490 |
(org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region) |
|
4491 |
|
|
4492 |
(when orgtbl-optimized |
|
4493 |
;; If the user wants maximum table support, we need to hijack |
|
4494 |
;; some standard editing functions |
|
4495 |
(org-remap orgtbl-mode-map |
|
4496 |
'self-insert-command 'orgtbl-self-insert-command |
|
4497 |
'delete-char 'org-delete-char |
|
4498 |
'delete-backward-char 'org-delete-backward-char) |
|
4499 |
(org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) |
|
4500 |
(easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" |
|
4501 |
'("OrgTbl" |
|
4502 |
["Create or convert" org-table-create-or-convert-from-region |
|
4503 |
:active (not (org-at-table-p)) :keys "C-c |" ] |
|
4504 |
"--" |
|
4505 |
["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] |
|
4506 |
["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] |
|
4507 |
["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] |
|
4508 |
["Next Row" org-return :active (org-at-table-p) :keys "RET"] |
|
4509 |
"--" |
|
4510 |
["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] |
|
4511 |
["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] |
|
4512 |
["Copy Field from Above" |
|
4513 |
org-table-copy-down :active (org-at-table-p) :keys "S-RET"] |
|
4514 |
"--" |
|
4515 |
("Column" |
|
4516 |
["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] |
|
4517 |
["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"] |
|
4518 |
["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] |
|
4519 |
["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) |
|
4520 |
("Row" |
|
4521 |
["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"] |
|
4522 |
["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"] |
|
4523 |
["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] |
|
4524 |
["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] |
|
4525 |
["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"] |
|
4526 |
"--" |
|
4527 |
["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) |
|
4528 |
("Rectangle" |
|
4529 |
["Copy Rectangle" org-copy-special :active (org-at-table-p)] |
|
4530 |
["Cut Rectangle" org-cut-special :active (org-at-table-p)] |
|
4531 |
["Paste Rectangle" org-paste-special :active (org-at-table-p)] |
|
4532 |
["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) |
|
4533 |
"--" |
|
4534 |
("Radio tables" |
|
4535 |
["Insert table template" orgtbl-insert-radio-table |
|
4536 |
(cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)] |
|
4537 |
["Comment/uncomment table" orgtbl-toggle-comment t]) |
|
4538 |
"--" |
|
4539 |
["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] |
|
4540 |
["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] |
|
4541 |
["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] |
|
4542 |
["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] |
|
4543 |
["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] |
|
4544 |
["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] |
|
4545 |
["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] |
|
4546 |
["Sum Column/Rectangle" org-table-sum |
|
4547 |
:active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] |
|
4548 |
["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] |
|
4549 |
["Debug Formulas" |
|
4550 |
org-table-toggle-formula-debugger :active (org-at-table-p) |
|
4551 |
:keys "C-c {" |
|
4552 |
:style toggle :selected org-table-formula-debug] |
|
4553 |
["Show Col/Row Numbers" |
|
4554 |
org-table-toggle-coordinate-overlays :active (org-at-table-p) |
|
4555 |
:keys "C-c }" |
|
4556 |
:style toggle :selected org-table-overlay-coordinates] |
|
4557 |
"--" |
|
4558 |
("Plot" |
|
4559 |
["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"] |
|
4560 |
["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"]))) |
|
4561 |
t)) |
|
4562 |
|
|
4563 |
(defun orgtbl-ctrl-c-ctrl-c (arg) |
|
4564 |
"If the cursor is inside a table, realign the table. |
|
4565 |
If it is a table to be sent away to a receiver, do it. |
|
4566 |
With prefix arg, also recompute table." |
|
4567 |
(interactive "P") |
|
4568 |
(let ((case-fold-search t) (pos (point)) action) |
|
4569 |
(save-excursion |
|
4570 |
(beginning-of-line 1) |
|
4571 |
(setq action (cond |
|
4572 |
((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) |
|
4573 |
((looking-at "[ \t]*|") pos) |
|
4574 |
((looking-at "[ \t]*#\\+tblfm:") 'recalc)))) |
|
4575 |
(cond |
|
4576 |
((integerp action) |
|
4577 |
(goto-char action) |
|
4578 |
(org-table-maybe-eval-formula) |
|
4579 |
(if arg |
|
4580 |
(call-interactively 'org-table-recalculate) |
|
4581 |
(org-table-maybe-recalculate-line)) |
|
4582 |
(call-interactively 'org-table-align) |
|
4583 |
(when (orgtbl-send-table 'maybe) |
|
4584 |
(run-hooks 'orgtbl-after-send-table-hook))) |
|
4585 |
((eq action 'recalc) |
|
4586 |
(save-excursion |
|
4587 |
(beginning-of-line 1) |
|
4588 |
(skip-chars-backward " \r\n\t") |
|
4589 |
(if (org-at-table-p) |
|
4590 |
(org-call-with-arg 'org-table-recalculate t)))) |
|
4591 |
(t (let (orgtbl-mode) |
|
4592 |
(call-interactively (key-binding "\C-c\C-c"))))))) |
|
4593 |
|
|
4594 |
(defun orgtbl-create-or-convert-from-region (_arg) |
|
4595 |
"Create table or convert region to table, if no conflicting binding. |
|
4596 |
This installs the table binding `C-c |', but only if there is no |
|
4597 |
conflicting binding to this key outside orgtbl-mode." |
|
4598 |
(interactive "P") |
|
4599 |
(let* (orgtbl-mode (cmd (key-binding "\C-c|"))) |
|
4600 |
(if cmd |
|
4601 |
(call-interactively cmd) |
|
4602 |
(call-interactively 'org-table-create-or-convert-from-region)))) |
|
4603 |
|
|
4604 |
(defun orgtbl-tab (arg) |
|
4605 |
"Justification and field motion for `orgtbl-mode'." |
|
4606 |
(interactive "P") |
|
4607 |
(if arg (org-table-edit-field t) |
|
4608 |
(org-table-justify-field-maybe) |
|
4609 |
(org-table-next-field))) |
|
4610 |
|
|
4611 |
(defun orgtbl-ret () |
|
4612 |
"Justification and field motion for `orgtbl-mode'." |
|
4613 |
(interactive) |
|
4614 |
(if (bobp) |
|
4615 |
(newline) |
|
4616 |
(org-table-justify-field-maybe) |
|
4617 |
(org-table-next-row))) |
|
4618 |
|
|
4619 |
(defun orgtbl-self-insert-command (N) |
|
4620 |
"Like `self-insert-command', use overwrite-mode for whitespace in tables. |
|
4621 |
If the cursor is in a table looking at whitespace, the whitespace is |
|
4622 |
overwritten, and the table is not marked as requiring realignment." |
|
4623 |
(interactive "p") |
|
4624 |
(if (and (org-at-table-p) |
|
4625 |
(or |
|
4626 |
(and org-table-auto-blank-field |
|
4627 |
(member last-command |
|
4628 |
'(orgtbl-hijacker-command-100 |
|
4629 |
orgtbl-hijacker-command-101 |
|
4630 |
orgtbl-hijacker-command-102 |
|
4631 |
orgtbl-hijacker-command-103 |
|
4632 |
orgtbl-hijacker-command-104 |
|
4633 |
orgtbl-hijacker-command-105 |
|
4634 |
yas/expand)) |
|
4635 |
(org-table-blank-field)) |
|
4636 |
t) |
|
4637 |
(eq N 1) |
|
4638 |
(looking-at "[^|\n]* \\( \\)|")) |
|
4639 |
(let (org-table-may-need-update) |
|
4640 |
(delete-region (match-beginning 1) (match-end 1)) |
|
4641 |
(self-insert-command N)) |
|
4642 |
(setq org-table-may-need-update t) |
|
4643 |
(let* (orgtbl-mode |
|
4644 |
a |
|
4645 |
(cmd (or (key-binding |
|
4646 |
(or (and (listp function-key-map) |
|
4647 |
(setq a (assoc last-input-event function-key-map)) |
|
4648 |
(cdr a)) |
|
4649 |
(vector last-input-event))) |
|
4650 |
'self-insert-command))) |
|
4651 |
(call-interactively cmd) |
|
4652 |
(if (and org-self-insert-cluster-for-undo |
|
4653 |
(eq cmd 'self-insert-command)) |
|
4654 |
(if (not (eq last-command 'orgtbl-self-insert-command)) |
|
4655 |
(setq org-self-insert-command-undo-counter 1) |
|
4656 |
(if (>= org-self-insert-command-undo-counter 20) |
|
4657 |
(setq org-self-insert-command-undo-counter 1) |
|
4658 |
(and (> org-self-insert-command-undo-counter 0) |
|
4659 |
buffer-undo-list |
|
4660 |
(not (cadr buffer-undo-list)) ; remove nil entry |
|
4661 |
(setcdr buffer-undo-list (cddr buffer-undo-list))) |
|
4662 |
(setq org-self-insert-command-undo-counter |
|
4663 |
(1+ org-self-insert-command-undo-counter)))))))) |
|
4664 |
|
|
4665 |
;;;###autoload |
|
4666 |
(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" |
|
4667 |
"Regular expression matching exponentials as produced by calc.") |
|
4668 |
|
|
4669 |
(defun orgtbl-gather-send-defs () |
|
4670 |
"Gather a plist of :name, :transform, :params for each destination before |
|
4671 |
a radio table." |
|
4672 |
(save-excursion |
|
4673 |
(goto-char (org-table-begin)) |
|
4674 |
(let (rtn) |
|
4675 |
(beginning-of-line 0) |
|
4676 |
(while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") |
|
4677 |
(let ((name (org-no-properties (match-string 1))) |
|
4678 |
(transform (intern (match-string 2))) |
|
4679 |
(params (if (match-end 3) |
|
4680 |
(read (concat "(" (match-string 3) ")"))))) |
|
4681 |
(push (list :name name :transform transform :params params) |
|
4682 |
rtn) |
|
4683 |
(beginning-of-line 0))) |
|
4684 |
rtn))) |
|
4685 |
|
|
4686 |
(defun orgtbl-send-replace-tbl (name text) |
|
4687 |
"Find and replace table NAME with TEXT." |
|
4688 |
(save-excursion |
|
4689 |
(goto-char (point-min)) |
|
4690 |
(let* ((location-flag nil) |
|
4691 |
(name (regexp-quote name)) |
|
4692 |
(begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)) |
|
4693 |
(end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))) |
|
4694 |
(while (re-search-forward begin-re nil t) |
|
4695 |
(unless location-flag (setq location-flag t)) |
|
4696 |
(let ((beg (line-beginning-position 2))) |
|
4697 |
(unless (re-search-forward end-re nil t) |
|
4698 |
(user-error "Cannot find end of receiver location at %d" beg)) |
|
4699 |
(beginning-of-line) |
|
4700 |
(delete-region beg (point)) |
|
4701 |
(insert text "\n"))) |
|
4702 |
(unless location-flag |
|
4703 |
(user-error "No valid receiver location found in the buffer"))))) |
|
4704 |
|
|
4705 |
;;;###autoload |
|
4706 |
(defun org-table-to-lisp (&optional txt) |
|
4707 |
"Convert the table at point to a Lisp structure. |
|
4708 |
The structure will be a list. Each item is either the symbol `hline' |
|
4709 |
for a horizontal separator line, or a list of field values as strings. |
|
4710 |
The table is taken from the parameter TXT, or from the buffer at point." |
|
4711 |
(unless (or txt (org-at-table-p)) (user-error "No table at point")) |
|
4712 |
(let ((txt (or txt |
|
4713 |
(buffer-substring-no-properties (org-table-begin) |
|
4714 |
(org-table-end))))) |
|
4715 |
(mapcar (lambda (x) |
|
4716 |
(if (string-match org-table-hline-regexp x) 'hline |
|
4717 |
(org-split-string (org-trim x) "\\s-*|\\s-*"))) |
|
4718 |
(org-split-string txt "[ \t]*\n[ \t]*")))) |
|
4719 |
|
|
4720 |
(defun orgtbl-send-table (&optional maybe) |
|
4721 |
"Send a transformed version of table at point to the receiver position. |
|
4722 |
With argument MAYBE, fail quietly if no transformation is defined |
|
4723 |
for this table." |
|
4724 |
(interactive) |
|
4725 |
(catch 'exit |
|
4726 |
(unless (org-at-table-p) (user-error "Not at a table")) |
|
4727 |
;; when non-interactive, we assume align has just happened. |
|
4728 |
(when (called-interactively-p 'any) (org-table-align)) |
|
4729 |
(let ((dests (orgtbl-gather-send-defs)) |
|
4730 |
(table (org-table-to-lisp |
|
4731 |
(buffer-substring-no-properties (org-table-begin) |
|
4732 |
(org-table-end)))) |
|
4733 |
(ntbl 0)) |
|
4734 |
(unless dests |
|
4735 |
(if maybe (throw 'exit nil) |
|
4736 |
(user-error "Don't know how to transform this table"))) |
|
4737 |
(dolist (dest dests) |
|
4738 |
(let ((name (plist-get dest :name)) |
|
4739 |
(transform (plist-get dest :transform)) |
|
4740 |
(params (plist-get dest :params))) |
|
4741 |
(unless (fboundp transform) |
|
4742 |
(user-error "No such transformation function %s" transform)) |
|
4743 |
(orgtbl-send-replace-tbl name (funcall transform table params))) |
|
4744 |
(cl-incf ntbl)) |
|
4745 |
(message "Table converted and installed at %d receiver location%s" |
|
4746 |
ntbl (if (> ntbl 1) "s" "")) |
|
4747 |
(and (> ntbl 0) ntbl)))) |
|
4748 |
|
|
4749 |
(defun org-remove-by-index (list indices &optional i0) |
|
4750 |
"Remove the elements in LIST with indices in INDICES. |
|
4751 |
First element has index 0, or I0 if given." |
|
4752 |
(if (not indices) |
|
4753 |
list |
|
4754 |
(if (integerp indices) (setq indices (list indices))) |
|
4755 |
(setq i0 (1- (or i0 0))) |
|
4756 |
(delq :rm (mapcar (lambda (x) |
|
4757 |
(setq i0 (1+ i0)) |
|
4758 |
(if (memq i0 indices) :rm x)) |
|
4759 |
list)))) |
|
4760 |
|
|
4761 |
(defun orgtbl-toggle-comment () |
|
4762 |
"Comment or uncomment the orgtbl at point." |
|
4763 |
(interactive) |
|
4764 |
(let* ((case-fold-search t) |
|
4765 |
(re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) |
|
4766 |
(re2 (concat "^" orgtbl-line-start-regexp)) |
|
4767 |
(commented (save-excursion (beginning-of-line 1) |
|
4768 |
(cond ((looking-at re1) t) |
|
4769 |
((looking-at re2) nil) |
|
4770 |
(t (user-error "Not at an org table"))))) |
|
4771 |
(re (if commented re1 re2)) |
|
4772 |
beg end) |
|
4773 |
(save-excursion |
|
4774 |
(beginning-of-line 1) |
|
4775 |
(while (looking-at re) (beginning-of-line 0)) |
|
4776 |
(beginning-of-line 2) |
|
4777 |
(setq beg (point)) |
|
4778 |
(while (looking-at re) (beginning-of-line 2)) |
|
4779 |
(setq end (point))) |
|
4780 |
(comment-region beg end (if commented '(4) nil)))) |
|
4781 |
|
|
4782 |
(defun orgtbl-insert-radio-table () |
|
4783 |
"Insert a radio table template appropriate for this major mode." |
|
4784 |
(interactive) |
|
4785 |
(let* ((e (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)) |
|
4786 |
(txt (nth 1 e)) |
|
4787 |
name pos) |
|
4788 |
(unless e (user-error "No radio table setup defined for %s" major-mode)) |
|
4789 |
(setq name (read-string "Table name: ")) |
|
4790 |
(while (string-match "%n" txt) |
|
4791 |
(setq txt (replace-match name t t txt))) |
|
4792 |
(or (bolp) (insert "\n")) |
|
4793 |
(setq pos (point)) |
|
4794 |
(insert txt) |
|
4795 |
(goto-char pos))) |
|
4796 |
|
|
4797 |
;;;###autoload |
|
4798 |
(defun orgtbl-to-generic (table params) |
|
4799 |
"Convert the orgtbl-mode TABLE to some other format. |
|
4800 |
|
|
4801 |
This generic routine can be used for many standard cases. |
|
4802 |
|
|
4803 |
TABLE is a list, each entry either the symbol `hline' for |
|
4804 |
a horizontal separator line, or a list of fields for that |
|
4805 |
line. PARAMS is a property list of parameters that can |
|
4806 |
influence the conversion. |
|
4807 |
|
|
4808 |
Valid parameters are: |
|
4809 |
|
|
4810 |
:backend, :raw |
|
4811 |
|
|
4812 |
Export back-end used as a basis to transcode elements of the |
|
4813 |
table, when no specific parameter applies to it. It is also |
|
4814 |
used to translate cells contents. You can prevent this by |
|
4815 |
setting :raw property to a non-nil value. |
|
4816 |
|
|
4817 |
:splice |
|
4818 |
|
|
4819 |
When non-nil, only convert rows, not the table itself. This is |
|
4820 |
equivalent to setting to the empty string both :tstart |
|
4821 |
and :tend, which see. |
|
4822 |
|
|
4823 |
:skip |
|
4824 |
|
|
4825 |
When set to an integer N, skip the first N lines of the table. |
|
4826 |
Horizontal separation lines do count for this parameter! |
|
4827 |
|
|
4828 |
:skipcols |
|
4829 |
|
|
4830 |
List of columns that should be skipped. If the table has |
|
4831 |
a column with calculation marks, that column is automatically |
|
4832 |
discarded beforehand. |
|
4833 |
|
|
4834 |
:hline |
|
4835 |
|
|
4836 |
String to be inserted on horizontal separation lines. May be |
|
4837 |
nil to ignore these lines altogether. |
|
4838 |
|
|
4839 |
:sep |
|
4840 |
|
|
4841 |
Separator between two fields, as a string. |
|
4842 |
|
|
4843 |
Each in the following group may be either a string or a function |
|
4844 |
of no arguments returning a string: |
|
4845 |
|
|
4846 |
:tstart, :tend |
|
4847 |
|
|
4848 |
Strings to start and end the table. Ignored when :splice is t. |
|
4849 |
|
|
4850 |
:lstart, :lend |
|
4851 |
|
|
4852 |
Strings to start and end a new table line. |
|
4853 |
|
|
4854 |
:llstart, :llend |
|
4855 |
|
|
4856 |
Strings to start and end the last table line. Default, |
|
4857 |
respectively, to :lstart and :lend. |
|
4858 |
|
|
4859 |
Each in the following group may be a string or a function of one |
|
4860 |
argument (either the cells in the current row, as a list of |
|
4861 |
strings, or the current cell) returning a string: |
|
4862 |
|
|
4863 |
:lfmt |
|
4864 |
|
|
4865 |
Format string for an entire row, with enough %s to capture all |
|
4866 |
fields. When non-nil, :lstart, :lend, and :sep are ignored. |
|
4867 |
|
|
4868 |
:llfmt |
|
4869 |
|
|
4870 |
Format for the entire last line, defaults to :lfmt. |
|
4871 |
|
|
4872 |
:fmt |
|
4873 |
|
|
4874 |
A format to be used to wrap the field, should contain %s for |
|
4875 |
the original field value. For example, to wrap everything in |
|
4876 |
dollars, you could use :fmt \"$%s$\". This may also be |
|
4877 |
a property list with column numbers and format strings, or |
|
4878 |
functions, e.g., |
|
4879 |
|
|
4880 |
(:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c)))) |
|
4881 |
|
|
4882 |
:hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt |
|
4883 |
|
|
4884 |
Same as above, specific for the header lines in the table. |
|
4885 |
All lines before the first hline are treated as header. If |
|
4886 |
any of these is not present, the data line value is used. |
|
4887 |
|
|
4888 |
This may be either a string or a function of two arguments: |
|
4889 |
|
|
4890 |
:efmt |
|
4891 |
|
|
4892 |
Use this format to print numbers with exponential. The format |
|
4893 |
should have %s twice for inserting mantissa and exponent, for |
|
4894 |
example \"%s\\\\times10^{%s}\". This may also be a property |
|
4895 |
list with column numbers and format strings or functions. |
|
4896 |
:fmt will still be applied after :efmt." |
|
4897 |
;; Make sure `org-export-create-backend' is available. |
|
4898 |
(require 'ox) |
|
4899 |
(let* ((backend (plist-get params :backend)) |
|
4900 |
(custom-backend |
|
4901 |
;; Build a custom back-end according to PARAMS. Before |
|
4902 |
;; defining a translator, check if there is anything to do. |
|
4903 |
;; When there isn't, let BACKEND handle the element. |
|
4904 |
(org-export-create-backend |
|
4905 |
:parent (or backend 'org) |
|
4906 |
:transcoders |
|
4907 |
`((table . ,(org-table--to-generic-table params)) |
|
4908 |
(table-row . ,(org-table--to-generic-row params)) |
|
4909 |
(table-cell . ,(org-table--to-generic-cell params)) |
|
4910 |
;; Macros are not going to be expanded. However, no |
|
4911 |
;; regular back-end has a transcoder for them. We |
|
4912 |
;; provide one so they are not ignored, but displayed |
|
4913 |
;; as-is instead. |
|
4914 |
(macro . (lambda (m c i) (org-element-macro-interpreter m nil)))))) |
|
4915 |
data info) |
|
4916 |
;; Store TABLE as Org syntax in DATA. Tolerate non-string cells. |
|
4917 |
;; Initialize communication channel in INFO. |
|
4918 |
(with-temp-buffer |
|
4919 |
(let ((org-inhibit-startup t)) (org-mode)) |
|
4920 |
(let ((standard-output (current-buffer)) |
|
4921 |
(org-element-use-cache nil)) |
|
4922 |
(dolist (e table) |
|
4923 |
(cond ((eq e 'hline) (princ "|--\n")) |
|
4924 |
((consp e) |
|
4925 |
(princ "| ") (dolist (c e) (princ c) (princ " |")) |
|
4926 |
(princ "\n"))))) |
|
4927 |
;; Add back-end specific filters, but not user-defined ones. In |
|
4928 |
;; particular, make sure to call parse-tree filters on the |
|
4929 |
;; table. |
|
4930 |
(setq info |
|
4931 |
(let ((org-export-filters-alist nil)) |
|
4932 |
(org-export-install-filters |
|
4933 |
(org-combine-plists |
|
4934 |
(org-export-get-environment backend nil params) |
|
4935 |
`(:back-end ,(org-export-get-backend backend)))))) |
|
4936 |
(setq data |
|
4937 |
(org-export-filter-apply-functions |
|
4938 |
(plist-get info :filter-parse-tree) |
|
4939 |
(org-element-map (org-element-parse-buffer) 'table |
|
4940 |
#'identity nil t) |
|
4941 |
info))) |
|
4942 |
(when (and backend (symbolp backend) (not (org-export-get-backend backend))) |
|
4943 |
(user-error "Unknown :backend value")) |
|
4944 |
(when (or (not backend) (plist-get info :raw)) (require 'ox-org)) |
|
4945 |
;; Handle :skip parameter. |
|
4946 |
(let ((skip (plist-get info :skip))) |
|
4947 |
(when skip |
|
4948 |
(unless (wholenump skip) (user-error "Wrong :skip value")) |
|
4949 |
(let ((n 0)) |
|
4950 |
(org-element-map data 'table-row |
|
4951 |
(lambda (row) |
|
4952 |
(if (>= n skip) t |
|
4953 |
(org-element-extract-element row) |
|
4954 |
(cl-incf n) |
|
4955 |
nil)) |
|
4956 |
nil t)))) |
|
4957 |
;; Handle :skipcols parameter. |
|
4958 |
(let ((skipcols (plist-get info :skipcols))) |
|
4959 |
(when skipcols |
|
4960 |
(unless (consp skipcols) (user-error "Wrong :skipcols value")) |
|
4961 |
(org-element-map data 'table |
|
4962 |
(lambda (table) |
|
4963 |
(let ((specialp (org-export-table-has-special-column-p table))) |
|
4964 |
(dolist (row (org-element-contents table)) |
|
4965 |
(when (eq (org-element-property :type row) 'standard) |
|
4966 |
(let ((c 1)) |
|
4967 |
(dolist (cell (nthcdr (if specialp 1 0) |
|
4968 |
(org-element-contents row))) |
|
4969 |
(when (memq c skipcols) |
|
4970 |
(org-element-extract-element cell)) |
|
4971 |
(cl-incf c)))))))))) |
|
4972 |
;; Since we are going to export using a low-level mechanism, |
|
4973 |
;; ignore special column and special rows manually. |
|
4974 |
(let ((special? (org-export-table-has-special-column-p data)) |
|
4975 |
ignore) |
|
4976 |
(org-element-map data (if special? '(table-cell table-row) 'table-row) |
|
4977 |
(lambda (datum) |
|
4978 |
(when (if (eq (org-element-type datum) 'table-row) |
|
4979 |
(org-export-table-row-is-special-p datum nil) |
|
4980 |
(org-export-first-sibling-p datum nil)) |
|
4981 |
(push datum ignore)))) |
|
4982 |
(setq info (plist-put info :ignore-list ignore))) |
|
4983 |
;; We use a low-level mechanism to export DATA so as to skip all |
|
4984 |
;; usual pre-processing and post-processing, i.e., hooks, Babel |
|
4985 |
;; code evaluation, include keywords and macro expansion. Only |
|
4986 |
;; back-end specific filters are retained. |
|
4987 |
(let ((output (org-export-data-with-backend data custom-backend info))) |
|
4988 |
;; Remove final newline. |
|
4989 |
(if (org-string-nw-p output) (substring-no-properties output 0 -1) "")))) |
|
4990 |
|
|
4991 |
(defun org-table--generic-apply (value name &optional with-cons &rest args) |
|
4992 |
(cond ((null value) nil) |
|
4993 |
((functionp value) `(funcall ',value ,@args)) |
|
4994 |
((stringp value) |
|
4995 |
(cond ((consp (car args)) `(apply #'format ,value ,@args)) |
|
4996 |
(args `(format ,value ,@args)) |
|
4997 |
(t value))) |
|
4998 |
((and with-cons (consp value)) |
|
4999 |
`(let ((val (cadr (memq column ',value)))) |
|
5000 |
(cond ((null val) contents) |
|
5001 |
((stringp val) (format val ,@args)) |
|
5002 |
((functionp val) (funcall val ,@args)) |
|
5003 |
(t (user-error "Wrong %s value" ,name))))) |
|
5004 |
(t (user-error "Wrong %s value" name)))) |
|
5005 |
|
|
5006 |
(defun org-table--to-generic-table (params) |
|
5007 |
"Return custom table transcoder according to PARAMS. |
|
5008 |
PARAMS is a plist. See `orgtbl-to-generic' for more |
|
5009 |
information." |
|
5010 |
(let ((backend (plist-get params :backend)) |
|
5011 |
(splice (plist-get params :splice)) |
|
5012 |
(tstart (plist-get params :tstart)) |
|
5013 |
(tend (plist-get params :tend))) |
|
5014 |
`(lambda (table contents info) |
|
5015 |
(concat |
|
5016 |
,(and tstart (not splice) |
|
5017 |
`(concat ,(org-table--generic-apply tstart ":tstart") "\n")) |
|
5018 |
,(if (or (not backend) tstart tend splice) 'contents |
|
5019 |
`(org-export-with-backend ',backend table contents info)) |
|
5020 |
,(org-table--generic-apply (and (not splice) tend) ":tend"))))) |
|
5021 |
|
|
5022 |
(defun org-table--to-generic-row (params) |
|
5023 |
"Return custom table row transcoder according to PARAMS. |
|
5024 |
PARAMS is a plist. See `orgtbl-to-generic' for more |
|
5025 |
information." |
|
5026 |
(let* ((backend (plist-get params :backend)) |
|
5027 |
(lstart (plist-get params :lstart)) |
|
5028 |
(llstart (plist-get params :llstart)) |
|
5029 |
(hlstart (plist-get params :hlstart)) |
|
5030 |
(hllstart (plist-get params :hllstart)) |
|
5031 |
(lend (plist-get params :lend)) |
|
5032 |
(llend (plist-get params :llend)) |
|
5033 |
(hlend (plist-get params :hlend)) |
|
5034 |
(hllend (plist-get params :hllend)) |
|
5035 |
(lfmt (plist-get params :lfmt)) |
|
5036 |
(llfmt (plist-get params :llfmt)) |
|
5037 |
(hlfmt (plist-get params :hlfmt)) |
|
5038 |
(hllfmt (plist-get params :hllfmt))) |
|
5039 |
`(lambda (row contents info) |
|
5040 |
(if (eq (org-element-property :type row) 'rule) |
|
5041 |
,(cond |
|
5042 |
((plist-member params :hline) |
|
5043 |
(org-table--generic-apply (plist-get params :hline) ":hline")) |
|
5044 |
(backend `(org-export-with-backend ',backend row nil info))) |
|
5045 |
(let ((headerp ,(and (or hlfmt hlstart hlend) |
|
5046 |
'(org-export-table-row-in-header-p row info))) |
|
5047 |
(last-header-p |
|
5048 |
,(and (or hllfmt hllstart hllend) |
|
5049 |
'(org-export-table-row-ends-header-p row info))) |
|
5050 |
(lastp (not (org-export-get-next-element row info)))) |
|
5051 |
(when contents |
|
5052 |
;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or |
|
5053 |
;; `:hllfmt' to CONTENTS. Otherwise, fallback on |
|
5054 |
;; `:lstart', `:lend' and their relatives. |
|
5055 |
,(let ((cells |
|
5056 |
'(org-element-map row 'table-cell |
|
5057 |
(lambda (cell) |
|
5058 |
;; Export all cells, without separators. |
|
5059 |
;; |
|
5060 |
;; Use `org-export-data-with-backend' |
|
5061 |
;; instead of `org-export-data' to eschew |
|
5062 |
;; cached values, which |
|
5063 |
;; ignore :orgtbl-ignore-sep parameter. |
|
5064 |
(org-export-data-with-backend |
|
5065 |
cell |
|
5066 |
(plist-get info :back-end) |
|
5067 |
(org-combine-plists info '(:orgtbl-ignore-sep t)))) |
|
5068 |
info))) |
|
5069 |
`(cond |
|
5070 |
,(and hllfmt |
|
5071 |
`(last-header-p ,(org-table--generic-apply |
|
5072 |
hllfmt ":hllfmt" nil cells))) |
|
5073 |
,(and hlfmt |
|
5074 |
`(headerp ,(org-table--generic-apply |
|
5075 |
hlfmt ":hlfmt" nil cells))) |
|
5076 |
,(and llfmt |
|
5077 |
`(lastp ,(org-table--generic-apply |
|
5078 |
llfmt ":llfmt" nil cells))) |
|
5079 |
(t |
|
5080 |
,(if lfmt (org-table--generic-apply lfmt ":lfmt" nil cells) |
|
5081 |
`(concat |
|
5082 |
(cond |
|
5083 |
,(and |
|
5084 |
(or hllstart hllend) |
|
5085 |
`(last-header-p |
|
5086 |
(concat |
|
5087 |
,(org-table--generic-apply hllstart ":hllstart") |
|
5088 |
contents |
|
5089 |
,(org-table--generic-apply hllend ":hllend")))) |
|
5090 |
,(and |
|
5091 |
(or hlstart hlend) |
|
5092 |
`(headerp |
|
5093 |
(concat |
|
5094 |
,(org-table--generic-apply hlstart ":hlstart") |
|
5095 |
contents |
|
5096 |
,(org-table--generic-apply hlend ":hlend")))) |
|
5097 |
,(and |
|
5098 |
(or llstart llend) |
|
5099 |
`(lastp |
|
5100 |
(concat |
|
5101 |
,(org-table--generic-apply llstart ":llstart") |
|
5102 |
contents |
|
5103 |
,(org-table--generic-apply llend ":llend")))) |
|
5104 |
(t |
|
5105 |
,(cond |
|
5106 |
((or lstart lend) |
|
5107 |
`(concat |
|
5108 |
,(org-table--generic-apply lstart ":lstart") |
|
5109 |
contents |
|
5110 |
,(org-table--generic-apply lend ":lend"))) |
|
5111 |
(backend |
|
5112 |
`(org-export-with-backend |
|
5113 |
',backend row contents info)) |
|
5114 |
(t 'contents))))))))))))))) |
|
5115 |
|
|
5116 |
(defun org-table--to-generic-cell (params) |
|
5117 |
"Return custom table cell transcoder according to PARAMS. |
|
5118 |
PARAMS is a plist. See `orgtbl-to-generic' for more |
|
5119 |
information." |
|
5120 |
(let* ((backend (plist-get params :backend)) |
|
5121 |
(efmt (plist-get params :efmt)) |
|
5122 |
(fmt (plist-get params :fmt)) |
|
5123 |
(hfmt (plist-get params :hfmt)) |
|
5124 |
(sep (plist-get params :sep)) |
|
5125 |
(hsep (plist-get params :hsep))) |
|
5126 |
`(lambda (cell contents info) |
|
5127 |
;; Make sure that contents are exported as Org data when :raw |
|
5128 |
;; parameter is non-nil. |
|
5129 |
,(when (and backend (plist-get params :raw)) |
|
5130 |
`(setq contents |
|
5131 |
;; Since we don't know what are the pseudo object |
|
5132 |
;; types defined in backend, we cannot pass them to |
|
5133 |
;; `org-element-interpret-data'. As a consequence, |
|
5134 |
;; they will be treated as pseudo elements, and will |
|
5135 |
;; have newlines appended instead of spaces. |
|
5136 |
;; Therefore, we must make sure :post-blank value is |
|
5137 |
;; really turned into spaces. |
|
5138 |
(replace-regexp-in-string |
|
5139 |
"\n" " " |
|
5140 |
(org-trim |
|
5141 |
(org-element-interpret-data |
|
5142 |
(org-element-contents cell)))))) |
|
5143 |
|
|
5144 |
(let ((headerp ,(and (or hfmt hsep) |
|
5145 |
'(org-export-table-row-in-header-p |
|
5146 |
(org-export-get-parent-element cell) info))) |
|
5147 |
(column |
|
5148 |
;; Call costly `org-export-table-cell-address' only if |
|
5149 |
;; absolutely necessary, i.e., if one |
|
5150 |
;; of :fmt :efmt :hfmt has a "plist type" value. |
|
5151 |
,(and (cl-some (lambda (v) (integerp (car-safe v))) |
|
5152 |
(list efmt hfmt fmt)) |
|
5153 |
'(1+ (cdr (org-export-table-cell-address cell info)))))) |
|
5154 |
(when contents |
|
5155 |
;; Check if we can apply `:efmt' on CONTENTS. |
|
5156 |
,(when efmt |
|
5157 |
`(when (string-match orgtbl-exp-regexp contents) |
|
5158 |
(let ((mantissa (match-string 1 contents)) |
|
5159 |
(exponent (match-string 2 contents))) |
|
5160 |
(setq contents ,(org-table--generic-apply |
|
5161 |
efmt ":efmt" t 'mantissa 'exponent))))) |
|
5162 |
;; Check if we can apply FMT (or HFMT) on CONTENTS. |
|
5163 |
(cond |
|
5164 |
,(and hfmt `(headerp (setq contents ,(org-table--generic-apply |
|
5165 |
hfmt ":hfmt" t 'contents)))) |
|
5166 |
,(and fmt `(t (setq contents ,(org-table--generic-apply |
|
5167 |
fmt ":fmt" t 'contents)))))) |
|
5168 |
;; If a separator is provided, use it instead of BACKEND's. |
|
5169 |
;; Separators are ignored when LFMT (or equivalent) is |
|
5170 |
;; provided. |
|
5171 |
,(cond |
|
5172 |
((or hsep sep) |
|
5173 |
`(if (or ,(and (not sep) '(not headerp)) |
|
5174 |
(plist-get info :orgtbl-ignore-sep) |
|
5175 |
(not (org-export-get-next-element cell info))) |
|
5176 |
,(if (not backend) 'contents |
|
5177 |
`(org-export-with-backend ',backend cell contents info)) |
|
5178 |
(concat contents |
|
5179 |
,(if (and sep hsep) `(if headerp ,hsep ,sep) |
|
5180 |
(or hsep sep))))) |
|
5181 |
(backend `(org-export-with-backend ',backend cell contents info)) |
|
5182 |
(t 'contents)))))) |
|
5183 |
|
|
5184 |
;;;###autoload |
|
5185 |
(defun orgtbl-to-tsv (table params) |
|
5186 |
"Convert the orgtbl-mode table to TAB separated material." |
|
5187 |
(orgtbl-to-generic table (org-combine-plists '(:sep "\t") params))) |
|
5188 |
|
|
5189 |
;;;###autoload |
|
5190 |
(defun orgtbl-to-csv (table params) |
|
5191 |
"Convert the orgtbl-mode table to CSV material. |
|
5192 |
This does take care of the proper quoting of fields with comma or quotes." |
|
5193 |
(orgtbl-to-generic table |
|
5194 |
(org-combine-plists '(:sep "," :fmt org-quote-csv-field) |
|
5195 |
params))) |
|
5196 |
|
|
5197 |
;;;###autoload |
|
5198 |
(defun orgtbl-to-latex (table params) |
|
5199 |
"Convert the orgtbl-mode TABLE to LaTeX. |
|
5200 |
|
|
5201 |
TABLE is a list, each entry either the symbol `hline' for |
|
5202 |
a horizontal separator line, or a list of fields for that line. |
|
5203 |
PARAMS is a property list of parameters that can influence the |
|
5204 |
conversion. All parameters from `orgtbl-to-generic' are |
|
5205 |
supported. It is also possible to use the following ones: |
|
5206 |
|
|
5207 |
:booktabs |
|
5208 |
|
|
5209 |
When non-nil, use formal \"booktabs\" style. |
|
5210 |
|
|
5211 |
:environment |
|
5212 |
|
|
5213 |
Specify environment to use, as a string. If you use |
|
5214 |
\"longtable\", you may also want to specify :language property, |
|
5215 |
as a string, to get proper continuation strings." |
|
5216 |
(require 'ox-latex) |
|
5217 |
(orgtbl-to-generic |
|
5218 |
table |
|
5219 |
(org-combine-plists |
|
5220 |
;; Provide sane default values. |
|
5221 |
(list :backend 'latex |
|
5222 |
:latex-default-table-mode 'table |
|
5223 |
:latex-tables-centered nil |
|
5224 |
:latex-tables-booktabs (plist-get params :booktabs) |
|
5225 |
:latex-table-scientific-notation nil |
|
5226 |
:latex-default-table-environment |
|
5227 |
(or (plist-get params :environment) "tabular")) |
|
5228 |
params))) |
|
5229 |
|
|
5230 |
;;;###autoload |
|
5231 |
(defun orgtbl-to-html (table params) |
|
5232 |
"Convert the orgtbl-mode TABLE to HTML. |
|
5233 |
|
|
5234 |
TABLE is a list, each entry either the symbol `hline' for |
|
5235 |
a horizontal separator line, or a list of fields for that line. |
|
5236 |
PARAMS is a property list of parameters that can influence the |
|
5237 |
conversion. All parameters from `orgtbl-to-generic' are |
|
5238 |
supported. It is also possible to use the following one: |
|
5239 |
|
|
5240 |
:attributes |
|
5241 |
|
|
5242 |
Attributes and values, as a plist, which will be used in |
|
5243 |
<table> tag." |
|
5244 |
(require 'ox-html) |
|
5245 |
(orgtbl-to-generic |
|
5246 |
table |
|
5247 |
(org-combine-plists |
|
5248 |
;; Provide sane default values. |
|
5249 |
(list :backend 'html |
|
5250 |
:html-table-data-tags '("<td%s>" . "</td>") |
|
5251 |
:html-table-use-header-tags-for-first-column nil |
|
5252 |
:html-table-align-individual-fields t |
|
5253 |
:html-table-row-tags '("<tr>" . "</tr>") |
|
5254 |
:html-table-attributes |
|
5255 |
(if (plist-member params :attributes) |
|
5256 |
(plist-get params :attributes) |
|
5257 |
'(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" |
|
5258 |
:frame "hsides"))) |
|
5259 |
params))) |
|
5260 |
|
|
5261 |
;;;###autoload |
|
5262 |
(defun orgtbl-to-texinfo (table params) |
|
5263 |
"Convert the orgtbl-mode TABLE to Texinfo. |
|
5264 |
|
|
5265 |
TABLE is a list, each entry either the symbol `hline' for |
|
5266 |
a horizontal separator line, or a list of fields for that line. |
|
5267 |
PARAMS is a property list of parameters that can influence the |
|
5268 |
conversion. All parameters from `orgtbl-to-generic' are |
|
5269 |
supported. It is also possible to use the following one: |
|
5270 |
|
|
5271 |
:columns |
|
5272 |
|
|
5273 |
Column widths, as a string. When providing column fractions, |
|
5274 |
\"@columnfractions\" command can be omitted." |
|
5275 |
(require 'ox-texinfo) |
|
5276 |
(let ((output |
|
5277 |
(orgtbl-to-generic |
|
5278 |
table |
|
5279 |
(org-combine-plists |
|
5280 |
(list :backend 'texinfo |
|
5281 |
:texinfo-tables-verbatim nil |
|
5282 |
:texinfo-table-scientific-notation nil) |
|
5283 |
params))) |
|
5284 |
(columns (let ((w (plist-get params :columns))) |
|
5285 |
(cond ((not w) nil) |
|
5286 |
((string-match-p "{\\|@columnfractions " w) w) |
|
5287 |
(t (concat "@columnfractions " w)))))) |
|
5288 |
(if (not columns) output |
|
5289 |
(replace-regexp-in-string |
|
5290 |
"@multitable \\(.*\\)" columns output t nil 1)))) |
|
5291 |
|
|
5292 |
;;;###autoload |
|
5293 |
(defun orgtbl-to-orgtbl (table params) |
|
5294 |
"Convert the orgtbl-mode TABLE into another orgtbl-mode table. |
|
5295 |
|
|
5296 |
TABLE is a list, each entry either the symbol `hline' for |
|
5297 |
a horizontal separator line, or a list of fields for that line. |
|
5298 |
PARAMS is a property list of parameters that can influence the |
|
5299 |
conversion. All parameters from `orgtbl-to-generic' are |
|
5300 |
supported. |
|
5301 |
|
|
5302 |
Useful when slicing one table into many. The :hline, :sep, |
|
5303 |
:lstart, and :lend provide orgtbl framing. :tstart and :tend can |
|
5304 |
be set to provide ORGTBL directives for the generated table." |
|
5305 |
(require 'ox-org) |
|
5306 |
(orgtbl-to-generic table (org-combine-plists params (list :backend 'org)))) |
|
5307 |
|
|
5308 |
(defun orgtbl-to-table.el (table params) |
|
5309 |
"Convert the orgtbl-mode TABLE into a table.el table. |
|
5310 |
TABLE is a list, each entry either the symbol `hline' for |
|
5311 |
a horizontal separator line, or a list of fields for that line. |
|
5312 |
PARAMS is a property list of parameters that can influence the |
|
5313 |
conversion. All parameters from `orgtbl-to-generic' are |
|
5314 |
supported." |
|
5315 |
(with-temp-buffer |
|
5316 |
(insert (orgtbl-to-orgtbl table params)) |
|
5317 |
(org-table-align) |
|
5318 |
(replace-regexp-in-string |
|
5319 |
"-|" "-+" |
|
5320 |
(replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size)))))) |
|
5321 |
|
|
5322 |
(defun orgtbl-to-unicode (table params) |
|
5323 |
"Convert the orgtbl-mode TABLE into a table with unicode characters. |
|
5324 |
|
|
5325 |
TABLE is a list, each entry either the symbol `hline' for |
|
5326 |
a horizontal separator line, or a list of fields for that line. |
|
5327 |
PARAMS is a property list of parameters that can influence the |
|
5328 |
conversion. All parameters from `orgtbl-to-generic' are |
|
5329 |
supported. It is also possible to use the following ones: |
|
5330 |
|
|
5331 |
:ascii-art |
|
5332 |
|
|
5333 |
When non-nil, use \"ascii-art-to-unicode\" package to translate |
|
5334 |
the table. You can download it here: |
|
5335 |
http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el. |
|
5336 |
|
|
5337 |
:narrow |
|
5338 |
|
|
5339 |
When non-nil, narrow columns width than provided width cookie, |
|
5340 |
using \"=>\" as an ellipsis, just like in an Org mode buffer." |
|
5341 |
(require 'ox-ascii) |
|
5342 |
(orgtbl-to-generic |
|
5343 |
table |
|
5344 |
(org-combine-plists |
|
5345 |
(list :backend 'ascii |
|
5346 |
:ascii-charset 'utf-8 |
|
5347 |
:ascii-table-widen-columns (not (plist-get params :narrow)) |
|
5348 |
:ascii-table-use-ascii-art (plist-get params :ascii-art)) |
|
5349 |
params))) |
|
5350 |
|
|
5351 |
;; Put the cursor in a column containing numerical values |
|
5352 |
;; of an Org table, |
|
5353 |
;; type C-c " a |
|
5354 |
;; A new column is added with a bar plot. |
|
5355 |
;; When the table is refreshed (C-u C-c *), |
|
5356 |
;; the plot is updated to reflect the new values. |
|
5357 |
|
|
5358 |
(defun orgtbl-ascii-draw (value min max &optional width characters) |
|
5359 |
"Draw an ascii bar in a table. |
|
5360 |
VALUE is the value to plot, it determines the width of the bar to draw. |
|
5361 |
MIN is the value that will be displayed as empty (zero width bar). |
|
5362 |
MAX is the value that will draw a bar filling all the WIDTH. |
|
5363 |
WIDTH is the span in characters from MIN to MAX. |
|
5364 |
CHARACTERS is a string that will compose the bar, with shades of grey |
|
5365 |
from pure white to pure black. It defaults to a 10 characters string |
|
5366 |
of regular ascii characters." |
|
5367 |
(let* ((width (ceiling (or width 12))) |
|
5368 |
(characters (or characters " .:;c!lhVHW")) |
|
5369 |
(len (1- (length characters))) |
|
5370 |
(value (float (if (numberp value) |
|
5371 |
value (string-to-number value)))) |
|
5372 |
(relative (/ (- value min) (- max min))) |
|
5373 |
(steps (round (* relative width len)))) |
|
5374 |
(cond ((< steps 0) "too small") |
|
5375 |
((> steps (* width len)) "too large") |
|
5376 |
(t (let* ((int-division (/ steps len)) |
|
5377 |
(remainder (- steps (* int-division len)))) |
|
5378 |
(concat (make-string int-division (elt characters len)) |
|
5379 |
(string (elt characters remainder)))))))) |
|
5380 |
|
|
5381 |
;;;###autoload |
|
5382 |
(defun orgtbl-ascii-plot (&optional ask) |
|
5383 |
"Draw an ASCII bar plot in a column. |
|
5384 |
|
|
5385 |
With cursor in a column containing numerical values, this function |
|
5386 |
will draw a plot in a new column. |
|
5387 |
|
|
5388 |
ASK, if given, is a numeric prefix to override the default 12 |
|
5389 |
characters width of the plot. ASK may also be the `\\[universal-argument]' \ |
|
5390 |
prefix, |
|
5391 |
which will prompt for the width." |
|
5392 |
(interactive "P") |
|
5393 |
(let ((col (org-table-current-column)) |
|
5394 |
(min 1e999) ; 1e999 will be converted to infinity |
|
5395 |
(max -1e999) ; which is the desired result |
|
5396 |
(table (org-table-to-lisp)) |
|
5397 |
(length |
|
5398 |
(cond ((consp ask) |
|
5399 |
(read-number "Length of column " 12)) |
|
5400 |
((numberp ask) ask) |
|
5401 |
(t 12)))) |
|
5402 |
;; Skip any hline a the top of table. |
|
5403 |
(while (eq (car table) 'hline) (setq table (cdr table))) |
|
5404 |
;; Skip table header if any. |
|
5405 |
(dolist (x (or (cdr (memq 'hline table)) table)) |
|
5406 |
(when (consp x) |
|
5407 |
(setq x (nth (1- col) x)) |
|
5408 |
(when (string-match |
|
5409 |
"^[-+]?\\([0-9]*[.]\\)?[0-9]*\\([eE][+-]?[0-9]+\\)?$" |
|
5410 |
x) |
|
5411 |
(setq x (string-to-number x)) |
|
5412 |
(when (> min x) (setq min x)) |
|
5413 |
(when (< max x) (setq max x))))) |
|
5414 |
(org-table-insert-column) |
|
5415 |
(org-table-move-column-right) |
|
5416 |
(org-table-store-formulas |
|
5417 |
(cons |
|
5418 |
(cons |
|
5419 |
(concat "$" (number-to-string (1+ col))) |
|
5420 |
(format "'(%s $%s %s %s %s)" |
|
5421 |
"orgtbl-ascii-draw" col min max length)) |
|
5422 |
(org-table-get-stored-formulas))) |
|
5423 |
(org-table-recalculate t))) |
|
5424 |
|
|
5425 |
;; Example of extension: unicode characters |
|
5426 |
;; Here are two examples of different styles. |
|
5427 |
|
|
5428 |
;; Unicode block characters are used to give a smooth effect. |
|
5429 |
;; See http://en.wikipedia.org/wiki/Block_Elements |
|
5430 |
;; Use one of those drawing functions |
|
5431 |
;; - orgtbl-ascii-draw (the default ascii) |
|
5432 |
;; - orgtbl-uc-draw-grid (unicode with a grid effect) |
|
5433 |
;; - orgtbl-uc-draw-cont (smooth unicode) |
|
5434 |
|
|
5435 |
;; This is best viewed with the "DejaVu Sans Mono" font |
|
5436 |
;; (use M-x set-frame-font). |
|
5437 |
|
|
5438 |
(defun orgtbl-uc-draw-grid (value min max &optional width) |
|
5439 |
"Draw a bar in a table using block unicode characters. |
|
5440 |
It is a variant of orgtbl-ascii-draw with Unicode block |
|
5441 |
characters, for a smooth display. Bars appear as grids (to the |
|
5442 |
extent the font allows)." |
|
5443 |
;; http://en.wikipedia.org/wiki/Block_Elements |
|
5444 |
;; best viewed with the "DejaVu Sans Mono" font. |
|
5445 |
(orgtbl-ascii-draw value min max width |
|
5446 |
" \u258F\u258E\u258D\u258C\u258B\u258A\u2589")) |
|
5447 |
|
|
5448 |
(defun orgtbl-uc-draw-cont (value min max &optional width) |
|
5449 |
"Draw a bar in a table using block unicode characters. |
|
5450 |
It is a variant of orgtbl-ascii-draw with Unicode block |
|
5451 |
characters, for a smooth display. Bars are solid (to the extent |
|
5452 |
the font allows)." |
|
5453 |
(orgtbl-ascii-draw value min max width |
|
5454 |
" \u258F\u258E\u258D\u258C\u258B\u258A\u2589\u2588")) |
|
5455 |
|
|
5456 |
(defun org-table-get-remote-range (name-or-id form) |
|
5457 |
"Get a field value or a list of values in a range from table at ID. |
|
5458 |
|
|
5459 |
NAME-OR-ID may be the name of a table in the current file as set |
|
5460 |
by a \"#+NAME:\" directive. The first table following this line |
|
5461 |
will then be used. Alternatively, it may be an ID referring to |
|
5462 |
any entry, also in a different file. In this case, the first |
|
5463 |
table in that entry will be referenced. |
|
5464 |
FORM is a field or range descriptor like \"@2$3\" or \"B3\" or |
|
5465 |
\"@I$2..@II$2\". All the references must be absolute, not relative. |
|
5466 |
|
|
5467 |
The return value is either a single string for a single field, or a |
|
5468 |
list of the fields in the rectangle." |
|
5469 |
(save-match-data |
|
5470 |
(let ((case-fold-search t) (id-loc nil) |
|
5471 |
;; Protect a bunch of variables from being overwritten by |
|
5472 |
;; the context of the remote table. |
|
5473 |
org-table-column-names org-table-column-name-regexp |
|
5474 |
org-table-local-parameters org-table-named-field-locations |
|
5475 |
org-table-current-line-types |
|
5476 |
org-table-current-begin-pos org-table-dlines |
|
5477 |
org-table-current-ncol |
|
5478 |
org-table-hlines org-table-last-alignment |
|
5479 |
org-table-last-column-widths org-table-last-alignment |
|
5480 |
org-table-last-column-widths |
|
5481 |
buffer loc) |
|
5482 |
(setq form (org-table-convert-refs-to-rc form)) |
|
5483 |
(org-with-wide-buffer |
|
5484 |
(goto-char (point-min)) |
|
5485 |
(if (re-search-forward |
|
5486 |
(concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" |
|
5487 |
(regexp-quote name-or-id) "[ \t]*$") |
|
5488 |
nil t) |
|
5489 |
(setq buffer (current-buffer) loc (match-beginning 0)) |
|
5490 |
(setq id-loc (org-id-find name-or-id 'marker)) |
|
5491 |
(unless (and id-loc (markerp id-loc)) |
|
5492 |
(user-error "Can't find remote table \"%s\"" name-or-id)) |
|
5493 |
(setq buffer (marker-buffer id-loc) |
|
5494 |
loc (marker-position id-loc)) |
|
5495 |
(move-marker id-loc nil)) |
|
5496 |
(with-current-buffer buffer |
|
5497 |
(org-with-wide-buffer |
|
5498 |
(goto-char loc) |
|
5499 |
(forward-char 1) |
|
5500 |
(unless (and (re-search-forward "^\\(\\*+ \\)\\|^[ \t]*|" nil t) |
|
5501 |
(not (match-beginning 1))) |
|
5502 |
(user-error "Cannot find a table at NAME or ID %s" name-or-id)) |
|
5503 |
(org-table-analyze) |
|
5504 |
(setq form (org-table-formula-substitute-names |
|
5505 |
(org-table-formula-handle-first/last-rc form))) |
|
5506 |
(if (and (string-match org-table-range-regexp form) |
|
5507 |
(> (length (match-string 0 form)) 1)) |
|
5508 |
(org-table-get-range |
|
5509 |
(match-string 0 form) org-table-current-begin-pos 1) |
|
5510 |
form))))))) |
|
5511 |
|
|
5512 |
(defun org-table-remote-reference-indirection (form) |
|
5513 |
"Return formula with table remote references substituted by indirection. |
|
5514 |
For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\". |
|
5515 |
This indirection works only with the format @ROW$COLUMN. The |
|
5516 |
format \"B3\" is not supported because it can not be |
|
5517 |
distinguished from a plain table name or ID." |
|
5518 |
(let ((regexp |
|
5519 |
;; Same as in `org-table-eval-formula'. |
|
5520 |
(concat "\\<remote([ \t]*\\(" |
|
5521 |
;; Allow "$1", "@<", "$-1", "@<<$1" etc. |
|
5522 |
"[@$][^ \t,]+" |
|
5523 |
"\\)[ \t]*,[ \t]*\\([^\n)]+\\))"))) |
|
5524 |
(replace-regexp-in-string |
|
5525 |
regexp |
|
5526 |
(lambda (m) |
|
5527 |
(save-match-data |
|
5528 |
(let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m)))) |
|
5529 |
(org-table-get-range |
|
5530 |
(if (string-match-p "\\`\\$[0-9]+\\'" eq) |
|
5531 |
(concat "@0" eq) |
|
5532 |
eq))))) |
|
5533 |
form t t 1))) |
|
5534 |
|
|
5535 |
(defmacro org-define-lookup-function (mode) |
|
5536 |
(let ((mode-str (symbol-name mode)) |
|
5537 |
(first-p (eq mode 'first)) |
|
5538 |
(all-p (eq mode 'all))) |
|
5539 |
(let ((plural-str (if all-p "s" ""))) |
|
5540 |
`(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) |
|
5541 |
,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. |
|
5542 |
If R-LIST is nil, return matching element%s of S-LIST. |
|
5543 |
If PREDICATE is not nil, use it instead of `equal' to match VAL. |
|
5544 |
Matching is done by (PREDICATE VAL S), where S is an element of S-LIST. |
|
5545 |
This function is generated by a call to the macro `org-define-lookup-function'." |
|
5546 |
mode-str plural-str plural-str plural-str) |
|
5547 |
(let ,(let ((lvars '((p (or predicate 'equal)) |
|
5548 |
(sl s-list) |
|
5549 |
(rl (or r-list s-list)) |
|
5550 |
(ret nil)))) |
|
5551 |
(if first-p (cons '(match-p nil) lvars) lvars)) |
|
5552 |
(while ,(if first-p '(and (not match-p) sl) 'sl) |
|
5553 |
(when (funcall p val (car sl)) |
|
5554 |
,(when first-p '(setq match-p t)) |
|
5555 |
(let ((rval (car rl))) |
|
5556 |
(setq ret ,(if all-p '(append ret (list rval)) 'rval)))) |
|
5557 |
(setq sl (cdr sl) rl (cdr rl))) |
|
5558 |
ret))))) |
|
5559 |
|
|
5560 |
(org-define-lookup-function first) |
|
5561 |
(org-define-lookup-function last) |
|
5562 |
(org-define-lookup-function all) |
|
5563 |
|
|
5564 |
(provide 'org-table) |
|
5565 |
|
|
5566 |
;; Local variables: |
|
5567 |
;; generated-autoload-file: "org-loaddefs.el" |
|
5568 |
;; End: |
|
5569 |
|
|
5570 |
;;; org-table.el ends here |