dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-table.el (242476B)


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