1 ;;; chartg.el --- Google charts (and maybe other)
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
4 ;; Created: 2008-04-06 Sun
5 (defconst chart:version "0.2") ;; Version:
11 ;; Features that might be required by this library:
15 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
21 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; This program is free software; you can redistribute it and/or
29 ;; modify it under the terms of the GNU General Public License as
30 ;; published by the Free Software Foundation; either version 2, or
31 ;; (at your option) any later version.
33 ;; This program is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
36 ;; General Public License for more details.
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with this program; see the file COPYING. If not, write to
40 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
41 ;; Floor, Boston, MA 02110-1301, USA.
43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
47 (eval-when-compile (require 'cl))
49 (defconst chartg-types
54 (bar-chartg-horizontal bhs)
55 (bar-chartg-vertical bvs)
56 (bar-chartg-horizontal-grouped bhg)
57 (bar-chartg-vertical-grouped bvg)
60 (pie-3-dimensional p3)
66 (radar-chartg-w-splines rs)
71 (defconst chartg-types-keywords
73 (symbol-name (car rec)))
76 (defvar chartg-mode-keywords-and-states
77 '(("Output-file:" (accept file-name))
78 ("Size:" (accept number))
79 ("Data:" (accept number))
80 ("Type:" (accept chartg-type))
83 (defvar chartg-mode-keywords
86 chartg-mode-keywords-and-states))
88 ;; Fix-me: I started to implement a parser, but I think I will drop it
89 ;; and wait for Semantic to be easily available instead. Or just use
92 (defvar chartg-intermediate-states
93 '((end-or-label (or end-of-file label))
96 (defvar chartg-extra-keywords-and-states
103 ("Chartg-title:" (and string end-or-label))
104 ("Legends:" (accept string))
110 ("Bar-chartg-zero-line:")
111 ("Bar-chartg-zero-line-2:")
119 (defvar chartg-extra-keywords
120 (mapcar (lambda (rec)
122 chartg-extra-keywords-and-states))
124 (defvar chartg-raw-keywords-and-states
126 ("Google-chartg-raw:" (accept string))
129 (defvar chartg-raw-keywords
130 (mapcar (lambda (rec)
132 chartg-raw-keywords-and-states))
134 (defvar chartg-mode-keywords-re (regexp-opt chartg-mode-keywords))
135 (defvar chartg-extra-keywords-re (regexp-opt chartg-extra-keywords))
136 (defvar chartg-types-keywords-re (regexp-opt chartg-types-keywords))
137 (defvar chartg-raw-keywords-re (regexp-opt chartg-raw-keywords))
139 (defvar chartg-font-lock-keywords
140 `((,chartg-mode-keywords-re . font-lock-keyword-face)
141 (,chartg-extra-keywords-re . font-lock-variable-name-face)
142 (,chartg-types-keywords-re . font-lock-function-name-face)
143 (,chartg-raw-keywords-re . font-lock-preprocessor-face)
146 (defvar chartg-font-lock-defaults
147 '(chartg-font-lock-keywords nil t))
149 (defvar chartg-mode-syntax-table
150 (let ((table (make-syntax-table)))
151 (modify-syntax-entry ?\n "> " table)
152 (modify-syntax-entry ?\; "< " table)
155 (defun chartg-create (provider out-file size data type
156 title legends &optional extras)
157 "Create a chart image.
158 PROVIDER is what to use for creating the chart. Currently only
159 `google' for Google's chart API is supported.
161 OUT-FILE is where the image goes.
163 SIZE is a cons cell with pixel width and height.
165 DATA is the data to draw the chart from. It is a list of data
166 sets where each data set has the form:
168 (list (list NUMBERS ...) (MIN . MAX)))
170 TYPE can be the following:
174 - lc: Line chart with only y values. Each dataset is a new
177 - lxy: Line chart with both x and y values. For each line there
178 should be a pair of datasets, the first for x and the second
179 for y. If the x dataset just contains a single -1 then values
180 are evenly spaced along the x-axis.
182 - ls: Like above, but axis are not drawn.
186 - bhs: horizontal bars.
187 - bvs: vertical bars.
188 - bhg, bvg: dito grouped.
192 - cht=p: one dimensional
193 - cht=p3: three dimensional
197 - cht=v: data should be specified as
198 * the first three values specify the relative sizes of three
200 * the fourth value specifies the area of A intersecting B
201 * the fifth value specifies the area of A intersecting C
202 * the sixth value specifies the area of B intersecting C
203 * the seventh value specifies the area of A intersecting B
208 - cht=s: Supply a pair of datasets, first for x and second for
213 - cht=r: straight lines.
216 You will have to find out the format of the datasets
217 yourself, I don't understand it ;-)
219 Or perhaps mail google?
227 - chtm=AREA: AREA for provider `google' is currently one of
238 - cht=gom: A speed meter type meter. Takes a single value.
240 TITLE is a string to use as title.
242 LEGENDS is a list of labels to put on the data.
244 EXTRAS is a list of extra arguments with the form
246 (EXTRA-TYPE EXTRA-VALUE)
248 Where EXTRA-TYPE is the extra argument type and EXTRA-VALUE the
249 value. The following EXTRA-TYPEs are supported:
251 * COLORS: value is a list of colors corresponding to the list of
252 DATA. Each color have the format RRGGBB or RRGGBBTT where the
253 first form is the normal way to specify colors in rgb-format
254 and the second has an additional TT for transparence. TT=00
255 means completely transparent and TT=FF means completely opaque.
257 FILL-AREA are fill colors for data sets in line charts. It should
260 (list COLOR START-INDEX END-INDEX)
263 (message "(chartg-create %s %s %s %s %s %s %s" provider out-file size data type
265 (unless (symbolp type)
266 (error "Argument TYPE should be a symbol"))
267 (unless (assoc type chartg-types)
268 (error "Unknown chart type: %s" type))
270 ((eq provider 'google)
271 (let* ((g-type (nth 1 (assoc type chartg-types)))
274 ;;(size-par (format "&chs=%sx%s" width height))
285 "http://chart.apis.google.com/chart?cht=%s&chs=%dx%d" g-type width height))
286 ;;(setq url (concat url size-par))
291 (let* ((rec-numbers (car rec))
294 (dolist (num rec-numbers)
297 (number-to-string num)
298 (concat str "," (number-to-string num)))))
300 (rec-scale (cadr rec))
301 (rec-min (car rec-scale))
302 (rec-max (cdr rec-scale))
303 (scale-str (when rec-scale (format "%s,%s" rec-min rec-max)))
307 (setq numbers (concat "&chd=t:" number-str))
309 (memq g-type '(p p3 gom)))
310 (setq scales (concat "&chds=" scale-str))))
311 (setq numbers (concat numbers "|" number-str))
313 (setq scales (concat scales "," scale-str))))))
314 (setq url (concat url numbers))
315 (when scales (setq url (concat url scales)))
316 ;; fix-me: encode the url
317 (when title (setq url (concat url "&chtt=" (url-hexify-string title))))
319 (let ((url-legends (mapconcat 'url-hexify-string legends "|"))
320 (arg (if (memq g-type '(p p3 gom))
323 (setq url (concat url arg url-legends))))
324 (dolist (extra extras)
325 (let ((extra-type (car extra))
326 (extra-value (cdr extra)))
328 ((eq extra-type 'GOOGLE-RAW)
329 (setq url (concat url extra-value)))
330 ((eq extra-type 'colors)
332 (dolist (color extra-value)
334 (setq colors-par (concat "&chco=" color))
335 (setq colors-par (concat colors-par "," color))))
336 (when colors-par (setq url (concat url colors-par))))
337 (t (error "Unsupported extra type: %s" extra-type)))))
339 ;;(lwarn t :warning "url=%s" url)(top-level)
340 ;;(setq url (concat url "&chxt=y"))
341 (message "Sending %s" url)
343 (with-current-buffer (url-retrieve-synchronously url)
344 (goto-char (point-min))
345 (if (search-forward "\n\n" nil t)
346 (buffer-substring-no-properties (point) (point-max))
347 (view-buffer-other-window (current-buffer))
348 (error "Bad content"))))
349 (let* ((is-html (string-match-p "</body></html>" content))
352 (setq out-file (concat (file-name-sans-extension out-file) ".html")))
353 (expand-file-name out-file)
355 (do-it (or (not (file-exists-p fname))
357 (concat "File " fname " exists. Replace it? "))))
358 (buf (find-buffer-visiting fname))
359 (this-window (selected-window)))
361 (when buf (kill-buffer buf))
362 (with-temp-file fname
365 (view-file-other-window fname)
366 (chartg-show-last-error-file fname))
367 (select-window this-window)))))
368 (t (error "Unknown provider: %s" provider)))
371 (defun chartg-show-last-error-file (fname)
373 (with-output-to-temp-buffer (help-buffer)
374 (help-setup-xref (list #'chartg-show-last-error-file fname) (interactive-p))
375 (with-current-buffer (help-buffer)
376 (insert "Error, see ")
377 (insert-text-button "result error page"
380 (browse-url ,fname))))))
382 (defvar chartg-mode-map
383 (let ((map (make-sparse-keymap)))
384 (define-key map [(meta tab)] 'chartg-complete)
385 (define-key map [(control ?c) (control ?c)] 'chartg-make-chart)
388 (defun chartg-missing-keywords ()
389 (let ((collection (copy-sequence chartg-mode-keywords)))
393 (goto-char (point-min))
394 (while (re-search-forward chartg-mode-keywords-re nil t)
396 (delete (match-string-no-properties 0)
401 (defun chartg-complete ()
403 (let* ((here (point))
404 (partial (when (looking-back (rx word-start
407 (match-string-no-properties 0)))
408 (part-pos (if partial
412 (state (catch 'pos-state (chartg-get-state (point))))
413 (msg "No completions")
420 ((or (= (current-column) 0)
421 (equal state 'need-label))
422 (setq collection (append (chartg-missing-keywords)
423 chartg-extra-keywords
426 (setq prompt "Label: "))
427 ((equal state '(accept number))
429 (setq msg (propertize "Needs a number here!"
430 'face 'secondary-selection)))
431 ((equal state '(accept chartg-type))
432 (setq collection chartg-types-keywords)
433 (setq prompt "Chart type: "))
434 ((equal state '(accept file-name))
436 (concat "\"" (read-file-name "Output-file: "
438 ;; fix-me: handle partial
442 (let ((all (if partial
443 (all-completions partial collection)
446 (if (= (length all) 1)
448 (completing-read prompt collection nil t partial)))))))
451 (insert (substring res (length partial))))))
454 (defun chartg-get-state (want-pos-state)
455 (let* (par-output-file
458 par-data par-data-temp
459 par-data-min par-data-max
473 (unless (re-search-backward chartg-mode-keywords-re nil t)
474 (goto-char (point-min)))
475 (goto-char (point-min)))
487 (setq pos-state state)
488 (setq token-before-pos (point))
490 (setq token (read (current-buffer)))
492 (if (eq (car err) 'end-of-file)
493 (unless (or (eq state 'need-label)
494 (member '(quote |) state))
495 (throw 'problems (format "Unexpected end, state=%s" state)))
497 (error-message-string err)))))))
498 (message "token=%s, label=%s, state=%s" token current-label state)
499 (when (and want-pos-state
500 (>= (point) want-pos-state))
501 (when (= (point) want-pos-state)
503 (setq pos-state nil))
505 (throw 'pos-state pos-state))
506 (when (and (listp state) (memq 'number state))
507 (unless (numberp token)
509 (let ((token-str (format "%s" token)))
510 (setq token-str (replace-regexp-in-string "\\([0-9]\\),\\([0-9]\\)" "\\1\\2" token-str))
511 (when (string-match-p "^[0-9]+$" token-str)
512 (setq token (string-to-number token-str)))))))
515 ((eq state 'need-label)
516 (unless (symbolp token)
517 (throw 'problems (format "Expected label, got %s" token)))
518 (unless (member (symbol-name token)
519 (append chartg-mode-keywords
520 chartg-extra-keywords
523 (throw 'problems (format "Unknown label %s" token)))
524 (when (member (symbol-name token) found-labels)
525 (throw 'problems (format "Label %s defined twice" token)))
526 (setq current-label token)
527 (setq found-labels (cons current-label found-labels))
529 ;;(setq state 'need-value)
532 (setq state '(accept file-name)))
534 (setq state '(accept number)))
536 (setq state '(accept number)))
538 (setq state '(accept chartg-type)))
540 (setq state '(accept string)))
542 (setq state '(accept string)))
544 (setq state '(accept string)))
548 ((equal state '(accept '| symbol))
553 (setq state '(accept string)))
554 (t (error "internal error, current-label=%s, state=%s" current-label state)))
558 (setq state 'need-label))
559 (throw 'problems (format "Expected | or label, got %s" token)))))
561 ((equal state '(accept string))
562 (unless (stringp token)
563 (throw 'problems "Expected string"))
566 (setq par-title token)
568 (setq state 'need-label))
570 (setq par-legends (cons token par-legends))
572 (setq state '(accept '| symbol)))
574 (setq par-google-raw token)
576 (setq state 'need-label))
577 (t (error "internal error, current-label=%s, state=%s" current-label state))))
579 ((equal state '(accept file-name))
580 (unless (stringp token)
581 (throw 'problems "Expected file name string"))
582 (assert (eq current-label 'Output-file:))
583 (setq par-output-file token)
585 (setq state 'need-label))
587 ((equal state '(accept number))
588 (unless (numberp token)
589 (throw 'problems "Expected number"))
594 (setq par-size token)
596 (setq state '(accept number 'x 'X)))
597 (setq par-size (cons par-size token))
599 (setq state 'need-label)))
601 ;;(assert (not par-data-temp))
602 (setq par-data-temp (cons token par-data-temp))
603 (setq par-data-min token)
604 (setq par-data-max token)
606 (setq state '(accept number ', '| symbol))
608 (t (error "internal error, state=%s, current-label=%s" state current-label)))
611 ((equal state '(accept number ', '| symbol))
614 (setq par-data-min (if par-data-min (min par-data-min token) token))
615 (setq par-data-max (if par-data-max (max par-data-max token) token))
616 (setq par-data-temp (cons token par-data-temp))
617 (message "par-data-min/max=%s/%s, token=%s -- %s" par-data-min par-data-max token par-data-temp)
621 (if (or (eq '| token)
624 (unless par-data-temp
625 (throw 'problems "Empty data set"))
626 (setq par-data (cons (list (reverse par-data-temp) (cons par-data-min par-data-max)) par-data))
627 (setq par-data-temp nil)
628 (setq par-data-min nil)
629 (setq par-data-max nil)
630 (if (not (eq '| token))
631 (setq state 'need-label)
632 (setq state '(accept number))
634 (throw 'problems "Expected | or EOF")
637 ((equal state '(accept number 'x 'X))
638 (assert (eq current-label 'Size:))
639 (let ((is-n (numberp token))
640 (is-x (memq token '(x X))))
641 (unless (or is-n is-x)
642 (throw 'problems "Expected X or number"))
646 (setq state '(accept number)))
647 (setq par-size (cons par-size token))
649 (setq state 'need-label))))
651 ((equal state '(accept chartg-type))
652 (setq par-type token)
653 (unless (assoc par-type chartg-types)
654 (throw 'problems (format "Unknown chart type: %s" par-type)))
656 (setq state 'need-label))
657 (t (error "internal error, state=%s" state))))))
663 (throw 'pos-state state))
665 (let ((missing-lab (chartg-missing-keywords)))
667 (setq problems (format "Missing required labels: %s" missing-lab)))))
669 (let ((msg (if (listp problems)
672 (where (if (listp problems)
676 (skip-chars-forward " \t")
679 ;;(defun chartg-create (out-file provider size data type &rest extras)
680 (setq par-provider 'google)
681 (setq par-legends (nreverse par-legends))
684 (setq extras (cons (cons 'GOOGLE-RAW par-google-raw) extras)))
685 (chartg-create par-provider par-output-file par-size
686 par-data par-type par-title par-legends extras))
690 (defun chartg-make-chart ()
691 "Try to make a new chart.
692 If region is active then make a new chart from data in the
695 Else if current buffer is in `chartg-mode' then do it from the
696 chart specifications in this buffer. Otherwise create a new
697 buffer and initialize it with `chartg-mode'.
699 If the chart specifications are complete enough to make a chart
700 then do it and show the resulting chart image. If not then tell
701 user what is missing.
703 NOTE: This is beta, no alpha code. It is not ready.
705 Below are some examples. To test them mark an example and do
707 M-x chartg-make-chart
709 * Example, simple x-y chart:
711 Output-file: \"~/temp-chart.png\"
713 Data: 3 8 5 | 10 20 30
718 Output-file: \"~/temp-depression.png\"
729 Type: pie-3-dimensional
730 Chartg-title: \"Depression hits on Google\"
744 Output-file: \"~/temp-panic.png\"
755 Type: pie-3-dimensional
756 Chartg-title: \"Depression hits on Google\"
770 Output-file: \"~/temp-chartg-slipsen-kostar.png\"
773 Type: bar-chartg-horizontal
774 Chartg-title: \"Vad killen i slips tjänar jämfört med dig och mig\"
775 Google-chartg-raw: \"&chds=0,30000&chco=00cd00|ff4500|483d8b&chxt=y,x&chxl=0:|Killen+i+slips|Partiledarna|Du+och+jag&chf=bg,s,ffd700\"
781 (let* ((rb (region-beginning))
783 (data (buffer-substring-no-properties rb re))
784 (buf (generate-new-buffer "*Chart from region*")))
785 (switch-to-buffer buf)
788 (unless (eq major-mode 'chartg-mode)
789 (switch-to-buffer (generate-new-buffer "*Chart*"))
791 (chartg-get-state nil))
793 ;; (defun chartg-from-region (min max)
794 ;; "Try to make a new chart from data in selected region.
795 ;; See `chartg-mode' for examples you can test with this function."
797 ;; (unless mark-active (error "No region selected"))
798 ;; (let* ((rb (region-beginning))
800 ;; (data (buffer-substring-no-properties rb re))
801 ;; (buf (generate-new-buffer "*Chart from region*")))
802 ;; (switch-to-buffer buf)
805 ;; (chartg-get-state nil)))
807 (define-derived-mode chartg-mode fundamental-mode "Chart"
808 "Mode for specifying charts.
811 To make a chart see `chartg-make-chart'.
814 (set (make-local-variable 'font-lock-defaults) chartg-font-lock-defaults)
815 (set (make-local-variable 'comment-start) ";")
816 ;; Look within the line for a ; following an even number of backslashes
817 ;; after either a non-backslash or the line beginning.
818 (set (make-local-variable 'comment-start-skip)
819 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
820 ;; Font lock mode uses this only when it KNOWS a comment is starting.
821 (set (make-local-variable 'font-lock-comment-start-skip) ";+ *")
822 (set (make-local-variable 'comment-add) 1) ;default to `;;' in comment-region
823 (set (make-local-variable 'comment-column) 40)
824 ;; Don't get confused by `;' in doc strings when paragraph-filling.
825 (set (make-local-variable 'comment-use-global-state) t)
826 (set-syntax-table chartg-mode-syntax-table)
827 (when (looking-at (rx buffer-start (0+ whitespace) buffer-end))
828 (insert ";; Type C-c C-c to make a chart, M-Tab to complete\n"))
829 (let ((missing (chartg-missing-keywords)))
832 (goto-char (point-max))
833 (dolist (miss missing)
834 (insert "\n" miss " "))))))
837 ;;(chartg-create 'google "temp.png" '(200 . 150) '(((90 70) . nil)) 'pie-3-dimensional "test title" nil '((colors "FFFFFF" "00FF00")))
840 (add-to-list 'auto-mode-alist '("\\.mx-chart\\'" . chartg-mode))
843 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
844 ;;; chartg.el ends here