legacy-dotfiles/emacs.d/nxhtml/util/chartg.el
Tom Willemsen 94d2fc1815 Django, org
* Added nxhtml, mostly for django support.

  * Changed some org settings.
2011-03-07 09:04:49 +01:00

844 lines
29 KiB
EmacsLisp

;;; 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 "</body></html>" 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