changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > infra > home / .emacs.d/lib/eplot.el

changeset 97: f61dc77440df
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 08 Sep 2024 20:46:10 -0400
permissions: -rw-r--r--
description: add eplot.el
1 ;;; eplot.el --- Manage and Edit Wordpress Posts -*- lexical-binding: t -*-
2 
3 ;; Copyright (C) 2024 Free Software Foundation, Inc.
4 
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: charts
7 ;; Package: eplot
8 ;; Version: 1.0
9 ;; Package-Requires: ((emacs "29.0.59") (pcsv "0.0"))
10 
11 ;; eplot is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15 
16 ;;; Commentary:
17 
18 ;; The main entry point is `M-x eplot' in a buffer with time series
19 ;; data.
20 ;;
21 ;; If installing manually, put something like the following in your
22 ;; Emacs init file (but adjust the path to where you've put eplot):
23 ;;
24 ;; (push "~/src/eplot/" load-path)
25 ;; (autoload 'eplot "eplot" nil t)
26 ;; (autoload 'eplot-mode "eplot" nil t)
27 ;; (unless (assoc "\\.plt" auto-mode-alist)
28 ;; (setq auto-mode-alist (cons '("\\.plt" . eplot-mode) auto-mode-alist)))
29 
30 ;; This requires the pcsv package to parse CSV files.
31 
32 ;;; Code:
33 
34 (require 'svg)
35 (require 'cl-lib)
36 (require 'face-remap)
37 (require 'eieio)
38 (require 'iso8601)
39 (require 'transient)
40 
41 (defvar eplot--user-defaults nil)
42 (defvar eplot--chart-headers nil)
43 (defvar eplot--plot-headers nil)
44 (defvar eplot--transient-settings nil)
45 
46 
47 (defvar eplot--colors
48  '("aliceblue" "antiquewhite" "aqua" "aquamarine" "azure" "beige" "bisque"
49  "black" "blanchedalmond" "blue" "blueviolet" "brown" "burlywood"
50  "cadetblue" "chartreuse" "chocolate" "coral" "cornflowerblue" "cornsilk"
51  "crimson" "cyan" "darkblue" "darkcyan" "darkgoldenrod" "darkgray"
52  "darkgreen" "darkgrey" "darkkhaki" "darkmagenta" "darkolivegreen"
53  "darkorange" "darkorchid" "darkred" "darksalmon" "darkseagreen"
54  "darkslateblue" "darkslategray" "darkslategrey" "darkturquoise"
55  "darkviolet" "deeppink" "deepskyblue" "dimgray" "dimgrey" "dodgerblue"
56  "firebrick" "floralwhite" "forestgreen" "fuchsia" "gainsboro" "ghostwhite"
57  "gold" "goldenrod" "gray" "green" "greenyellow" "grey" "honeydew" "hotpink"
58  "indianred" "indigo" "ivory" "khaki" "lavender" "lavenderblush" "lawngreen"
59  "lemonchiffon" "lightblue" "lightcoral" "lightcyan" "lightgoldenrodyellow"
60  "lightgray" "lightgreen" "lightgrey" "lightpink" "lightsalmon"
61  "lightseagreen" "lightskyblue" "lightslategray" "lightslategrey"
62  "lightsteelblue" "lightyellow" "lime" "limegreen" "linen" "magenta"
63  "maroon" "mediumaquamarine" "mediumblue" "mediumorchid" "mediumpurple"
64  "mediumseagreen" "mediumslateblue" "mediumspringgreen" "mediumturquoise"
65  "mediumvioletred" "midnightblue" "mintcream" "mistyrose" "moccasin"
66  "navajowhite" "navy" "oldlace" "olive" "olivedrab" "orange" "orangered"
67  "orchid" "palegoldenrod" "palegreen" "paleturquoise" "palevioletred"
68  "papayawhip" "peachpuff" "peru" "pink" "plum" "powderblue" "purple" "red"
69  "rosybrown" "royalblue" "saddlebrown" "salmon" "sandybrown" "seagreen"
70  "seashell" "sienna" "silver" "skyblue" "slateblue" "slategray" "slategrey"
71  "snow" "springgreen" "steelblue" "tan" "teal" "thistle" "tomato"
72  "turquoise" "violet" "wheat" "white" "whitesmoke" "yellow" "yellowgreen"))
73 
74 (defun eplot-set (header value)
75  "Set the default value of HEADER to VALUE.
76 To get a list of all possible HEADERs, use the `M-x
77 eplot-list-chart-headers' command.
78 
79 Also see `eplot-reset'."
80  (let ((elem (or (assq header eplot--chart-headers)
81  (assq header eplot--plot-headers))))
82  (unless elem
83  (error "No such header type: %s" header))
84  (eplot--add-default header value)))
85 
86 (defun eplot--add-default (header value)
87  ;; We want to preserve the order defaults have been added, so that
88  ;; we can apply them in the same order. This makes a difference
89  ;; when we're dealing with specs that have inheritence.
90  (setq eplot--user-defaults (delq (assq header eplot--user-defaults)
91  eplot--user-defaults))
92  (setq eplot--user-defaults (list (cons header value))))
93 
94 (defun eplot-reset (&optional header)
95  "Reset HEADER to defaults.
96 If HEADER is nil or not present, reset everything to defaults."
97  (if header
98  (setq eplot--user-defaults (delq (assq header eplot--user-defaults)
99  eplot--user-defaults))
100  (setq eplot--user-defaults nil)))
101 
102 (unless (assoc "\\.plt" auto-mode-alist)
103  (setq auto-mode-alist (cons '("\\.plt" . eplot-mode) auto-mode-alist)))
104 
105 ;;; eplot modes.
106 
107 (defvar-keymap eplot-mode-map
108  "C-c C-c" #'eplot-update-view-buffer
109  "C-c C-p" #'eplot-switch-view-buffer
110  "C-c C-e" #'eplot-list-chart-headers
111  "C-c C-v" #'eplot-customize
112  "C-c C-l" #'eplot-create-controls
113  "TAB" #'eplot-complete)
114 
115 ;; # is working overtime in the syntax here:
116 ;; It can be a color like Color: #e0e0e0, and
117 ;; it can be a setting like 33 # Label: Apples,
118 ;; when it starts a line it's a comment.
119 (defvar eplot-font-lock-keywords
120  `(("^[ \t\n]*#.*" . font-lock-comment-face)
121  ("^[^ :\n]+:" . font-lock-keyword-face)
122  ("#[0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]\\([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]\\)?" . font-lock-variable-name-face)
123  ("#.*" . font-lock-builtin-face)))
124 
125 (define-derived-mode eplot-mode text-mode "eplot"
126  "Major mode for editing charts.
127 Use the \\[eplot-list-chart-headers] command to get a list of all
128 possible chart headers."
129  (setq-local completion-at-point-functions
130  (cons 'eplot--complete-header completion-at-point-functions))
131  (setq-local font-lock-defaults
132  '(eplot-font-lock-keywords nil nil nil)))
133 
134 (defun eplot-complete ()
135  "Complete headers."
136  (interactive)
137  (cond
138  ((let ((completion-fail-discreetly t))
139  (completion-at-point))
140  ;; Completion was performed; nothing else to do.
141  nil)
142  (t (indent-relative))))
143 
144 (defun eplot--complete-header ()
145  (or
146  ;; Complete headers names.
147  (and (or (looking-at ".*:")
148  (and (looking-at "[ \t]*$")
149  (save-excursion
150  (beginning-of-line)
151  (not (looking-at "\\(.+\\):")))))
152  (lambda ()
153  (let ((headers (mapcar
154  (lambda (h)
155  (if (looking-at ".*:")
156  (capitalize (symbol-name (car h)))
157  (concat (capitalize (symbol-name (car h))) ": ")))
158  (save-excursion
159  ;; If we're after the headers, then we want
160  ;; to complete over the plot headers. Otherwise,
161  ;; complete over the chart headers.
162  (if (and (not (bobp))
163  (progn
164  (forward-line -1)
165  (re-search-backward "^[ \t]*$" nil t)))
166  eplot--plot-headers
167  eplot--chart-headers))))
168  (completion-ignore-case t))
169  (completion-in-region (pos-bol) (line-end-position) headers)
170  'completion-attempted)))
171  ;; Complete header values.
172  (let ((hname nil))
173  (and (save-excursion
174  (and (looking-at "[ \t]*$")
175  (progn
176  (beginning-of-line)
177  (and (looking-at "\\(.+\\):")
178  (setq hname (intern (downcase (match-string 1)))))))
179  (lambda ()
180  (let ((valid (plist-get
181  (cdr (assq hname (append eplot--plot-headers
182  eplot--chart-headers)))
183  :valid))
184  (completion-ignore-case t))
185  (completion-in-region
186  (save-excursion
187  (search-backward ":" (pos-bol) t)
188  (skip-chars-forward ": \t")
189  (point))
190  (line-end-position)
191  (mapcar #'symbol-name valid))
192  'completion-attempted)))))))
193 
194 (define-minor-mode eplot-minor-mode
195  "Minor mode to issue commands from an eplot data buffer."
196  :lighter " eplot")
197 
198 (defvar-keymap eplot-minor-mode-map
199  "H-l" #'eplot-eval-and-update)
200 
201 (defvar-keymap eplot-view-mode-map
202  "s" #'eplot-view-write-file
203  "w" #'eplot-view-write-scaled-file
204  "c" #'eplot-view-customize
205  "l" #'eplot-create-controls)
206 
207 (define-derived-mode eplot-view-mode special-mode "eplot view"
208  "Major mode for displaying eplots."
209  (setq-local revert-buffer-function #'eplot-update
210  cursor-type nil))
211 
212 (defun eplot-view-write-file (file &optional width)
213  "Write the current chart to a file.
214 If you type in a file name that ends with something else than \"svg\",
215 ImageMagick \"convert\" will be used to convert the image first.
216 
217 If writing to a PNG file, \"rsvg-conver\" will be used instead if
218 it exists as this usually gives better results."
219  (interactive "FWrite to file name: ")
220  (when (and (file-exists-p file)
221  (not (yes-or-no-p "File exists, overwrite? ")))
222  (error "Not overwriting the file"))
223  (save-excursion
224  (goto-char (point-min))
225  (let ((match
226  (text-property-search-forward 'display nil
227  (lambda (_ e)
228  (and (consp e)
229  (eq (car e) 'image))))))
230  (unless match
231  (error "Can't find an image in the current buffer"))
232  (let ((svg (plist-get (cdr (prop-match-value match)) :data))
233  (tmp " *eplot convert*")
234  (executable (if width "rsvg-convert" "convert"))
235  sfile ofile)
236  (unless svg
237  (error "Invalid image in the current buffer"))
238  (with-temp-buffer
239  (set-buffer-multibyte nil)
240  (svg-print svg)
241  (if (string-match-p "\\.svg\\'" file)
242  (write-region (point-min) (point-max) file)
243  (if (and (string-match-p "\\.png\\'" file)
244  (executable-find "rsvg-convert"))
245  (setq executable "rsvg-convert")
246  (unless (executable-find executable)
247  (error "%s isn't installed; can only save svg files"
248  executable)))
249  (when (and (equal executable "rsvg-convert")
250  (not (string-match-p "\\.png\\'" file))
251  (not (executable-find "convert")))
252  (error "Can only write PNG files when scaling because \"convert\" isn't installed"))
253  (unwind-protect
254  (progn
255  (setq sfile (make-temp-file "eplot" nil ".svg")
256  ofile (make-temp-file "eplot" nil ".png"))
257  (write-region (point-min) (point-max) sfile nil 'silent)
258  ;; We don't use `call-process-region', because
259  ;; convert doesn't seem to like that?
260  (let ((code (if (equal executable "rsvg-convert")
261  (apply
262  #'call-process
263  executable nil (get-buffer-create tmp) nil
264  `(,(format "--output=%s"
265  (expand-file-name ofile))
266  ,@(and width
267  `(,(format "--width=%d" width)
268  "--keep-aspect-ratio"))
269  ,sfile))
270  (call-process
271  executable nil (get-buffer-create tmp) nil
272  sfile file))))
273  (eplot--view-error code tmp)
274  (when (file-exists-p ofile)
275  (if (string-match-p "\\.png\\'" file)
276  (rename-file ofile file)
277  (let ((code (call-process "convert" nil tmp nil
278  ofile file)))
279  (eplot--view-error code tmp))))
280  (message "Wrote %s" file)))
281  ;; Clean-up.
282  (when (get-buffer tmp)
283  (kill-buffer tmp))
284  (when (file-exists-p sfile)
285  (delete-file sfile))
286  (when (file-exists-p ofile)
287  (delete-file sfile)))))))))
288 
289 (defun eplot--view-error (code tmp)
290  (unless (zerop code)
291  (error "Error code %d: %s"
292  code
293  (with-current-buffer tmp
294  (while (search-forward "[ \t\n]+" nil t)
295  (replace-match " "))
296  (string-trim (buffer-string))))))
297 
298 (defun eplot-view-write-scaled-file (width file)
299  "Write the current chart to a rescaled to a file.
300 The rescaling is done by \"rsvg-convert\", which has to be
301 installed. Rescaling is done when rendering, so this should give
302 you a clear, non-blurry version of the chart at any size."
303  (interactive "nWidth: \nFWrite to file: ")
304  (eplot-view-write-file file width))
305 
306 (defun eplot-view-customize ()
307  "Customize the settings for the chart in the current buffer."
308  (interactive)
309  (with-suppressed-warnings ((interactive-only eplot-customize))
310  (eplot-customize)))
311 
312 (defvar eplot--data-buffer nil)
313 (defvar eplot--current-chart nil)
314 
315 (defun eplot ()
316  "Plot the data in the current buffer."
317  (interactive)
318  (eplot-update-view-buffer))
319 
320 (defun eplot-with-headers (header-file)
321  "Plot the data in the current buffer using headers from a file."
322  (interactive "fHeader file: ")
323  (eplot-update-view-buffer
324  (with-temp-buffer
325  (insert-file-contents header-file)
326  (eplot--parse-headers))))
327 
328 (defun eplot-switch-view-buffer ()
329  "Switch to the eplot view buffer and render the chart."
330  (interactive)
331  (eplot-update-view-buffer nil t))
332 
333 (defun eplot-update-view-buffer (&optional headers switch)
334  "Update the eplot view buffer based on the current data buffer."
335  (interactive)
336  ;; This is mainly useful during implementation.
337  (if (and (eq major-mode 'emacs-lisp-mode)
338  (get-buffer-window "*eplot*" t))
339  (with-current-buffer "*eplot*"
340  (eplot-update)
341  (when-let ((win (get-buffer-window "*eplot*" t)))
342  (set-window-point win (point-min))))
343  ;; Normal case.
344  (let* ((eplot--user-defaults (eplot--settings-table))
345  (data (eplot--parse-buffer))
346  (data-buffer (current-buffer))
347  (window (selected-window)))
348  (unless data
349  (user-error "No data in the current buffer"))
350  (setq data (eplot--inject-headers data headers))
351  (if (get-buffer-window "*eplot*" t)
352  (set-buffer "*eplot*")
353  (if switch
354  (pop-to-buffer-same-window "*eplot*")
355  (pop-to-buffer "*eplot*")))
356  (let ((inhibit-read-only t))
357  (erase-buffer)
358  (unless (eq major-mode 'eplot-view-mode)
359  (eplot-view-mode))
360  (setq-local eplot--data-buffer data-buffer)
361  (let ((chart (eplot--render data)))
362  (with-current-buffer data-buffer
363  (setq-local eplot--current-chart chart)))
364  (insert "\n")
365  (when-let ((win (get-buffer-window "*eplot*" t)))
366  (set-window-point win (point-min))))
367  (select-window window))))
368 
369 (defun eplot--settings-table ()
370  (if (not eplot--transient-settings)
371  eplot--user-defaults
372  (append eplot--user-defaults eplot--transient-settings)))
373 
374 (defun eplot--inject-headers (data headers)
375  ;; It's OK not to separate the plot headers from the chart
376  ;; headers. Collect them here, if any.
377  (when-let ((plot-headers
378  (cl-loop for elem in (mapcar #'car eplot--plot-headers)
379  for value = (eplot--vs elem headers)
380  when value
381  collect (progn
382  ;; Remove these headers from the data
383  ;; headers so that we don't get errors
384  ;; on undefined headers.
385  (setq headers (delq (assq elem headers)
386  headers))
387  (cons elem value)))))
388  (dolist (plot (cdr (assq :plots data)))
389  (let ((headers (assq :headers plot)))
390  (if headers
391  (nconc headers plot-headers)
392  (nconc plot (list (list :headers plot-headers)))))))
393  (append data headers))
394 
395 (defun eplot-eval-and-update ()
396  "Helper command when developing."
397  (interactive nil emacs-lisp-mode)
398  (save-some-buffers t)
399  (elisp-eval-region-or-buffer)
400  (eval-defun nil)
401  (eplot-update-view-buffer))
402 
403 ;;; Parsing buffers.
404 
405 (defun eplot-update (&rest _ignore)
406  "Update the plot in the current buffer."
407  (interactive)
408  (unless eplot--data-buffer
409  (user-error "No data buffer associated with this eplot view buffer"))
410  (let ((data (with-current-buffer eplot--data-buffer
411  (eplot--parse-buffer)))
412  (eplot--user-defaults (with-current-buffer eplot--data-buffer
413  (eplot--settings-table)))
414  (inhibit-read-only t))
415  (erase-buffer)
416  (let ((chart (eplot--render data)))
417  (with-current-buffer eplot--data-buffer
418  (setq-local eplot--current-chart chart)))
419  (insert "\n\n")))
420 
421 (defun eplot--parse-buffer ()
422  (if (eq major-mode 'org-mode)
423  (eplot--parse-org-buffer)
424  (eplot--parse-eplot-buffer)))
425 
426 (defun eplot--parse-eplot-buffer ()
427  (if (eplot--csv-buffer-p)
428  (eplot--parse-csv-buffer)
429  (let ((buf (current-buffer)))
430  (with-temp-buffer
431  (insert-buffer-substring buf)
432  ;; Remove comments first.
433  (goto-char (point-min))
434  (while (re-search-forward "^[ \t]*#" nil t)
435  (delete-line))
436  (goto-char (point-min))
437  ;; First headers.
438  (let* ((data (eplot--parse-headers))
439  (plot-headers
440  ;; It's OK not to separate the plot headers from the chart
441  ;; headers. Collect them here, if any.
442  (cl-loop for elem in (mapcar #'car eplot--plot-headers)
443  for value = (eplot--vs elem data)
444  when value
445  collect (progn
446  ;; Remove these headers from the data
447  ;; headers so that we don't get errors
448  ;; on undefined headers.
449  (setq data (delq (assq elem data) data))
450  (cons elem value))))
451  plots)
452  ;; Then the values.
453  (while-let ((plot (eplot--parse-values nil plot-headers)))
454  (setq plot-headers nil)
455  (push plot plots))
456  (when plots
457  (push (cons :plots (nreverse plots)) data))
458  data)))))
459 
460 (defun eplot--parse-headers ()
461  (let ((data nil)
462  type value)
463  (while (looking-at "\\([^\n\t :]+\\):\\(.*\\)")
464  (setq type (intern (downcase (match-string 1)))
465  value (substring-no-properties (string-trim (match-string 2))))
466  (forward-line 1)
467  ;; Get continuation lines.
468  (while (looking-at "[ \t]+\\(.*\\)")
469  (setq value (concat value " " (string-trim (match-string 1))))
470  (forward-line 1))
471  (if (eq type 'header-file)
472  (setq data (nconc data
473  (with-temp-buffer
474  (insert-file-contents value)
475  (eplot--parse-headers))))
476  ;; We don't use `push' here because we want to preserve order
477  ;; also when inserting headers from other files.
478  (setq data (nconc data (list (cons type value))))))
479  data))
480 
481 (defun eplot--parse-values (&optional in-headers data-headers)
482  ;; Skip past separator lines.
483  (while (looking-at "[ \t]*\n")
484  (forward-line 1))
485  (let* ((values nil)
486  ;; We may have plot-specific headers.
487  (headers (nconc (eplot--parse-headers) data-headers))
488  (data-format (or (eplot--vyl 'data-format headers)
489  (eplot--vyl 'data-format in-headers)))
490  (two-values (memq 'two-values data-format))
491  (xy (or (memq 'year data-format)
492  (memq 'date data-format)
493  (memq 'time data-format)
494  (memq 'xy data-format)))
495  (data-column (or (eplot--vn 'data-column headers)
496  (eplot--vn 'data-column in-headers))))
497  (if-let ((data-file (eplot--vs 'data-file headers)))
498  (with-temp-buffer
499  (insert-file-contents data-file)
500  (setq values (cdr (assq :values (eplot--parse-values headers)))
501  headers (delq (assq 'data headers) headers)))
502  ;; Now we come to the data. The data is typically either just a
503  ;; number, or two numbers (in which case the first number is a
504  ;; date or a time). Labels ans settings can be introduced with
505  ;; a # char.
506  (while (looking-at "\\([-0-9. \t]+\\)\\([ \t]*#\\(.*\\)\\)?")
507  (let ((numbers (match-string 1))
508  (settings (eplot--parse-settings (match-string 3)))
509  this)
510  (setq numbers (mapcar #'string-to-number
511  (split-string (string-trim numbers))))
512  ;; If we're reading two dimensionalish data, the first
513  ;; number is the date/time/x.
514  (when xy
515  (setq this (list :x (pop numbers))))
516  ;; Chop off all the numbers until we read the column(s)
517  ;; we're using.
518  (when data-column
519  (setq numbers (nthcdr (1- data-column) numbers)))
520  (when numbers
521  (setq this (nconc this (list :value (pop numbers)))))
522  (when two-values
523  (setq this (nconc this (list :extra-value (pop numbers)))))
524  (when settings
525  (setq this (nconc this (list :settings settings))))
526  (when (plist-get this :value)
527  (push this values)))
528  (forward-line 1))
529  (setq values (nreverse values)))
530  (and values
531  `((:headers . ,headers) (:values . ,values)))))
532 
533 (defun eplot--parse-settings (string)
534  (when string
535  (with-temp-buffer
536  (insert (string-trim string) "\n")
537  (goto-char (point-min))
538  (while (re-search-forward "\\(.\\)," nil t)
539  (if (equal (match-string 1) "\\")
540  (replace-match "," t t)
541  (delete-char -1)
542  (insert "\n")
543  (when (looking-at "[ \t]+")
544  (replace-match ""))))
545  (goto-char (point-min))
546  (eplot--parse-headers))))
547 
548 ;;; Accessing data.
549 
550 (defun eplot--vn (type data &optional default)
551  (if-let ((value (cdr (assq type data))))
552  (string-to-number value)
553  default))
554 
555 (defun eplot--vs (type data &optional default)
556  (or (cdr (assq type data)) default))
557 
558 (defun eplot--vy (type data &optional default)
559  (if-let ((value (cdr (assq type data))))
560  (intern (downcase value))
561  default))
562 
563 (defun eplot--vyl (type data &optional default)
564  (if-let ((value (cdr (assq type data))))
565  (mapcar #'intern (split-string (downcase value)))
566  default))
567 
568 (defmacro eplot-def (args doc-string)
569  (declare (indent defun))
570  `(eplot--def ',(nth 0 args) ',(nth 1 args) ',(nth 2 args) ',(nth 3 args)
571  ,doc-string))
572 
573 (defun eplot--def (name type default valid doc)
574  (setq eplot--chart-headers (delq (assq name eplot--chart-headers)
575  eplot--chart-headers))
576  (push (list name
577  :type type
578  :default default
579  :doc doc
580  :valid valid)
581  eplot--chart-headers))
582 
583 (eplot-def (width number)
584  "The width of the entire chart.")
585 
586 (eplot-def (height number)
587  "The height of the entire chart.")
588 
589 (eplot-def (format symbol normal (normal bar-chart horizontal-bar-chart))
590  "The overall format of the chart.")
591 
592 (eplot-def (layout symbol nil (normal compact))
593  "The general layout of the chart.")
594 
595 (eplot-def (mode symbol light (dark light))
596  "Dark/light mode.")
597 
598 (eplot-def (margin-left number 70)
599  "The left margin.")
600 
601 (eplot-def (margin-right number 20)
602  "The right margin.")
603 
604 (eplot-def (margin-top number 40)
605  "The top margin.")
606 
607 (eplot-def (margin-bottom number 60)
608  "The bottom margin.")
609 
610 (eplot-def (x-axis-title-space number 5)
611  "The space between the X axis and the label.")
612 
613 (eplot-def (font string "sans-serif")
614  "The font to use in titles, labels and legends.")
615 
616 (eplot-def (font-size number 12)
617  "The font size.")
618 
619 (eplot-def (font-weight symbol bold (bold normal))
620  "The font weight.")
621 
622 (eplot-def (label-font string (spec font))
623  "The font to use for axes labels.")
624 
625 (eplot-def (label-font-size number (spec font-size))
626  "The font size to use for axes labels.")
627 
628 (eplot-def (bar-font string (spec font))
629  "The font to use for bar chart labels.")
630 
631 (eplot-def (bar-font-size number (spec font-size))
632  "The font size to use for bar chart labels.")
633 
634 (eplot-def (bar-font-weight symbol (spec font-weight) (bold normal))
635  "The font weight to use for bar chart labels.")
636 
637 (eplot-def (chart-color string "black")
638  "The foreground color to use in plots, axes, legends, etc.
639 This is used as the default, but can be overridden per thing.")
640 
641 (eplot-def (background-color string "white")
642  "The background color.
643 If you want a chart with a transparent background, use the color
644 \"none\".")
645 
646 (eplot-def (background-gradient string)
647  "Use this to get a gradient color in the background.")
648 
649 (eplot-def (axes-color string (spec chart-color))
650  "The color of the axes.")
651 
652 (eplot-def (grid-color string "#e0e0e0")
653  "The color of the grid.")
654 
655 (eplot-def (grid symbol xy (xy x y off))
656  "What grid axes to do.")
657 
658 (eplot-def (grid-opacity number)
659  "The opacity of the grid.
660 This should either be nil or a value between 0 and 1, where 0 is
661 fully transparent.")
662 
663 (eplot-def (grid-position symbol bottom (bottom top))
664  "Whether to put the grid on top or under the plot.")
665 
666 (eplot-def (legend symbol nil (true nil))
667  "Whether to do a legend.")
668 
669 (eplot-def (legend-color string (spec chart-color))
670  "The color of legends (if any).")
671 
672 (eplot-def (legend-border-color string (spec chart-color))
673  "The border color of legends (if any).")
674 
675 (eplot-def (legend-background-color string (spec background-color))
676  "The background color of legends (if any).")
677 
678 (eplot-def (label-color string (spec axes-color))
679  "The color of labels on the axes.")
680 
681 (eplot-def (surround-color string)
682  "The color between the plot area and the edges of the chart.")
683 
684 (eplot-def (border-color string)
685  "The color of the border of the chart, if any.")
686 
687 (eplot-def (border-width number)
688  "The width of the border of the chart, if any.")
689 
690 (eplot-def (frame-color string)
691  "The color of the frame of the plot, if any.")
692 
693 (eplot-def (frame-width number)
694  "The width of the frame of the plot, if any.")
695 
696 (eplot-def (min number)
697  "The minimum value in the chart.
698 This is normally computed automatically, but can be overridden
699  with this spec.")
700 
701 (eplot-def (max number)
702  "The maximum value in the chart.
703 This is normally computed automatically, but can be overridden
704  with this spec.")
705 
706 (eplot-def (title string)
707  "The title of the chart, if any.")
708 
709 (eplot-def (title-color string (spec chart-color))
710  "The color of the title.")
711 
712 (eplot-def (x-title string)
713  "The title of the X axis, if any.")
714 
715 (eplot-def (y-title string)
716  "The title of the X axis, if any.")
717 
718 (eplot-def (x-label-format string)
719  "Format string for the X labels.
720 This is a `format' string.")
721 
722 (eplot-def (y-label-format string)
723  "Format string for the Y labels.
724 This is a `format' string.")
725 
726 (eplot-def (x-label-orientation symbol horizontal (horizontal vertical))
727  "Orientation of the X labels.")
728 
729 (eplot-def (background-image-file string)
730  "Use an image as the background.")
731 
732 (eplot-def (background-image-opacity number 1)
733  "The opacity of the background image.")
734 
735 (eplot-def (background-image-cover symbol all (all plot frame))
736  "Position of the background image.
737 Valid values are `all' (the entire image), `plot' (the plot area)
738 and `frame' (the surrounding area).")
739 
740 (eplot-def (header-file string)
741  "File where the headers are.")
742 
743 (defvar eplot-compact-defaults
744  '((margin-left 30)
745  (margin-right 10)
746  (margin-top 20)
747  (margin-bottom 21)
748  (font-size 12)
749  (x-axis-title-space 3)))
750 
751 (defvar eplot-dark-defaults
752  '((chart-color "#c0c0c0")
753  (axes-color "#c0c0c0")
754  (grid-color "#404040")
755  (background-color "#101010")
756  (label-color "#c0c0c0")
757  (legend-color "#c0c0c0")
758  (title-color "#c0c0c0")))
759 
760 (defvar eplot-bar-chart-defaults
761  '((grid-position top)
762  (grid y)
763  (grid-opacity 0.2)
764  (min 0)))
765 
766 (defvar eplot-horizontal-bar-chart-defaults
767  '((grid-position top)
768  (grid-opacity 0.2)
769  (min 0)))
770 
771 (defclass eplot-chart ()
772  (
773  (plots :initarg :plots)
774  (data :initarg :data)
775  (xs)
776  (ys)
777  (x-values :initform nil)
778  (x-type :initform nil)
779  (x-min)
780  (x-max)
781  (x-ticks)
782  (y-ticks)
783  (y-labels)
784  (x-labels)
785  (print-format)
786  (x-tick-step)
787  (x-label-step)
788  (x-step-map :initform nil)
789  (y-tick-step)
790  (y-label-step)
791  (inhibit-compute-x-step :initform nil)
792  ;; ---- CUT HERE ----
793  (axes-color :initarg :axes-color :initform nil)
794  (background-color :initarg :background-color :initform nil)
795  (background-gradient :initarg :background-gradient :initform nil)
796  (background-image-cover :initarg :background-image-cover :initform nil)
797  (background-image-file :initarg :background-image-file :initform nil)
798  (background-image-opacity :initarg :background-image-opacity :initform nil)
799  (bar-font :initarg :bar-font :initform nil)
800  (bar-font-size :initarg :bar-font-size :initform nil)
801  (bar-font-weight :initarg :bar-font-weight :initform nil)
802  (border-color :initarg :border-color :initform nil)
803  (border-width :initarg :border-width :initform nil)
804  (chart-color :initarg :chart-color :initform nil)
805  (font :initarg :font :initform nil)
806  (font-size :initarg :font-size :initform nil)
807  (font-weight :initarg :font-weight :initform nil)
808  (format :initarg :format :initform nil)
809  (frame-color :initarg :frame-color :initform nil)
810  (frame-width :initarg :frame-width :initform nil)
811  (grid :initarg :grid :initform nil)
812  (grid-color :initarg :grid-color :initform nil)
813  (grid-opacity :initarg :grid-opacity :initform nil)
814  (grid-position :initarg :grid-position :initform nil)
815  (header-file :initarg :header-file :initform nil)
816  (height :initarg :height :initform nil)
817  (label-color :initarg :label-color :initform nil)
818  (label-font :initarg :label-font :initform nil)
819  (label-font-size :initarg :label-font-size :initform nil)
820  (layout :initarg :layout :initform nil)
821  (legend :initarg :legend :initform nil)
822  (legend-background-color :initarg :legend-background-color :initform nil)
823  (legend-border-color :initarg :legend-border-color :initform nil)
824  (legend-color :initarg :legend-color :initform nil)
825  (margin-bottom :initarg :margin-bottom :initform nil)
826  (margin-left :initarg :margin-left :initform nil)
827  (margin-right :initarg :margin-right :initform nil)
828  (margin-top :initarg :margin-top :initform nil)
829  (max :initarg :max :initform nil)
830  (min :initarg :min :initform nil)
831  (mode :initarg :mode :initform nil)
832  (surround-color :initarg :surround-color :initform nil)
833  (title :initarg :title :initform nil)
834  (title-color :initarg :title-color :initform nil)
835  (width :initarg :width :initform nil)
836  (x-axis-title-space :initarg :x-axis-title-space :initform nil)
837  (x-title :initarg :x-title :initform nil)
838  (y-title :initarg :y-title :initform nil)
839  (x-label-format :initarg :x-label-format :initform nil)
840  (x-label-orientation :initarg :x-label-orientation :initform nil)
841  (y-label-format :initarg :y-label-format :initform nil)
842  ;; ---- CUT HERE ----
843  ))
844 
845 ;;; Parameters that are plot specific.
846 
847 (defmacro eplot-pdef (args doc-string)
848  (declare (indent defun))
849  `(eplot--pdef ',(nth 0 args) ',(nth 1 args) ',(nth 2 args) ',(nth 3 args)
850  ,doc-string))
851 
852 (defun eplot--pdef (name type default valid doc)
853  (setq eplot--plot-headers (delq (assq name eplot--plot-headers)
854  eplot--plot-headers))
855  (push (list name
856  :type type
857  :default default
858  :valid valid
859  :doc doc)
860  eplot--plot-headers))
861 
862 (eplot-pdef (smoothing symbol nil (moving-average nil))
863  "Smoothing algorithm to apply to the data, if any.
864 Valid values are `moving-average' and, er, probably more to come.")
865 
866 (eplot-pdef (gradient string)
867  "Gradient to apply to the plot.
868 The syntax is:
869 
870  from-color to-color direction position
871 
872 The last two parameters are optional.
873 
874 direction is either `top-down' (the default), `bottom-up',
875 `left-right' or `right-left').
876 
877 position is either `below' or `above'.
878 
879 to-color can be either a color name, or a string that defines
880 stops and colors:
881 
882  Gradient: black 25-purple-50-white-75-purple-black
883 
884 In that case, the second element specifies the percentage points
885 of where each color ends, so the above starts with black, then at
886 25% it's purple, then at 50% it's white, then it's back to purple
887 again at 75%, before ending up at black at a 100% (but you don't
888 have to include the 100% here -- it's understood).")
889 
890 (eplot-pdef (style symbol line ( line impulse point square circle cross
891  triangle rectangle curve))
892  "Style the plot should be drawn in.
893 Valid values are listed below. Some styles take additional
894 optional parameters.
895 
896 line
897  Straight lines between values.
898 
899 curve
900  Curved lines between values.
901 
902 impulse
903  size: width of the impulse
904 
905 point
906 
907 square
908 
909 circle
910  size: diameter of the circle
911  fill-color: color to fill the center
912 
913 cross
914  size: length of the lines in the cross
915 
916 triangle
917  size: length of the sides of the triangle
918  fill-color: color to fill the center
919 
920 rectangle
921  size: length of the sides of the rectangle
922  fill-color: color to fill the center")
923 
924 (eplot-pdef (fill-color string)
925  "Color to use to fill the plot styles that are closed shapes.
926 I.e., circle, triangle and rectangle.")
927 
928 (eplot-pdef (color string (spec chart-color))
929  "Color to draw the plot.")
930 
931 (eplot-pdef (data-format symbol single (single date time xy))
932  "Format of the data.
933 By default, eplot assumes that each line has a single data point.
934 This can also be `date', `time' and `xy'.
935 
936 date: The first column is a date on ISO8601 format (i.e., YYYYMMDD).
937 
938 time: The first column is a clock (i.e., HHMMSS).
939 
940 xy: The first column is the X position.")
941 
942 (eplot-pdef (data-column number 1)
943  "Column where the data is.")
944 
945 (eplot-pdef (fill-border-color string)
946  "Border around the fill area when using a fill/gradient style.")
947 
948 (eplot-pdef (size number)
949  "Size of elements in styles that have meaningful sizes.")
950 
951 (eplot-pdef (size-factor number)
952  "Multiply the size of the elements by the value.")
953 
954 (eplot-pdef (data-file string)
955  "File where the data is.")
956 
957 (eplot-pdef (data-format symbol-list nil (nil two-values date time))
958  "List of symbols to describe the data format.
959 Elements allowed are `two-values', `date' and `time'.")
960 
961 (eplot-pdef (name string)
962  "Name of the plot, which will be displayed if legends are switched on.")
963 
964 (eplot-pdef (legend-color string (spec chart-color))
965  "Color for the name to be displayed in the legend.")
966 
967 (eplot-pdef (bezier-factor number 0.1)
968  "The Bezier factor to apply to curve plots.")
969 
970 (defclass eplot-plot ()
971  (
972  (values :initarg :values)
973  ;; ---- CUT HERE ----
974  (bezier-factor :initarg :bezier-factor :initform nil)
975  (color :initarg :color :initform nil)
976  (data-column :initarg :data-column :initform nil)
977  (data-file :initarg :data-file :initform nil)
978  (data-format :initarg :data-format :initform nil)
979  (fill-border-color :initarg :fill-border-color :initform nil)
980  (fill-color :initarg :fill-color :initform nil)
981  (gradient :initarg :gradient :initform nil)
982  (legend-color :initarg :legend-color :initform nil)
983  (name :initarg :name :initform nil)
984  (size :initarg :size :initform nil)
985  (size-factor :initarg :size-factor :initform nil)
986  (smoothing :initarg :smoothing :initform nil)
987  (style :initarg :style :initform nil)
988  ;; ---- CUT HERE ----
989  ))
990 
991 (defun eplot--make-plot (data)
992  "Make an `eplot-plot' object and initialize based on DATA."
993  (let ((plot (make-instance 'eplot-plot
994  :values (cdr (assq :values data)))))
995  ;; Get the program-defined defaults.
996  (eplot--object-defaults plot eplot--plot-headers)
997  ;; One special case. I don't think this hack is quite right...
998  (when (or (eq (eplot--vs 'mode data) 'dark)
999  (eq (cdr (assq 'mode eplot--user-defaults)) 'dark))
1000  (setf (slot-value plot 'color) "#c0c0c0"))
1001  ;; Use the headers.
1002  (eplot--object-values plot (cdr (assq :headers data)) eplot--plot-headers)
1003  plot))
1004 
1005 (defun eplot--make-chart (data)
1006  "Make an `eplot-chart' object and initialize based on DATA."
1007  (let ((chart (make-instance 'eplot-chart
1008  :plots (mapcar #'eplot--make-plot
1009  (eplot--vs :plots data))
1010  :data data)))
1011  ;; First get the program-defined defaults.
1012  (eplot--object-defaults chart eplot--chart-headers)
1013  ;; Then do the "meta" variables.
1014  (eplot--meta chart data 'mode 'dark eplot-dark-defaults)
1015  (eplot--meta chart data 'layout 'compact eplot-compact-defaults)
1016  (eplot--meta chart data 'format 'bar-chart eplot-bar-chart-defaults)
1017  (eplot--meta chart data 'format 'horizontal-bar-chart
1018  eplot-horizontal-bar-chart-defaults)
1019  ;; Set defaults from user settings/transients.
1020  (cl-loop for (name . value) in eplot--user-defaults
1021  when (assq name eplot--chart-headers)
1022  do
1023  (setf (slot-value chart name) value)
1024  (eplot--set-dependent-values chart name value))
1025  ;; Finally, use the data from the chart.
1026  (eplot--object-values chart data eplot--chart-headers)
1027  ;; If not set, recompute the margins based on the font sizes (if
1028  ;; the font size has been changed from defaults).
1029  (when (or (assq 'font-size eplot--user-defaults)
1030  (assq 'font-size data))
1031  (with-slots ( title x-title y-title
1032  margin-top margin-bottom margin-left
1033  font-size font font-weight)
1034  chart
1035  (when (or title x-title y-title)
1036  (let ((text-height
1037  (eplot--text-height (concat title x-title y-title)
1038  font font-size font-weight)))
1039  (when (and title
1040  (and (not (assq 'margin-top eplot--user-defaults))
1041  (not (assq 'margin-top data))))
1042  (cl-incf margin-top (* text-height 1.4)))
1043  (when (and x-title
1044  (and (not (assq 'margin-bottom eplot--user-defaults))
1045  (not (assq 'margin-bottom data))))
1046  (cl-incf margin-bottom (* text-height 1.4)))
1047  (when (and y-title
1048  (and (not (assq 'margin-left eplot--user-defaults))
1049  (not (assq 'margin-left data))))
1050  (cl-incf margin-left (* text-height 1.4)))))))
1051  chart))
1052 
1053 (defun eplot--meta (chart data slot value defaults)
1054  (when (or (eq (cdr (assq slot eplot--user-defaults)) value)
1055  (eq (eplot--vy slot data) value))
1056  (eplot--set-theme chart defaults)))
1057 
1058 (defun eplot--object-defaults (object headers)
1059  (dolist (header headers)
1060  (when-let ((default (plist-get (cdr header) :default)))
1061  (setf (slot-value object (car header))
1062  ;; Allow overrides via `eplot-set'.
1063  (or (cdr (assq (car header) eplot--user-defaults))
1064  (if (and (consp default)
1065  (eq (car default) 'spec))
1066  ;; Chase dependencies.
1067  (eplot--default (cadr default))
1068  default))))))
1069 
1070 (defun eplot--object-values (object data headers)
1071  (cl-loop for (name . value) in data
1072  do (unless (eq name :plots)
1073  (let ((spec (cdr (assq name headers))))
1074  (if (not spec)
1075  (error "%s is not a valid spec" name)
1076  (let ((value
1077  (cl-case (plist-get spec :type)
1078  (number
1079  (string-to-number value))
1080  (symbol
1081  (intern (downcase value)))
1082  (symbol-list
1083  (mapcar #'intern (split-string (downcase value))))
1084  (t
1085  value))))
1086  (setf (slot-value object name) value)
1087  (eplot--set-dependent-values object name value)))))))
1088 
1089 (defun eplot--set-dependent-values (object name value)
1090  (dolist (slot (gethash name (eplot--dependecy-graph)))
1091  (setf (slot-value object slot) value)
1092  (eplot--set-dependent-values object slot value)))
1093 
1094 (defun eplot--set-theme (chart map)
1095  (cl-loop for (slot value) in map
1096  do (setf (slot-value chart slot) value)))
1097 
1098 (defun eplot--default (slot)
1099  "Find the default value for SLOT, chasing dependencies."
1100  (let ((spec (cdr (assq slot eplot--chart-headers))))
1101  (unless spec
1102  (error "Invalid slot %s" slot))
1103  (let ((default (plist-get spec :default)))
1104  (if (and (consp default)
1105  (eq (car default) 'spec))
1106  (eplot--default (cadr default))
1107  (or (cdr (assq slot eplot--user-defaults)) default)))))
1108 
1109 (defun eplot--dependecy-graph ()
1110  (let ((table (make-hash-table)))
1111  (dolist (elem eplot--chart-headers)
1112  (let ((default (plist-get (cdr elem) :default)))
1113  (when (and (consp default)
1114  (eq (car default) 'spec))
1115  (push (car elem) (gethash (cadr default) table)))))
1116  table))
1117 
1118 (defun eplot--render (data &optional return-image)
1119  "Create the chart and display it.
1120 If RETURN-IMAGE is non-nil, return it instead of displaying it."
1121  (let* ((chart (eplot--make-chart data))
1122  svg)
1123  (with-slots ( width height xs ys
1124  margin-left margin-right margin-top margin-bottom
1125  grid-position plots x-min format
1126  x-label-orientation)
1127  chart
1128  ;; Set the size of the chart based on the window it's going to
1129  ;; be displayed in. It uses the *eplot* window by default, or
1130  ;; the current one if that isn't displayed.
1131  (let ((factor (image-compute-scaling-factor image-scaling-factor)))
1132  (unless width
1133  (setq width (truncate
1134  (/ (* (window-pixel-width
1135  (get-buffer-window "*eplot*" t))
1136  0.9)
1137  factor))))
1138  (unless height
1139  (setq height (truncate
1140  (/ (* (window-pixel-height
1141  (get-buffer-window "*eplot*" t))
1142  0.9)
1143  factor)))))
1144  (setq svg (svg-create width height)
1145  xs (- width margin-left margin-right)
1146  ys (- height margin-top margin-bottom))
1147  ;; Protect against being called in an empty buffer.
1148  (if (not (and plots
1149  ;; Sanity check against the user choosing dimensions
1150  ;; that leave no space for the plot.
1151  (> ys 0) (> xs 0)))
1152  ;; Just draw the basics.
1153  (eplot--draw-basics svg chart)
1154 
1155  ;; Horizontal bar charts are special.
1156  (when (eq format 'horizontal-bar-chart)
1157  (eplot--adjust-horizontal-bar-chart chart data))
1158  ;; Compute min/max based on all plots, and also compute x-ticks
1159  ;; etc.
1160  (eplot--compute-chart-dimensions chart)
1161  (when (and (eq x-label-orientation 'vertical)
1162  (eplot--default-p 'margin-bottom (slot-value chart 'data)))
1163  (eplot--adjust-vertical-x-labels chart))
1164  ;; Analyze values and adjust values accordingly.
1165  (eplot--adjust-chart chart)
1166  ;; Compute the Y labels -- this may adjust `margin-left'.
1167  (eplot--compute-y-labels chart)
1168  ;; Compute the X labels -- this may adjust `margin-bottom'.
1169  (eplot--compute-x-labels chart)
1170  ;; Draw background/borders/titles/etc.
1171  (eplot--draw-basics svg chart)
1172 
1173  (when (eq grid-position 'top)
1174  (eplot--draw-plots svg chart))
1175 
1176  (eplot--draw-x-ticks svg chart)
1177  (unless (eq format 'horizontal-bar-chart)
1178  (eplot--draw-y-ticks svg chart))
1179 
1180  ;; Draw axes.
1181  (with-slots ( margin-left margin-right margin-margin-top
1182  margin-bottom axes-color)
1183  chart
1184  (svg-line svg margin-left margin-top margin-left
1185  (+ (- height margin-bottom) 5)
1186  :stroke axes-color)
1187  (svg-line svg (- margin-left 5) (- height margin-bottom)
1188  (- width margin-right) (- height margin-bottom)
1189  :stroke axes-color))
1190 
1191  (when (eq grid-position 'bottom)
1192  (eplot--draw-plots svg chart)))
1193 
1194  (with-slots (frame-color frame-width) chart
1195  (when (or frame-color frame-width)
1196  (svg-rectangle svg margin-left margin-top xs ys
1197  :stroke-width frame-width
1198  :fill "none"
1199  :stroke-color frame-color)))
1200  (eplot--draw-legend svg chart))
1201 
1202  (if return-image
1203  svg
1204  (svg-insert-image svg)
1205  chart)))
1206 
1207 (defun eplot--adjust-horizontal-bar-chart (chart data)
1208  (with-slots ( plots bar-font bar-font-size bar-font-weight margin-left
1209  width margin-right xs)
1210  chart
1211  (with-slots ( data-format values) (car plots)
1212  (push 'xy data-format)
1213  ;; Flip the values -- we want the values to be on the X
1214  ;; axis instead.
1215  (setf values
1216  (cl-loop for value in values
1217  for i from 1
1218  collect (list :value i
1219  :x (plist-get value :value)
1220  :settings
1221  (plist-get value :settings))))
1222  (when (eplot--default-p 'margin-left data)
1223  (setf margin-left
1224  (+ (cl-loop for value in values
1225  maximize
1226  (eplot--text-width
1227  (eplot--vs 'label (plist-get value :settings))
1228  bar-font bar-font-size bar-font-weight))
1229  20)
1230  xs (- width margin-left margin-right))))))
1231 
1232 (defun eplot--draw-basics (svg chart)
1233  (with-slots ( width height
1234  chart-color font font-size font-weight
1235  margin-left margin-right margin-top margin-bottom
1236  background-color label-color
1237  xs ys)
1238  chart
1239  ;; Add background.
1240  (eplot--draw-background chart svg 0 0 width height)
1241  (with-slots ( background-image-file background-image-opacity
1242  background-image-cover)
1243  chart
1244  (when (and background-image-file
1245  ;; Sanity checks to avoid erroring out later.
1246  (file-exists-p background-image-file)
1247  (file-regular-p background-image-file))
1248  (apply #'svg-embed svg background-image-file "image/jpeg" nil
1249  :opacity background-image-opacity
1250  :preserveAspectRatio "xMidYMid slice"
1251  (if (memq background-image-cover '(all frame))
1252  `(:x 0 :y 0 :width ,width :height ,height)
1253  `(:x ,margin-left :y ,margin-top :width ,xs :height ,ys)))
1254  (when (eq background-image-cover 'frame)
1255  (eplot--draw-background chart svg margin-left margin-right xs ys))))
1256  ;; Area between plot and edges.
1257  (with-slots (surround-color) chart
1258  (when surround-color
1259  (svg-rectangle svg 0 0 width height
1260  :fill surround-color)
1261  (svg-rectangle svg margin-left margin-top
1262  xs ys
1263  :fill background-color)))
1264  ;; Border around the entire chart.
1265  (with-slots (border-width border-color) chart
1266  (when (or border-width border-color)
1267  (svg-rectangle svg 0 0 width height
1268  :stroke-width (or border-width 1)
1269  :fill "none"
1270  :stroke-color (or border-color chart-color))))
1271  ;; Frame around the plot.
1272  (with-slots (frame-width frame-color) chart
1273  (when (or frame-width frame-color)
1274  (svg-rectangle svg margin-left margin-top xs ys
1275  :stroke-width (or frame-width 1)
1276  :fill "none"
1277  :stroke-color (or frame-color chart-color))))
1278  ;; Title and legends.
1279  (with-slots (title title-color) chart
1280  (when title
1281  (svg-text svg title
1282  :font-family font
1283  :text-anchor "middle"
1284  :font-weight font-weight
1285  :font-size font-size
1286  :fill title-color
1287  :x (+ margin-left (/ (- width margin-left margin-right) 2))
1288  :y (+ 3 (/ margin-top 2)))))
1289  (with-slots (x-title) chart
1290  (when x-title
1291  (svg-text svg x-title
1292  :font-family font
1293  :text-anchor "middle"
1294  :font-weight font-weight
1295  :font-size font-size
1296  :fill label-color
1297  :x (+ margin-left (/ (- width margin-left margin-right) 2))
1298  :y (- height (/ margin-bottom 4)))))
1299  (with-slots (y-title) chart
1300  (when y-title
1301  (let ((text-height
1302  (eplot--text-height y-title font font-size font-weight)))
1303  (svg-text svg y-title
1304  :font-family font
1305  :text-anchor "middle"
1306  :font-weight font-weight
1307  :font-size font-size
1308  :fill label-color
1309  :transform
1310  (format "translate(%s,%s) rotate(-90)"
1311  (- (/ margin-left 2) (/ text-height 2) 4)
1312  (+ margin-top
1313  (/ (- height margin-bottom margin-top) 2)))))))))
1314 
1315 (defun eplot--draw-background (chart svg left top width height)
1316  (with-slots (background-gradient background-color) chart
1317  (let ((gradient (eplot--parse-gradient background-gradient))
1318  id)
1319  (when gradient
1320  (setq id (format "gradient-%s" (make-temp-name "grad")))
1321  (eplot--gradient svg id 'linear
1322  (eplot--stops (eplot--vs 'from gradient)
1323  (eplot--vs 'to gradient))
1324  (eplot--vs 'direction gradient)))
1325  (apply #'svg-rectangle svg left top width height
1326  (if gradient
1327  `(:gradient ,id)
1328  `(:fill ,background-color))))))
1329 
1330 (defun eplot--compute-chart-dimensions (chart)
1331  (with-slots ( min max plots x-values x-min x-max x-ticks
1332  print-format font-size
1333  xs
1334  inhibit-compute-x-step x-type x-step-map format
1335  x-tick-step x-label-step
1336  label-font label-font-size x-label-format)
1337  chart
1338  (let ((set-min min)
1339  (set-max max))
1340  (dolist (plot plots)
1341  (with-slots (values data-format) plot
1342  (let* ((vals (nconc (seq-map (lambda (v) (plist-get v :value)) values)
1343  (and (memq 'two-values data-format)
1344  (seq-map
1345  (lambda (v) (plist-get v :extra-value))
1346  values)))))
1347  ;; Set the x-values based on the first plot.
1348  (unless x-values
1349  (setq print-format (cond
1350  ((memq 'year data-format) 'year)
1351  ((memq 'date data-format) 'date)
1352  ((memq 'time data-format) 'time)
1353  (t 'number)))
1354  (cond
1355  ((or (memq 'xy data-format)
1356  (memq 'year data-format))
1357  (setq x-values (cl-loop for val in values
1358  collect (plist-get val :x))
1359  x-min (if (eq format 'horizontal-bar-chart)
1360  0
1361  (seq-min x-values))
1362  x-max (seq-max x-values)
1363  x-ticks (eplot--get-ticks x-min x-max xs))
1364  (when (memq 'year data-format)
1365  (setq print-format 'literal-year)))
1366  ((memq 'date data-format)
1367  (setq x-values
1368  (cl-loop for val in values
1369  collect
1370  (time-to-days
1371  (encode-time
1372  (decoded-time-set-defaults
1373  (iso8601-parse-date
1374  (format "%d" (plist-get val :x)))))))
1375  x-min (seq-min x-values)
1376  x-max (seq-max x-values)
1377  inhibit-compute-x-step t)
1378  (let ((xs (eplot--get-date-ticks
1379  x-min x-max xs
1380  label-font label-font-size x-label-format)))
1381  (setq x-ticks (car xs)
1382  print-format (cadr xs)
1383  x-tick-step 1
1384  x-label-step 1
1385  x-step-map (nth 2 xs))))
1386  ((memq 'time data-format)
1387  (setq x-values
1388  (cl-loop for val in values
1389  collect
1390  (time-convert
1391  (encode-time
1392  (decoded-time-set-defaults
1393  (iso8601-parse-time
1394  (format "%06d" (plist-get val :x)))))
1395  'integer))
1396  x-min (car x-values)
1397  x-max (car (last x-values))
1398  inhibit-compute-x-step t)
1399  (let ((xs (eplot--get-time-ticks
1400  x-min x-max xs label-font label-font-size
1401  x-label-format)))
1402  (setq x-ticks (car xs)
1403  print-format (cadr xs)
1404  x-tick-step 1
1405  x-label-step 1
1406  x-step-map (nth 2 xs))))
1407  (t
1408  ;; This is a one-dimensional plot -- we don't have X
1409  ;; values, really, so we just do zero to (1- (length
1410  ;; values)).
1411  (setq x-type 'one-dimensional
1412  x-values (cl-loop for i from 0
1413  repeat (length values)
1414  collect i)
1415  x-min (car x-values)
1416  x-max (car (last x-values))
1417  x-ticks x-values))))
1418  (unless set-min
1419  (setq min (min (or min 1.0e+INF) (seq-min vals))))
1420  (unless set-max
1421  (setq max (max (or max -1.0e+INF) (seq-max vals))))))))))
1422 
1423 (defun eplot--adjust-chart (chart)
1424  (with-slots ( x-tick-step x-label-step y-tick-step y-label-step
1425  min max ys format inhibit-compute-x-step
1426  y-ticks xs x-values print-format
1427  x-label-format label-font label-font-size data
1428  x-ticks)
1429  chart
1430  (setq y-ticks (and max
1431  (eplot--get-ticks
1432  min
1433  ;; We get 5% more ticks to check whether we
1434  ;; should extend max.
1435  (if (eplot--default-p 'max data)
1436  (* max 1.02)
1437  max)
1438  ys)))
1439  (when (eplot--default-p 'max data)
1440  (setq max (max max (car (last y-ticks)))))
1441  (if (eq format 'bar-chart)
1442  (setq x-tick-step 1
1443  x-label-step 1)
1444  (unless inhibit-compute-x-step
1445  (let ((xt (eplot--compute-x-ticks
1446  xs x-ticks print-format
1447  x-label-format label-font label-font-size)))
1448  (setq x-tick-step (car xt)
1449  x-label-step (cadr xt)))))
1450  (when max
1451  (let ((yt (eplot--compute-y-ticks
1452  ys y-ticks
1453  (eplot--text-height "100" label-font label-font-size))))
1454  (setq y-tick-step (car yt)
1455  y-label-step (cadr yt))))
1456  ;; If max is less than 2% off from a pleasant number, then
1457  ;; increase max.
1458  (when (eplot--default-p 'max data)
1459  (cl-loop for tick in (reverse y-ticks)
1460  when (and (< max tick)
1461  (< (e/ (- tick max) (- max min)) 0.02))
1462  return (progn
1463  (setq max tick)
1464  ;; Chop off any further ticks.
1465  (setcdr (member tick y-ticks) nil))))
1466 
1467  (when y-ticks
1468  (if (and (eplot--default-p 'min data)
1469  (< (car y-ticks) min))
1470  (setq min (car y-ticks))
1471  ;; We may be extending the bottom of the chart to get pleasing
1472  ;; numbers. We don't want to be drawing the chart on top of the
1473  ;; X axis, because the chart won't be visible there.
1474  (when (and nil
1475  (<= min (car y-ticks))
1476  ;; But not if we start at origo, because that just
1477  ;; looks confusing.
1478  (not (zerop min)))
1479  (setq min (- (car y-ticks)
1480  ;; 2% of the value range.
1481  (* 0.02 (- (car (last y-ticks)) (car y-ticks))))))))))
1482 
1483 (defun eplot--adjust-vertical-x-labels (chart)
1484  (with-slots ( x-step-map x-ticks format plots
1485  print-format x-label-format label-font
1486  label-font-size margin-bottom
1487  bar-font bar-font-size bar-font-weight)
1488  chart
1489  ;; Make X ticks.
1490  (let ((width
1491  (cl-loop
1492  for xv in (or x-step-map x-ticks)
1493  for x = (if (consp xv) (car xv) xv)
1494  for i from 0
1495  for value = (and (equal format 'bar-chart)
1496  (elt (slot-value (car plots) 'values) i))
1497  for label = (if (equal format 'bar-chart)
1498  (eplot--vs 'label
1499  (plist-get value :settings)
1500  ;; When we're doing bar charts, we
1501  ;; want default labeling to start with
1502  ;; 1 and not zero.
1503  (format "%s" (1+ x)))
1504  (eplot--format-value x print-format x-label-format))
1505  maximize (if (equal format 'bar-chart)
1506  (eplot--text-width
1507  label bar-font bar-font-size bar-font-weight)
1508  (eplot--text-width
1509  label label-font label-font-size)))))
1510  ;; Ensure that we have enough room to display the X labels
1511  ;; (unless overridden).
1512  (with-slots ( height margin-top ys
1513  y-ticks y-tick-step y-label-step min max)
1514  chart
1515  (setq margin-bottom (max margin-bottom (+ width 40))
1516  ys (- height margin-top margin-bottom))))))
1517 
1518 (defun eplot--compute-x-labels (chart)
1519  (with-slots ( x-step-map x-ticks
1520  format plots print-format x-label-format x-labels
1521  x-tick-step x-label-step
1522  x-label-orientation margin-bottom)
1523  chart
1524  ;; Make X ticks.
1525  (setf x-labels
1526  (cl-loop
1527  for xv in (or x-step-map x-ticks)
1528  for x = (if (consp xv) (car xv) xv)
1529  for do-tick = (if (consp xv)
1530  (nth 1 xv)
1531  (zerop (e% x x-tick-step)))
1532  for do-label = (if (consp xv)
1533  (nth 2 xv)
1534  (zerop (e% x x-label-step)))
1535  for i from 0
1536  for value = (and (equal format 'bar-chart)
1537  (elt (slot-value (car plots) 'values) i))
1538  collect (list
1539  (if (equal format 'bar-chart)
1540  (eplot--vs 'label
1541  (plist-get value :settings)
1542  ;; When we're doing bar charts, we
1543  ;; want default labeling to start with
1544  ;; 1 and not zero.
1545  (format "%s" (1+ x)))
1546  (eplot--format-value x print-format x-label-format))
1547  do-tick
1548  do-label)))))
1549 
1550 (defun eplot--draw-x-ticks (svg chart)
1551  (with-slots ( x-step-map x-ticks format layout print-format
1552  margin-left margin-right margin-top margin-bottom
1553  x-min x-max xs
1554  width height
1555  axes-color label-color
1556  grid grid-opacity grid-color
1557  font x-tick-step x-label-step x-label-format x-label-orientation
1558  label-font label-font-size
1559  plots x-labels
1560  bar-font bar-font-size bar-font-weight)
1561  chart
1562  (let ((font label-font)
1563  (font-size label-font-size)
1564  (font-weight 'normal))
1565  (when (equal format 'bar-chart)
1566  (setq font bar-font
1567  font-size bar-font-size
1568  font-weight bar-font-weight))
1569  ;; Make X ticks.
1570  (cl-loop with label-height
1571  for xv in (or x-step-map x-ticks)
1572  for x = (if (consp xv) (car xv) xv)
1573  for i from 0
1574  for (label do-tick do-label) in x-labels
1575  for stride = (eplot--stride chart x-ticks)
1576  for px = (if (equal format 'bar-chart)
1577  (+ margin-left (* x stride) (/ stride 2)
1578  (/ (* stride 0.1) 2))
1579  (+ margin-left
1580  (* (/ (- (* 1.0 x) x-min) (- x-max x-min))
1581  xs)))
1582  ;; We might have one extra stride outside the area -- don't
1583  ;; draw it.
1584  when (<= px (- width margin-right))
1585  do
1586  (when do-tick
1587  ;; Draw little tick.
1588  (unless (equal format 'bar-chart)
1589  (svg-line svg
1590  px (- height margin-bottom)
1591  px (+ (- height margin-bottom)
1592  (if do-label
1593  4
1594  2))
1595  :stroke axes-color))
1596  (when (or (eq grid 'xy) (eq grid 'x))
1597  (svg-line svg px margin-top
1598  px (- height margin-bottom)
1599  :opacity grid-opacity
1600  :stroke grid-color)))
1601  (when (and do-label
1602  ;; We want to skip marking the first X value
1603  ;; unless we're a bar chart or we're a one
1604  ;; dimensional chart.
1605  (or (equal format 'bar-chart)
1606  t
1607  (not (= x-min (car x-values)))
1608  (eq x-type 'one-dimensional)
1609  (and (not (zerop x)) (not (zerop i)))))
1610  (if (eq x-label-orientation 'vertical)
1611  (progn
1612  (unless label-height
1613  ;; The X position we're putting the label at is
1614  ;; based on the bottom of the lower-case
1615  ;; characters. So we want to ignore descenders
1616  ;; etc, so we use "xx" to determine the height
1617  ;; to be able to center the text.
1618  (setq label-height
1619  (eplot--text-height
1620  ;; If the labels are numerical, we need
1621  ;; to center them using the height of
1622  ;; numbers.
1623  (if (string-match "^[0-9]+$" label)
1624  "10"
1625  ;; Otherwise center them on the baseline.
1626  "xx")
1627  font font-size font-weight)))
1628  (svg-text svg label
1629  :font-family font
1630  :text-anchor "end"
1631  :font-size font-size
1632  :font-weight font-weight
1633  :fill label-color
1634  :transform
1635  (format "translate(%s,%s) rotate(-90)"
1636  (+ px (/ label-height 2))
1637  (- height margin-bottom -10))))
1638  (svg-text svg label
1639  :font-family font
1640  :text-anchor "middle"
1641  :font-size font-size
1642  :font-weight font-weight
1643  :fill label-color
1644  :x px
1645  :y (+ (- height margin-bottom)
1646  font-size
1647  (if (equal format 'bar-chart)
1648  (if (equal layout 'compact) 3 5)
1649  2)))))))))
1650 
1651 (defun eplot--stride (chart values)
1652  (with-slots (xs x-type format) chart
1653  (if (eq x-type 'one-dimensional)
1654  (e/ xs
1655  ;; Fenceposting bar-chart vs everything else.
1656  (if (eq format 'bar-chart)
1657  (length values)
1658  (1- (length values))))
1659  (e/ xs (length values)))))
1660 
1661 (defun eplot--default-p (slot data)
1662  "Return non-nil if SLOT is at the default value."
1663  (and (not (assq slot eplot--user-defaults))
1664  (not (assq slot data))))
1665 
1666 (defun eplot--compute-y-labels (chart)
1667  (with-slots ( y-ticks y-labels
1668  width height min max xs ys
1669  margin-top margin-bottom margin-left margin-right
1670  y-tick-step y-label-step y-label-format)
1671  chart
1672  ;; First collect all the labels we're thinking about outputting.
1673  (setq y-labels
1674  (cl-loop for y in y-ticks
1675  for py = (- (- height margin-bottom)
1676  (* (/ (- (* 1.0 y) min) (- max min))
1677  ys))
1678  when (and (<= margin-top py (- height margin-bottom))
1679  (zerop (e% y y-tick-step))
1680  (zerop (e% y y-label-step)))
1681  collect (eplot--format-y
1682  y (- (cadr y-ticks) (car y-ticks)) nil
1683  y-label-format)))
1684  ;; Check the labels to see whether we have too many digits for
1685  ;; what we're actually going to display. Man, this is a lot of
1686  ;; back-and-forth and should be rewritten to be less insanely
1687  ;; inefficient.
1688  (when (= (seq-count (lambda (label)
1689  (string-match "\\." label))
1690  y-labels)
1691  (length y-labels))
1692  (setq y-labels
1693  (cl-loop with max = (cl-loop for label in y-labels
1694  maximize (eplot--decimal-digits
1695  (string-to-number label)))
1696  for label in y-labels
1697  collect (format (if (zerop max)
1698  "%d"
1699  (format "%%.%df" max))
1700  (string-to-number label)))))
1701  (setq y-labels (cl-coerce y-labels 'vector))
1702  ;; Ensure that we have enough room to display the Y labels
1703  ;; (unless overridden).
1704  (when (eplot--default-p 'margin-left (slot-value chart 'data))
1705  (with-slots (label-font label-font-size) chart
1706  (setq margin-left (max margin-left
1707  (+ (eplot--text-width
1708  (elt y-labels (1- (length y-labels)))
1709  label-font label-font-size)
1710  10))
1711  xs (- width margin-left margin-right))))))
1712 
1713 (defun eplot--draw-y-ticks (svg chart)
1714  (with-slots ( y-ticks y-labels y-tick-step y-label-step label-color
1715  label-font label-font-size
1716  width height min max ys
1717  margin-top margin-bottom margin-left margin-right
1718  axes-color
1719  grid grid-opacity grid-color)
1720  chart
1721  ;; Make Y ticks.
1722  (cl-loop with lnum = 0
1723  with text-height = (eplot--text-height
1724  "012" label-font label-font-size)
1725  for y in y-ticks
1726  for i from 0
1727  for py = (- (- height margin-bottom)
1728  (* (/ (- (* 1.0 y) min) (- max min))
1729  ys))
1730  do
1731  (when (and (<= margin-top py (- height margin-bottom))
1732  (zerop (e% y y-tick-step)))
1733  (svg-line svg margin-left py
1734  (- margin-left 3) py
1735  :stroke-color axes-color)
1736  (when (or (eq grid 'xy) (eq grid 'y))
1737  (svg-line svg margin-left py
1738  (- width margin-right) py
1739  :opacity grid-opacity
1740  :stroke-color grid-color))
1741  (when (zerop (e% y y-label-step))
1742  (svg-text svg (elt y-labels lnum)
1743  :font-family label-font
1744  :text-anchor "end"
1745  :font-size label-font-size
1746  :fill label-color
1747  :x (- margin-left 6)
1748  :y (+ py (/ text-height 2) -1))
1749  (cl-incf lnum))))))
1750 
1751 (defun eplot--text-width (text font font-size &optional font-weight)
1752  (string-pixel-width
1753  (propertize text 'face
1754  (list :font (font-spec :family font
1755  :weight (or font-weight 'normal)
1756  :size font-size)))))
1757 
1758 (defvar eplot--text-size-cache (make-hash-table :test #'equal))
1759 
1760 (defun eplot--text-height (text font font-size &optional font-weight)
1761  (cdr (eplot--text-size text font font-size font-weight)))
1762 
1763 (defun eplot--text-size (text font font-size font-weight)
1764  (let ((key (list text font font-size font-weight)))
1765  (or (gethash key eplot--text-size-cache)
1766  (let ((size (eplot--text-size-1 text font font-size font-weight)))
1767  (setf (gethash key eplot--text-size-cache) size)
1768  size))))
1769 
1770 (defun eplot--text-size-1 (text font font-size font-weight)
1771  (if (not (executable-find "convert"))
1772  ;; This "default" text size is kinda bogus.
1773  (cons (* (length text) font-size) font-size)
1774  (let* ((size (* font-size 10))
1775  (svg (svg-create size size))
1776  text-size)
1777  (svg-rectangle svg 0 0 size size :fill "black")
1778  (svg-text svg text
1779  :font-family font
1780  :text-anchor "middle"
1781  :font-size font-size
1782  :font-weight (or font-weight 'normal)
1783  :fill "white"
1784  :x (/ size 2)
1785  :y (/ size 2))
1786  (with-temp-buffer
1787  (set-buffer-multibyte nil)
1788  (svg-print svg)
1789  (let* ((file (concat (make-temp-name "/tmp/eplot") ".svg"))
1790  (png (file-name-with-extension file ".png")))
1791  (unwind-protect
1792  (progn
1793  (write-region (point-min) (point-max) file nil 'silent)
1794  ;; rsvg-convert is 5x faster than convert when doing SVG, so
1795  ;; if we have it, we use it.
1796  (when (executable-find "rsvg-convert")
1797  (unwind-protect
1798  (call-process "rsvg-convert" nil nil nil
1799  (format "--output=%s" png) file)
1800  (when (file-exists-p png)
1801  (delete-file file)
1802  (setq file png))))
1803  (erase-buffer)
1804  (when (zerop (call-process "convert" nil t nil
1805  "-trim" "+repage" file "info:-"))
1806  (goto-char (point-min))
1807  (when (re-search-forward " \\([0-9]+\\)x\\([0-9]+\\)" nil t)
1808  (setq text-size
1809  (cons (string-to-number (match-string 1))
1810  (string-to-number (match-string 2)))))))
1811  (when (file-exists-p file)
1812  (delete-file file)))))
1813  (or text-size
1814  ;; This "default" text size is kinda bogus.
1815  (cons (* (length text) font-size) font-size)))))
1816 
1817 (defun eplot--draw-legend (svg chart)
1818  (with-slots ( legend plots
1819  margin-left margin-top
1820  font font-size font-weight
1821  background-color axes-color
1822  legend-color legend-background-color legend-border-color)
1823  chart
1824  (when (eq legend 'true)
1825  (when-let ((names
1826  (cl-loop for plot in plots
1827  for name = (slot-value plot 'name)
1828  when name
1829  collect
1830  (cons name (slot-value plot 'color)))))
1831  (svg-rectangle svg (+ margin-left 20) (+ margin-top 20)
1832  (format "%dex"
1833  (+ 2
1834  (seq-max (mapcar (lambda (name)
1835  (length (car name)))
1836  names))))
1837  (* font-size (+ (length names) 2))
1838  :font-size font-size
1839  :fill-color legend-background-color
1840  :stroke-color legend-border-color)
1841  (cl-loop for name in names
1842  for i from 0
1843  do (svg-text svg (car name)
1844  :font-family font
1845  :text-anchor "front"
1846  :font-size font-size
1847  :font-weight font-weight
1848  :fill (or (cdr name) legend-color)
1849  :x (+ margin-left 25)
1850  :y (+ margin-top 40 (* i font-size))))))))
1851 
1852 (defun eplot--format-y (y spacing whole format-string)
1853  (format (or format-string "%s")
1854  (cond
1855  ((or (= (round (* spacing 100)) 10) (= (round (* spacing 100)) 20))
1856  (format "%.1f" y))
1857  ((< spacing 0.01)
1858  (format "%.3f" y))
1859  ((< spacing 1)
1860  (format "%.2f" y))
1861  ((and (< spacing 1) (not (zerop (mod (* spacing 10) 1))))
1862  (format "%.1f" y))
1863  ((zerop (% spacing 1000000000))
1864  (format "%dG" (/ y 1000000000)))
1865  ((zerop (% spacing 1000000))
1866  (format "%dM" (/ y 1000000)))
1867  ((zerop (% spacing 1000))
1868  (format "%dk" (/ y 1000)))
1869  ((>= spacing 1)
1870  (format "%s" y))
1871  ((not whole)
1872  (format "%.1f" y))
1873  (t
1874  (format "%s" y)))))
1875 
1876 (defun eplot--format-value (value print-format label-format)
1877  (replace-regexp-in-string
1878  ;; Texts in SVG collapse multiple spaces into one. So do it here,
1879  ;; too, so that width calculations are correct.
1880  " +" " "
1881  (cond
1882  ((eq print-format 'date)
1883  (format-time-string
1884  (or label-format "%Y-%m-%d") (eplot--days-to-time value)))
1885  ((eq print-format 'year)
1886  (format-time-string (or label-format "%Y") (eplot--days-to-time value)))
1887  ((eq print-format 'time)
1888  (format-time-string (or label-format "%H:%M:%S") value))
1889  ((eq print-format 'minute)
1890  (format-time-string (or label-format "%H:%M") value))
1891  ((eq print-format 'hour)
1892  (format-time-string (or label-format "%H") value))
1893  (t
1894  (format (or label-format "%s") value)))))
1895 
1896 (defun eplot--compute-x-ticks (xs x-values print-format x-label-format
1897  label-font label-font-size)
1898  (let* ((min (seq-min x-values))
1899  (max (seq-max x-values))
1900  (count (length x-values))
1901  (max-print (eplot--format-value max print-format x-label-format))
1902  ;; We want each label to be spaced at least as long apart as
1903  ;; the length of the longest label, with room for two blanks
1904  ;; in between.
1905  (min-spacing (* 1.2 (eplot--text-width max-print label-font
1906  label-font-size)))
1907  (digits (eplot--decimal-digits (- (cadr x-values) (car x-values))))
1908  (every (e/ 1 (expt 10 digits))))
1909  (cond
1910  ;; We have room for every X value.
1911  ((< (* count min-spacing) xs)
1912  (list every every))
1913  ;; We have to prune X labels, but not grid lines. (We shouldn't
1914  ;; have a grid line more than every 10 pixels.)
1915  ((< (* count 10) xs)
1916  (list every
1917  (let ((label-step every))
1918  (while (> (/ (- max min) label-step) (/ xs min-spacing))
1919  (setq label-step (eplot--next-weed label-step)))
1920  label-step)))
1921  ;; We have to reduce both grid lines and labels.
1922  (t
1923  (let ((tick-step every))
1924  (while (> (/ (- max min) tick-step) (/ xs 10))
1925  (setq tick-step (eplot--next-weed tick-step)))
1926  (list tick-step
1927  (let ((label-step tick-step))
1928  (while (> (/ (- max min) label-step) (/ xs min-spacing))
1929  (setq label-step (eplot--next-weed label-step))
1930  (while (not (zerop (% label-step tick-step)))
1931  (setq label-step (eplot--next-weed label-step))))
1932  label-step)))))))
1933 
1934 (defun eplot--compute-y-ticks (ys y-values text-height)
1935  (let* ((min (car y-values))
1936  (max (car (last y-values)))
1937  (count (length y-values))
1938  ;; We want each label to be spaced at least as long apart as
1939  ;; the height of the label.
1940  (min-spacing (+ text-height 10))
1941  (digits (eplot--decimal-digits (- (cadr y-values) (car y-values))))
1942  (every (e/ 1 (expt 10 digits))))
1943  (cond
1944  ;; We have room for every X value.
1945  ((< (* count min-spacing) ys)
1946  (list every every))
1947  ;; We have to prune Y labels, but not grid lines. (We shouldn't
1948  ;; have a grid line more than every 10 pixels.)
1949  ((< (* count 10) ys)
1950  (list every
1951  (let ((label-step every))
1952  (while (> (/ (- max min) label-step) (/ ys min-spacing))
1953  (setq label-step (eplot--next-weed label-step)))
1954  label-step)))
1955  ;; We have to reduce both grid lines and labels.
1956  (t
1957  (let ((tick-step 1))
1958  (while (> (/ count tick-step) (/ ys 10))
1959  (setq tick-step (eplot--next-weed tick-step)))
1960  (list tick-step
1961  (let ((label-step tick-step))
1962  (while (> (/ count label-step) (/ ys min-spacing))
1963  (setq label-step (eplot--next-weed label-step))
1964  (while (not (zerop (% label-step tick-step)))
1965  (setq label-step (eplot--next-weed label-step))))
1966  label-step)))))))
1967 
1968 (defvar eplot--pleasing-numbers '(1 2 5 10))
1969 
1970 (defun eplot--next-weed (weed)
1971  (let (digits series)
1972  (if (>= weed 1)
1973  (setq digits (truncate (log weed 10))
1974  series (/ weed (expt 10 digits)))
1975  (setq digits (eplot--decimal-digits weed)
1976  series (truncate (* weed (expt 10 digits)))))
1977  (let ((next (cadr (memq series eplot--pleasing-numbers))))
1978  (unless next
1979  (error "Invalid weed: %s" weed))
1980  (if (>= weed 1)
1981  (* next (expt 10 digits))
1982  (e/ next (expt 10 digits))))))
1983 
1984 (defun eplot--parse-gradient (string)
1985  (when string
1986  (let ((bits (split-string string)))
1987  (list
1988  (cons 'from (nth 0 bits))
1989  (cons 'to (nth 1 bits))
1990  (cons 'direction (intern (or (nth 2 bits) "top-down")))
1991  (cons 'position (intern (or (nth 3 bits) "below")))))))
1992 
1993 (defun eplot--smooth (values algo xs)
1994  (if (not algo)
1995  values
1996  (let* ((vals (cl-coerce values 'vector))
1997  (max (1- (length vals)))
1998  (period (* 4 (ceiling (/ max xs)))))
1999  (cl-case algo
2000  (moving-average
2001  (cl-loop for i from 0 upto max
2002  collect (e/ (cl-loop for ii from 0 upto (1- period)
2003  sum (elt vals (min (+ i ii) max)))
2004  period)))))))
2005 
2006 (defun eplot--vary-color (color n)
2007  (let ((colors ["#e6194b" "#3cb44b" "#ffe119" "#4363d8" "#f58231" "#911eb4"
2008  "#46f0f0" "#f032e6" "#bcf60c" "#fabebe" "#008080" "#e6beff"
2009  "#9a6324" "#fffac8" "#800000" "#aaffc3" "#808000" "#ffd8b1"
2010  "#000075" "#808080" "#ffffff" "#000000"]))
2011  (unless (equal color "vary")
2012  (setq colors
2013  (if (string-search " " color)
2014  (split-string color)
2015  (list color))))
2016  (elt colors (mod n (length colors)))))
2017 
2018 (defun eplot--pv (plot slot &optional default)
2019  (let ((user (cdr (assq slot eplot--user-defaults))))
2020  (when (and (stringp user) (zerop (length user)))
2021  (setq user nil))
2022  (or user (slot-value plot slot) default)))
2023 
2024 (defun eplot--draw-plots (svg chart)
2025  (if (eq (slot-value chart 'format) 'horizontal-bar-chart)
2026  (eplot--draw-horizontal-bar-chart svg chart)
2027  (eplot--draw-normal-plots svg chart)))
2028 
2029 (defun eplot--draw-normal-plots (svg chart)
2030  (with-slots ( plots chart-color height format
2031  margin-bottom margin-left
2032  min max xs ys
2033  margin-top
2034  x-values x-min x-max
2035  label-font label-font-size)
2036  chart
2037  ;; Draw all the plots.
2038  (cl-loop for plot in (reverse plots)
2039  for plot-number from 0
2040  for values = (slot-value plot 'values)
2041  for stride = (eplot--stride chart values)
2042  for vals = (eplot--smooth
2043  (seq-map (lambda (v) (plist-get v :value)) values)
2044  (slot-value plot 'smoothing)
2045  xs)
2046  for polygon = nil
2047  for gradient = (eplot--parse-gradient (eplot--pv plot 'gradient))
2048  for lpy = nil
2049  for lpx = nil
2050  for style = (if (eq format 'bar-chart)
2051  'bar
2052  (slot-value plot 'style))
2053  for bar-gap = (* stride 0.1)
2054  for clip-id = (format "url(#clip-%d)" plot-number)
2055  do
2056  (svg--append
2057  svg
2058  (dom-node 'clipPath
2059  `((id . ,(format "clip-%d" plot-number)))
2060  (dom-node 'rect
2061  `((x . ,margin-left)
2062  (y . , margin-top)
2063  (width . ,xs)
2064  (height . ,ys)))))
2065  (unless gradient
2066  (when-let ((fill (slot-value plot 'fill-color)))
2067  (setq gradient `((from . ,fill) (to . ,fill)
2068  (direction . top-down) (position . below)))))
2069  (when gradient
2070  (if (eq (eplot--vs 'position gradient) 'above)
2071  (push (cons margin-left margin-top) polygon)
2072  (push (cons margin-left (- height margin-bottom)) polygon)))
2073  (cl-loop
2074  for val in vals
2075  for value in values
2076  for x in x-values
2077  for i from 0
2078  for settings = (plist-get value :settings)
2079  for color = (eplot--vary-color
2080  (eplot--vs 'color settings (slot-value plot 'color))
2081  i)
2082  for py = (- (- height margin-bottom)
2083  (* (/ (- (* 1.0 val) min) (- max min))
2084  ys))
2085  for px = (if (eq style 'bar)
2086  (+ margin-left
2087  (* (e/ (- x x-min) (- x-max x-min -1))
2088  xs))
2089  (+ margin-left
2090  (* (e/ (- x x-min) (- x-max x-min))
2091  xs)))
2092  do
2093  ;; Some data points may have texts.
2094  (when-let ((text (eplot--vs 'text settings)))
2095  (svg-text svg text
2096  :font-family label-font
2097  :text-anchor "middle"
2098  :font-size label-font-size
2099  :font-weight 'normal
2100  :fill color
2101  :x px
2102  :y (- py (eplot--text-height
2103  text label-font label-font-size)
2104  -5)))
2105  ;; You may mark certain points.
2106  (when-let ((mark (eplot--vy 'mark settings)))
2107  (cl-case mark
2108  (cross
2109  (let ((s (eplot--element-size val plot settings 3)))
2110  (svg-line svg (- px s) (- py s)
2111  (+ px s) (+ py s)
2112  :clip-path clip-id
2113  :stroke color)
2114  (svg-line svg (+ px s) (- py s)
2115  (- px s) (+ py s)
2116  :clip-path clip-id
2117  :stroke color)))
2118  (otherwise
2119  (svg-circle svg px py 3
2120  :fill color))))
2121  (cl-case style
2122  (bar
2123  (if (not gradient)
2124  (svg-rectangle
2125  svg (+ px bar-gap) py
2126  (- stride bar-gap) (- height margin-bottom py)
2127  :clip-path clip-id
2128  :fill color)
2129  (let ((id (format "gradient-%s" (make-temp-name "grad"))))
2130  (eplot--gradient svg id 'linear
2131  (eplot--stops (eplot--vs 'from gradient)
2132  (eplot--vs 'to gradient))
2133  (eplot--vs 'direction gradient))
2134  (svg-rectangle
2135  svg (+ px bar-gap) py
2136  (- stride bar-gap) (- height margin-bottom py)
2137  :clip-path clip-id
2138  :gradient id))))
2139  (impulse
2140  (let ((width (eplot--element-size val plot settings 1)))
2141  (if (= width 1)
2142  (svg-line svg
2143  px py
2144  px (- height margin-bottom)
2145  :clip-path clip-id
2146  :stroke color)
2147  (svg-rectangle svg
2148  (- px (e/ width 2)) py
2149  width (- height py margin-bottom)
2150  :clip-path clip-id
2151  :fill color))))
2152  (point
2153  (svg-line svg px py (1+ px) (1+ py)
2154  :clip-path clip-id
2155  :stroke color))
2156  (line
2157  ;; If we're doing a gradient, we're just collecting
2158  ;; points and will draw the polygon later.
2159  (if gradient
2160  (push (cons px py) polygon)
2161  (when lpx
2162  (svg-line svg lpx lpy px py
2163  :stroke-width (eplot--pv plot 'size 1)
2164  :clip-path clip-id
2165  :stroke color))))
2166  (curve
2167  (push (cons px py) polygon))
2168  (square
2169  (if gradient
2170  (progn
2171  (when lpx
2172  (push (cons lpx py) polygon))
2173  (push (cons px py) polygon))
2174  (when lpx
2175  (svg-line svg lpx lpy px lpy
2176  :clip-path clip-id
2177  :stroke color)
2178  (svg-line svg px lpy px py
2179  :clip-path clip-id
2180  :stroke color))))
2181  (circle
2182  (svg-circle svg px py
2183  (eplot--element-size val plot settings 3)
2184  :clip-path clip-id
2185  :stroke color
2186  :fill (eplot--vary-color
2187  (eplot--vs
2188  'fill-color settings
2189  (or (slot-value plot 'fill-color) "none"))
2190  i)))
2191  (cross
2192  (let ((s (eplot--element-size val plot settings 3)))
2193  (svg-line svg (- px s) (- py s)
2194  (+ px s) (+ py s)
2195  :clip-path clip-id
2196  :stroke color)
2197  (svg-line svg (+ px s) (- py s)
2198  (- px s) (+ py s)
2199  :clip-path clip-id
2200  :stroke color)))
2201  (triangle
2202  (let ((s (eplot--element-size val plot settings 5)))
2203  (svg-polygon svg
2204  (list
2205  (cons (- px (e/ s 2)) (+ py (e/ s 2)))
2206  (cons px (- py (e/ s 2)))
2207  (cons (+ px (e/ s 2)) (+ py (e/ s 2))))
2208  :clip-path clip-id
2209  :stroke color
2210  :fill-color
2211  (or (slot-value plot 'fill-color) "none"))))
2212  (rectangle
2213  (let ((s (eplot--element-size val plot settings 3)))
2214  (svg-rectangle svg (- px (e/ s 2)) (- py (e/ s 2))
2215  s s
2216  :clip-path clip-id
2217  :stroke color
2218  :fill-color
2219  (or (slot-value plot 'fill-color) "none")))))
2220  (setq lpy py
2221  lpx px))
2222 
2223  ;; We're doing a gradient of some kind (or a curve), so
2224  ;; draw it now when we've collected the polygon.
2225  (when polygon
2226  ;; We have a "between" chart, so collect the data points
2227  ;; from the "extra" values, too.
2228  (when (memq 'two-values (slot-value plot 'data-format))
2229  (cl-loop
2230  for val in (nreverse
2231  (seq-map (lambda (v) (plist-get v :extra-value))
2232  values))
2233  for x from (1- (length vals)) downto 0
2234  for py = (- (- height margin-bottom)
2235  (* (/ (- (* 1.0 val) min) (- max min))
2236  ys))
2237  for px = (+ margin-left
2238  (* (e/ (- x x-min) (- x-max x-min))
2239  xs))
2240  do
2241  (cl-case style
2242  (line
2243  (push (cons px py) polygon))
2244  (square
2245  (when lpx
2246  (push (cons lpx py) polygon))
2247  (push (cons px py) polygon)))
2248  (setq lpx px lpy py)))
2249  (when gradient
2250  (if (eq (eplot--vs 'position gradient) 'above)
2251  (push (cons lpx margin-top) polygon)
2252  (push (cons lpx (- height margin-bottom)) polygon)))
2253  (let ((id (format "gradient-%d" plot-number)))
2254  (when gradient
2255  (eplot--gradient svg id 'linear
2256  (eplot--stops (eplot--vs 'from gradient)
2257  (eplot--vs 'to gradient))
2258  (eplot--vs 'direction gradient)))
2259  (if (eq style 'curve)
2260  (apply #'svg-path svg
2261  (nconc
2262  (cl-loop
2263  with points = (cl-coerce
2264  (nreverse polygon) 'vector)
2265  for i from 0 upto (1- (length points))
2266  collect
2267  (cond
2268  ((zerop i)
2269  `(moveto ((,(car (elt points 0)) .
2270  ,(cdr (elt points 0))))))
2271  (t
2272  `(curveto
2273  (,(eplot--bezier
2274  (eplot--pv plot 'bezier-factor)
2275  i points))))))
2276  (and gradient '((closepath))))
2277  `( :clip-path ,clip-id
2278  :stroke-width ,(eplot--pv plot 'size 1)
2279  :stroke ,(slot-value plot 'color)
2280  ,@(if gradient
2281  `(:gradient ,id)
2282  `(:fill "none"))))
2283  (svg-polygon
2284  svg (nreverse polygon)
2285  :clip-path clip-id
2286  :gradient id
2287  :stroke (slot-value plot 'fill-border-color))))))))
2288 
2289 (defun eplot--element-size (value plot settings default)
2290  (eplot--vn 'size settings
2291  (if (slot-value plot 'size-factor)
2292  (* value (slot-value plot 'size-factor))
2293  (or (slot-value plot 'size) default))))
2294 
2295 (defun eplot--draw-horizontal-bar-chart (svg chart)
2296  (with-slots ( plots chart-color height format
2297  margin-bottom margin-left
2298  min max xs ys
2299  margin-top
2300  x-values x-min x-max
2301  label-font label-font-size label-color)
2302  chart
2303  (cl-loop with plot = (car plots)
2304  with values = (slot-value plot 'values)
2305  with stride = (e/ ys (length values))
2306  with label-height = (eplot--text-height "xx" label-font
2307  label-font-size)
2308  with bar-gap = (* stride 0.1)
2309  for i from 0
2310  for value in values
2311  for settings = (plist-get value :settings)
2312  for py = (+ margin-top (* i stride))
2313  for px = (* (e/ (plist-get value :x) x-max) xs)
2314  for color = (eplot--vary-color
2315  (eplot--vs 'color settings (slot-value plot 'color))
2316  i)
2317  do
2318  (svg-text svg (eplot--vs 'label settings)
2319  :font-family label-font
2320  :text-anchor "left"
2321  :font-size label-font-size
2322  :font-weight 'normal
2323  :fill label-color
2324  :x 5
2325  :y (+ py label-height (/ (- stride label-height) 2)))
2326  (svg-rectangle svg
2327  margin-left (+ py (e/ bar-gap 2))
2328  px (- stride bar-gap)
2329  :fill color))))
2330 
2331 (defun eplot--stops (from to)
2332  (append `((0 . ,from))
2333  (cl-loop for (pct col) on (split-string to "-") by #'cddr
2334  collect (if col
2335  (cons (string-to-number pct) col)
2336  (cons 100 pct)))))
2337 
2338 (defun eplot--gradient (svg id type stops &optional direction)
2339  "Add a gradient with ID to SVG.
2340 TYPE is `linear' or `radial'.
2341 
2342 STOPS is a list of percentage/color pairs.
2343 
2344 DIRECTION is one of `top-down', `bottom-up', `left-right' or `right-left'.
2345 nil means `top-down'."
2346  (svg--def
2347  svg
2348  (apply
2349  #'dom-node
2350  (if (eq type 'linear)
2351  'linearGradient
2352  'radialGradient)
2353  `((id . ,id)
2354  (x1 . ,(if (eq direction 'left-right) 1 0))
2355  (x2 . ,(if (eq direction 'right-left) 1 0))
2356  (y1 . ,(if (eq direction 'bottom-up) 1 0))
2357  (y2 . ,(if (eq direction 'top-down) 1 0)))
2358  (mapcar
2359  (lambda (stop)
2360  (dom-node 'stop `((offset . ,(format "%s%%" (car stop)))
2361  (stop-color . ,(cdr stop)))))
2362  stops))))
2363 
2364 (defun e% (num1 num2)
2365  (let ((factor (max (expt 10 (eplot--decimal-digits num1))
2366  (expt 10 (eplot--decimal-digits num2)))))
2367  (% (truncate (* num1 factor)) (truncate (* num2 factor)))))
2368 
2369 (defun eplot--decimal-digits (number)
2370  (- (length (replace-regexp-in-string
2371  "0+\\'" ""
2372  (format "%.10f" (- number (truncate number)))))
2373  2))
2374 
2375 (defun e/ (&rest numbers)
2376  (if (cl-every #'integerp numbers)
2377  (let ((int (apply #'/ numbers))
2378  (float (apply #'/ (* 1.0 (car numbers)) (cdr numbers))))
2379  (if (= int float)
2380  int
2381  float))
2382  (apply #'/ numbers)))
2383 
2384 (defun eplot--get-ticks (min max height &optional whole)
2385  (let* ((diff (abs (- min max)))
2386  (even (eplot--pleasing-numbers (* (e/ diff height) 10)))
2387  (factor (max (expt 10 (eplot--decimal-digits even))
2388  (expt 10 (eplot--decimal-digits diff))))
2389  (fmin (truncate (* min factor)))
2390  (feven (truncate (* factor even)))
2391  start)
2392  (when whole
2393  (setq even 1
2394  feven factor))
2395 
2396  (setq start
2397  (cond
2398  ((< min 0)
2399  (+ (floor fmin)
2400  feven
2401  (- (% (floor fmin) feven))
2402  (- feven)))
2403  (t
2404  (- fmin (% fmin feven)))))
2405  (cl-loop for x from start upto (* max factor) by feven
2406  collect (e/ x factor))))
2407 
2408 (defun eplot--days-to-time (days)
2409  (days-to-time (- days (time-to-days 0))))
2410 
2411 (defun eplot--get-date-ticks (start end xs label-font label-font-size
2412  x-label-format &optional skip-until)
2413  (let* ((duration (- end start))
2414  (limits
2415  (list
2416  (list (/ 368 16) 'date
2417  (lambda (_d) t))
2418  (list (/ 368 4) 'date
2419  ;; Collect Mondays.
2420  (lambda (decoded)
2421  (= (decoded-time-weekday decoded) 1)))
2422  (list (/ 368 2) 'date
2423  ;; Collect 1st and 15th.
2424  (lambda (decoded)
2425  (or (= (decoded-time-day decoded) 1)
2426  (= (decoded-time-day decoded) 15))))
2427  (list (* 368 2) 'date
2428  ;; Collect 1st of every month.
2429  (lambda (decoded)
2430  (= (decoded-time-day decoded) 1)))
2431  (list (* 368 4) 'date
2432  ;; Collect every quarter.
2433  (lambda (decoded)
2434  (and (= (decoded-time-day decoded) 1)
2435  (memq (decoded-time-month decoded) '(1 4 7 10)))))
2436  (list (* 368 8) 'date
2437  ;; Collect every half year.
2438  (lambda (decoded)
2439  (and (= (decoded-time-day decoded) 1)
2440  (memq (decoded-time-month decoded) '(1 7)))))
2441  (list 1.0e+INF 'year
2442  ;; Collect every Jan 1st.
2443  (lambda (decoded)
2444  (and (= (decoded-time-day decoded) 1)
2445  (= (decoded-time-month decoded) 1)))))))
2446  ;; First we collect the potential ticks.
2447  (while (or (>= duration (caar limits))
2448  (and skip-until (>= skip-until (caar limits))))
2449  (pop limits))
2450  (let* ((x-ticks (cl-loop for day from start upto end
2451  for time = (eplot--days-to-time day)
2452  for decoded = (decode-time time)
2453  when (funcall (nth 2 (car limits)) decoded)
2454  collect day))
2455  (count (length x-ticks))
2456  (print-format (nth 1 (car limits)))
2457  (max-print (eplot--format-value (car x-ticks) print-format
2458  x-label-format))
2459  (min-spacing (* 1.2 (eplot--text-width max-print label-font
2460  label-font-size))))
2461  (cond
2462  ;; We have room for every X value.
2463  ((< (* count min-spacing) xs)
2464  (list x-ticks print-format))
2465  ;; We have to prune X labels, but not grid lines. (We shouldn't
2466  ;; have a grid line more than every 10 pixels.)
2467  ((< (* count 10) xs)
2468  (cond
2469  ((not (cdr limits))
2470  (eplot--year-ticks
2471  x-ticks xs label-font label-font-size x-label-format))
2472  ;; The Mondays grid is special, because it doesn't resolve
2473  ;; into any of the bigger limits evenly.
2474  ((= (caar limits) (/ 368 4))
2475  (let* ((max-print (eplot--format-value
2476  (car x-ticks) print-format x-label-format))
2477  (min-spacing (* 1.2 (eplot--text-width
2478  max-print label-font label-font-size)))
2479  (weed-factor 2))
2480  (while (> (* (/ (length x-ticks) weed-factor) min-spacing) xs)
2481  (setq weed-factor (* weed-factor 2)))
2482  (list x-ticks 'date
2483  (cl-loop for val in x-ticks
2484  for i from 0
2485  collect (list val t (zerop (% i weed-factor)))))))
2486  (t
2487  (pop limits)
2488  (catch 'found
2489  (while limits
2490  (let ((candidate
2491  (cl-loop for day in x-ticks
2492  for time = (eplot--days-to-time day)
2493  for decoded = (decode-time time)
2494  collect (list day t
2495  (not (not
2496  (funcall (nth 2 (car limits))
2497  decoded)))))))
2498  (setq print-format (nth 1 (car limits)))
2499  (let* ((max-print (eplot--format-value
2500  (car x-ticks) print-format x-label-format))
2501  (min-spacing (* 1.2 (eplot--text-width
2502  max-print label-font
2503  label-font-size)))
2504  (num-labels (seq-count (lambda (v) (nth 2 v))
2505  candidate)))
2506  (when (and (not (zerop num-labels))
2507  (< (* num-labels min-spacing) xs))
2508  (throw 'found (list x-ticks print-format candidate)))))
2509  (pop limits))
2510  (eplot--year-ticks
2511  x-ticks xs label-font label-font-size x-label-format)))))
2512  ;; We have to reduce both grid lines and labels.
2513  (t
2514  (eplot--get-date-ticks start end xs label-font label-font-size
2515  x-label-format (caar limits)))))))
2516 
2517 (defun eplot--year-ticks (x-ticks xs label-font label-font-size x-label-format)
2518  (let* ((year-ticks (mapcar (lambda (day)
2519  (decoded-time-year
2520  (decode-time (eplot--days-to-time day))))
2521  x-ticks))
2522  (xv (eplot--compute-x-ticks
2523  xs year-ticks 'year x-label-format label-font label-font-size)))
2524  (let ((tick-step (car xv))
2525  (label-step (cadr xv)))
2526  (list x-ticks 'year
2527  (cl-loop for year in year-ticks
2528  for val in x-ticks
2529  collect (list val
2530  (zerop (% year tick-step))
2531  (zerop (% year label-step))))))))
2532 
2533 (defun eplot--get-time-ticks (start end xs label-font label-font-size
2534  x-label-format
2535  &optional skip-until)
2536  (let* ((duration (- end start))
2537  (limits
2538  (list
2539  (list (* 2 60) 'time
2540  (lambda (_d) t))
2541  (list (* 2 60 60) 'time
2542  ;; Collect whole minutes.
2543  (lambda (decoded)
2544  (zerop (decoded-time-second decoded))))
2545  (list (* 3 60 60) 'minute
2546  ;; Collect five minutes.
2547  (lambda (decoded)
2548  (zerop (% (decoded-time-minute decoded) 5))))
2549  (list (* 4 60 60) 'minute
2550  ;; Collect fifteen minutes.
2551  (lambda (decoded)
2552  (and (zerop (decoded-time-second decoded))
2553  (memq (decoded-time-minute decoded) '(0 15 30 45)))))
2554  (list (* 8 60 60) 'minute
2555  ;; Collect half hours.
2556  (lambda (decoded)
2557  (and (zerop (decoded-time-second decoded))
2558  (memq (decoded-time-minute decoded) '(0 30)))))
2559  (list 1.0e+INF 'hour
2560  ;; Collect whole hours.
2561  (lambda (decoded)
2562  (and (zerop (decoded-time-second decoded))
2563  (zerop (decoded-time-minute decoded))))))))
2564  ;; First we collect the potential ticks.
2565  (while (or (>= duration (caar limits))
2566  (and skip-until (>= skip-until (caar limits))))
2567  (pop limits))
2568  (let* ((x-ticks (cl-loop for time from start upto end
2569  for decoded = (decode-time time)
2570  when (funcall (nth 2 (car limits)) decoded)
2571  collect time))
2572  (count (length x-ticks))
2573  (print-format (nth 1 (car limits)))
2574  (max-print (eplot--format-value (car x-ticks) print-format
2575  x-label-format))
2576  (min-spacing (* (+ (length max-print) 2) (e/ label-font-size 2))))
2577  (cond
2578  ;; We have room for every X value.
2579  ((< (* count min-spacing) xs)
2580  (list x-ticks print-format))
2581  ;; We have to prune X labels, but not grid lines. (We shouldn't
2582  ;; have a grid line more than every 10 pixels.)
2583  ;; If we're plotting just seconds, then just weed out some seconds.
2584  ((and (< (* count 10) xs)
2585  (= (caar limits) (* 2 60)))
2586  (let ((xv (eplot--compute-x-ticks
2587  xs x-ticks 'time x-label-format label-font label-font-size)))
2588  (let ((tick-step (car xv))
2589  (label-step (cadr xv)))
2590  (list x-ticks 'time
2591  (cl-loop for val in x-ticks
2592  collect (list val
2593  (zerop (% val tick-step))
2594  (zerop (% val label-step))))))))
2595  ;; Normal case for pruning labels, but not grid lines.
2596  ((< (* count 10) xs)
2597  (if (not (cdr limits))
2598  (eplot--hour-ticks x-ticks xs label-font label-font-size
2599  x-label-format)
2600  (pop limits)
2601  (catch 'found
2602  (while limits
2603  (let ((candidate
2604  (cl-loop for val in x-ticks
2605  for decoded = (decode-time val)
2606  collect (list val t
2607  (not (not
2608  (funcall (nth 2 (car limits))
2609  decoded)))))))
2610  (setq print-format (nth 1 (car limits)))
2611  (let ((min-spacing (* (+ (length max-print) 2)
2612  (e/ label-font-size 2))))
2613  (when (< (* (seq-count (lambda (v) (nth 2 v)) candidate)
2614  min-spacing)
2615  xs)
2616  (throw 'found (list x-ticks print-format candidate)))))
2617  (pop limits))
2618  (eplot--hour-ticks x-ticks xs label-font label-font-size
2619  x-label-format))))
2620  ;; We have to reduce both grid lines and labels.
2621  (t
2622  (eplot--get-time-ticks start end xs label-font label-font-size
2623  x-label-format (caar limits)))))))
2624 
2625 (defun eplot--hour-ticks (x-ticks xs label-font label-font-size
2626  x-label-format)
2627  (let* ((eplot--pleasing-numbers '(1 3 6 12))
2628  (hour-ticks (mapcar (lambda (time)
2629  (decoded-time-hour (decode-time time)))
2630  x-ticks))
2631  (xv (eplot--compute-x-ticks
2632  xs hour-ticks 'year x-label-format label-font label-font-size)))
2633  (let ((tick-step (car xv))
2634  (label-step (cadr xv)))
2635  (list x-ticks 'hour
2636  (cl-loop for hour in hour-ticks
2637  for val in x-ticks
2638  collect (list val
2639  (zerop (% hour tick-step))
2640  (zerop (% hour label-step))))))))
2641 
2642 (defun eplot--int (number)
2643  (cond
2644  ((integerp number)
2645  number)
2646  ((= number (truncate number))
2647  (truncate number))
2648  (t
2649  number)))
2650 
2651 (defun eplot--pleasing-numbers (number)
2652  (let* ((digits (eplot--decimal-digits number))
2653  (one (e/ 1 (expt 10 digits)))
2654  (two (e/ 2 (expt 10 digits)))
2655  (five (e/ 5 (expt 10 digits))))
2656  (catch 'found
2657  (while t
2658  (when (< number one)
2659  (throw 'found one))
2660  (setq one (* one 10))
2661  (when (< number two)
2662  (throw 'found two))
2663  (setq two (* two 10))
2664  (when (< number five)
2665  (throw 'found five))
2666  (setq five (* five 10))))))
2667 
2668 (defun eplot-parse-and-insert (file)
2669  "Parse and insert a file in the current buffer."
2670  (interactive "fEplot file: ")
2671  (let ((default-directory (file-name-directory file)))
2672  (setq-local eplot--current-chart
2673  (eplot--render (with-temp-buffer
2674  (insert-file-contents file)
2675  (eplot--parse-buffer))))))
2676 
2677 (defun eplot-list-chart-headers ()
2678  "Pop to a buffer showing all chart parameters."
2679  (interactive)
2680  (pop-to-buffer "*eplot help*")
2681  (let ((inhibit-read-only t))
2682  (special-mode)
2683  (erase-buffer)
2684  (insert "The following headers influence the overall\nlook of the chart:\n\n")
2685  (eplot--list-headers eplot--chart-headers)
2686  (ensure-empty-lines 2)
2687  (insert "The following headers are per plot:\n\n")
2688  (eplot--list-headers eplot--plot-headers)
2689  (goto-char (point-min))))
2690 
2691 (defun eplot--list-headers (headers)
2692  (dolist (header (sort (copy-sequence headers)
2693  (lambda (e1 e2)
2694  (string< (car e1) (car e2)))))
2695  (insert (propertize (capitalize (symbol-name (car header))) 'face 'bold)
2696  "\n")
2697  (let ((start (point)))
2698  (insert (plist-get (cdr header) :doc) "\n")
2699  (when-let ((valid (plist-get (cdr header) :valid)))
2700  (insert "Possible values are: "
2701  (mapconcat (lambda (v) (format "`%s'" v)) valid ", ")
2702  ".\n"))
2703  (indent-rigidly start (point) 2))
2704  (ensure-empty-lines 1)))
2705 
2706 (defvar eplot--transients
2707  '((("Size"
2708  ("sw" "Width")
2709  ("sh" "Height")
2710  ("sl" "Margin-Left")
2711  ("st" "Margin-Top")
2712  ("sr" "Margin-Right")
2713  ("sb" "Margin-Bottom"))
2714  ("Colors"
2715  ("ca" "Axes-Color")
2716  ("cb" "Border-Color")
2717  ("cc" "Chart-Color")
2718  ("cf" "Frame-Color")
2719  ("cs" "Surround-Color")
2720  ("ct" "Title-Color"))
2721  ("Background"
2722  ("bc" "Background-Color")
2723  ("bg" "Background-Gradient")
2724  ("bi" "Background-Image-File")
2725  ("bv" "Background-Image-Cover")
2726  ("bo" "Background-Image-Opacity")))
2727  (("General"
2728  ("gt" "Title")
2729  ("gf" "Font")
2730  ("gs" "Font-Size")
2731  ("ge" "Font-Weight")
2732  ("go" "Format")
2733  ("gw" "Frame-Width")
2734  ("gh" "Header-File")
2735  ("gi" "Min")
2736  ("ga" "Max")
2737  ("gm" "Mode")
2738  ("gr" "Reset" eplot--reset-transient)
2739  ("gv" "Save" eplot--save-transient))
2740  ("Axes, Grid & Legend"
2741  ("xx" "X-Title")
2742  ("xy" "Y-Title")
2743  ("xf" "Label-Font")
2744  ("xz" "Label-Font-Size")
2745  ("xs" "X-Axis-Title-Space")
2746  ("xl" "X-Label-Format")
2747  ("xa" "Y-Label-Format")
2748  ("il" "Grid-Color")
2749  ("io" "Grid-Opacity")
2750  ("ip" "Grid-Position")
2751  ("ll" "Legend")
2752  ("lb" "Legend-Background-Color")
2753  ("lo" "Legend-Border-Color")
2754  ("lc" "Legend-Color"))
2755  ("Plot"
2756  ("ps" "Style")
2757  ("pc" "Color")
2758  ("po" "Data-Column")
2759  ("pr" "Data-format")
2760  ("pn" "Fill-Border-Color")
2761  ("pi" "Fill-Color")
2762  ("pg" "Gradient")
2763  ("pz" "Size")
2764  ("pm" "Smoothing")
2765  ("pb" "Bezier-Factor")))))
2766 
2767 (defun eplot--define-transients ()
2768  (cl-loop for row in eplot--transients
2769  collect (cl-coerce
2770  (cl-loop for column in row
2771  collect
2772  (cl-coerce
2773  (cons (pop column)
2774  (mapcar #'eplot--define-transient column))
2775  'vector))
2776  'vector)))
2777 
2778 (defun eplot--define-transient (action)
2779  (list (nth 0 action)
2780  (nth 1 action)
2781  ;; Allow explicit commands.
2782  (or (nth 2 action)
2783  ;; Make a command for altering a setting.
2784  (lambda ()
2785  (interactive)
2786  (eplot--execute-transient (nth 1 action))))))
2787 
2788 (defun eplot--execute-transient (action)
2789  (with-current-buffer (or eplot--data-buffer (current-buffer))
2790  (unless eplot--transient-settings
2791  (setq-local eplot--transient-settings nil))
2792  (let* ((name (intern (downcase action)))
2793  (spec (assq name (append eplot--chart-headers eplot--plot-headers)))
2794  (type (plist-get (cdr spec) :type)))
2795  ;; Sanity check.
2796  (unless spec
2797  (error "No such header type: %s" name))
2798  (setq eplot--transient-settings
2799  (append
2800  eplot--transient-settings
2801  (list
2802  (cons
2803  name
2804  (cond
2805  ((eq type 'number)
2806  (read-number (format "Value for %s (%s): " action type)))
2807  ((string-match "color" (downcase action))
2808  (eplot--read-color (format "Value for %s (color): " action)))
2809  ((string-match "font" (downcase action))
2810  (eplot--read-font-family
2811  (format "Value for %s (font family): " action)))
2812  ((string-match "gradient" (downcase action))
2813  (eplot--read-gradient action))
2814  ((string-match "file" (downcase action))
2815  (read-file-name (format "File for %s: " action)))
2816  ((eq type 'symbol)
2817  (intern
2818  (completing-read (format "Value for %s: " action)
2819  (plist-get (cdr spec) :valid)
2820  nil t)))
2821  (t
2822  (read-string (format "Value for %s (string): " action))))))))
2823  (eplot-update-view-buffer))))
2824 
2825 (defun eplot--read-gradient (action)
2826  (format "%s %s %s %s"
2827  (eplot--read-color (format "%s from color: " action))
2828  (eplot--read-color (format "%s to color: " action))
2829  (completing-read (format "%s direction: " action)
2830  '(top-down bottom-up left-right right-left)
2831  nil t)
2832  (completing-read (format "%s position: " action)
2833  '(below above)
2834  nil t)))
2835 
2836 (defun eplot--reset-transient ()
2837  (interactive)
2838  (with-current-buffer (or eplot--data-buffer (current-buffer))
2839  (setq-local eplot--transient-settings nil)
2840  (eplot-update-view-buffer)))
2841 
2842 (defun eplot--save-transient (file)
2843  (interactive "FSave parameters to file: ")
2844  (when (and (file-exists-p file)
2845  (not (yes-or-no-p "File exists; overwrite? ")))
2846  (user-error "Exiting"))
2847  (let ((settings (with-current-buffer (or eplot--data-buffer (current-buffer))
2848  eplot--transient-settings)))
2849  (with-temp-buffer
2850  (cl-loop for (name . value) in settings
2851  do (insert (capitalize (symbol-name name)) ": "
2852  (format "%s" value) "\n"))
2853  (write-region (point-min) (point-max) file))))
2854 
2855 (defvar-keymap eplot-control-mode-map
2856  "RET" #'eplot-control-update
2857  "TAB" #'eplot-control-next-field
2858  "C-<tab>" #'eplot-control-next-field
2859  "<backtab>" #'eplot-control-prev-field)
2860 
2861 (define-derived-mode eplot-control-mode special-mode "eplot control"
2862  (setq-local completion-at-point-functions
2863  (cons 'eplot--complete-control completion-at-point-functions))
2864  (add-hook 'before-change-functions #'eplot--process-text-input-before nil t)
2865  (add-hook 'after-change-functions #'eplot--process-text-value nil t)
2866  (add-hook 'after-change-functions #'eplot--process-text-input nil t)
2867  (setq-local nobreak-char-display nil)
2868  (setq truncate-lines t))
2869 
2870 (defun eplot--complete-control ()
2871  ;; Complete headers names.
2872  (when-let* ((input (get-text-property (point) 'input))
2873  (name (plist-get input :name))
2874  (spec (cdr (assq name (append eplot--plot-headers
2875  eplot--chart-headers))))
2876  (start (plist-get input :start))
2877  (end (- (plist-get input :end) 2))
2878  (completion-ignore-case t))
2879  (skip-chars-backward " " start)
2880  (or
2881  (and (eq (plist-get spec :type) 'symbol)
2882  (lambda ()
2883  (let ((valid (plist-get spec :valid)))
2884  (completion-in-region
2885  (save-excursion
2886  (skip-chars-backward "^ " start)
2887  (point))
2888  end
2889  (mapcar #'symbol-name valid))
2890  'completion-attempted)))
2891  (and (string-match "color" (symbol-name name))
2892  (lambda ()
2893  (completion-in-region
2894  (save-excursion
2895  (skip-chars-backward "^ " start)
2896  (point))
2897  end eplot--colors)
2898  'completion-attempted))
2899  (and (string-match "\\bfile\\b" (symbol-name name))
2900  (lambda ()
2901  (completion-in-region
2902  (save-excursion
2903  (skip-chars-backward "^ " start)
2904  (point))
2905  end (directory-files "."))
2906  'completion-attempted))
2907  (and (string-match "\\bfont\\b" (symbol-name name))
2908  (lambda ()
2909  (completion-in-region
2910  (save-excursion
2911  (skip-chars-backward "^ " start)
2912  (point))
2913  end
2914  (eplot--font-families))
2915  'completion-attempted)))))
2916 
2917 (defun eplot--read-font-family (prompt)
2918  "Prompt for a font family, possibly offering autocomplete."
2919  (let ((families (eplot--font-families)))
2920  (if families
2921  (completing-read prompt families)
2922  (read-string prompt))))
2923 
2924 (defun eplot--font-families ()
2925  (when (executable-find "fc-list")
2926  (let ((fonts nil))
2927  (with-temp-buffer
2928  (call-process "fc-list" nil t nil ":" "family")
2929  (goto-char (point-min))
2930  (while (re-search-forward "^\\([^,\n]+\\)" nil t)
2931  (push (downcase (match-string 1)) fonts)))
2932  (seq-uniq (sort fonts #'string<)))))
2933 
2934 (defun eplot-control-next-input ()
2935  "Go to the next input field."
2936  (interactive)
2937  (when-let ((match (text-property-search-forward 'input)))
2938  (goto-char (prop-match-beginning match))))
2939 
2940 (defun eplot-control-update ()
2941  "Update the chart based on the current settings."
2942  (interactive)
2943  (let ((settings nil))
2944  (save-excursion
2945  (goto-char (point-min))
2946  (while-let ((match (text-property-search-forward 'input)))
2947  (when (equal (get-text-property (prop-match-beginning match) 'face)
2948  'eplot--input-changed)
2949  (let* ((name (plist-get (prop-match-value match) :name))
2950  (spec (cdr (assq name (append eplot--plot-headers
2951  eplot--chart-headers))))
2952  (value
2953  (or (plist-get (prop-match-value match) :value)
2954  (plist-get (prop-match-value match) :original-value))))
2955  (setq value (string-trim (string-replace "\u00A0" " " value)))
2956  (push (cons name
2957  (cl-case (plist-get spec :type)
2958  (number
2959  (string-to-number value))
2960  (symbol
2961  (intern (downcase value)))
2962  (symbol-list
2963  (mapcar #'intern (split-string (downcase value))))
2964  (t
2965  value)))
2966  settings)))))
2967  (with-current-buffer eplot--data-buffer
2968  (setq-local eplot--transient-settings (nreverse settings))
2969  (eplot-update-view-buffer))))
2970 
2971 (defvar eplot--column-width nil)
2972 
2973 (defun eplot-create-controls ()
2974  "Pop to a buffer that lists all parameters and allows editing."
2975  (interactive)
2976  (with-current-buffer (or eplot--data-buffer (current-buffer))
2977  (let ((settings eplot--transient-settings)
2978  (data-buffer (current-buffer))
2979  (chart eplot--current-chart)
2980  ;; Find the max width of all the different names.
2981  (width (seq-max
2982  (mapcar (lambda (e)
2983  (length (cadr e)))
2984  (apply #'append
2985  (mapcar #'cdr
2986  (apply #'append eplot--transients))))))
2987  (transients (mapcar #'copy-sequence
2988  (copy-sequence eplot--transients))))
2989  (unless chart
2990  (user-error "Must be called from an eplot buffer that has rendered a chart"))
2991  ;; Rearrange the transients a bit for better display.
2992  (let ((size (caar transients)))
2993  (setcar (car transients) (caadr transients))
2994  (setcar (cadr transients) size))
2995  (pop-to-buffer "*eplot controls*")
2996  (unless (eq major-mode 'eplot-control-mode)
2997  (eplot-control-mode))
2998  (setq-local eplot--data-buffer data-buffer
2999  eplot--column-width (+ width 12 2))
3000  (let ((inhibit-read-only t)
3001  (before-change-functions nil)
3002  (after-change-functions nil))
3003  (erase-buffer)
3004  (cl-loop for column in transients
3005  for cn from 0
3006  do
3007  (goto-char (point-min))
3008  (end-of-line)
3009  (cl-loop
3010  for row in column
3011  do
3012  (if (zerop cn)
3013  (when (not (bobp))
3014  (insert (format (format "%%-%ds" (+ width 14)) "")
3015  "\n"))
3016  (unless (= (count-lines (point-min) (point)) 1)
3017  (if (eobp)
3018  (progn
3019  (insert (format (format "%%-%ds" (+ width 14)) "")
3020  "\n")
3021  (insert (format (format "%%-%ds" (+ width 14)) "")
3022  "\n")
3023  (forward-line -1)
3024  (end-of-line))
3025  (forward-line 1)
3026  (end-of-line))))
3027  ;; If we have a too-long input in the first column,
3028  ;; then go to the next line.
3029  (when (and (> cn 0)
3030  (> (- (point) (pos-bol))
3031  (+ width 12 2)))
3032  (forward-line 1)
3033  (end-of-line))
3034  (insert (format (format "%%-%ds" (+ width 14))
3035  (propertize (pop row) 'face 'bold)))
3036  (if (looking-at "\n")
3037  (forward-line 1)
3038  (insert "\n"))
3039  (cl-loop
3040  for elem in row
3041  for name = (cadr elem)
3042  for slot = (intern (downcase name))
3043  when (null (nth 2 elem))
3044  do
3045  (let* ((object (if (assq slot eplot--chart-headers)
3046  chart
3047  (car (slot-value chart 'plots))))
3048  (value (format "%s"
3049  (or (cdr (assq slot settings))
3050  (if (not (slot-boundp object slot))
3051  ""
3052  (or (slot-value object slot)
3053  ""))))))
3054  (end-of-line)
3055  ;; If we have a too-long input in the first column,
3056  ;; then go to the next line.
3057  (when (and (> cn 0)
3058  (> (- (point) (pos-bol))
3059  (+ width 12 2)))
3060  (forward-line 1)
3061  (end-of-line))
3062  (when (and (> cn 0)
3063  (bolp))
3064  (insert (format (format "%%-%ds" (+ width 14)) "") "\n")
3065  (forward-line -1)
3066  (end-of-line))
3067  (insert (format (format "%%-%ds" (1+ width)) name))
3068  (eplot--input slot value
3069  (if (cdr (assq slot settings))
3070  'eplot--input-changed
3071  'eplot--input-default))
3072  (if (looking-at "\n")
3073  (forward-line 1)
3074  (insert "\n")))))))
3075  (goto-char (point-min)))))
3076 
3077 (defface eplot--input-default
3078  '((t :background "#505050"
3079  :foreground "#a0a0a0"
3080  :box (:line-width 1)))
3081  "Face for eplot default inputs.")
3082 
3083 (defface eplot--input-changed
3084  '((t :background "#505050"
3085  :foreground "white"
3086  :box (:line-width 1)))
3087  "Face for eplot changed inputs.")
3088 
3089 (defvar-keymap eplot--input-map
3090  :full t :parent text-mode-map
3091  "RET" #'eplot-control-update
3092  "TAB" #'eplot-input-complete
3093  "C-a" #'eplot-move-beginning-of-input
3094  "C-e" #'eplot-move-end-of-input
3095  "C-k" #'eplot-kill-input
3096  "C-<tab>" #'eplot-control-next-field
3097  "<backtab>" #'eplot-control-prev-field)
3098 
3099 (defun eplot-input-complete ()
3100  "Complete values in inputs."
3101  (interactive)
3102  (cond
3103  ((let ((completion-fail-discreetly t))
3104  (completion-at-point))
3105  ;; Completion was performed; nothing else to do.
3106  nil)
3107  ((not (get-text-property (point) 'input))
3108  (eplot-control-next-input))
3109  (t
3110  (user-error "No completion in this field"))))
3111 
3112 (defun eplot-move-beginning-of-input ()
3113  "Move to the start of the current input field."
3114  (interactive)
3115  (if (= (point) (eplot--beginning-of-field))
3116  (goto-char (pos-bol))
3117  (goto-char (eplot--beginning-of-field))))
3118 
3119 (defun eplot-move-end-of-input ()
3120  "Move to the end of the current input field."
3121  (interactive)
3122  (let ((input (get-text-property (point) 'input)))
3123  (if (or (not input)
3124  (= (point) (1- (plist-get input :end))))
3125  (goto-char (pos-eol))
3126  (goto-char (1+ (eplot--end-of-field))))))
3127 
3128 (defun eplot-control-next-field ()
3129  "Move to the beginning of the next field."
3130  (interactive)
3131  (let ((input (get-text-property (point) 'input))
3132  (start (point)))
3133  (when input
3134  (goto-char (plist-get input :end)))
3135  (let ((match (text-property-search-forward 'input)))
3136  (if match
3137  (goto-char (prop-match-beginning match))
3138  (goto-char start)
3139  (user-error "No next field")))))
3140 
3141 (defun eplot-control-prev-field ()
3142  "Move to the beginning of the previous field."
3143  (interactive)
3144  (let ((input (get-text-property (point) 'input))
3145  (start (point)))
3146  (when input
3147  (goto-char (plist-get input :start))
3148  (unless (bobp)
3149  (forward-char -1)))
3150  (let ((match (text-property-search-backward 'input)))
3151  (unless match
3152  (goto-char start)
3153  (user-error "No previous field")))))
3154 
3155 (defun eplot-kill-input ()
3156  "Remove the part of the input after point."
3157  (interactive)
3158  (let ((end (1+ (eplot--end-of-field))))
3159  (kill-new (string-trim (buffer-substring (point) end)))
3160  (delete-region (point) end)))
3161 
3162 (defun eplot--input (name value face)
3163  (let ((start (point))
3164  input)
3165  (insert value)
3166  (when (< (length value) 11)
3167  (insert (make-string (- 11 (length value)) ?\u00A0)))
3168  (put-text-property start (point) 'face face)
3169  (put-text-property start (point) 'inhibit-read-only t)
3170  (put-text-property start (point) 'input
3171  (setq input
3172  (list :name name
3173  :size 11
3174  :is-default (eq face 'eplot--input-default)
3175  :original-value value
3176  :original-face face
3177  :start (set-marker (make-marker) start)
3178  :value value)))
3179  (put-text-property start (point) 'local-map eplot--input-map)
3180  ;; This seems like a NOOP, but redoing the properties like this
3181  ;; somehow makes `delete-region' work better.
3182  (set-text-properties start (point) (text-properties-at start))
3183  (insert (propertize " " 'face face
3184  'input input
3185  'inhibit-read-only t
3186  'local-map eplot--input-map))
3187  (plist-put input :end (point-marker))
3188  (insert " ")))
3189 
3190 (defun eplot--end-of-field ()
3191  (- (plist-get (get-text-property (point) 'input) :end) 2))
3192 
3193 (defun eplot--beginning-of-field ()
3194  (plist-get (get-text-property (point) 'input) :start))
3195 
3196 (defvar eplot--prev-deletion nil)
3197 
3198 (defun eplot--process-text-input-before (beg end)
3199  (message "Before: %s %s" beg end)
3200  (cond
3201  ((= beg end)
3202  (setq eplot--prev-deletion nil))
3203  ((> end beg)
3204  (setq eplot--prev-deletion (buffer-substring beg end)))))
3205 
3206 (defun eplot--process-text-input (beg end _replace-length)
3207  ;;(message "After: %s %s %s %s" beg end replace-length eplot--prev-deletion)
3208  (when-let ((props (if eplot--prev-deletion
3209  (text-properties-at 0 eplot--prev-deletion)
3210  (if (get-text-property end 'input)
3211  (text-properties-at end)
3212  (text-properties-at beg))))
3213  (input (plist-get props 'input)))
3214  ;; The action concerns something in the input field.
3215  (let ((buffer-undo-list t)
3216  (inhibit-read-only t)
3217  (size (plist-get input :size)))
3218  (save-excursion
3219  (set-text-properties beg (- (plist-get input :end) 2) props)
3220  (goto-char (1- (plist-get input :end)))
3221  (let* ((remains (- (point) (plist-get input :start) 1))
3222  (trim (- size remains 1)))
3223  (if (< remains size)
3224  ;; We need to add some padding.
3225  (insert (apply #'propertize (make-string trim ?\u00A0)
3226  props))
3227  ;; We need to delete some padding, but only delete
3228  ;; spaces at the end.
3229  (setq trim (abs trim))
3230  (while (and (> trim 0)
3231  (eql (char-after (1- (point))) ?\u00A0))
3232  (delete-region (1- (point)) (point))
3233  (cl-decf trim))
3234  (when (> trim 0)
3235  (eplot--possibly-open-column)))))
3236  ;; We re-set the properties so that they are continguous. This
3237  ;; somehow makes the machinery that decides whether we can kill
3238  ;; a word work better.
3239  (set-text-properties (plist-get input :start)
3240  (1- (plist-get input :end)) props)
3241  ;; Compute what the value is now.
3242  (let ((value (buffer-substring-no-properties
3243  (plist-get input :start)
3244  (plist-get input :end))))
3245  (when (string-match "\u00A0+\\'" value)
3246  (setq value (substring value 0 (match-beginning 0))))
3247  (plist-put input :value value)))))
3248 
3249 (defun eplot--possibly-open-column ()
3250  (save-excursion
3251  (when-let ((input (get-text-property (point) 'input)))
3252  (goto-char (plist-get input :end)))
3253  (unless (looking-at " *\n")
3254  (skip-chars-forward " ")
3255  (while (not (eobp))
3256  (let ((text (buffer-substring (point) (pos-eol))))
3257  (delete-region (point) (pos-eol))
3258  (forward-line 1)
3259  (if (eobp)
3260  (insert (make-string eplot--column-width ?\s) text "\n")
3261  (forward-char eplot--column-width)
3262  (if (get-text-property (point) 'input)
3263  (forward-line 1)
3264  (insert text)
3265  ;; We have to fix up the markers.
3266  (save-excursion
3267  (let* ((match (text-property-search-backward 'input))
3268  (input (prop-match-value match)))
3269  (plist-put input :start
3270  (set-marker (plist-get input :start)
3271  (prop-match-beginning match)))
3272  (plist-put input :end
3273  (set-marker (plist-get input :end)
3274  (+ (prop-match-end match) 1))))))))))))
3275 
3276 (defun eplot--process-text-value (beg _end _replace-length)
3277  (when-let* ((input (get-text-property beg 'input)))
3278  (let ((inhibit-read-only t))
3279  (when (plist-get input :is-default)
3280  (put-text-property (plist-get input :start)
3281  (plist-get input :end)
3282  'face
3283  (if (equal (plist-get input :original-value)
3284  (plist-get input :value))
3285  'eplot--input-default
3286  'eplot--input-changed))))))
3287 
3288 (defun eplot--read-color (prompt)
3289  "Read an SVG color."
3290  (completing-read prompt eplot--colors))
3291 
3292 (eval `(transient-define-prefix eplot-customize ()
3293  "Customize Chart"
3294  ,@(eplot--define-transients)))
3295 
3296 (defun eplot--bezier (factor i points)
3297  (cl-labels ((padd (p1 p2)
3298  (cons (+ (car p1) (car p2)) (+ (cdr p1) (cdr p2))))
3299  (psub (p1 p2)
3300  (cons (- (car p1) (car p2)) (- (cdr p1) (cdr p2))))
3301  (pscale (factor point)
3302  (cons (* factor (car point)) (* factor (cdr point)))))
3303  (let* ((start (elt points (1- i)))
3304  (end (elt points i))
3305  (prev (if (< (- i 2) 0)
3306  start
3307  (elt points (- i 2))))
3308  (next (if (> (1+ i) (1- (length points)))
3309  end
3310  (elt points (1+ i))))
3311  (start-control-point
3312  (padd start (pscale factor (psub end prev))))
3313  (end-control-point
3314  (padd end (pscale factor (psub start next)))))
3315  (list (car start-control-point)
3316  (cdr start-control-point)
3317  (car end-control-point)
3318  (cdr end-control-point)
3319  (car end)
3320  (cdr end)))))
3321 
3322 ;;; CSV Parsing Stuff.
3323 
3324 (defun eplot--csv-buffer-p ()
3325  (save-excursion
3326  (goto-char (point-min))
3327  (let ((min 1.0e+INF)
3328  (max -1.0e+INF)
3329  (total 0)
3330  (lines 0))
3331  (while (not (eobp))
3332  (let ((this 0))
3333  (while (search-forward "," (pos-eol) t)
3334  (cl-incf total)
3335  (cl-incf this))
3336  (forward-line 1)
3337  (cl-incf lines)
3338  (setq min (min min this)
3339  max (max max this))))
3340  (let ((mid (e/ total lines)))
3341  ;; If we have a comma on each line, and it's fairly evenly
3342  ;; distributed, it's a CSV buffer.
3343  (and (>= min 1)
3344  (< (* mid 0.9) min)
3345  (> (* mid 1.1) max))))))
3346 
3347 (defun eplot--numericalp (value)
3348  (string-match-p "\\`[-.0-9]*\\'" value))
3349 
3350 (defun eplot--numberish (value)
3351  (if (or (zerop (length value))
3352  (not (eplot--numericalp value)))
3353  value
3354  (string-to-number value)))
3355 
3356 (defun eplot--parse-csv-buffer ()
3357  (unless (fboundp 'pcsv-parse-buffer)
3358  (user-error "You need to install the pcsv package to parse CSV files"))
3359  (let ((csv (and (fboundp 'pcsv-parse-buffer)
3360  ;; This repeated check is just to silence the byte
3361  ;; compiler.
3362  (pcsv-parse-buffer)))
3363  names)
3364  ;; Check whether the first line looks like a header.
3365  (when (and (length> csv 1)
3366  ;; The second line is all numbers...
3367  (cl-every #'eplot--numericalp (nth 1 csv))
3368  ;; .. and the first line isn't.
3369  (not (cl-every #'eplot--numericalp (nth 0 csv))))
3370  (setq names (pop csv)))
3371  (list
3372  (cons 'legend (and names "true"))
3373  (cons :plots
3374  (cl-loop
3375  for column from 1 upto (1- (length (car csv)))
3376  collect
3377  (list (cons :headers
3378  (list
3379  (cons 'name (elt names column))
3380  (cons 'data-format
3381  (cond
3382  ((cl-every (lambda (e) (<= (length e) 4))
3383  (mapcar #'car csv))
3384  "year")
3385  ((cl-every (lambda (e) (= (length e) 8))
3386  (mapcar #'car csv))
3387  "date")
3388  (t
3389  "number")))
3390  (cons 'color (eplot--vary-color "vary" (1- column)))))
3391  (cons
3392  :values
3393  (cl-loop for line in csv
3394  collect (list :x (eplot--numberish (car line))
3395  :value (eplot--numberish
3396  (elt line column)))))))))))
3397 
3398 (declare-function org-element-parse-buffer "org-element")
3399 
3400 (defun eplot--parse-org-buffer ()
3401  (require 'org-element)
3402  (let* ((table (nth 2 (nth 2 (org-element-parse-buffer))))
3403  (columns (cl-loop for cell in (nthcdr 2 (nth 2 table))
3404  collect (substring-no-properties (nth 2 cell))))
3405  (value-column (or (seq-position columns "value") 0))
3406  (date-column (seq-position columns "date")))
3407  `((:plots
3408  ((:headers
3409  ,@(and date-column '((data-format . "date"))))
3410  (:values
3411  ,@(cl-loop for row in (nthcdr 4 table)
3412  collect
3413  (let ((cells (cl-loop for cell in (nthcdr 2 row)
3414  collect (substring-no-properties
3415  (nth 2 cell)))))
3416  (list :value (string-to-number (elt cells value-column))
3417  :x (string-to-number
3418  (replace-regexp-in-string
3419  "[^0-9]" "" (elt cells date-column)))
3420  )))))))))
3421 
3422 (provide 'eplot)
3423 
3424 ;;; eplot.el ends here