* [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
* Re: [patch] simplify-compact initial data extraction from plist
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
1 sibling, 0 replies; 3+ messages in thread
From: tomas @ 2020-06-27 16:49 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 773 bytes --]
On Sat, Jun 27, 2020 at 10:18:21AM -0500, Mario Frasca wrote:
> 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.
I assume you mean a "colon", like this `:'
Those :foo thingies have another nice property: they are self-evaluating,
like numbers. If you try, e.g. to eval foo, the evaluator tries to find
a variable named foo and the result is then that variable's value.
If you evaluate 'foo, the result is the symbol foo.
If you evaluate :foo, the result is :foo, like when you evaluate 1234,
where the result is simply 1234.
Cheers
-- t
[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 198 bytes --]
^ permalink raw reply [flat|nested] 3+ messages in thread
* Fwd: [patch] simplify-compact initial data extraction from plist
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 ` Mario Frasca
1 sibling, 0 replies; 3+ messages in thread
From: Mario Frasca @ 2020-07-12 18:03 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1.1: Type: text/plain, Size: 852 bytes --]
Anyone?
-------- Forwarded Message --------
Subject: [patch] simplify-compact initial data extraction from plist
Date: Sat, 27 Jun 2020 10:18:21 -0500
From: Mario Frasca <mario@anche.no>
To: emacs-orgmode@gnu.org
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 #1.2: Type: text/html, Size: 2061 bytes --]
[-- Attachment #2: 0001-cl-destructuring-bind-simplifies-initial-repeating-l.patch --]
[-- Type: text/x-patch, Size: 20362 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).