emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Daniele Nicolodi <daniele@grinta.net>
To: emacs-orgmode@gnu.org
Subject: [PATCH] org-table: Add mode flag to enable Calc units simplification mode
Date: Tue, 20 Oct 2020 15:30:00 +0200	[thread overview]
Message-ID: <33143b05-a298-8277-313b-3a1deb69ad27@grinta.net> (raw)
In-Reply-To: <6d8c15c2-d1b0-d913-df39-c60381cff70b@grinta.net>

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

Hello,

attached there are a few patches reworking the code, fixing the bug, and
introducing a new mode flag to enable Calc's units simplification mode
as discussed in a recent thread on the mailing list.  I haven't updated
the documentation.  I can do it once we agree that this feature is a
good idea.

Cheers,
Dan


On 19/10/2020 17:38, Daniele Nicolodi wrote:
> Hello,
> 
> I am hacking org-table-eval-formula (see thread about monetary values in
> org-tables) which uses this inline function:
> 
> (defsubst org-table--set-calc-mode (var &optional value)
>   (if (stringp var)
>       (setq var (assoc var '(("D" calc-angle-mode deg)
> 			     ("R" calc-angle-mode rad)
> 			     ("F" calc-prefer-frac t)
> 			     ("S" calc-symbolic-mode t)))
> 	    value (nth 2 var) var (nth 1 var)))
>   (if (memq var org-tbl-calc-modes)
>       (setcar (cdr (memq var org-tbl-calc-modes)) value)
>     (cons var (cons value org-tbl-calc-modes)))
>   org-tbl-calc-modes)
> 
> which I am not able to understand or which is not correct.
> 
> The first (if ...) does some value substitutions, however, IIUC the
> second (if ...) sets a new value for an entry in the org-tbl-calc-modes
> plist if the entry is already present and builds a new plist with the
> entry prepended if the entry is not there. However, the original plist
> is returned and not the one with the new entry prepended.
> 
> It does not seem to be the intended behavior.
> 
> Shouldn't this be simply:
> 
> (defsubst org-table--set-calc-mode (var &optional value)
>   (if (stringp var)
>       (setq var (assoc var '(("D" calc-angle-mode deg)
> 			     ("R" calc-angle-mode rad)
> 			     ("F" calc-prefer-frac t)
> 			     ("S" calc-symbolic-mode t)))
> 	    value (nth 2 var) var (nth 1 var)))
>   (plist-put org-tbl-calc-modes var value))
> 
> or, better, the code refactored to do not use this function?
> 
> Cheers,
> Dan
> 


[-- Attachment #2: 0001-org-table-Fix-table-formula-mode-string-handling.patch --]
[-- Type: text/plain, Size: 2160 bytes --]

From c7434974897d932fe3acd182f06a98a61719e208 Mon Sep 17 00:00:00 2001
From: Daniele Nicolodi <daniele@grinta.net>
Date: Tue, 20 Oct 2020 11:03:14 +0200
Subject: [PATCH 1/3] org-table: Fix table formula mode string handling

* lisp/org-table.el (org-table-eval-formula): Move mode lookup table
from org-table--set-calc-mode to here.

* lisp/org-table.el (org-table--set-calc-mode): Use plist-put instead
of the buggy open coded version.
---
 lisp/org-table.el | 24 ++++++++++--------------
 1 file changed, 10 insertions(+), 14 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 112b1e171..0790dc3ca 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -721,17 +721,8 @@ Field is restored even in case of abnormal exit."
 	 (org-table-goto-column ,column)
 	 (set-marker ,line nil)))))
 
-(defsubst org-table--set-calc-mode (var &optional value)
-  (if (stringp var)
-      (setq var (assoc var '(("D" calc-angle-mode deg)
-			     ("R" calc-angle-mode rad)
-			     ("F" calc-prefer-frac t)
-			     ("S" calc-symbolic-mode t)))
-	    value (nth 2 var) var (nth 1 var)))
-  (if (memq var org-tbl-calc-modes)
-      (setcar (cdr (memq var org-tbl-calc-modes)) value)
-    (cons var (cons value org-tbl-calc-modes)))
-  org-tbl-calc-modes)
+(defsubst org-table--set-calc-mode (var value)
+  (plist-put org-tbl-calc-modes var value))
 
 \f
 ;;; Predicates
@@ -2476,9 +2467,14 @@ location of point."
 		(setq keep-empty t
 		      fmt (replace-match "" t t fmt)))
 	    (while (string-match "[DRFS]" fmt)
-	      (setq org-tbl-calc-modes
-		    (org-table--set-calc-mode (match-string 0 fmt)))
-	      (setq fmt (replace-match "" t t fmt)))
+	      (let* ((c (string-to-char (match-string 0 fmt)))
+		     (mode (cdr (assoc c '((?D calc-angle-mode deg)
+					   (?R calc-angle-mode rad)
+					   (?F calc-prefer-frac t)
+					   (?S calc-symbolic-mode t))))))
+		(setq org-tbl-calc-modes (org-table--set-calc-mode
+					  (car mode) (cadr mode))
+		      fmt (replace-match "" t t fmt))))
 	    (unless (string-match "\\S-" fmt)
 	      (setq fmt nil))))
       (when (and (not suppress-const) org-table-formula-use-constants)
-- 
2.28.0


[-- Attachment #3: 0003-org-table-Add-mode-flag-to-enable-Calc-units-simplif.patch --]
[-- Type: text/plain, Size: 1301 bytes --]

From aad8eb548e7a7a7fde1908a9f9c66f980da10b56 Mon Sep 17 00:00:00 2001
From: Daniele Nicolodi <daniele@grinta.net>
Date: Tue, 20 Oct 2020 15:22:02 +0200
Subject: [PATCH 3/3] org-table: Add mode flag to enable Calc units
 simplification mode

* org-table.el (org-table-eval-formula): Add the `u` mode flag to
enable Calc's units simplification mode.
---
 lisp/org-table.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 4baad2600..6b92656bd 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -2447,11 +2447,12 @@ location of point."
 		  (?e (org-table--set-calc-mode 'calc-float-format (list 'eng n)))))
 	      ;; Remove matched flags from the mode string.
 	      (setq fmt (replace-match "" t t fmt)))
-	    (while (string-match "\\([tTUNLEDRFS]\\)" fmt)
+	    (while (string-match "\\([tuTUNLEDRFS]\\)" fmt)
 	      (let ((c (string-to-char (match-string 1 fmt))))
 		(cl-case c
 		  (?t (setq duration t numbers t
 		      	    duration-output-format org-table-duration-custom-format))
+		  (?u (org-table--set-calc-mode 'calc-simplify-mode 'units))
 		  (?T (setq duration t numbers t duration-output-format nil))
 		  (?U (setq duration t numbers t duration-output-format 'hh:mm))
 		  (?N (setq numbers t))
-- 
2.28.0


[-- Attachment #4: 0002-org-table-Simplify-mode-string-parsing.patch --]
[-- Type: text/plain, Size: 5850 bytes --]

From fb8b62e5faabca2b6c6514e25bd306f7a5e8696f Mon Sep 17 00:00:00 2001
From: Daniele Nicolodi <daniele@grinta.net>
Date: Tue, 20 Oct 2020 15:13:40 +0200
Subject: [PATCH 2/3] org-table: Simplify mode string parsing

* org-table.el (org-table-eval-formula): Simplify mode string parsing
and reduce scope of local variables.
---
 lisp/org-table.el | 98 +++++++++++++++++++++--------------------------
 1 file changed, 43 insertions(+), 55 deletions(-)

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 0790dc3ca..4baad2600 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -722,7 +722,7 @@ Field is restored even in case of abnormal exit."
 	 (set-marker ,line nil)))))
 
 (defsubst org-table--set-calc-mode (var value)
-  (plist-put org-tbl-calc-modes var value))
+  (setq org-tbl-calc-modes (plist-put org-tbl-calc-modes var value)))
 
 \f
 ;;; Predicates
@@ -2427,54 +2427,42 @@ location of point."
 	   (org-tbl-calc-modes (copy-sequence org-calc-default-modes))
 	   (numbers nil)	   ; was a variable, now fixed default
 	   (keep-empty nil)
-	   n form form0 formrpl formrg bw fmt x ev orig c lispp literal
+	   form form0 formrpl formrg bw fmt ev orig lispp literal
 	   duration duration-output-format)
       ;; Parse the format string.  Since we have a lot of modes, this is
       ;; a lot of work.  However, I think calc still uses most of the time.
-      (if (string-match ";" formula)
-	  (let ((tmp (org-split-string formula ";")))
-	    (setq formula (car tmp)
-		  fmt (concat (cdr (assoc "%" org-table-local-parameters))
-			      (nth 1 tmp)))
+      (if (string-match "\\(.*\\);\\(.*\\)" formula)
+	  (progn
+	    (setq fmt (concat (match-string-no-properties 2 formula)
+			      (cdr (assoc "%" org-table-local-parameters)))
+		  formula (match-string-no-properties 1 formula))
 	    (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
-	      (setq c (string-to-char (match-string 1 fmt))
-		    n (string-to-number (match-string 2 fmt)))
-	      (if (= c ?p)
-		  (setq org-tbl-calc-modes
-			(org-table--set-calc-mode 'calc-internal-prec n))
-		(setq org-tbl-calc-modes
-		      (org-table--set-calc-mode
-		       'calc-float-format
-		       (list (cdr (assoc c '((?n . float) (?f . fix)
-					     (?s . sci) (?e . eng))))
-			     n))))
+	      (let ((c (string-to-char (match-string 1 fmt)))
+		    (n (string-to-number (match-string 2 fmt))))
+		(cl-case c
+		  (?p (org-table--set-calc-mode 'calc-internal-prec n))
+		  (?n (org-table--set-calc-mode 'calc-float-format (list 'float n)))
+		  (?f (org-table--set-calc-mode 'calc-float-format (list 'fix n)))
+		  (?s (org-table--set-calc-mode 'calc-float-format (list 'sci n)))
+		  (?e (org-table--set-calc-mode 'calc-float-format (list 'eng n)))))
+	      ;; Remove matched flags from the mode string.
+	      (setq fmt (replace-match "" t t fmt)))
+	    (while (string-match "\\([tTUNLEDRFS]\\)" fmt)
+	      (let ((c (string-to-char (match-string 1 fmt))))
+		(cl-case c
+		  (?t (setq duration t numbers t
+		      	    duration-output-format org-table-duration-custom-format))
+		  (?T (setq duration t numbers t duration-output-format nil))
+		  (?U (setq duration t numbers t duration-output-format 'hh:mm))
+		  (?N (setq numbers t))
+		  (?L (setq literal t))
+		  (?E (setq keep-empty t))
+		  (?D (org-table--set-calc-mode 'calc-angle-mode 'deg))
+		  (?R (org-table--set-calc-mode 'calc-angle-mode 'rad))
+		  (?F (org-table--set-calc-mode 'calc-prefer-frac t))
+		  (?S (org-table--set-calc-mode 'calc-symbolic-mode t))))
+	      ;; Remove matched flags from the mode string.
 	      (setq fmt (replace-match "" t t fmt)))
-	    (if (string-match "[tTU]" fmt)
-		(let ((ff (match-string 0 fmt)))
-		  (setq duration t numbers t
-			duration-output-format
-			(cond ((equal ff "T") nil)
-			      ((equal ff "t") org-table-duration-custom-format)
-			      ((equal ff "U") 'hh:mm))
-			fmt (replace-match "" t t fmt))))
-	    (if (string-match "N" fmt)
-		(setq numbers t
-		      fmt (replace-match "" t t fmt)))
-	    (if (string-match "L" fmt)
-		(setq literal t
-		      fmt (replace-match "" t t fmt)))
-	    (if (string-match "E" fmt)
-		(setq keep-empty t
-		      fmt (replace-match "" t t fmt)))
-	    (while (string-match "[DRFS]" fmt)
-	      (let* ((c (string-to-char (match-string 0 fmt)))
-		     (mode (cdr (assoc c '((?D calc-angle-mode deg)
-					   (?R calc-angle-mode rad)
-					   (?F calc-prefer-frac t)
-					   (?S calc-symbolic-mode t))))))
-		(setq org-tbl-calc-modes (org-table--set-calc-mode
-					  (car mode) (cadr mode))
-		      fmt (replace-match "" t t fmt))))
 	    (unless (string-match "\\S-" fmt)
 	      (setq fmt nil))))
       (when (and (not suppress-const) org-table-formula-use-constants)
@@ -2575,17 +2563,17 @@ location of point."
 	(setq form0 form)
 	;; Insert the references to fields in same row
 	(while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
-	  (setq n (+ (string-to-number (match-string 1 form))
-		     (if (match-end 2) n0 0))
-		x (nth (1- (if (= n 0) n0 (max n 1))) fields)
-		formrpl (save-match-data
-			  (org-table-make-reference
-			   x keep-empty numbers lispp)))
-	  (when (or (not x)
-		    (save-match-data
-		      (string-match (regexp-quote formula) formrpl)))
-	    (user-error "Invalid field specifier \"%s\""
-			(match-string 0 form)))
+	  (let* ((n (+ (string-to-number (match-string 1 form))
+		       (if (match-end 2) n0 0)))
+		 (x (nth (1- (if (= n 0) n0 (max n 1))) fields)))
+	    (setq formrpl (save-match-data
+			    (org-table-make-reference
+			     x keep-empty numbers lispp)))
+	    (when (or (not x)
+		      (save-match-data
+			(string-match (regexp-quote formula) formrpl)))
+	      (user-error "Invalid field specifier \"%s\""
+			  (match-string 0 form))))
 	  (setq form (replace-match formrpl t t form)))
 
 	(if lispp
-- 
2.28.0


  reply	other threads:[~2020-10-20 13:31 UTC|newest]

Thread overview: 26+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2020-10-19 15:38 Bug in org-table--set-calc-mode? Daniele Nicolodi
2020-10-20 13:30 ` Daniele Nicolodi [this message]
2020-10-20 13:44   ` [PATCH] org-table: Add mode flag to enable Calc units simplification mode Eric S Fraga
2020-10-20 14:00     ` Daniele Nicolodi
2020-10-20 14:22       ` Eric S Fraga
2020-10-20 14:19     ` Eric S Fraga
2020-10-20 14:32       ` Daniele Nicolodi
2020-10-20 14:53         ` Daniele Nicolodi
2020-10-20 15:35           ` Eric S Fraga
2020-10-20 15:35         ` Eric S Fraga
2020-10-21 15:57   ` Daniele Nicolodi
  -- strict thread matches above, loose matches on Subject: below --
2020-10-24 15:33 Daniele Nicolodi
2020-11-07 14:03 ` Daniele Nicolodi
2020-11-19  5:58   ` Kyle Meyer
2020-11-19 20:02     ` Daniele Nicolodi
2020-11-23  3:14 ` Kyle Meyer
2020-11-23 10:22   ` Daniele Nicolodi
2020-11-23 22:27     ` Kyle Meyer
2020-11-24  0:03       ` Daniele Nicolodi
2020-11-24  5:35         ` Kyle Meyer
2020-11-24  8:05           ` Daniele Nicolodi
2020-11-25  2:07             ` Kyle Meyer
2020-11-25  7:41               ` Christian Moe
2020-11-23 10:25   ` Daniele Nicolodi
2020-11-23 22:25     ` Kyle Meyer
2020-11-23 23:01       ` Daniele Nicolodi

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=33143b05-a298-8277-313b-3a1deb69ad27@grinta.net \
    --to=daniele@grinta.net \
    --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).