;;; chartg.el --- Google charts (and maybe other) ;; ;; Author: Lennart Borgman (lennart O borgman A gmail O com) ;; Created: 2008-04-06 Sun (defconst chart:version "0.2") ;; Version: ;; Last-Updated: ;; URL: ;; Keywords: ;; Compatibility: ;; ;; Features that might be required by this library: ;; ;; None ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: ;; ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Change log: ;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 2, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Code: (eval-when-compile (require 'cl)) (defconst chartg-types '((line-chartg-x lc) (line-chartg-xy lxy) (line-chart ls) (bar-chartg-horizontal bhs) (bar-chartg-vertical bvs) (bar-chartg-horizontal-grouped bhg) (bar-chartg-vertical-grouped bvg) (pie-2-dimensional p) (pie-3-dimensional p3) (venn-diagram v) (scatter-plot s) (radar-chart r) (radar-chartg-w-splines rs) (geographical-map t) (meter gom))) (defconst chartg-types-keywords (mapcar (lambda (rec) (symbol-name (car rec))) chartg-types)) (defvar chartg-mode-keywords-and-states '(("Output-file:" (accept file-name)) ("Size:" (accept number)) ("Data:" (accept number)) ("Type:" (accept chartg-type)) )) (defvar chartg-mode-keywords (mapcar (lambda (rec) (car rec)) chartg-mode-keywords-and-states)) ;; Fix-me: I started to implement a parser, but I think I will drop it ;; and wait for Semantic to be easily available instead. Or just use ;; Calc/Org Tables. (defvar chartg-intermediate-states '((end-or-label (or end-of-file label)) )) (defvar chartg-extra-keywords-and-states '( ;;("Provider:") ("Colors:") ("Solid-fill:") ("Linear-gradient:") ("Linear-stripes:") ("Chartg-title:" (and string end-or-label)) ("Legends:" (accept string)) ("Axis-types:") ("Axis-labels:") ("Axis-ranges:") ("Axis-styles:") ("Bar-thickness:") ("Bar-chartg-zero-line:") ("Bar-chartg-zero-line-2:") ("Line-styles-1:") ("Line-styles-2:") ("Grid-lines:") ("Shape-markers:") ("Range-markers:") )) (defvar chartg-extra-keywords (mapcar (lambda (rec) (car rec)) chartg-extra-keywords-and-states)) (defvar chartg-raw-keywords-and-states '( ("Google-chartg-raw:" (accept string)) )) (defvar chartg-raw-keywords (mapcar (lambda (rec) (car rec)) chartg-raw-keywords-and-states)) (defvar chartg-mode-keywords-re (regexp-opt chartg-mode-keywords)) (defvar chartg-extra-keywords-re (regexp-opt chartg-extra-keywords)) (defvar chartg-types-keywords-re (regexp-opt chartg-types-keywords)) (defvar chartg-raw-keywords-re (regexp-opt chartg-raw-keywords)) (defvar chartg-font-lock-keywords `((,chartg-mode-keywords-re . font-lock-keyword-face) (,chartg-extra-keywords-re . font-lock-variable-name-face) (,chartg-types-keywords-re . font-lock-function-name-face) (,chartg-raw-keywords-re . font-lock-preprocessor-face) )) (defvar chartg-font-lock-defaults '(chartg-font-lock-keywords nil t)) (defvar chartg-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\n "> " table) (modify-syntax-entry ?\; "< " table) table)) (defun chartg-create (provider out-file size data type title legends &optional extras) "Create a chart image. PROVIDER is what to use for creating the chart. Currently only `google' for Google's chart API is supported. OUT-FILE is where the image goes. SIZE is a cons cell with pixel width and height. DATA is the data to draw the chart from. It is a list of data sets where each data set has the form: (list (list NUMBERS ...) (MIN . MAX))) TYPE can be the following: * Line charts - lc: Line chart with only y values. Each dataset is a new line. - lxy: Line chart with both x and y values. For each line there should be a pair of datasets, the first for x and the second for y. If the x dataset just contains a single -1 then values are evenly spaced along the x-axis. - ls: Like above, but axis are not drawn. * Bar charts: - bhs: horizontal bars. - bvs: vertical bars. - bhg, bvg: dito grouped. * Pie charts: - cht=p: one dimensional - cht=p3: three dimensional * Venn diagrams - cht=v: data should be specified as * the first three values specify the relative sizes of three circles, A, B, and C * the fourth value specifies the area of A intersecting B * the fifth value specifies the area of A intersecting C * the sixth value specifies the area of B intersecting C * the seventh value specifies the area of A intersecting B intersecting C * Scatter plots - cht=s: Supply a pair of datasets, first for x and second for y coordinates. * Radar charts - cht=r: straight lines. - cht=rs: splines. You will have to find out the format of the datasets yourself, I don't understand it ;-) Or perhaps mail google? * Maps - cht=t together with - chtm=AREA: AREA for provider `google' is currently one of * africa * asia * europe * middle_east * south_america * usa * world * Meter - cht=gom: A speed meter type meter. Takes a single value. TITLE is a string to use as title. LEGENDS is a list of labels to put on the data. EXTRAS is a list of extra arguments with the form (EXTRA-TYPE EXTRA-VALUE) Where EXTRA-TYPE is the extra argument type and EXTRA-VALUE the value. The following EXTRA-TYPEs are supported: * COLORS: value is a list of colors corresponding to the list of DATA. Each color have the format RRGGBB or RRGGBBTT where the first form is the normal way to specify colors in rgb-format and the second has an additional TT for transparence. TT=00 means completely transparent and TT=FF means completely opaque. FILL-AREA are fill colors for data sets in line charts. It should be a list (list COLOR START-INDEX END-INDEX) " (message "(chartg-create %s %s %s %s %s %s %s" provider out-file size data type title legends) (unless (symbolp type) (error "Argument TYPE should be a symbol")) (unless (assoc type chartg-types) (error "Unknown chart type: %s" type)) (cond ((eq provider 'google) (let* ((g-type (nth 1 (assoc type chartg-types))) (width (car size)) (height (cdr size)) ;;(size-par (format "&chs=%sx%s" width height)) ;; numbers scales colors-par ;; url content ) (setq url (format "http://chart.apis.google.com/chart?cht=%s&chs=%dx%d" g-type width height)) ;;(setq url (concat url size-par)) ;; Data and scales (unless data (error "No data")) (dolist (rec data) (let* ((rec-numbers (car rec)) (number-str (let (str) (dolist (num rec-numbers) (setq str (if (not str) (number-to-string num) (concat str "," (number-to-string num))))) str)) (rec-scale (cadr rec)) (rec-min (car rec-scale)) (rec-max (cdr rec-scale)) (scale-str (when rec-scale (format "%s,%s" rec-min rec-max))) ) (if (not numbers) (progn (setq numbers (concat "&chd=t:" number-str)) (when (or scale-str (memq g-type '(p p3 gom))) (setq scales (concat "&chds=" scale-str)))) (setq numbers (concat numbers "|" number-str)) (when scale-str (setq scales (concat scales "," scale-str)))))) (setq url (concat url numbers)) (when scales (setq url (concat url scales))) ;; fix-me: encode the url (when title (setq url (concat url "&chtt=" (url-hexify-string title)))) (when legends (let ((url-legends (mapconcat 'url-hexify-string legends "|")) (arg (if (memq g-type '(p p3 gom)) "&chl=" "&chdl="))) (setq url (concat url arg url-legends)))) (dolist (extra extras) (let ((extra-type (car extra)) (extra-value (cdr extra))) (cond ((eq extra-type 'GOOGLE-RAW) (setq url (concat url extra-value))) ((eq extra-type 'colors) ;; Colors (dolist (color extra-value) (if (not colors-par) (setq colors-par (concat "&chco=" color)) (setq colors-par (concat colors-par "," color)))) (when colors-par (setq url (concat url colors-par)))) (t (error "Unsupported extra type: %s" extra-type))))) ;;(lwarn t :warning "url=%s" url)(top-level) ;;(setq url (concat url "&chxt=y")) (message "Sending %s" url) (setq content (with-current-buffer (url-retrieve-synchronously url) (goto-char (point-min)) (if (search-forward "\n\n" nil t) (buffer-substring-no-properties (point) (point-max)) (view-buffer-other-window (current-buffer)) (error "Bad content")))) (let* ((is-html (string-match-p "" content)) (fname (progn (when is-html (setq out-file (concat (file-name-sans-extension out-file) ".html"))) (expand-file-name out-file) )) (do-it (or (not (file-exists-p fname)) (y-or-n-p (concat "File " fname " exists. Replace it? ")))) (buf (find-buffer-visiting fname)) (this-window (selected-window))) (when do-it (when buf (kill-buffer buf)) (with-temp-file fname (insert content)) (if (not is-html) (view-file-other-window fname) (chartg-show-last-error-file fname)) (select-window this-window))))) (t (error "Unknown provider: %s" provider))) ) (defun chartg-show-last-error-file (fname) (interactive) (with-output-to-temp-buffer (help-buffer) (help-setup-xref (list #'chartg-show-last-error-file fname) (interactive-p)) (with-current-buffer (help-buffer) (insert "Error, see ") (insert-text-button "result error page" 'action `(lambda (btn) (browse-url ,fname)))))) (defvar chartg-mode-map (let ((map (make-sparse-keymap))) (define-key map [(meta tab)] 'chartg-complete) (define-key map [(control ?c) (control ?c)] 'chartg-make-chart) map)) (defun chartg-missing-keywords () (let ((collection (copy-sequence chartg-mode-keywords))) (save-excursion (save-restriction (widen) (goto-char (point-min)) (while (re-search-forward chartg-mode-keywords-re nil t) (setq collection (delete (match-string-no-properties 0) collection))))) collection)) ;;;###autoload (defun chartg-complete () (interactive) (let* ((here (point)) (partial (when (looking-back (rx word-start (optional ?\") (0+ (any "[a-z]")))) (match-string-no-properties 0))) (part-pos (if partial (match-beginning 0) (setq partial "") (point))) (state (catch 'pos-state (chartg-get-state (point)))) (msg "No completions") collection all prompt res) (when state (cond ((or (= (current-column) 0) (equal state 'need-label)) (setq collection (append (chartg-missing-keywords) chartg-extra-keywords chartg-raw-keywords nil)) (setq prompt "Label: ")) ((equal state '(accept number)) (setq res nil) (setq msg (propertize "Needs a number here!" 'face 'secondary-selection))) ((equal state '(accept chartg-type)) (setq collection chartg-types-keywords) (setq prompt "Chart type: ")) ((equal state '(accept file-name)) (setq res (concat "\"" (read-file-name "Output-file: " nil ;; fix-me: handle partial partial) "\"")))) (when collection (let ((all (if partial (all-completions partial collection) collection))) (setq res (when all (if (= (length all) 1) (car all) (completing-read prompt collection nil t partial))))))) (if (not res) (message "%s" msg) (insert (substring res (length partial)))))) (defun chartg-get-state (want-pos-state) (let* (par-output-file par-provider par-size par-data par-data-temp par-data-min par-data-max par-type par-title par-legends par-google-raw (here (point)) token-before-pos pos-state (state 'need-label) (problems (catch 'problems (save-restriction ;;(widen) (if want-pos-state (unless (re-search-backward chartg-mode-keywords-re nil t) (goto-char (point-min))) (goto-char (point-min))) (let (this-keyword this-start this-end params token token-pos next-token found-labels current-label) (while (or token (progn (setq pos-state state) (setq token-before-pos (point)) (condition-case err (setq token (read (current-buffer))) (error (if (eq (car err) 'end-of-file) (unless (or (eq state 'need-label) (member '(quote |) state)) (throw 'problems (format "Unexpected end, state=%s" state))) (throw 'problems (error-message-string err))))))) (message "token=%s, label=%s, state=%s" token current-label state) (when (and want-pos-state (>= (point) want-pos-state)) (when (= (point) want-pos-state) ;; right after item (setq pos-state nil)) (goto-char here) (throw 'pos-state pos-state)) (when (and (listp state) (memq 'number state)) (unless (numberp token) (save-match-data (let ((token-str (format "%s" token))) (setq token-str (replace-regexp-in-string "\\([0-9]\\),\\([0-9]\\)" "\\1\\2" token-str)) (when (string-match-p "^[0-9]+$" token-str) (setq token (string-to-number token-str))))))) (cond ;; state ;; Label ((eq state 'need-label) (unless (symbolp token) (throw 'problems (format "Expected label, got %s" token))) (unless (member (symbol-name token) (append chartg-mode-keywords chartg-extra-keywords chartg-raw-keywords nil)) (throw 'problems (format "Unknown label %s" token))) (when (member (symbol-name token) found-labels) (throw 'problems (format "Label %s defined twice" token))) (setq current-label token) (setq found-labels (cons current-label found-labels)) (setq token nil) ;;(setq state 'need-value) (case current-label ('Output-file: (setq state '(accept file-name))) ('Size: (setq state '(accept number))) ('Data: (setq state '(accept number))) ('Type: (setq state '(accept chartg-type))) ('Chartg-title: (setq state '(accept string))) ('Legends: (setq state '(accept string))) ('Google-chartg-raw: (setq state '(accept string))) )) ;;;; Values ;; Alt ((equal state '(accept '| symbol)) (if (eq '| token) (case current-label ('Legends: (setq token nil) (setq state '(accept string))) (t (error "internal error, current-label=%s, state=%s" current-label state))) (if (symbolp token) (progn ;;(setq token nil) (setq state 'need-label)) (throw 'problems (format "Expected | or label, got %s" token))))) ;; Strings ((equal state '(accept string)) (unless (stringp token) (throw 'problems "Expected string")) (case current-label ('Chartg-title: (setq par-title token) (setq token nil) (setq state 'need-label)) ('Legends: (setq par-legends (cons token par-legends)) (setq token nil) (setq state '(accept '| symbol))) ('Google-chartg-raw: (setq par-google-raw token) (setq token nil) (setq state 'need-label)) (t (error "internal error, current-label=%s, state=%s" current-label state)))) ;; Output file ((equal state '(accept file-name)) (unless (stringp token) (throw 'problems "Expected file name string")) (assert (eq current-label 'Output-file:)) (setq par-output-file token) (setq token nil) (setq state 'need-label)) ;; Numbers ((equal state '(accept number)) (unless (numberp token) (throw 'problems "Expected number")) (case current-label ('Size: (if (not par-size) (progn (setq par-size token) (setq token nil) (setq state '(accept number 'x 'X))) (setq par-size (cons par-size token)) (setq token nil) (setq state 'need-label))) ('Data: ;;(assert (not par-data-temp)) (setq par-data-temp (cons token par-data-temp)) (setq par-data-min token) (setq par-data-max token) (setq token nil) (setq state '(accept number ', '| symbol)) ) (t (error "internal error, state=%s, current-label=%s" state current-label))) ) ;; Numbers or | ((equal state '(accept number ', '| symbol)) (if (numberp token) (progn (setq par-data-min (if par-data-min (min par-data-min token) token)) (setq par-data-max (if par-data-max (max par-data-max token) token)) (setq par-data-temp (cons token par-data-temp)) (message "par-data-min/max=%s/%s, token=%s -- %s" par-data-min par-data-max token par-data-temp) (setq token nil)) (if (eq ', token) (setq token nil) (if (or (eq '| token) (symbolp token)) (progn (unless par-data-temp (throw 'problems "Empty data set")) (setq par-data (cons (list (reverse par-data-temp) (cons par-data-min par-data-max)) par-data)) (setq par-data-temp nil) (setq par-data-min nil) (setq par-data-max nil) (if (not (eq '| token)) (setq state 'need-label) (setq state '(accept number)) (setq token nil))) (throw 'problems "Expected | or EOF") )))) ;; Numbers or x/X ((equal state '(accept number 'x 'X)) (assert (eq current-label 'Size:)) (let ((is-n (numberp token)) (is-x (memq token '(x X)))) (unless (or is-n is-x) (throw 'problems "Expected X or number")) (if is-x (progn (setq token nil) (setq state '(accept number))) (setq par-size (cons par-size token)) (setq token nil) (setq state 'need-label)))) ;; Chart type ((equal state '(accept chartg-type)) (setq par-type token) (unless (assoc par-type chartg-types) (throw 'problems (format "Unknown chart type: %s" par-type))) (setq token nil) (setq state 'need-label)) (t (error "internal error, state=%s" state)))))) ;; fix-me here nil))) (when want-pos-state (goto-char here) (throw 'pos-state state)) (unless problems (let ((missing-lab (chartg-missing-keywords))) (when missing-lab (setq problems (format "Missing required labels: %s" missing-lab))))) (if problems (let ((msg (if (listp problems) (nth 1 problems) problems)) (where (if (listp problems) (nth 0 problems) token-before-pos))) (goto-char where) (skip-chars-forward " \t") (error msg)) (goto-char here) ;;(defun chartg-create (out-file provider size data type &rest extras) (setq par-provider 'google) (setq par-legends (nreverse par-legends)) (let ((extras nil)) (when par-google-raw (setq extras (cons (cons 'GOOGLE-RAW par-google-raw) extras))) (chartg-create par-provider par-output-file par-size par-data par-type par-title par-legends extras)) nil))) ;;;###autoload (defun chartg-make-chart () "Try to make a new chart. If region is active then make a new chart from data in the selected region. Else if current buffer is in `chartg-mode' then do it from the chart specifications in this buffer. Otherwise create a new buffer and initialize it with `chartg-mode'. If the chart specifications are complete enough to make a chart then do it and show the resulting chart image. If not then tell user what is missing. NOTE: This is beta, no alpha code. It is not ready. Below are some examples. To test them mark an example and do M-x chartg-make-chart * Example, simple x-y chart: Output-file: \"~/temp-chart.png\" Size: 200 200 Data: 3 8 5 | 10 20 30 Type: line-chartg-xy * Example, pie: Output-file: \"~/temp-depression.png\" Size: 400 200 Data: 2,160,000 3,110,000 1,510,000 73,600 775,000 726,000 8,180,000 419,000 Type: pie-3-dimensional Chartg-title: \"Depression hits on Google\" Legends: \"SSRI\" | \"Psychotherapy\" | \"CBT\" | \"IPT\" | \"Psychoanalysis\" | \"Mindfulness\" | \"Meditation\" | \"Exercise\" * Example, pie: Output-file: \"~/temp-panic.png\" Size: 400 200 Data: 979,000 969,000 500,000 71,900 193,000 154,000 2,500,000 9,310,000 Type: pie-3-dimensional Chartg-title: \"Depression hits on Google\" Legends: \"SSRI\" | \"Psychotherapy\" | \"CBT\" | \"IPT\" | \"Psychoanalysis\" | \"Mindfulness\" | \"Meditation\" | \"Exercise\" * Example using raw: Output-file: \"~/temp-chartg-slipsen-kostar.png\" Size: 400 130 Data: 300 1000 30000 Type: bar-chartg-horizontal Chartg-title: \"Vad killen i slips tjänar jämfört med dig och mig\" 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\" " (interactive) (if mark-active (let* ((rb (region-beginning)) (re (region-end)) (data (buffer-substring-no-properties rb re)) (buf (generate-new-buffer "*Chart from region*"))) (switch-to-buffer buf) (insert data) (chartg-mode)) (unless (eq major-mode 'chartg-mode) (switch-to-buffer (generate-new-buffer "*Chart*")) (chartg-mode))) (chartg-get-state nil)) ;; (defun chartg-from-region (min max) ;; "Try to make a new chart from data in selected region. ;; See `chartg-mode' for examples you can test with this function." ;; (interactive "r") ;; (unless mark-active (error "No region selected")) ;; (let* ((rb (region-beginning)) ;; (re (region-end)) ;; (data (buffer-substring-no-properties rb re)) ;; (buf (generate-new-buffer "*Chart from region*"))) ;; (switch-to-buffer buf) ;; (insert data) ;; (chartg-mode) ;; (chartg-get-state nil))) (define-derived-mode chartg-mode fundamental-mode "Chart" "Mode for specifying charts. \\{chartg-mode-map} To make a chart see `chartg-make-chart'. " (set (make-local-variable 'font-lock-defaults) chartg-font-lock-defaults) (set (make-local-variable 'comment-start) ";") ;; Look within the line for a ; following an even number of backslashes ;; after either a non-backslash or the line beginning. (set (make-local-variable 'comment-start-skip) "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") ;; Font lock mode uses this only when it KNOWS a comment is starting. (set (make-local-variable 'font-lock-comment-start-skip) ";+ *") (set (make-local-variable 'comment-add) 1) ;default to `;;' in comment-region (set (make-local-variable 'comment-column) 40) ;; Don't get confused by `;' in doc strings when paragraph-filling. (set (make-local-variable 'comment-use-global-state) t) (set-syntax-table chartg-mode-syntax-table) (when (looking-at (rx buffer-start (0+ whitespace) buffer-end)) (insert ";; Type C-c C-c to make a chart, M-Tab to complete\n")) (let ((missing (chartg-missing-keywords))) (when missing (save-excursion (goto-char (point-max)) (dolist (miss missing) (insert "\n" miss " ")))))) ;; Tests ;;(chartg-create 'google "temp.png" '(200 . 150) '(((90 70) . nil)) 'pie-3-dimensional "test title" nil '((colors "FFFFFF" "00FF00"))) ;; Fix-me (add-to-list 'auto-mode-alist '("\\.mx-chart\\'" . chartg-mode)) (provide 'chartg) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; chartg.el ends here