emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
blob 790621e69cbdb31777310bb3afdf4b6fa551a52f 14078 bytes (raw)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
 
;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*-

;; Copyright (C) 2008-2020 Free Software Foundation, Inc.
;;
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: tables, plotting
;; Homepage: https://orgmode.org
;;
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Borrows ideas and a couple of lines of code from org-exp.el.

;; Thanks to the Org mailing list for testing and implementation and
;; feature suggestions

;;; Code:

(require 'cl-lib)
(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" ())

(defvar org-plot/gnuplot-default-options
  '((:plot-type . 2d)
    (:with . lines)
    (:ind . 0))
  "Default options to gnuplot used by `org-plot/gnuplot'.")

(defvar org-plot-timestamp-fmt nil)

(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 to beginning of nearest table.

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 ((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."
  (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s)))

(defun org-plot-quote-tsv-field (s)
  "Quote field S for export to gnuplot."
  (if (string-match org-table-number-regexp s) s
    (if (string-match org-ts-regexp3 s)
	(org-plot-quote-timestamp-field s)
      (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))

(defun org-plot/gnuplot-to-data (table data-file params)
  "Export TABLE to DATA-FILE in a format readable by gnuplot.
Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE."
  (with-temp-file
      data-file
    (setq-local org-plot-timestamp-fmt (or
					(plist-get params :timefmt)
					"%Y-%m-%d-%H:%M:%S"))
    (insert (orgtbl-to-generic
	     table
	     (org-combine-plists
	      '(:sep "\t" :fmt org-plot-quote-tsv-field)
	      params))))
  nil)

(defun org-plot/gnuplot-to-grid-data (table data-file params)
  "Export the data in TABLE to DATA-FILE for gnuplot.
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 (1- (plist-get params :ind)))
	 (deps (if (plist-member params :deps)
		   (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
      (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter))
			       (cons counter (nth ind row)))
			     table)))
    (when (or deps (>= ind 0)) ;; remove non-plotting columns
      (setf deps (delq ind deps))
      (setf table (mapcar (lambda (row)
			    (dotimes (col (length row))
			      (unless (memq col deps)
				(setf (nth col row) nil)))
			    (delq nil row))
			  table)))
    ;; write table to gnuplot grid datafile format
    (with-temp-file data-file
      (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))
			   (format "%f  %f  %f\n%f  %f  %f\n"
				   col (- row 0.5) value ;; lower edge
				   col (+ row 0.5) value))) ;; upper edge
	    front-edge back-edge)
	(dotimes (col num-cols)
	  (dotimes (row num-rows)
	    (setf back-edge
		  (concat back-edge
			  (funcall gnuplot-row (- col 1) row
				   (string-to-number (nth col (nth row table))))))
	    (setf front-edge
		  (concat front-edge
			  (funcall gnuplot-row col row
				   (string-to-number (nth col (nth row table)))))))
	  ;; only insert once per row
	  (insert back-edge) (insert "\n") ;; back edge
	  (insert front-edge) (insert "\n") ;; front edge
	  (setf back-edge "") (setf front-edge ""))))
    row-vals))

(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."
  (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
;;;###autoload
(defun org-plot/gnuplot (&optional params)
  "Plot table using gnuplot.  Gnuplot options can be specified with PARAMS.
If not given options will be taken from the +PLOT
line directly before or after the table."
  (interactive)
  (require 'gnuplot)
  (save-window-excursion
    (delete-other-windows)
    (when (get-buffer "*gnuplot*") ; reset *gnuplot* if it already running
      (with-current-buffer "*gnuplot*"
	(goto-char (point-max))))
    (org-plot/goto-nearest-table)
    ;; Set default options.
    (dolist (pair org-plot/gnuplot-default-options)
      (unless (plist-member params (car pair))
	(setf params (plist-put params (car pair) (cdr pair)))))
    ;; collect table and table information
    (let* ((data-file (make-temp-file "org-plot"))
	   (table (org-table-to-lisp))
	   (num-cols (length (if (eq (nth 0 table) 'hline) (nth 1 table)
			       (nth 0 table)))))
      (run-with-idle-timer 0.1 nil #'delete-file data-file)
      (while (eq 'hline (car table)) (setf table (cdr table)))
      (when (eq (cadr table) 'hline)
	(setf params
	      (plist-put params :labels (nth 0 table))) ; headers to labels
	(setf table (delq 'hline (cdr table)))) ; clean non-data from table
      ;; Collect options.
      (save-excursion (while (and (equal 0 (forward-line -1))
				  (looking-at "[[:space:]]*#\\+"))
			(setf params (org-plot/collect-options params))))
      ;; Dump table to datafile (very different for grid).
      (pcase (plist-get params :plot-type)
	((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)))))
      ;; Check for timestamp ind column.
      (let ((ind (1- (plist-get params :ind))))
	(when (and (>= ind 0) (eq '2d (plist-get params :plot-type)))
	  (if (= (length
		  (delq 0 (mapcar
			   (lambda (el)
			     (if (string-match org-ts-regexp3 el) 0 1))
			   (mapcar (lambda (row) (nth ind row)) table))))
		 0)
	      (plist-put params :timeind t)
	    ;; Check for text ind column.
	    (if (or (string= (plist-get params :with) "hist")
		    (> (length
			(delq 0 (mapcar
				 (lambda (el)
				   (if (string-match org-table-number-regexp el)
				       0 1))
				 (mapcar (lambda (row) (nth ind row)) table))))
		       0))
		(plist-put params :textind t)))))
      ;; Write script.
      (with-temp-buffer
	(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))
      ;; Cleanup.
      (bury-buffer (get-buffer "*gnuplot*")))))

(provide 'org-plot)

;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:

;;; org-plot.el ends here

debug log:

solving 790621e69 ...
found 790621e69 in https://list.orgmode.org/orgmode/f55ce1a9-9c96-119f-ad8a-d28ba66e10c2@anche.no/ ||
	https://list.orgmode.org/orgmode/7a5fe631-844b-b038-53b7-ee1392b49f49@anche.no/
found a23195d2a in https://git.savannah.gnu.org/cgit/emacs/org-mode.git
preparing index
index prepared:
100644 a23195d2a13e3dc19a2b4d8ecb75df8652466157	lisp/org-plot.el

applying [1/1] https://list.orgmode.org/orgmode/f55ce1a9-9c96-119f-ad8a-d28ba66e10c2@anche.no/
diff --git a/lisp/org-plot.el b/lisp/org-plot.el
index a23195d2a..790621e69 100644

Checking patch lisp/org-plot.el...
Applied patch lisp/org-plot.el cleanly.

skipping https://list.orgmode.org/orgmode/7a5fe631-844b-b038-53b7-ee1392b49f49@anche.no/ for 790621e69
index at:
100644 790621e69cbdb31777310bb3afdf4b6fa551a52f	lisp/org-plot.el

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