|
@@ -186,7 +186,7 @@ t: accept as input and present for editing"
|
|
|
:type '(choice
|
|
|
(const :tag "Never, don't even check user input for them" nil)
|
|
|
(const :tag "Always, both as user input, and when editing" t)
|
|
|
- (const :tag "Convert user input, don't offer during editing" 'from)))
|
|
|
+ (const :tag "Convert user input, don't offer during editing" from)))
|
|
|
|
|
|
(defcustom org-table-copy-increment t
|
|
|
"Non-nil means increment when copying current field with \\[org-table-copy-down]."
|
|
@@ -316,6 +316,8 @@ available parameters."
|
|
|
"Table begin line, non-nil only for the duration of a command.")
|
|
|
(defvar org-table-current-begin-pos nil
|
|
|
"Table begin position, non-nil only for the duration of a command.")
|
|
|
+(defvar org-table-current-ncol nil
|
|
|
+ "Number of columns in table, non-nil only for the duration of a command.")
|
|
|
(defvar org-table-dlines nil
|
|
|
"Vector of data line line numbers in the current table.")
|
|
|
(defvar org-table-hlines nil
|
|
@@ -1128,13 +1130,19 @@ is always the old value."
|
|
|
(cname (car (rassoc (int-to-string col) org-table-column-names)))
|
|
|
(name (car (rassoc (list (org-current-line) col)
|
|
|
org-table-named-field-locations)))
|
|
|
- (eql (org-table-get-stored-formulas))
|
|
|
+ (eql (org-table-expand-lhs-ranges
|
|
|
+ (mapcar
|
|
|
+ (lambda (e)
|
|
|
+ (cons (org-table-formula-handle-@L (car e)) (cdr e)))
|
|
|
+ (org-table-get-stored-formulas))))
|
|
|
(dline (org-table-current-dline))
|
|
|
(ref (format "@%d$%d" dline col))
|
|
|
(ref1 (org-table-convert-refs-to-an ref))
|
|
|
(fequation (or (assoc name eql) (assoc ref eql)))
|
|
|
(cequation (assoc (int-to-string col) eql))
|
|
|
(eqn (or fequation cequation)))
|
|
|
+ (if (and eqn (get-text-property 0 :orig-eqn (car eqn)))
|
|
|
+ (setq eqn (get-text-property 0 :orig-eqn (car eqn))))
|
|
|
(goto-char pos)
|
|
|
(condition-case nil
|
|
|
(org-table-show-reference 'local)
|
|
@@ -1246,6 +1254,28 @@ However, when FORCE is non-nil, create new columns if necessary."
|
|
|
(error
|
|
|
"Please position cursor in a data line for column operations")))))
|
|
|
|
|
|
+(defun org-table-line-to-dline (line &optional above)
|
|
|
+ "Turn a buffer line number into a data line number.
|
|
|
+If there is no data line in this line, return nil.
|
|
|
+If there is no matchin dline (most likely te refrence was a hline), the
|
|
|
+first dline below it is used. When ABOVE is non-nil, the one above is used."
|
|
|
+ (catch 'exit
|
|
|
+ (let ((ll (length org-table-dlines))
|
|
|
+ i)
|
|
|
+ (if above
|
|
|
+ (progn
|
|
|
+ (setq i (1- ll))
|
|
|
+ (while (> i 0)
|
|
|
+ (if (<= (aref org-table-dlines i) line)
|
|
|
+ (throw 'exit i))
|
|
|
+ (setq i (1- i))))
|
|
|
+ (setq i 1)
|
|
|
+ (while (< i ll)
|
|
|
+ (if (>= (aref org-table-dlines i) line)
|
|
|
+ (throw 'exit i))
|
|
|
+ (setq i (1+ i)))))
|
|
|
+ nil))
|
|
|
+
|
|
|
(defun org-table-delete-column ()
|
|
|
"Delete a column from the table."
|
|
|
(interactive)
|
|
@@ -1966,7 +1996,7 @@ When NAMED is non-nil, look for a named equation."
|
|
|
(when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
|
|
|
(setq strings (org-split-string (match-string 2) " *:: *"))
|
|
|
(while (setq string (pop strings))
|
|
|
- (when (string-match "\\`\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
|
|
|
+ (when (string-match "\\`\\(@[-+LI0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*[^ \t]\\)" string)
|
|
|
(setq scol (if (match-end 2)
|
|
|
(match-string 2 string)
|
|
|
(match-string 1 string))
|
|
@@ -2022,7 +2052,8 @@ For all numbers larger than LIMIT, shift them by DELTA."
|
|
|
org-table-named-field-locations nil
|
|
|
org-table-current-begin-line nil
|
|
|
org-table-current-begin-pos nil
|
|
|
- org-table-current-line-types nil)
|
|
|
+ org-table-current-line-types nil
|
|
|
+ org-table-current-ncol 0)
|
|
|
(goto-char beg)
|
|
|
(when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t)
|
|
|
(setq names (org-split-string (match-string 1) " *| *")
|
|
@@ -2078,6 +2109,7 @@ For all numbers larger than LIMIT, shift them by DELTA."
|
|
|
"[ \t]*|[ \t]*"))
|
|
|
(nfields (length fields))
|
|
|
al al2)
|
|
|
+ (setq org-table-current-ncol nfields)
|
|
|
(loop for i from 1 to nfields do
|
|
|
(push (list (format "LR%d" i) l i) al)
|
|
|
(push (cons (format "LR%d" i) (nth (1- i) fields)) al2))
|
|
@@ -2086,7 +2118,6 @@ For all numbers larger than LIMIT, shift them by DELTA."
|
|
|
(setq org-table-local-parameters
|
|
|
(append org-table-local-parameters al2))))))
|
|
|
|
|
|
-
|
|
|
(defun org-table-maybe-eval-formula ()
|
|
|
"Check if the current field starts with \"=\" or \":=\".
|
|
|
If yes, store the formula and apply it."
|
|
@@ -2415,11 +2446,16 @@ $1-> %s\n" orig formula form0 form))
|
|
|
(progn (skip-chars-forward "^|") (point))
|
|
|
prop value)))
|
|
|
|
|
|
-(defun org-table-get-range (desc &optional tbeg col highlight)
|
|
|
+(defun org-table-get-range (desc &optional tbeg col highlight corners-only)
|
|
|
"Get a calc vector from a column, according to descriptor DESC.
|
|
|
Optional arguments TBEG and COL can give the beginning of the table and
|
|
|
the current column, to avoid unnecessary parsing.
|
|
|
-HIGHLIGHT means just highlight the range."
|
|
|
+
|
|
|
+HIGHLIGHT means just highlight the range.
|
|
|
+
|
|
|
+When CORNERS-ONLY is set, only return the corners of the range as
|
|
|
+a list (line1 column1 line2 column2) where line1 and line2 are line numbers
|
|
|
+in the buffer and column1 and column2 are table column numbers."
|
|
|
(if (not (equal (string-to-char desc) ?@))
|
|
|
(setq desc (concat "@" desc)))
|
|
|
(save-excursion
|
|
@@ -2448,7 +2484,8 @@ HIGHLIGHT means just highlight the range."
|
|
|
(if (not r2) (setq r2 thisline))
|
|
|
(if (not c1) (setq c1 col))
|
|
|
(if (not c2) (setq c2 col))
|
|
|
- (if (or (not rangep) (and (= r1 r2) (= c1 c2)))
|
|
|
+ (if (and (not corners-only)
|
|
|
+ (or (not rangep) (and (= r1 r2) (= c1 c2))))
|
|
|
;; just one field
|
|
|
(progn
|
|
|
(org-goto-line r1)
|
|
@@ -2460,22 +2497,26 @@ HIGHLIGHT means just highlight the range."
|
|
|
;; First sort the numbers to get a regular ractangle
|
|
|
(if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp))
|
|
|
(if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp))
|
|
|
- (org-goto-line r1)
|
|
|
- (while (not (looking-at org-table-dataline-regexp))
|
|
|
- (beginning-of-line 2))
|
|
|
- (org-table-goto-column c1)
|
|
|
- (setq beg (point))
|
|
|
- (org-goto-line r2)
|
|
|
- (while (not (looking-at org-table-dataline-regexp))
|
|
|
- (beginning-of-line 0))
|
|
|
- (org-table-goto-column c2)
|
|
|
- (setq end (point))
|
|
|
- (if highlight
|
|
|
- (org-table-highlight-rectangle
|
|
|
- beg (progn (skip-chars-forward "^|\n") (point))))
|
|
|
- ;; return string representation of calc vector
|
|
|
- (mapcar 'org-trim
|
|
|
- (apply 'append (org-table-copy-region beg end)))))))
|
|
|
+ (if corners-only
|
|
|
+ ;; Only return the corners of the range
|
|
|
+ (list r1 c1 r2 c2)
|
|
|
+ ;; Copy the range values into a list
|
|
|
+ (org-goto-line r1)
|
|
|
+ (while (not (looking-at org-table-dataline-regexp))
|
|
|
+ (beginning-of-line 2))
|
|
|
+ (org-table-goto-column c1)
|
|
|
+ (setq beg (point))
|
|
|
+ (org-goto-line r2)
|
|
|
+ (while (not (looking-at org-table-dataline-regexp))
|
|
|
+ (beginning-of-line 0))
|
|
|
+ (org-table-goto-column c2)
|
|
|
+ (setq end (point))
|
|
|
+ (if highlight
|
|
|
+ (org-table-highlight-rectangle
|
|
|
+ beg (progn (skip-chars-forward "^|\n") (point))))
|
|
|
+ ;; return string representation of calc vector
|
|
|
+ (mapcar 'org-trim
|
|
|
+ (apply 'append (org-table-copy-region beg end))))))))
|
|
|
|
|
|
(defun org-table-get-descriptor-line (desc &optional cline bline table)
|
|
|
"Analyze descriptor DESC and retrieve the corresponding line number.
|
|
@@ -2595,12 +2636,15 @@ known that the table will be realigned a little later anyway."
|
|
|
(line-re org-table-dataline-regexp)
|
|
|
(thisline (org-current-line))
|
|
|
(thiscol (org-table-current-column))
|
|
|
- beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name)
|
|
|
+ seen-fields
|
|
|
+ beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1)
|
|
|
;; Insert constants in all formulas
|
|
|
(setq eqlist
|
|
|
(mapcar (lambda (x)
|
|
|
- (setcdr x (org-table-formula-substitute-names (cdr x)))
|
|
|
- x)
|
|
|
+ (cons
|
|
|
+ (org-table-formula-handle-@L (car x))
|
|
|
+ (org-table-formula-substitute-names
|
|
|
+ (org-table-formula-handle-@L (cdr x)))))
|
|
|
eqlist))
|
|
|
;; Split the equation list
|
|
|
(while (setq eq (pop eqlist))
|
|
@@ -2608,6 +2652,10 @@ known that the table will be realigned a little later anyway."
|
|
|
(push eq eqlnum)
|
|
|
(push eq eqlname)))
|
|
|
(setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname))
|
|
|
+ ;; Expand ranges in lhs of formulas
|
|
|
+ (setq eqlname (org-table-expand-lhs-ranges eqlname))
|
|
|
+
|
|
|
+ ;; Get the correct line range to process
|
|
|
(if all
|
|
|
(progn
|
|
|
(setq end (move-marker (make-marker) (1+ (org-table-end))))
|
|
@@ -2626,11 +2674,19 @@ known that the table will be realigned a little later anyway."
|
|
|
(goto-char beg)
|
|
|
(and all (message "Re-applying formulas to full table..."))
|
|
|
|
|
|
- ;; First find the named fields, and mark them untouchable
|
|
|
+ ;; First find the named fields, and mark them untouchable.
|
|
|
+ ;; Also check if several field/range formulas try to set the same field.
|
|
|
(remove-text-properties beg end '(org-untouchable t))
|
|
|
(while (setq eq (pop eqlname))
|
|
|
(setq name (car eq)
|
|
|
a (assoc name org-table-named-field-locations))
|
|
|
+ (setq name1 name)
|
|
|
+ (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a))
|
|
|
+ (nth 2 a))))
|
|
|
+ (when (member name1 seen-fields)
|
|
|
+ (error "Several field/range formulas try to set %s" name1))
|
|
|
+ (push name1 seen-fields)
|
|
|
+
|
|
|
(and (not a)
|
|
|
(string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name)
|
|
|
(setq a (list name
|
|
@@ -2646,7 +2702,7 @@ known that the table will be realigned a little later anyway."
|
|
|
(org-table-goto-column (nth 2 a))
|
|
|
(push (append a (list (cdr eq))) eqlname1)
|
|
|
(org-table-put-field-property :org-untouchable t)))
|
|
|
-
|
|
|
+
|
|
|
;; Now evaluate the column formulas, but skip fields covered by
|
|
|
;; field formulas
|
|
|
(goto-char beg)
|
|
@@ -2735,6 +2791,50 @@ known that the table will be realigned a little later anyway."
|
|
|
(setq checksum c1)))
|
|
|
(error "No convergence after %d iterations" imax))))))
|
|
|
|
|
|
+(defun org-table-expand-lhs-ranges (equations)
|
|
|
+ "Expand list of formulas.
|
|
|
+If some of the RHS in the formulas are ranges or a row reference, expand
|
|
|
+them to individual field equations for each field."
|
|
|
+ (let (e res lhs rhs range r1 r2 c1 c2)
|
|
|
+ (while (setq e (pop equations))
|
|
|
+ (setq lhs (car e) rhs (cdr e))
|
|
|
+ (cond
|
|
|
+ ((string-match "^@-?[-+I0-9]+\\$-?[0-9]+$" lhs)
|
|
|
+ ;; This just refers to one fixed field
|
|
|
+ (push e res))
|
|
|
+ ((string-match "^[a-zA-Z][a-zA-Z0-9]*$" lhs)
|
|
|
+ ;; This just refers to one fixed named field
|
|
|
+ (push e res))
|
|
|
+ ((string-match "^@[0-9]+$" lhs)
|
|
|
+ (loop for ic from 1 to org-table-current-ncol do
|
|
|
+ (push (cons (format "%s$%d" lhs ic) rhs) res)
|
|
|
+ (put-text-property 0 (length (caar res))
|
|
|
+ :orig-eqn e (caar res))))
|
|
|
+ (t
|
|
|
+ (setq range (org-table-get-range lhs org-table-current-begin-pos
|
|
|
+ 1 nil 'corners))
|
|
|
+ (setq r1 (nth 0 range) c1 (nth 1 range)
|
|
|
+ r2 (nth 2 range) c2 (nth 3 range))
|
|
|
+ (setq r1 (org-table-line-to-dline r1))
|
|
|
+ (setq r2 (org-table-line-to-dline r2 'above))
|
|
|
+ (loop for ir from r1 to r2 do
|
|
|
+ (loop for ic from c1 to c2 do
|
|
|
+ (push (cons (format "@%d$%d" ir ic) rhs) res)
|
|
|
+ (put-text-property 0 (length (caar res))
|
|
|
+ :orig-eqn e (caar res)))))))
|
|
|
+ (nreverse res)))
|
|
|
+
|
|
|
+(defun org-table-formula-handle-@L (s)
|
|
|
+ "Replace @L with the last row data row of the table."
|
|
|
+ (while (string-match "@L\\(-[0-9]+\\)?" s)
|
|
|
+ (setq s (replace-match
|
|
|
+ (format "@%d" (+ (length org-table-dlines) -1
|
|
|
+ (if (match-end 1)
|
|
|
+ (string-to-number (match-string 1 s))
|
|
|
+ 0)))
|
|
|
+ t t s)))
|
|
|
+ s)
|
|
|
+
|
|
|
(defun org-table-formula-substitute-names (f)
|
|
|
"Replace $const with values in string F."
|
|
|
(let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?')))
|
|
@@ -2837,7 +2937,7 @@ Parameters get priority."
|
|
|
(wc (current-window-configuration))
|
|
|
(sel-win (selected-window))
|
|
|
(titles '((column . "# Column Formulas\n")
|
|
|
- (field . "# Field Formulas\n")
|
|
|
+ (field . "# Field and Range Formulas\n")
|
|
|
(named . "# Named Field Formulas\n")))
|
|
|
entry s type title)
|
|
|
(org-switch-to-buffer-other-window "*Edit Formulas*")
|
|
@@ -2861,7 +2961,7 @@ Parameters get priority."
|
|
|
(when (setq title (assq type titles))
|
|
|
(or (bobp) (insert "\n"))
|
|
|
(insert (org-add-props (cdr title) nil 'face font-lock-comment-face))
|
|
|
- (setq titles (delq title titles)))
|
|
|
+ (setq titles (remove title titles)))
|
|
|
(if (equal key (car entry)) (setq startline (org-current-line)))
|
|
|
(setq s (concat (if (equal (string-to-char (car entry)) ?@) "" "$")
|
|
|
(car entry) " = " (cdr entry) "\n"))
|
|
@@ -3078,7 +3178,7 @@ With prefix ARG, apply the new formulas to the table."
|
|
|
(let ((pos org-pos) (sel-win org-selected-window) eql var form)
|
|
|
(goto-char (point-min))
|
|
|
(while (re-search-forward
|
|
|
- "^\\(@[0-9]+\\$[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
|
|
|
+ "^\\(@[-+IL0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
|
|
|
nil t)
|
|
|
(setq var (if (match-end 2) (match-string 2) (match-string 1))
|
|
|
form (match-string 3))
|
|
@@ -3167,6 +3267,12 @@ With prefix ARG, apply the new formulas to the table."
|
|
|
var name e what match dest)
|
|
|
(if local (org-table-get-specials))
|
|
|
(setq what (cond
|
|
|
+ ((org-at-regexp-p "^@[0-9]+[ \t=]")
|
|
|
+ (setq match (concat (substring (match-string 0) 0 -1)
|
|
|
+ "$1.."
|
|
|
+ (substring (match-string 0) 0 -1)
|
|
|
+ "$100"))
|
|
|
+ 'range)
|
|
|
((or (org-at-regexp-p org-table-range-regexp2)
|
|
|
(org-at-regexp-p org-table-translate-regexp)
|
|
|
(org-at-regexp-p org-table-range-regexp))
|
|
@@ -4359,6 +4465,7 @@ list of the fields in the rectangle ."
|
|
|
org-table-local-parameters org-table-named-field-locations
|
|
|
org-table-current-line-types org-table-current-begin-line
|
|
|
org-table-current-begin-pos org-table-dlines
|
|
|
+ org-table-current-ncol
|
|
|
org-table-hlines org-table-last-alignment
|
|
|
org-table-last-column-widths org-table-last-alignment
|
|
|
org-table-last-column-widths tbeg
|
|
@@ -4402,3 +4509,4 @@ list of the fields in the rectangle ."
|
|
|
;; arch-tag: 4d21cfdd-0268-440a-84b0-09237a0fe0ef
|
|
|
|
|
|
;;; org-table.el ends here
|
|
|
+
|