emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Ippei FURUHASHI <top.tuna+orgmode@gmail.com>
To: "emacs-orgmode@gnu.org" <emacs-orgmode@gnu.org>
Subject: [PATCH] Was: How to apply multiple TBLFM rules?
Date: Tue, 02 Apr 2013 22:33:27 +0900	[thread overview]
Message-ID: <80wqslys48.fsf_-_@gmail.com> (raw)
In-Reply-To: <1336508514.23203.YahooMailNeo@web161906.mail.bf1.yahoo.com> (Michael Hannon's message of "Tue, 8 May 2012 13:21:54 -0700 (PDT)")

[-- Attachment #1: Type: text/plain, Size: 607 bytes --]

Hi,

This patch enables user to applies a temporal TBLFM line where you are in.
It is useful when you switch a formula to another.
I hope you liked this.


When you have the following table,

    #+TBLNAME: test2
    | 1 | 2 |   |
    | 4 | 5 |   |
    | 7 | 8 | 9 |
    #+TBLFM: @1$3='(+ 10 7)
    #+TBLFM: @2$3='(+ 11 9)

hitting =C-c C-c= in the 2nd TBLFM line containg
"#+TBLFM: @2$3='(+ 11 9)" gives you this result:

    #+TBLNAME: test2
    | 1 | 2 |    |
    | 4 | 5 | 19 |
    | 7 | 8 |  9 |
    #+TBLFM: @1$3='(+ 10 7)
    #+TBLFM: @2$3='(+ 11 9)



This patch consists of 4 parts as shown below:

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: a supporting library of this patch --]
[-- Type: text/x-patch, Size: 2378 bytes --]

From e905aea041a2d306a37921797364a9056eadfa48 Mon Sep 17 00:00:00 2001
From: Ippei FURUHASHI <top.tuna+orgmode@gmail.com>
Date: Tue, 2 Apr 2013 18:05:46 +0900
Subject: [PATCH 1/4] org.el (org-at-TBLFM-p): Add functon

* org.el (org-at-TBLFM-p): Add function.

* testing/lisp/test-org-table.el: Add test.
---
 lisp/org.el                    |   12 ++++++++++++
 testing/lisp/test-org-table.el |   19 +++++++++++++++++++
 2 files changed, 31 insertions(+), 0 deletions(-)

diff --git a/lisp/org.el b/lisp/org.el
index 04ce386..ef27944 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4197,6 +4197,9 @@ (defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]"
   (org-autoload "org-table"
 		'(org-table-begin org-table-blank-field org-table-end)))
 
+(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: "
+  "Detect a #+TBLFM line.")
+
 ;;;###autoload
 (defun turn-on-orgtbl ()
   "Unconditionally turn on `orgtbl-mode'."
@@ -4291,6 +4294,15 @@ (defun org-table-map-tables (function &optional quietly)
 (declare-function org-clock-update-mode-line "org-clock" ())
 (declare-function org-resolve-clocks "org-clock"
 		  (&optional also-non-dangling-p prompt last-valid))
+
+(defun org-at-TBLFM-p (&optional pos)
+  "Return t when point (or POS) is in #+TBLFM line. If not, return nil."
+  (save-excursion
+    (let ((pos pos)))
+    (goto-char (or pos (point)))
+    (beginning-of-line 1)
+    (looking-at org-TBLFM-regexp)))
+
 (defvar org-clock-start-time)
 (defvar org-clock-marker (make-marker)
   "Marker recording the last clock-in.")
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 4c09239..ea8c4d8 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -749,6 +749,25 @@ (defconst references/target-special "
 ;;   "Remote reference."
 ;;   (should
 ;;    (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
+(ert-deftest test-org-table/org-at-TBLFM-p ()
+  (org-test-with-temp-text-in-file
+      "
+| 1 |
+| 2 |
+#+TBLFM: $2=$1*2
+
+"
+    (goto-char (point-min))
+    (forward-line 2)
+    (should (equal (org-at-TBLFM-p) nil))
+
+    (goto-char (point-min))
+    (forward-line 3)
+    (should (equal (org-at-TBLFM-p) t))
+
+    (goto-char (point-min))
+    (forward-line 4)
+    (should (equal (org-at-TBLFM-p) nil))))
 
 (provide 'test-org-table)
 
-- 
1.7.9.msysgit.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: another supporting library of this patch --]
[-- Type: text/x-patch, Size: 4426 bytes --]

From 37369815b555ba1f2df168ac45c83237c628d609 Mon Sep 17 00:00:00 2001
From: Ippei FURUHASHI <top.tuna+orgmode@gmail.com>
Date: Tue, 2 Apr 2013 18:09:26 +0900
Subject: [PATCH 2/4] org-table.el (org-TBLFM-begin): Add function

* org-table.el (org-TBLFM-begin): Add function.

* testing/lisp/test-org-table.el: Add test.
---
 lisp/org-table.el              |   14 +++++
 testing/lisp/test-org-table.el |  123 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 137 insertions(+), 0 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index f087cf7..78fbb2e 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -52,6 +52,8 @@ (defvar orgtbl-after-send-table-hook nil
 to the receiver position, otherwise, if table is not sent, the functions
 are not run.")
 
+(defvar org-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ")
+
 (defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized)
   "Non-nil means use the optimized table editor version for `orgtbl-mode'.
 In the optimized version, the table editor takes over all simple keys that
@@ -3169,6 +3171,18 @@ (defun org-table-iterate-buffer-tables ()
 	      (setq checksum c1)))
 	  (user-error "No convergence after %d iterations" imax))))))
 
+(defun org-TBLFM-begin ()
+  "Find the beginning of the TBLFM lines and return its position.
+Return nil when the beginning of TBLFM line was not found."
+  (save-excursion
+    (if (progn (forward-line 1)
+	    (re-search-backward
+	     org-TBLFM-begin-regexp
+	     nil t))
+	(progn (beginning-of-line 2)
+	       (point))
+      nil)))
+
 (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
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index ea8c4d8..805f57a 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -769,6 +769,129 @@ (defconst references/target-special "
     (forward-line 4)
     (should (equal (org-at-TBLFM-p) nil))))
 
+(ert-deftest test-org-table/org-TBLFM-begin ()
+  (org-test-with-temp-text-in-file
+      "
+| 1 |
+| 2 |
+#+TBLFM: $2=$1*2
+
+"
+    (goto-char (point-min))
+    (should (equal (org-TBLFM-begin)
+		   nil))
+
+    (goto-char (point-min))
+    (forward-line 1)
+    (should (equal (org-TBLFM-begin)
+		   nil))
+
+    (goto-char (point-min))
+    (forward-line 3)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 4)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    ))
+
+(ert-deftest test-org-table/org-TBLFM-begin-for-multiple-TBLFM-lines ()
+  "For multiple #+TBLFM lines."
+  (org-test-with-temp-text-in-file
+      "
+| 1 |
+| 2 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+
+"
+    (goto-char (point-min))
+    (should (equal (org-TBLFM-begin)
+		   nil))
+
+    (goto-char (point-min))
+    (forward-line 1)
+    (should (equal (org-TBLFM-begin)
+		   nil))
+
+    (goto-char (point-min))
+    (forward-line 3)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 4)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 5)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    ))
+
+(ert-deftest test-org-table/org-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
+  (org-test-with-temp-text-in-file
+      "
+| 1 |
+| 2 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+
+| 6 |
+| 7 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+
+"
+    (goto-char (point-min))
+    (should (equal (org-TBLFM-begin)
+		   nil))
+
+    (goto-char (point-min))
+    (forward-line 1)
+    (should (equal (org-TBLFM-begin)
+		   nil))
+
+    (goto-char (point-min))
+    (forward-line 3)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 4)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 5)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 6)
+    (should (= (org-TBLFM-begin)
+		   14))
+
+    (goto-char (point-min))
+    (forward-line 8)
+    (should (= (org-TBLFM-begin)
+		   61))
+
+    (goto-char (point-min))
+    (forward-line 9)
+    (should (= (org-TBLFM-begin)
+		   61))
+
+    (goto-char (point-min))
+    (forward-line 10)
+    (should (= (org-TBLFM-begin)
+		   61))))
+
 (provide 'test-org-table)
 
 ;;; test-org-table.el ends here
-- 
1.7.9.msysgit.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: the core of this patch --]
[-- Type: text/x-patch, Size: 3943 bytes --]

From 12cd28d44a67f1b3efe666fe981430bf15aafc15 Mon Sep 17 00:00:00 2001
From: Ippei FURUHASHI <top.tuna+orgmode@gmail.com>
Date: Tue, 2 Apr 2013 18:11:26 +0900
Subject: [PATCH 3/4] org-table.el (org-calc-current-TBLFM): Add function

* org-table.el (org-calc-current-TBLFM): re-calculate the table
by applying the #+TBLFM in the line where the point is.

* org.el (org-ctrl-c-ctrl-c): Call `org-calc-current-TBLFM' when
the point is in the #+TBLFM line.

* testing/lisp/test-org-table.el: Add test.
---
 lisp/org-table.el              |   24 ++++++++++++++++++++++++
 lisp/org.el                    |    7 ++++---
 testing/lisp/test-org-table.el |   37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 65 insertions(+), 3 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 78fbb2e..4b97760 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -3171,6 +3171,30 @@ (defun org-table-iterate-buffer-tables ()
 	      (setq checksum c1)))
 	  (user-error "No convergence after %d iterations" imax))))))
 
+(defun org-calc-current-TBLFM (&optional arg)
+  "Apply the #+TBLFM in the line to the table."
+  (interactive "P")
+  (if (not (org-at-TBLFM-p)) (error "Not at #+TBLFM line"))
+  (let ((formula (buffer-substring
+		  (point-at-bol)
+		  (point-at-eol)))
+	s e)
+    (save-excursion
+      ;; insert a temporary formula at right after the table
+      (goto-char (org-TBLFM-begin))
+      (setq s (set-marker (make-marker) (point)))
+      (insert (concat formula "\n"))
+      (setq e (set-marker (make-marker) (point)))
+
+      ;; recalculate the table
+      (beginning-of-line 0)		;move to the inserted line
+      (skip-chars-backward " \r\n\t")
+      (if (org-at-table-p)
+	  (org-call-with-arg 'org-table-recalculate (or arg t)))
+
+      ;; delete the formula inserted temporarily
+      (delete-region s e))))
+
 (defun org-TBLFM-begin ()
   "Find the beginning of the TBLFM lines and return its position.
 Return nil when the beginning of TBLFM line was not found."
diff --git a/lisp/org.el b/lisp/org.el
index ef27944..51b8812 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -20174,9 +20174,10 @@ (defun org-ctrl-c-ctrl-c (&optional arg)
 		       (and (eq type 'table-row)
 			    (= (point) (org-element-property :end context))))
 		   (save-excursion
-		     (goto-char (org-element-property :contents-begin context))
-		     (org-call-with-arg 'org-table-recalculate (or arg t))
-		     (orgtbl-send-table 'maybe))
+		     (if (org-at-TBLFM-p) (org-calc-current-TBLFM)
+		       (goto-char (org-element-property :contents-begin context))
+		       (org-call-with-arg 'org-table-recalculate (or arg t))
+		       (orgtbl-send-table 'maybe)))
 		 (org-table-maybe-eval-formula)
 		 (cond (arg (call-interactively 'org-table-recalculate))
 		       ((org-table-maybe-recalculate-line))
diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el
index 805f57a..dda8561 100644
--- a/testing/lisp/test-org-table.el
+++ b/testing/lisp/test-org-table.el
@@ -892,6 +892,43 @@ (defconst references/target-special "
     (should (= (org-TBLFM-begin)
 		   61))))
 
+(ert-deftest test-org-table/org-calc-current-TBLFM ()
+    (org-test-with-temp-text-in-file
+      "
+| 1 |   |
+| 2 |   |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+#+TBLFM: $2=$1*3
+"
+    (let ((got (progn (goto-char (point-min))
+		      (forward-line 3)
+		      (org-calc-current-TBLFM)
+		      (buffer-string)))
+	  (expect "
+| 1 | 1 |
+| 2 | 2 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+#+TBLFM: $2=$1*3
+"))
+      (should (string= got
+		       expect)))
+
+    (let ((got (progn (goto-char (point-min))
+		      (forward-line 4)
+		      (org-calc-current-TBLFM)
+		      (buffer-string)))
+	  (expect "
+| 1 | 2 |
+| 2 | 4 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+#+TBLFM: $2=$1*3
+"))
+      (should (string= got
+		       expect)))))
+
 (provide 'test-org-table)
 
 ;;; test-org-table.el ends here
-- 
1.7.9.msysgit.0


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: documentation of this patch --]
[-- Type: text/x-patch, Size: 2606 bytes --]

From 34b2661238801fa99a284ea500a32f6d5c68c52d Mon Sep 17 00:00:00 2001
From: Ippei FURUHASHI <top.tuna+orgmode@gmail.com>
Date: Tue, 2 Apr 2013 17:12:02 +0900
Subject: [PATCH 4/4] doc/org.texi: Document applying current TBLFM to table

* org.texi (Editing and debugging formulas): Document an example
when a table has multiple #+TBLFM lines.
---
 doc/org.texi |   53 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 files changed, 53 insertions(+), 0 deletions(-)

diff --git a/doc/org.texi b/doc/org.texi
index 6791570..7c0e17f 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -3003,6 +3003,52 @@ @subsection Editing and debugging formulas
 equations with @kbd{C-c C-c} in that line or with the normal
 recalculation commands in the table.
 
+@anchor{Using multiple #+TBLFM lines}
+@subsubheading Using multiple #+TBLFM lines
+@cindex #+TBLFM line, multiple
+@cindex #+TBLFM
+@cindex #+TBLFM, switching
+@kindex C-c C-c
+
+You may apply the formula temporarily. This is useful when you
+switch the formula. Place multiple @samp{#+TBLFM} lines right
+after the table, and then press @kbd{C-c C-c} on the formula to
+apply. Here is an example:
+
+@example
+| x | y |
+|---+---|
+| 1 |   |
+| 2 |   |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+@end example
+
+@noindent
+Pressing @kbd{C-c C-c} in the line of @samp{#+TBLFM: $2=$1*2} yields:
+
+@example
+| x | y |
+|---+---|
+| 1 | 2 |
+| 2 | 4 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+@end example
+
+@noindent
+Note: If you recalculate this table (with @kbd{C-u C-c *}, for example), you
+will get the following result of applying only the first @samp{#+TBLFM} line.
+
+@example
+| x | y |
+|---+---|
+| 1 | 1 |
+| 2 | 2 |
+#+TBLFM: $2=$1*1
+#+TBLFM: $2=$1*2
+@end example
+
 @subsubheading Debugging formulas
 @cindex formula debugging
 @cindex debugging, of table formulas
@@ -14889,8 +14935,15 @@ @section Summary of in-buffer settings
 These lines (several such lines are allowed) specify the valid tags in
 this file, and (potentially) the corresponding @emph{fast tag selection}
 keys.  The corresponding variable is @code{org-tag-alist}.
+@cindex #+TBLFM
 @item #+TBLFM:
 This line contains the formulas for the table directly above the line.
+
+Table can have multiple lines containing @samp{#+TBLFM:}. Note
+that only the first line of @samp{#+TBLFM:} will be applied when
+you reculculate the table. For more details see @ref{Using
+multiple #+TBLFM lines} in @ref{Editing and debugging formulas}.
+
 @item #+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+DATE:,
 @itemx #+OPTIONS:, #+BIND:,
 @itemx #+DESCRIPTION:, #+KEYWORDS:,
-- 
1.7.9.msysgit.0


[-- Attachment #6: Type: text/plain, Size: 12 bytes --]


Thanks,
IP

  parent reply	other threads:[~2013-04-02 13:38 UTC|newest]

Thread overview: 10+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2012-05-07 22:00 How to apply multiple TBLFM rules? Michael Hannon
2012-05-08  1:01 ` Charles
2012-05-08  1:41   ` Michael Hannon
2012-05-08  8:11   ` Bastien
2012-05-08 20:21     ` Michael Hannon
2012-05-10  6:52       ` Bastien
2013-04-02 13:33       ` Ippei FURUHASHI [this message]
2013-04-04 13:09         ` [PATCH] Was: " Bastien
2013-04-06 13:07           ` Ippei FURUHASHI
2013-04-06 13:15             ` Bastien

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=80wqslys48.fsf_-_@gmail.com \
    --to=top.tuna+orgmode@gmail.com \
    --cc=emacs-orgmode@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).