Files
gnucash/gnucash/report/html-linechart.scm
T
Geert Janssens cb50f7aaa0 RptCleanup - fold report/report-system into report
This moves a lot of files and all scm modules that get moved need to have their definition updated.
Aside of that, it also tweaks the install location of the report scm files that are not modules
(but instead included in report.scm).
Lastly, report-system.scm has been renamed to report.scm to match the gnc-module name.
This required a rename of the original report.scm (which is not a module). I chose to rename
that to report-core.scm as it's implementing the guts of the report system.

Still missing in this commit: some compatibility code to give users a warning when they try to
use the old scm module names.
2019-06-18 14:25:04 +02:00

613 lines
22 KiB
Scheme

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; html-linechart.scm : generate HTML programmatically, with support
;; for simple style elements.
;; Copyright 2008 Sven Henkel <shenkel@gmail.com>
;;
;; Adapted from html-barchart.scm which is
;; Copyright 2000 Bill Gribble <grib@gnumatic.com>
;;
;; 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 of
;; the License, 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; if not, contact:
;;
;; Free Software Foundation Voice: +1-617-542-5942
;; 51 Franklin Street, Fifth Floor Fax: +1-617-542-2652
;; Boston, MA 02110-1301, USA gnu@gnu.org
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash report report))
(define <html-linechart>
(make-record-type "<html-linechart>"
'(width
height
title
subtitle
x-axis-label
y-axis-label
col-labels
row-labels
col-colors
legend-reversed?
row-labels-rotated?
stacked?
markers?
major-grid?
minor-grid?
data
button-1-line-urls
button-2-line-urls
button-3-line-urls
button-1-legend-urls
button-2-legend-urls
button-3-legend-urls
line-width)))
(define gnc:html-linechart?
(record-predicate <html-linechart>))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <html-linechart> class
;; generate the <object> form for a linechart.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define gnc:make-html-linechart-internal
(record-constructor <html-linechart>))
(define (gnc:make-html-linechart)
(gnc:make-html-linechart-internal
'(pixels . -1) ;;width
'(pixels . -1) ;;height
#f ;;title
#f ;;subtitle
#f ;;x-axis-label
#f ;;y-axis-label
'() ;;col-labels
'() ;;row-labels
'() ;;col-colors
#f ;;legend-reversed?
#f ;;row-labels-rotated?
#f ;;stacked?
#t ;;markers?
#t ;;major-grid?
#t ;;minor-grid?
'() ;;data
#f ;;button-1-line-urls
#f ;;button-2-line-urls
#f ;;button-3-line-urls
#f ;;button-1-legend-urls
#f ;;button-2-legend-urls
#f ;;button-3-legend-urls
1.5 ;;line-width
)
)
(define gnc:html-linechart-data
(record-accessor <html-linechart> 'data))
(define gnc:html-linechart-set-data!
(record-modifier <html-linechart> 'data))
(define gnc:html-linechart-width
(record-accessor <html-linechart> 'width))
(define gnc:html-linechart-set-width!
(record-modifier <html-linechart> 'width))
(define gnc:html-linechart-height
(record-accessor <html-linechart> 'height))
(define gnc:html-linechart-set-height!
(record-modifier <html-linechart> 'height))
(define gnc:html-linechart-x-axis-label
(record-accessor <html-linechart> 'x-axis-label))
(define gnc:html-linechart-set-x-axis-label!
(record-modifier <html-linechart> 'x-axis-label))
(define gnc:html-linechart-y-axis-label
(record-accessor <html-linechart> 'y-axis-label))
(define gnc:html-linechart-set-y-axis-label!
(record-modifier <html-linechart> 'y-axis-label))
(define gnc:html-linechart-row-labels
(record-accessor <html-linechart> 'row-labels))
(define gnc:html-linechart-set-row-labels!
(record-modifier <html-linechart> 'row-labels))
(define gnc:html-linechart-row-labels-rotated?
(record-accessor <html-linechart> 'row-labels-rotated?))
(define gnc:html-linechart-set-row-labels-rotated?!
(record-modifier <html-linechart> 'row-labels-rotated?))
(define gnc:html-linechart-stacked?
(record-accessor <html-linechart> 'stacked?))
(define gnc:html-linechart-set-stacked?!
(record-modifier <html-linechart> 'stacked?))
(define gnc:html-linechart-markers?
(record-accessor <html-linechart> 'markers?))
(define gnc:html-linechart-set-markers?!
(record-modifier <html-linechart> 'markers?))
(define gnc:html-linechart-major-grid?
(record-accessor <html-linechart> 'major-grid?))
(define gnc:html-linechart-set-major-grid?!
(record-modifier <html-linechart> 'major-grid?))
(define gnc:html-linechart-minor-grid?
(record-accessor <html-linechart> 'minor-grid?))
(define gnc:html-linechart-set-minor-grid?!
(record-modifier <html-linechart> 'minor-grid?))
(define gnc:html-linechart-col-labels
(record-accessor <html-linechart> 'col-labels))
(define gnc:html-linechart-set-col-labels!
(record-modifier <html-linechart> 'col-labels))
(define gnc:html-linechart-col-colors
(record-accessor <html-linechart> 'col-colors))
(define gnc:html-linechart-set-col-colors!
(record-modifier <html-linechart> 'col-colors))
(define gnc:html-linechart-legend-reversed?
(record-accessor <html-linechart> 'legend-reversed?))
(define gnc:html-linechart-set-legend-reversed?!
(record-modifier <html-linechart> 'legend-reversed?))
(define gnc:html-linechart-title
(record-accessor <html-linechart> 'title))
(define gnc:html-linechart-set-title!
(record-modifier <html-linechart> 'title))
(define gnc:html-linechart-subtitle
(record-accessor <html-linechart> 'subtitle))
(define gnc:html-linechart-set-subtitle!
(record-modifier <html-linechart> 'subtitle))
;; Note: ATM you can specify one url per column, but this url will be
;; used for all of the rows. Otherwise we could have cols*rows urls
;; (quite a lot), but this first requires fixing
;; guppi_line_1_callback() in gnome/gnc-html-guppi.c .
;; FIXME url's haven't been working since GnuCash 1.x
;; GnuCash 2.x switched from guppy to goffice, which
;; made it very hard to remain the url functionality
;; At this point I (gjanssens) is in the process of
;; moving from goffice to jqplot for our charts
;; which perhaps may allow urls again in the charts
;; I'm keeping the parameters below around to remind
;; us this still has to be investigated again
(define gnc:html-linechart-button-1-line-urls
(record-accessor <html-linechart> 'button-1-line-urls))
(define gnc:html-linechart-set-button-1-line-urls!
(record-modifier <html-linechart> 'button-1-line-urls))
(define gnc:html-linechart-button-2-line-urls
(record-accessor <html-linechart> 'button-2-line-urls))
(define gnc:html-linechart-set-button-2-line-urls!
(record-modifier <html-linechart> 'button-2-line-urls))
(define gnc:html-linechart-button-3-line-urls
(record-accessor <html-linechart> 'button-3-line-urls))
(define gnc:html-linechart-set-button-3-line-urls!
(record-modifier <html-linechart> 'button-3-line-urls))
(define gnc:html-linechart-button-1-legend-urls
(record-accessor <html-linechart> 'button-1-legend-urls))
(define gnc:html-linechart-set-button-1-legend-urls!
(record-modifier <html-linechart> 'button-1-legend-urls))
(define gnc:html-linechart-button-2-legend-urls
(record-accessor <html-linechart> 'button-2-legend-urls))
(define gnc:html-linechart-set-button-2-legend-urls!
(record-modifier <html-linechart> 'button-2-legend-urls))
(define gnc:html-linechart-button-3-legend-urls
(record-accessor <html-linechart> 'button-3-legend-urls))
(define gnc:html-linechart-set-button-3-legend-urls!
(record-modifier <html-linechart> 'button-3-legend-urls))
(define gnc:html-linechart-line-width
(record-accessor <html-linechart> 'line-width))
(define gnc:html-linechart-set-line-width!
(record-modifier <html-linechart> 'line-width))
(define (gnc:html-linechart-append-row! linechart newrow)
(let ((dd (gnc:html-linechart-data linechart)))
(set! dd (append dd (list newrow)))
(gnc:html-linechart-set-data! linechart dd)))
(define (gnc:html-linechart-prepend-row! linechart newrow)
(let ((dd (gnc:html-linechart-data linechart)))
(set! dd (cons newrow dd))
(gnc:html-linechart-set-data! linechart dd)))
(define (gnc:html-linechart-append-column! linechart newcol)
(let ((colnum 0)
(rownum 0)
(rows (gnc:html-linechart-data linechart))
(this-row #f)
(new-row #f))
;; find out how many cols are already there in the deepest row
(for-each
(lambda (row)
(let ((l (length row)))
(if (> l colnum)
(set! colnum l))))
rows)
;; append the elements of 'newrow' to the rowumns
(for-each
(lambda (newelt)
;; find the row, or append one
(if (not (null? rows))
(begin
(set! new-row #f)
(set! this-row (car rows))
(if (null? (cdr rows))
(set! rows #f)
(set! rows (cdr rows))))
(begin
(set! new-row #t)
(set! this-row '())))
;; make sure the rowumn is long enough, then append the data
(let loop ((l (length this-row))
(r (reverse this-row)))
(if (< l colnum)
(loop (+ l 1) (cons #f r))
(set! this-row
(reverse (cons newelt r)))))
(if new-row
(gnc:html-linechart-append-row! linechart this-row)
(list-set! (gnc:html-linechart-data linechart) rownum this-row))
(set! rownum (+ 1 rownum)))
newcol)))
(define (gnc:not-all-zeros data)
(define (myor list)
(begin
(gnc:debug "list" list)
(if (null? list) #f
(or (car list) (myor (cdr list))))))
(cond ((number? data) (not (= 0 data)))
((list? data) (myor (map gnc:not-all-zeros data)))
(else #f)))
(define (gnc:html-linechart-prepend-column! linechart newcol)
(let ((rows (gnc:html-linechart-data linechart))
(this-row #f)
(new-row #f)
(rownum 0))
(for-each
(lambda (elt)
(if (not (null? rows))
(begin
(set! new-row #f)
(set! this-row (car rows))
(if (null? (cdr rows))
(set! rows #f)
(set! rows (cdr rows))))
(begin
(set! new-row #t)
(set! this-row '())))
(if new-row
(gnc:html-linechart-append-row! linechart (list elt))
(list-set! (gnc:html-linechart-data linechart) rownum
(cons elt this-row)))
(set! rownum (+ 1 rownum)))
newcol)))
(define (gnc:html-linechart-render linechart doc)
(define (ensure-numeric elt)
(cond ((number? elt)
(exact->inexact elt))
((string? elt)
(with-input-from-string elt
(lambda ()
(let ((n (read)))
(if (number? n) n 0.0)))))
(#t
0.0)))
(define (catenate-escaped-strings nlist)
(if (not (list? nlist))
""
(with-output-to-string
(lambda ()
(for-each
(lambda (s)
(let ((escaped
(regexp-substitute/global
#f " "
(regexp-substitute/global
#f "\\\\" s
'pre "\\\\" 'post)
'pre "\\ " 'post)))
(display escaped)
(display " ")))
nlist)))))
(let* ((retval '())
(push (lambda (l) (set! retval (cons l retval))))
(title (gnc:html-linechart-title linechart))
(subtitle (gnc:html-linechart-subtitle linechart))
(url-1
(catenate-escaped-strings
(gnc:html-linechart-button-1-line-urls linechart)))
(url-2
(catenate-escaped-strings
(gnc:html-linechart-button-2-line-urls linechart)))
(url-3
(catenate-escaped-strings
(gnc:html-linechart-button-3-line-urls linechart)))
(legend-1
(catenate-escaped-strings
(gnc:html-linechart-button-1-legend-urls linechart)))
(legend-2
(catenate-escaped-strings
(gnc:html-linechart-button-2-legend-urls linechart)))
(legend-3
(catenate-escaped-strings
(gnc:html-linechart-button-3-legend-urls linechart)))
(x-label (gnc:html-linechart-x-axis-label linechart))
(y-label (gnc:html-linechart-y-axis-label linechart))
(data (gnc:html-linechart-data linechart))
(dummy1 (gnc:debug "data " data))
(row-labels (catenate-escaped-strings
(gnc:html-linechart-row-labels linechart)))
(col-labels (catenate-escaped-strings
(gnc:html-linechart-col-labels linechart)))
;; convert color list to string with valid js array of strings, example: "\"blue\", \"red\""
(colors-str (string-join (map (lambda (color)
(string-append "\"" color "\""))
(gnc:html-linechart-col-colors linechart)) ", "))
(line-width (gnc:html-linechart-line-width linechart))
(series-data-start (lambda (series-index)
(push "var d")
(push series-index)
(push " = [];\n")))
(series-data-add (lambda (series-index date y)
(push (string-append
" d"
(number->string series-index)
".push(["
"\"" date "\""
", "
(number->string y)
"]);\n"))))
(series-data-end (lambda (series-index label)
(push "data.push(d")
(push series-index)
(push ");\n")
(push (format #f "series.push({ label: ~s });\n\n"
(gnc:html-string-sanitize label)))))
; Use a unique chart-id for each chart. This prevents chart
; clashed on multi-column reports
(chart-id (string-append "chart-" (number->string (random 999999)))))
(if (and (list? data)
(not (null? data))
(gnc:not-all-zeros data))
(begin
(push (gnc:html-js-include "jqplot/jquery.min.js"))
(push (gnc:html-js-include "jqplot/jquery.jqplot.js"))
(push (gnc:html-js-include "jqplot/jqplot.cursor.js"))
(push (gnc:html-js-include "jqplot/jqplot.dateAxisRenderer.js"))
(push (gnc:html-js-include "jqplot/jqplot.highlighter.js"))
(push (gnc:html-js-include "jqplot/jqplot.canvasTextRenderer.js"))
(push (gnc:html-js-include "jqplot/jqplot.canvasAxisTickRenderer.js"))
(push (gnc:html-css-include "jqplot/jquery.jqplot.css"))
(push "<div id=\"")(push chart-id)(push "\" style=\"width:")
(push (cdr (gnc:html-linechart-width linechart)))
(if (eq? 'pixels (car (gnc:html-linechart-width linechart)))
(push "px;height:")
(push "%;height:"))
(push (cdr (gnc:html-linechart-height linechart)))
(if (eq? 'pixels (car (gnc:html-linechart-height linechart)))
(push "px;\"></div>\n")
(push "%;\"></div>\n"))
(push "<script id=\"source\">\n$(function () {")
(push "var data = [];")
(push "var series = [];\n")
(if (and data (list? data))
(let ((rows (length data))
(cols 0))
(let loop ((col 0) (rowcnt 0))
(series-data-start col)
(if (list? (car data))
(begin
(set! cols (length (car data)))))
(for-each
(lambda (row)
(if (< rowcnt rows)
(series-data-add col
(list-ref (gnc:html-linechart-row-labels linechart) rowcnt)
(ensure-numeric (list-ref-safe row col))
)
)
(set! rowcnt (+ rowcnt 1)))
data)
(series-data-end col (list-ref-safe (gnc:html-linechart-col-labels linechart) col))
(if (< col (- cols 1))
(loop (+ 1 col) 0)))))
(push "var options = {
shadowAlpha: 0.07,
legend: {
show: true,
placement: \"outsideGrid\", },
seriesDefaults: {
lineWidth: ")
(push (ensure-numeric line-width))
(push ",
showMarker: true,
},
series: series,
axesDefaults: {
},
grid: {
},
axes: {
xaxis: {
renderer:$.jqplot.DateAxisRenderer,
tickRenderer: $.jqplot.CanvasAxisTickRenderer,
tickOptions: {
angle: -30,
fontSize: '10pt',
},
},
yaxis: {
autoscale: true,
},
},
highlighter: {
tooltipContentEditor: formatTooltip,
tooltipLocation: 'ne',
},
cursor: {
show: true,
zoom: true
},
seriesColors: false,
};\n")
(push " options.stackSeries = ")
(push (if (gnc:html-linechart-stacked? linechart)
"true;\n"
"false;\n"))
(push " options.seriesDefaults.showMarker = ")
(push (if (gnc:html-linechart-markers? linechart)
"true;\n"
"false;\n"))
(push " options.axesDefaults.drawMajorGridlines = ")
(push (if (gnc:html-linechart-major-grid? linechart)
"true;\n"
"false;\n"))
(push " options.axesDefaults.drawMinorGridlines = ")
(push (if (gnc:html-linechart-minor-grid? linechart)
"true;\n"
"false;\n"))
(if title
(push (format #f " options.title = ~s;\n"
(gnc:html-string-sanitize title))))
(if subtitle
(push (format #f " options.title += ' <br />' + ~s;\n"
(gnc:html-string-sanitize subtitle))))
(if (and (string? x-label) (> (string-length x-label) 0))
(begin
(push " options.axes.xaxis.label = \"")
(push x-label)
(push "\";\n")))
(if (and (string? y-label) (> (string-length y-label) 0))
(begin
(push " options.axes.yaxis.label = \"")
(push y-label)
(push "\";\n")))
(if (not (equal? colors-str ""))
(begin ; example: options.seriesColors= ["blue", "red"];
(push "options.seriesColors = [")
(push colors-str)
(push "];\n")
)
)
;; adjust the date string format to the one given by the preferences
(push " options.axes.xaxis.tickOptions.formatString = '")
(push (qof-date-format-get-string (qof-date-format-get)))
(push "';\n")
(push "$.jqplot.config.enablePlugins = true;\n")
(push "$(document).ready(function() {
var plot = $.jqplot('")(push chart-id)(push"', data, options);
plot.replot();
var timer;
var load_timer;
// var win_width = $(window).width();
// var win_height = $(window).height();
// console.log( 'Window Width ' + win_width + ' Height ' + win_height);
// var doc_width = document.body.clientWidth;
// var doc_height = document.body.clientHeight;
// console.log( 'Doc Width ' + doc_width + ' Height ' + doc_height);
$(window).resize(function () {
clearTimeout(timer);
timer = setTimeout(function () {
// console.log( 'Resize Timer!' );
plot.replot();
}, 100);
});
$(window).on('load', function () {
var hasVScroll = document.body.scrollHeight > document.body.clientHeight;
clearTimeout(load_timer);
load_timer = setTimeout(function () {
// console.log( 'Load Timer!' );
if(hasVScroll)
{
// console.log( 'Load Timer Replot!' );
plot.replot();
}
},100);
});
});
function formatTooltip(str, seriesIndex, pointIndex) {
x = $.jqplot.DateTickFormatter (options.axes.xaxis.tickOptions.formatString,
data[seriesIndex][pointIndex][0]);
y = data[seriesIndex][pointIndex][1].toFixed(2);
return options.series[seriesIndex].label + ' ' + x + '<br><b>' + y + '</b>';
}\n")
(push "});\n</script>")
(gnc:msg (string-join (reverse (map (lambda (e) (if (number? e) (number->string e) e)) retval)) ""))
)
(begin
(gnc:warn "linechart has no non-zero data.")
" "))
retval))