emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [patch] simplify-compact initial data extraction from plist
@ 2020-06-27 15:18 Mario Frasca
  2020-06-27 16:49 ` tomas
  2020-07-12 18:03 ` Fwd: " Mario Frasca
  0 siblings, 2 replies; 3+ messages in thread
From: Mario Frasca @ 2020-06-27 15:18 UTC (permalink / raw)
  To: emacs-orgmode

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

this is a result of some help I received a few days ago in the #emacs 
irc chat room on freenode.

I was wondering why we were adding a semicolon in front of names, before 
creating symbols, and I understand this is because such symbols work as 
keys.  next, I could not find how we were taking advantage of this in 
the code, asked further, looked for references and examples, and 
discovered how to use `cl-destructuring-bind' to define something 
looking and behaving like a `let' block, based on the content of a plist.

hope this helps.

I have signed my FSF papers, and received confirmation of reception.

ciao,

Mario


[-- Attachment #2: 0001-cl-destructuring-bind-simplifies-initial-repeating-l.patch --]
[-- Type: text/x-patch, Size: 20360 bytes --]

From 00e2bc506085b0a0343237810b63b7f213aeb67e Mon Sep 17 00:00:00 2001
From: mfrasca <mario@anche.no>
Date: Sat, 27 Jun 2020 09:58:45 -0500
Subject: [PATCH] cl-destructuring-bind simplifies initial repeating let block

* lisp/org-table.el (org-table--to-generic-row): introduce
`cl-destructuring-bind', simplifying leading `let'.
(org-table--to-generic-cell): introduce `cl-destructuring-bind',
simplifying leading `let'.

* lisp/org-list.el (org-list--to-generic-plain-list): introduce
`cl-destructuring-bind', simplifying leading `let'.
(org-list--to-generic-item): introduce `cl-destructuring-bind',
simplifying leading `let'.

These two files use a leading `let' block to extract keywords from a
plist.  This sequence of uniform invocations of `plist-get-params' can
be done more compactly with `cl-destructuring-bind', without repeating
names, without risking confusing name changes in the process (that's
the case in `org-plot.el'), evidentiating the uniformity of the
procedure.
---
 lisp/org-list.el  |  30 ++--
 lisp/org-plot.el  | 340 +++++++++++++++++++++++++---------------------
 lisp/org-table.el |  28 ++--
 3 files changed, 204 insertions(+), 194 deletions(-)

diff --git a/lisp/org-list.el b/lisp/org-list.el
index 7a5133dbe..6a353e726 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -3388,14 +3388,10 @@ it is called with arguments ARGS."
 (defun org-list--to-generic-plain-list (params)
   "Return a transcoder for `plain-list' elements.
 PARAMS is a plist used to tweak the behavior of the transcoder."
-  (let ((ustart (plist-get params :ustart))
-	(uend (plist-get params :uend))
-	(ostart (plist-get params :ostart))
-	(oend (plist-get params :oend))
-	(dstart (plist-get params :dstart))
-	(dend (plist-get params :dend))
-	(splice (plist-get params :splice))
-	(backend (plist-get params :backend)))
+  (cl-destructuring-bind
+      (&key ustart uend ostart oend dstart dend splice backend
+	    &allow-other-keys)
+      params
     (lambda (plain-list contents info)
       (let* ((type (org-element-property :type plain-list))
 	     (depth (org-list--depth plain-list))
@@ -3428,19 +3424,11 @@ PARAMS is a plist used to tweak the behavior of the transcoder."
 (defun org-list--to-generic-item (params)
   "Return a transcoder for `item' elements.
 PARAMS is a plist used to tweak the behavior of the transcoder."
-  (let ((backend (plist-get params :backend))
-	(istart (plist-get params :istart))
-	(iend (plist-get params :iend))
-	(isep (plist-get params :isep))
-	(icount (plist-get params :icount))
-	(ifmt (plist-get params :ifmt))
-	(cboff (plist-get params :cboff))
-	(cbon  (plist-get params :cbon))
-	(cbtrans (plist-get params :cbtrans))
-	(dtstart (plist-get params :dtstart))
-	(dtend (plist-get params :dtend))
-	(ddstart (plist-get params :ddstart))
-	(ddend (plist-get params :ddend)))
+  (cl-destructuring-bind
+      (&key backend istart iend isep icount ifmt cboff
+	    cbon cbtrans dtstart dtend ddstart ddend
+	    &allow-other-keys)
+      params
     (lambda (item contents info)
       (let* ((type
 	      (org-element-property :type (org-element-property :parent item)))
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index a23195d2a..790621e69 100644
--- a/lisp/org-plot.el
+++ b/lisp/org-plot.el
@@ -34,6 +34,19 @@
 (require 'org)
 (require 'org-table)
 
+(defmacro let-plist (plist &rest body)
+  (declare (indent 1))
+  (let ((syms (make-symbol "syms"))
+        (vals (make-symbol "vals"))
+        (list (make-symbol "list")))
+    `(let ((,list ,plist)
+           ,syms ,vals)
+       (while ,list
+         (push (intern (substring (symbol-name (pop ,list)) 1)) ,syms)
+         (push (pop ,list) ,vals))
+       (cl-progv ,syms ,vals
+         ,@body))))
+
 (declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg))
 (declare-function gnuplot-mode "ext:gnuplot" ())
 (declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ())
@@ -46,60 +59,70 @@
 
 (defvar org-plot-timestamp-fmt nil)
 
-(defun org-plot/add-options-to-plist (p options)
-  "Parse an OPTIONS line and set values in the property list P.
-Returns the resulting property list."
-  (when options
-    (let ((op '(("type"    . :plot-type)
-		("script"  . :script)
-		("line"    . :line)
-		("set"     . :set)
-		("title"   . :title)
-		("ind"     . :ind)
-		("deps"    . :deps)
-		("with"    . :with)
-		("file"    . :file)
-		("labels"  . :labels)
-		("map"     . :map)
-		("timeind" . :timeind)
-		("timefmt" . :timefmt)))
-	  (multiples '("set" "line"))
-	  (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)")
-	  (start 0))
-      (dolist (o op)
-	(if (member (car o) multiples) ;; keys with multiple values
-	    (while (string-match
-		    (concat (regexp-quote (car o)) regexp)
-		    options start)
-	      (setq start (match-end 0))
-	      (setq p (plist-put p (cdr o)
-				 (cons (car (read-from-string
-					     (match-string 1 options)))
-				       (plist-get p (cdr o)))))
-	      p)
-	  (if (string-match (concat (regexp-quote (car o)) regexp)
-			    options)
-	      (setq p (plist-put p (cdr o)
-				 (car (read-from-string
-				       (match-string 1 options))))))))))
-  p)
+(defun org-plot/add-options-to-plist (props options)
+  "Parse an OPTIONS line and set values in the PROPS property list.
+
+Return the augmented property list."
+  (let ((regexp "\\([[:word:]]+\\):\\([\"][^\"]+[\"]\\|[(][^)]+[)]\\|[^ \t\n\r;,.]*\\)")
+	(keys '(:type :use :script :line :set :title :ind :deps
+		:with :file :labels :map :xticdep :timeind :timefmt))
+	(multiples '(:set :line)) ;; cons values into list
+	(start 0))
+    (while (string-match regexp options start)
+      (let ((key (intern (concat ":" (match-string 1 options))))
+	    (value (car (read-from-string (match-string 2 options)))))
+	(setq start (match-end 0))
+	(when (member key keys)
+	  (when (eq key :type)
+	    (setq key :plot-type))
+	  (when (member key multiples)
+	    (setq value (cons value (plist-get props key))))
+	  (setq props (plist-put props key value)))))
+    props))
 
 (defun org-plot/goto-nearest-table ()
-  "Move the point forward to the beginning of nearest table.
-Return value is the point at the beginning of the table."
-  (interactive) (move-beginning-of-line 1)
-  (while (not (or (org-at-table-p) (< 0 (forward-line 1)))))
-  (goto-char (org-table-begin)))
+  "Move the point to beginning of nearest table.
 
-(defun org-plot/collect-options (&optional params)
-  "Collect options from an org-plot `#+Plot:' line.
-Accepts an optional property list PARAMS, to which the options
-will be added.  Returns the resulting property list."
+Go back to beginning of current table, or move forward to next
+table, or stay in place.  Return value is the new point."
   (interactive)
-  (let ((line (thing-at-point 'line)))
-    (if (string-match "#\\+PLOT: +\\(.*\\)$" line)
-	(org-plot/add-options-to-plist params (match-string 1 line))
-      params)))
+  (let ((position (point)))
+    (move-beginning-of-line 1)
+    (when (looking-at "[[:space:]]*#\\+TBLFM:")
+      (forward-line -1))
+    (while (not (or (org-at-table-p)
+		    (< 0 (forward-line 1)))))
+    (goto-char (if (org-at-table-p) (org-table-begin) position))))
+
+(defun org-plot/collect-line-options (line &optional params)
+  "Collect org-plot options from LINE.
+
+If LINE matches the org-plot definitions pattern, collect the
+options contained.  The options will be added to the optional
+PARAMS property list.  Return the augmented property list."
+  (or (when (string-match "#\\+PLOT\\(?:\\[\\(.*\\)\\]\\)?: +\\(.*\\)$" line)
+	(let ((expect-use (match-string 1 line))
+	      (options (match-string 2 line)))
+	  (when (or (not expect-use)
+		    (eq (string-to-number expect-use)
+			(plist-get params :use)))
+            (org-plot/add-options-to-plist params options))))
+      params))
+
+(defun org-plot/collect-table-options (&optional params)
+  "Scans all `#+' lines preceding point, collecting options.
+
+Point is assumed to be at table begin, immediately after last
+`#+' line.  Accepts an optional property list PARAMS, to which
+the options will be added.  Returns the accumulated property
+list."
+  (save-excursion
+    (while (and (equal 0 (forward-line -1))
+		(looking-at "[[:space:]]*#\\+"))
+      (setq params (org-plot/collect-line-options
+		    (string-trim (thing-at-point 'line))
+		    params))))
+  params)
 
 (defun org-plot-quote-timestamp-field (s)
   "Convert field S from timestamp to Unix time and export to gnuplot."
@@ -133,13 +156,10 @@ This means in a format appropriate for grid plotting by gnuplot.
 PARAMS specifies which columns of TABLE should be plotted as independent
 and dependent variables."
   (interactive)
-  (let* ((ind (- (plist-get params :ind) 1))
+  (let* ((ind (1- (plist-get params :ind)))
 	 (deps (if (plist-member params :deps)
-		   (mapcar (lambda (val) (- val 1)) (plist-get params :deps))
-		 (let (collector)
-		   (dotimes (col (length (nth 0 table)))
-		     (setf collector (cons col collector)))
-		   collector)))
+		   (mapcar #'1- (plist-get params :deps))
+		 (remove ind (number-sequence 0 (1- (length (car table)))))))
 	 (counter 0)
 	 row-vals)
     (when (>= ind 0) ;; collect values of ind col
@@ -156,9 +176,11 @@ and dependent variables."
 			  table)))
     ;; write table to gnuplot grid datafile format
     (with-temp-file data-file
-      (let ((num-rows (length table)) (num-cols (length (nth 0 table)))
+      (let ((num-rows (length table))
+	    (num-cols (length (nth 0 table)))
 	    (gnuplot-row (lambda (col row value)
-			   (setf col (+ 1 col)) (setf row (+ 1 row))
+			   (setf col (+ 1 col))
+			   (setf row (+ 1 row))
 			   (format "%f  %f  %f\n%f  %f  %f\n"
 				   col (- row 0.5) value ;; lower edge
 				   col (+ row 0.5) value))) ;; upper edge
@@ -179,94 +201,106 @@ and dependent variables."
 	  (setf back-edge "") (setf front-edge ""))))
     row-vals))
 
-(defun org-plot/gnuplot-script (data-file num-cols params &optional preface)
-  "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS.
+(defun org-plot/zip-deps-with (num-cols ind deps with)
+  "Describe each column to be plotted as (col . with).
+Loops over DEPS and WITH in order to cons their elements.
+If the DEPS list of columns is not given, use all columns from 1
+to NUM-COLS, excluding IND.
+If WITH is given as a string, use the given value for all columns.
+If WITH is given as a list, and it's shorter than DEPS, expand it
+with the global default value."
+  (unless deps
+    (setq deps (remove ind (number-sequence 1 num-cols))))
+  (setq with
+	(if (listp with)
+	    (append with
+		    (make-list (max 0 (- (length deps) (length with)))
+			       "lines"))
+	  (make-list (length deps) with)))
+  (cl-mapcar #'cons deps with))
+
+(defun org-plot/format-plot-str (ind col with col-labels
+				     text-ind xticdep)
+  (with-output-to-string
+    (princ "'$datafile' using ")
+    (when (and ind (> ind 0) (not text-ind))
+      (princ ind)
+      (princ ":"))
+    (princ col)
+    (when (or xticdep text-ind)
+      (princ (format ":xticlabel(%d)"
+		     (or xticdep ind))))
+    (princ (format " with %s title '%s'"
+		   with (or (nth (1- col) col-labels)
+			    (format "%d" col))))))
+
+(defun org-plot/gnuplot-script (num-cols params &optional preface)
+  "Write a gnuplot script respecting the options set in PARAMS.
 NUM-COLS controls the number of columns plotted in a 2-d plot.
 Optional argument PREFACE returns only option parameters in a
 manner suitable for prepending to a user-specified script."
-  (let* ((type (plist-get params :plot-type))
-	 (with (if (eq type 'grid) 'pm3d (plist-get params :with)))
-	 (sets (plist-get params :set))
-	 (lines (plist-get params :line))
-	 (map (plist-get params :map))
-	 (title (plist-get params :title))
-	 (file (plist-get params :file))
-	 (ind (plist-get params :ind))
-	 (time-ind (plist-get params :timeind))
-	 (timefmt (plist-get params :timefmt))
-	 (text-ind (plist-get params :textind))
-	 (deps (if (plist-member params :deps) (plist-get params :deps)))
-	 (col-labels (plist-get params :labels))
-	 (x-labels (plist-get params :xlabels))
-	 (y-labels (plist-get params :ylabels))
-	 (plot-str "'%s' using %s%d%s with %s title '%s'")
-	 (plot-cmd (pcase type
-		     (`2d "plot")
-		     (`3d "splot")
-		     (`grid "splot")))
-	 (script "reset")
-	 ;; ats = add-to-script
-	 (ats (lambda (line) (setf script (concat script "\n" line))))
-	 plot-lines)
-    (when file				; output file
-      (funcall ats (format "set term %s" (file-name-extension file)))
-      (funcall ats (format "set output '%s'" file)))
-    (pcase type				; type
-      (`2d ())
-      (`3d (when map (funcall ats "set map")))
-      (`grid (funcall ats (if map "set pm3d map" "set pm3d"))))
-    (when title (funcall ats (format "set title '%s'" title))) ; title
-    (mapc ats lines)					       ; line
-    (dolist (el sets) (funcall ats (format "set %s" el)))      ; set
-    ;; Unless specified otherwise, values are TAB separated.
-    (unless (string-match-p "^set datafile separator" script)
-      (funcall ats "set datafile separator \"\\t\""))
-    (when x-labels			; x labels (xtics)
-      (funcall ats
-	       (format "set xtics (%s)"
-		       (mapconcat (lambda (pair)
-				    (format "\"%s\" %d" (cdr pair) (car pair)))
-				  x-labels ", "))))
-    (when y-labels			; y labels (ytics)
-      (funcall ats
-	       (format "set ytics (%s)"
-		       (mapconcat (lambda (pair)
-				    (format "\"%s\" %d" (cdr pair) (car pair)))
-				  y-labels ", "))))
-    (when time-ind			; timestamp index
-      (funcall ats "set xdata time")
-      (funcall ats (concat "set timefmt \""
-			   (or timefmt	; timefmt passed to gnuplot
-			       "%Y-%m-%d-%H:%M:%S") "\"")))
-    (unless preface
-      (pcase type			; plot command
-	(`2d (dotimes (col num-cols)
-	       (unless (and (eq type '2d)
-			    (or (and ind (equal (1+ col) ind))
-				(and deps (not (member (1+ col) deps)))))
-		 (setf plot-lines
-		       (cons
-			(format plot-str data-file
-				(or (and ind (> ind 0)
-					 (not text-ind)
-					 (format "%d:" ind)) "")
-				(1+ col)
-				(if text-ind (format ":xticlabel(%d)" ind) "")
-				with
-				(or (nth col col-labels)
-				    (format "%d" (1+ col))))
-			plot-lines)))))
-	(`3d
-	 (setq plot-lines (list (format "'%s' matrix with %s title ''"
-					data-file with))))
-	(`grid
-	 (setq plot-lines (list (format "'%s' with %s title ''"
-					data-file with)))))
-      (funcall ats
-	       (concat plot-cmd " " (mapconcat #'identity
-					       (reverse plot-lines)
-					       ",\\\n    "))))
-    script))
+  (cl-destructuring-bind
+      (&key plot-type with set line map title file ind
+	    timeind timefmt textind xticdep deps labels
+	    xlabels ylabels &allow-other-keys)
+      params
+    (when (eq plot-type 'grid)
+      (setq with 'pm3d))
+    (let* ((plot-cmd (pcase plot-type
+		       (`2d "plot")
+		       (`3d "splot")
+		       (`grid "splot")))
+	   (script "\3reset")
+	   ;; ats = add-to-script
+	   (ats (lambda (line) (setq script (concat script "\n" line))))
+	   plot-lines)
+      (when file				; output file
+	(funcall ats (format "set term %s" (file-name-extension file)))
+	(funcall ats (format "set output '%s'" file)))
+      (pcase plot-type				; type
+	(`2d ())
+	(`3d (when map (funcall ats "set map")))
+	(`grid (funcall ats (if map "set pm3d map" "set pm3d"))))
+      (when title (funcall ats (format "set title '%s'" title))); title
+      (mapc ats line)					        ; line
+      (dolist (el set) (funcall ats (format "set %s" el)))      ; set
+      ;; Unless specified otherwise, values are TAB separated.
+      (unless (string-match-p "^set datafile separator" script)
+	(funcall ats "set datafile separator \"\\t\""))
+      (when xlabels			; x labels (xtics)
+	(funcall ats
+		 (format "set xtics (%s)"
+			 (mapconcat (lambda (pair)
+				      (format "\"%s\" %d" (cdr pair) (car pair)))
+				    xlabels ", "))))
+      (when ylabels			; y labels (ytics)
+	(funcall ats
+		 (format "set ytics (%s)"
+			 (mapconcat (lambda (pair)
+				      (format "\"%s\" %d" (cdr pair) (car pair)))
+				    ylabels ", "))))
+      (when timeind			; timestamp index
+	(funcall ats "set xdata time")
+	(funcall ats (concat "set timefmt \""
+			     (or timefmt	; timefmt passed to gnuplot
+				 "%Y-%m-%d-%H:%M:%S") "\"")))
+      (unless preface
+	(setq plot-lines
+	      (pcase plot-type			; plot command
+		(`2d (cl-loop
+		      for (col . with)
+		      in (org-plot/zip-deps-with num-cols ind deps with)
+		      collect (format-plot-str ind col with labels
+					       textind xticdep)))
+		(`3d (list (format "'$datafile' matrix with %s title ''"
+				   with)))
+		(`grid (list (format "'$datafile' with %s title ''"
+				     with)))))
+	(funcall ats
+		 (concat plot-cmd " " (mapconcat #'identity
+						 plot-lines
+						 ",\\\n    "))))
+      script)))
 
 ;;-----------------------------------------------------------------------------
 ;; facade functions
@@ -304,8 +338,7 @@ line directly before or after the table."
 			(setf params (org-plot/collect-options params))))
       ;; Dump table to datafile (very different for grid).
       (pcase (plist-get params :plot-type)
-	(`2d   (org-plot/gnuplot-to-data table data-file params))
-	(`3d   (org-plot/gnuplot-to-data table data-file params))
+	((or `2d `3d)   (org-plot/gnuplot-to-data table data-file params))
 	(`grid (let ((y-labels (org-plot/gnuplot-to-grid-data
 				table data-file params)))
 		 (when y-labels (plist-put params :ylabels y-labels)))))
@@ -331,15 +364,14 @@ line directly before or after the table."
 		(plist-put params :textind t)))))
       ;; Write script.
       (with-temp-buffer
-	(if (plist-get params :script)	; user script
-	    (progn (insert
-                    (org-plot/gnuplot-script data-file num-cols params t))
-                   (insert "\n")
-                   (insert-file-contents (plist-get params :script))
-                   (goto-char (point-min))
-                   (while (re-search-forward "\\$datafile" nil t)
-                     (replace-match data-file nil nil)))
-	  (insert (org-plot/gnuplot-script data-file num-cols params)))
+	(insert (org-plot/gnuplot-script num-cols params
+					 (plist-get params :script)))
+	(when (plist-get params :script) ; user script
+	  (insert "\n")
+	  (insert-file-contents (plist-get params :script)))
+	(goto-char (point-min))
+	(while (re-search-forward "\\$datafile" nil t)
+	  (replace-match data-file nil nil))
 	;; Graph table.
 	(gnuplot-mode)
 	(gnuplot-send-buffer-to-gnuplot))
diff --git a/lisp/org-table.el b/lisp/org-table.el
index 3bf3ea872..9460a07c0 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -5772,19 +5772,11 @@ information."
   "Return custom table row transcoder according to PARAMS.
 PARAMS is a plist.  See `orgtbl-to-generic' for more
 information."
-  (let* ((backend (plist-get params :backend))
-	 (lstart (plist-get params :lstart))
-	 (llstart (plist-get params :llstart))
-	 (hlstart (plist-get params :hlstart))
-	 (hllstart (plist-get params :hllstart))
-	 (lend (plist-get params :lend))
-	 (llend (plist-get params :llend))
-	 (hlend (plist-get params :hlend))
-	 (hllend (plist-get params :hllend))
-	 (lfmt (plist-get params :lfmt))
-	 (llfmt (plist-get params :llfmt))
-	 (hlfmt (plist-get params :hlfmt))
-	 (hllfmt (plist-get params :hllfmt)))
+  (cl-destructuring-bind
+      (&key backend lstart llstart hlstart hllstart lend llend
+	    hlend hllend lfmt llfmt hlfmt hllfmt
+	    &allow-other-keys)
+      params
     `(lambda (row contents info)
        (if (eq (org-element-property :type row) 'rule)
 	   ,(cond
@@ -5866,12 +5858,10 @@ information."
   "Return custom table cell transcoder according to PARAMS.
 PARAMS is a plist.  See `orgtbl-to-generic' for more
 information."
-  (let* ((backend (plist-get params :backend))
-	 (efmt (plist-get params :efmt))
-	 (fmt (plist-get params :fmt))
-	 (hfmt (plist-get params :hfmt))
-	 (sep (plist-get params :sep))
-	 (hsep (plist-get params :hsep)))
+  (cl-destructuring-bind
+      (&key backend efmt fmt hfmt sep hsep
+	    &allow-other-keys)
+      params
     `(lambda (cell contents info)
        ;; Make sure that contents are exported as Org data when :raw
        ;; parameter is non-nil.
-- 
2.20.1


^ permalink raw reply related	[flat|nested] 3+ messages in thread
end of thread, other threads:[~2020-07-12 18:05 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-06-27 15:18 [patch] simplify-compact initial data extraction from plist Mario Frasca
2020-06-27 16:49 ` tomas
2020-07-12 18:03 ` Fwd: " Mario Frasca

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).