mirror of
https://github.com/Gnucash/gnucash.git
synced 2025-02-25 18:55:30 -06:00
Bill Gribble's patch.
* src/gnome/dialog-column-view.c: set the view dirty on edit
* src/gnome/dialog-style-sheet.c: dirty every report using a
stylesheet when it's edited.
* src/gnome/window-report.c: Add display register/unregister for
reports so the reports know which report-windows they are being
displayed in.
* src/scm/html-{bar,pie}chart.scm: Add a little space to work
around a gtkhtml-0.8.3 bug in table display
* src/scm/html-document.scm: move tree collapse and
stringification to the html document rather than the report. Add
functions to render just the body elements of a document.
* src/scm/html-table.scm: fix broken html-table-set-cell!
* src/scm/report.scm: add parents list to report struct. Mark
parents dirty when report is marked dirty. reload windows showing
a report on dirty. Clean up rendering functions a little
* src/scm/report/view-column.scm: Add a link to open each report
in a window by itself. Change rendering to allow children to be
cached.
git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3848 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
Dave Peticolas
parent
2c984b5993
commit
6cc1792964
28
ChangeLog
28
ChangeLog
@ -1,3 +1,31 @@
|
||||
2001-03-28 Bill Gribble <grib@billgribble.com>
|
||||
|
||||
* src/gnome/dialog-column-view.c: set the view dirty on edit
|
||||
|
||||
* src/gnome/dialog-style-sheet.c: dirty every report using a
|
||||
stylesheet when it's edited.
|
||||
|
||||
* src/gnome/window-report.c: Add display register/unregister for
|
||||
reports so the reports know which report-windows they are being
|
||||
displayed in.
|
||||
|
||||
* src/scm/html-{bar,pie}chart.scm: Add a little space to work
|
||||
around a gtkhtml-0.8.3 bug in table display
|
||||
|
||||
* src/scm/html-document.scm: move tree collapse and
|
||||
stringification to the html document rather than the report. Add
|
||||
functions to render just the body elements of a document.
|
||||
|
||||
* src/scm/html-table.scm: fix broken html-table-set-cell!
|
||||
|
||||
* src/scm/report.scm: add parents list to report struct. Mark
|
||||
parents dirty when report is marked dirty. reload windows showing
|
||||
a report on dirty. Clean up rendering functions a little
|
||||
|
||||
* src/scm/report/view-column.scm: Add a link to open each report
|
||||
in a window by itself. Change rendering to allow children to be
|
||||
cached.
|
||||
|
||||
2001-03-28 Dave Peticolas <dave@krondo.com>
|
||||
|
||||
* src/gnome/dialog-tax-info.c: more work
|
||||
|
||||
@ -116,9 +116,13 @@ gnc_column_view_select_contents_cb(GtkCList * clist, gint row, gint col,
|
||||
}
|
||||
|
||||
static void
|
||||
gnc_column_view_edit_apply_cb(GNCOptionWin * win, gpointer user_data) {
|
||||
gnc_column_view_edit * r = user_data;
|
||||
gnc_option_db_commit(r->odb);
|
||||
gnc_column_view_edit_apply_cb(GNCOptionWin * w, gpointer user_data) {
|
||||
SCM dirty_report = gh_eval_str("gnc:report-set-dirty?!");
|
||||
gnc_column_view_edit * win = user_data;
|
||||
|
||||
if(!win) return;
|
||||
gnc_option_db_commit(win->odb);
|
||||
gh_call2(dirty_report, win->view, SCM_BOOL_T);
|
||||
}
|
||||
|
||||
static void
|
||||
@ -201,6 +205,7 @@ gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data) {
|
||||
gnc_column_view_edit * r =
|
||||
gtk_object_get_data(GTK_OBJECT(user_data), "view_edit_struct");
|
||||
SCM make_report = gh_eval_str("gnc:make-report");
|
||||
SCM add_child = gh_eval_str("gnc:report-add-child-by-id!");
|
||||
SCM template_name;
|
||||
SCM set_value = gh_eval_str("gnc:option-set-value");
|
||||
SCM new_report;
|
||||
@ -214,6 +219,8 @@ gnc_column_view_edit_add_cb(GtkButton * button, gpointer user_data) {
|
||||
template_name = gh_list_ref(r->available_list,
|
||||
gh_int2scm(r->available_selected));
|
||||
new_report = gh_call1(make_report, template_name);
|
||||
gh_call2(add_child, r->view, new_report);
|
||||
|
||||
oldlength = gh_length(r->contents_list);
|
||||
|
||||
if(oldlength > r->contents_selected) {
|
||||
|
||||
@ -45,9 +45,11 @@ struct ss_info {
|
||||
|
||||
static void
|
||||
gnc_style_sheet_options_apply_cb(GNCOptionWin * propertybox,
|
||||
gpointer user_data) {
|
||||
gpointer user_data) {
|
||||
struct ss_info * ssi = (struct ss_info *)user_data;
|
||||
SCM apply_changes = gh_eval_str("gnc:html-style-sheet-apply-changes");
|
||||
gnc_option_db_commit(ssi->odb);
|
||||
gh_call1(apply_changes, ssi->stylesheet);
|
||||
}
|
||||
|
||||
|
||||
|
||||
@ -188,6 +188,11 @@ gnc_report_window_set_fwd_button(gnc_report_window * win, int enabled) {
|
||||
gtk_widget_set_sensitive(win->fwd_widg, enabled);
|
||||
}
|
||||
|
||||
void
|
||||
gnc_report_window_reload(gnc_report_window * win) {
|
||||
gnc_html_reload(win->html);
|
||||
}
|
||||
|
||||
|
||||
/********************************************************************
|
||||
* gnc_report_window_load_cb
|
||||
@ -203,6 +208,9 @@ gnc_report_window_load_cb(gnc_html * html, URLType type,
|
||||
SCM find_report = gh_eval_str("gnc:find-report");
|
||||
SCM get_options = gh_eval_str("gnc:report-options");
|
||||
SCM get_editor = gh_eval_str("gnc:report-options-editor");
|
||||
SCM show_report = gh_eval_str("gnc:report-register-display");
|
||||
SCM unshow_report = gh_eval_str("gnc:report-unregister-display");
|
||||
SCM scm_wintype = gh_eval_str("<gnc:report-window*>");
|
||||
SCM inst_report;
|
||||
SCM inst_options;
|
||||
SCM inst_options_ed;
|
||||
@ -220,6 +228,13 @@ gnc_report_window_load_cb(gnc_html * html, URLType type,
|
||||
SCM_BOOL_F) {
|
||||
return;
|
||||
}
|
||||
|
||||
/* unregister ourselves as a "displayer" of the current report */
|
||||
if(win->scm_report != SCM_BOOL_F) {
|
||||
gh_call2(unshow_report, win->scm_report,
|
||||
gw_wcp_assimilate_ptr(win, scm_wintype));
|
||||
}
|
||||
|
||||
inst_options = gh_call1(get_options, inst_report);
|
||||
inst_options_ed = gh_call1(get_editor, inst_report);
|
||||
|
||||
@ -235,6 +250,11 @@ gnc_report_window_load_cb(gnc_html * html, URLType type,
|
||||
win->scm_report = inst_report;
|
||||
scm_protect_object(win->scm_report);
|
||||
|
||||
if(win->scm_report != SCM_BOOL_F) {
|
||||
gh_call2(show_report, win->scm_report,
|
||||
gw_wcp_assimilate_ptr(win, scm_wintype));
|
||||
}
|
||||
|
||||
if(gnc_html_history_forward_p(gnc_html_get_history(win->html))) {
|
||||
gnc_report_window_set_fwd_button(win, TRUE);
|
||||
}
|
||||
@ -258,7 +278,13 @@ gnc_report_window_load_cb(gnc_html * html, URLType type,
|
||||
static void
|
||||
gnc_report_window_destroy_cb(GtkWidget * w, gpointer data) {
|
||||
gnc_report_window * win = data;
|
||||
SCM scm_wintype = gh_eval_str("<gnc:report-window*>");
|
||||
SCM scm_wintype = gh_eval_str("<gnc:report-window*>");
|
||||
SCM unshow_report = gh_eval_str("gnc:report-unregister-display");
|
||||
|
||||
if(win->scm_report != SCM_BOOL_F) {
|
||||
gh_call2(unshow_report, win->scm_report,
|
||||
gw_wcp_assimilate_ptr(win, scm_wintype));
|
||||
}
|
||||
|
||||
/* make sure we don't get a double dose -o- destruction */
|
||||
gtk_signal_disconnect_by_data(GTK_OBJECT(win->container),
|
||||
|
||||
@ -36,6 +36,7 @@ typedef struct _gnc_report_window gnc_report_window;
|
||||
gnc_report_window * gnc_report_window_new(GtkWidget * container);
|
||||
void gnc_report_window_destroy(gnc_report_window * rep);
|
||||
void gnc_report_window_show_report(gnc_report_window * rw, int id);
|
||||
void gnc_report_window_reload(gnc_report_window * rw);
|
||||
gnc_html * gnc_report_window_get_html(gnc_report_window * rw);
|
||||
|
||||
void gnc_report_window_default_params_editor(SCM options, SCM report);
|
||||
|
||||
@ -316,7 +316,7 @@
|
||||
(if (gnc:html-barchart-stacked? barchart)
|
||||
(push " <param name=\"stacked\" value=\"1\">\n"))
|
||||
(push "Unable to push bar chart\n")
|
||||
(push "</object>"))
|
||||
(push "</object> \n"))
|
||||
" ")
|
||||
retval))
|
||||
|
||||
|
||||
@ -92,13 +92,29 @@
|
||||
(apply gnc:make-html-markup-style-info rest)))
|
||||
(gnc:html-style-table-set! (gnc:html-document-style doc) tag newstyle)))
|
||||
|
||||
(define (gnc:html-document-tree-collapse tree)
|
||||
(let ((retval '()))
|
||||
(define (do-list list)
|
||||
(for-each
|
||||
(lambda (elt)
|
||||
(if (string? elt)
|
||||
(set! retval (cons elt retval))
|
||||
(if (not (list? elt))
|
||||
(set! retval
|
||||
(cons (with-output-to-string
|
||||
(lambda () (display elt)))
|
||||
retval))
|
||||
(do-list elt))))
|
||||
list))
|
||||
(do-list tree)
|
||||
retval))
|
||||
|
||||
(define (gnc:html-document-render doc)
|
||||
(let ((stylesheet (gnc:html-document-style-sheet doc)))
|
||||
(if stylesheet
|
||||
;; if there's a style sheet, let it do the rendering
|
||||
(gnc:html-style-sheet-render stylesheet doc)
|
||||
|
||||
|
||||
;; otherwise, do the trivial render.
|
||||
(let* ((retval '())
|
||||
(push (lambda (l) (set! retval (cons l retval)))))
|
||||
@ -128,7 +144,33 @@
|
||||
(push "</html>\n")
|
||||
(gnc:html-document-pop-style doc)
|
||||
(gnc:html-style-table-uncompile (gnc:html-document-style doc))
|
||||
retval))))
|
||||
|
||||
(apply string-append
|
||||
(gnc:html-document-tree-collapse retval))))))
|
||||
|
||||
(define (gnc:html-document-render-body doc)
|
||||
;; this is a q&d render with no HTML, HEAD, or BODY tags, ignoring
|
||||
;; the style sheet. things *can* be pushed though.
|
||||
(let* ((retval '())
|
||||
(push (lambda (l) (set! retval (cons l retval)))))
|
||||
;; compile the doc style
|
||||
(gnc:html-style-table-compile (gnc:html-document-style doc)
|
||||
(gnc:html-document-style-stack doc))
|
||||
;; push it
|
||||
(gnc:html-document-push-style doc (gnc:html-document-style doc))
|
||||
|
||||
;; now render the children
|
||||
(for-each-in-order
|
||||
(lambda (child)
|
||||
(push (gnc:html-object-render child doc)))
|
||||
(gnc:html-document-objects doc))
|
||||
|
||||
(gnc:html-document-pop-style doc)
|
||||
(gnc:html-style-table-uncompile (gnc:html-document-style doc))
|
||||
|
||||
(apply string-append
|
||||
(gnc:html-document-tree-collapse retval))))
|
||||
|
||||
|
||||
(define (gnc:html-document-push-style doc style)
|
||||
(gnc:html-document-set-style-stack!
|
||||
|
||||
@ -258,7 +258,7 @@
|
||||
(push legend-3)
|
||||
(push "\">\n")))
|
||||
(push "Unable to display pie chart\n")
|
||||
(push "</object>"))
|
||||
(push "</object> \n"))
|
||||
" ")
|
||||
retval))
|
||||
|
||||
|
||||
@ -162,6 +162,19 @@
|
||||
#f)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-style-sheet-apply-changes
|
||||
;; when options have been changed, rerun relevant reports
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (gnc:html-style-sheet-apply-changes ss)
|
||||
(hash-fold
|
||||
(lambda (report-name report prior)
|
||||
(if (eq? (gnc:report-stylesheet report) ss)
|
||||
(gnc:report-set-dirty?! report #t))
|
||||
#t) #t *gnc:_reports_*))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; html-style-sheet-render
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@ -189,11 +202,10 @@
|
||||
newdoc (gnc:html-document-style doc))
|
||||
|
||||
;; render the ssdocument (using the trivial stylesheet). since
|
||||
;; the objects from 'doc' are now in ssdoc, this renders the whole
|
||||
;; the objects from 'doc' are now in newdoc, this renders the whole
|
||||
;; package.
|
||||
(gnc:html-document-render newdoc)))
|
||||
|
||||
|
||||
(define (gnc:get-html-style-sheets)
|
||||
(let* ((ss '()))
|
||||
(hash-for-each (lambda (k v) (set! ss (cons v ss)))
|
||||
|
||||
@ -376,14 +376,13 @@
|
||||
;; ensure the row-data is there
|
||||
(if (>= row l)
|
||||
(begin
|
||||
(do
|
||||
(i l (+ i 1))
|
||||
((< i row) #f)
|
||||
(gnc:html-document-append-row! table '()))
|
||||
(set! rowdata (make-list (+ col 1) #f))
|
||||
(gnc:html-document-append-row! table rowdata)
|
||||
(set! l (gnc:html-table-num-rows))
|
||||
(set! row-loc (- (- l 1) row)))
|
||||
(let loop ((i l))
|
||||
(gnc:html-table-append-row! table (list))
|
||||
(if (< i row)
|
||||
(loop (+ i 1))))
|
||||
(set! l (gnc:html-table-num-rows table))
|
||||
(set! row-loc (- (- l 1) row))
|
||||
(set! rowdata (list)))
|
||||
(begin
|
||||
(set! row-loc (- (- l 1) row))
|
||||
(set! rowdata (list-ref (gnc:html-table-data table) row-loc))))
|
||||
@ -391,12 +390,13 @@
|
||||
;; make a table-cell and set the data
|
||||
(let ((tc (gnc:make-html-table-cell)))
|
||||
(apply gnc:html-table-cell-append-objects! tc objects)
|
||||
(set! rowdata (list-set-safe! rowdata col tc)))
|
||||
|
||||
;; add the row-data back to the table
|
||||
(gnc:html-table-set-data!
|
||||
table
|
||||
(list-set-safe! (gnc:html-table-data table) row-loc rowdata))))
|
||||
(set! rowdata (list-set-safe! rowdata col tc))
|
||||
|
||||
;; add the row-data back to the table
|
||||
(gnc:html-table-set-data!
|
||||
table (list-set-safe!
|
||||
(gnc:html-table-data table)
|
||||
row-loc rowdata)))))
|
||||
|
||||
(define (gnc:html-table-append-column! table newcol)
|
||||
(define (maxwidth table-data)
|
||||
|
||||
@ -53,11 +53,13 @@
|
||||
(sprintf #f (_ "Display the %s report") name)
|
||||
(list "_Reports" "")
|
||||
(lambda ()
|
||||
(let ((rept (gnc:make-report
|
||||
(gnc:report-template-name report))))
|
||||
(gnc:report-in-main-window rept)))))
|
||||
(gnc:backtrace-if-exception
|
||||
(lambda ()
|
||||
(let ((rept (gnc:make-report
|
||||
(gnc:report-template-name report))))
|
||||
(gnc:report-in-main-window rept)))))))
|
||||
(gnc:add-extension item))))
|
||||
|
||||
|
||||
;; add the menu option to edit style sheets
|
||||
(gnc:add-extension menu)
|
||||
(gnc:add-extension
|
||||
@ -156,7 +158,9 @@
|
||||
options))))
|
||||
|
||||
(define <report>
|
||||
(make-record-type "<report>" '(type id options children dirty? ctext)))
|
||||
(make-record-type "<report>"
|
||||
'(type id options parents children
|
||||
dirty? display-list ctext)))
|
||||
|
||||
(define gnc:report-type
|
||||
(record-accessor <report> 'type))
|
||||
@ -179,27 +183,84 @@
|
||||
(define gnc:report-children
|
||||
(record-accessor <report> 'children))
|
||||
|
||||
(define gnc:report-set-parents!
|
||||
(record-modifier <report> 'parents))
|
||||
|
||||
(define gnc:report-parents
|
||||
(record-accessor <report> 'parents))
|
||||
|
||||
(define gnc:report-set-children!
|
||||
(record-modifier <report> 'children))
|
||||
|
||||
(define (gnc:report-add-child! report child)
|
||||
(gnc:report-set-children! report
|
||||
(cons child (gnc:report-children report))))
|
||||
(gnc:report-add-parent! child report)
|
||||
(gnc:report-set-children!
|
||||
report (cons child (gnc:report-children report))))
|
||||
|
||||
(define (gnc:report-add-child-by-id! report child)
|
||||
(let ((childrep (gnc:find-report child)))
|
||||
(if childrep
|
||||
(begin
|
||||
(gnc:report-add-parent! childrep report)
|
||||
(gnc:report-set-children!
|
||||
report (cons childrep (gnc:report-children report)))))))
|
||||
|
||||
(define (gnc:report-add-parent! report parent)
|
||||
(gnc:report-set-parents!
|
||||
report (cons parent (gnc:report-parents report))))
|
||||
|
||||
(define gnc:report-dirty?
|
||||
(record-accessor <report> 'dirty?))
|
||||
|
||||
(define gnc:report-set-dirty?!
|
||||
(define gnc:report-set-dirty?-internal!
|
||||
(record-modifier <report> 'dirty?))
|
||||
|
||||
(define (gnc:report-set-dirty?! report val)
|
||||
(gnc:report-set-dirty?-internal! report val)
|
||||
(if val
|
||||
(begin
|
||||
;; mark the parents as dirty
|
||||
(for-each
|
||||
(lambda (parent)
|
||||
(gnc:report-set-dirty?! parent val))
|
||||
(gnc:report-parents report))
|
||||
|
||||
;; reload the window
|
||||
(for-each
|
||||
(lambda (win)
|
||||
(gnc:report-window-reload win))
|
||||
(gnc:report-display-list report)))))
|
||||
|
||||
(define gnc:report-display-list
|
||||
(record-accessor <report> 'display-list))
|
||||
|
||||
(define gnc:report-set-display-list!
|
||||
(record-modifier <report> 'display-list))
|
||||
|
||||
(define gnc:report-ctext
|
||||
(record-accessor <report> 'ctext))
|
||||
|
||||
(define gnc:report-set-ctext!
|
||||
(record-modifier <report> 'ctext))
|
||||
|
||||
(define (gnc:report-register-display report window)
|
||||
(if (and window report)
|
||||
(if (not (member window (gnc:report-display-list report)))
|
||||
(gnc:report-set-display-list!
|
||||
report
|
||||
(cons window (gnc:report-display-list report))))))
|
||||
|
||||
(define (gnc:report-unregister-display report window)
|
||||
(if (and window report)
|
||||
(if (member window (gnc:report-display-list report))
|
||||
(gnc:report-set-display-list!
|
||||
report
|
||||
(delete window (gnc:report-display-list report))))))
|
||||
|
||||
|
||||
(define (gnc:make-report template-name . rest)
|
||||
(let ((r ((record-constructor <report>) template-name #f #f '() #t #f))
|
||||
(let ((r ((record-constructor <report>)
|
||||
template-name #f #f '() '() #t '() #f))
|
||||
(template (hash-ref *gnc:_report-templates_* template-name))
|
||||
(id *gnc:_report-next-serial_*))
|
||||
(gnc:report-set-id! r id)
|
||||
@ -231,8 +292,24 @@
|
||||
(gnc:option-value
|
||||
(gnc:lookup-option (gnc:report-options report)
|
||||
(N_ "General") (N_ "Report name"))))
|
||||
|
||||
|
||||
(define (gnc:report-stylesheet report)
|
||||
(gnc:html-style-sheet-find
|
||||
(symbol->string (gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report)
|
||||
(N_ "General")
|
||||
(N_ "Stylesheet"))))))
|
||||
|
||||
(define (gnc:report-set-stylesheet! report stylesheet)
|
||||
(gnc:option-set-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report)
|
||||
(N_ "General")
|
||||
(N_ "Stylesheet"))
|
||||
(string->symbol
|
||||
(gnc:html-style-sheet-name stylesheet))))
|
||||
|
||||
;;; (define (gnc:report-default-options-editor)
|
||||
;;; (let* ((option-db #f)
|
||||
;;; (option-dlg #f))
|
||||
@ -274,23 +351,6 @@
|
||||
(define (gnc:find-report id)
|
||||
(hash-ref *gnc:_reports_* id))
|
||||
|
||||
(define (gnc:report-tree-collapse tree)
|
||||
(let ((retval '()))
|
||||
(define (do-list list)
|
||||
(for-each
|
||||
(lambda (elt)
|
||||
(if (string? elt)
|
||||
(set! retval (cons elt retval))
|
||||
(if (not (list? elt))
|
||||
(set! retval
|
||||
(cons (with-output-to-string
|
||||
(lambda () (display elt)))
|
||||
retval))
|
||||
(do-list elt))))
|
||||
list))
|
||||
(do-list tree)
|
||||
retval))
|
||||
|
||||
(define (gnc:backtrace-if-exception proc . args)
|
||||
(define (dumper key . args)
|
||||
(let ((stack (make-stack #t dumper)))
|
||||
@ -307,50 +367,70 @@
|
||||
(lambda (key . args)
|
||||
#f)))
|
||||
|
||||
|
||||
(define (gnc:report-render-html report)
|
||||
(if (and (not (gnc:report-dirty? report))
|
||||
(gnc:report-ctext report))
|
||||
;; if there's clean cached text, return it
|
||||
(begin
|
||||
(gnc:report-ctext report))
|
||||
|
||||
;; otherwise, rerun the report
|
||||
(let ((template (hash-ref *gnc:_report-templates_*
|
||||
(gnc:report-type report))))
|
||||
(if template
|
||||
(let* ((renderer (gnc:report-template-renderer template))
|
||||
(stylesheet (gnc:report-stylesheet report))
|
||||
(doc (renderer report))
|
||||
(html #f))
|
||||
(gnc:html-document-set-style-sheet! doc stylesheet)
|
||||
(set! html (gnc:html-document-render doc))
|
||||
(gnc:report-set-ctext! report html)
|
||||
(gnc:report-set-dirty?! report #f)
|
||||
html)
|
||||
#f))))
|
||||
|
||||
;; render the body of the report document (ignoring style sheet)
|
||||
(define (gnc:report-render-body report)
|
||||
(if (and (not (gnc:report-dirty? report))
|
||||
(gnc:report-ctext report))
|
||||
;; if there's clean cached text, return it
|
||||
(begin
|
||||
(gnc:report-ctext report))
|
||||
|
||||
;; otherwise, rerun the report
|
||||
(let ((template (hash-ref *gnc:_report-templates_*
|
||||
(gnc:report-type report))))
|
||||
(if template
|
||||
(let* ((renderer (gnc:report-template-renderer template))
|
||||
(stylesheet (gnc:report-stylesheet report))
|
||||
(doc (renderer report))
|
||||
(html #f))
|
||||
|
||||
(gnc:html-document-push-style
|
||||
doc (gnc:html-style-sheet-style stylesheet))
|
||||
(set! html (gnc:html-document-render-body doc))
|
||||
(gnc:report-set-ctext! report html)
|
||||
(gnc:report-set-dirty?! report #f)
|
||||
html)
|
||||
#f))))
|
||||
|
||||
|
||||
(define (gnc:report-run id)
|
||||
(gnc:backtrace-if-exception
|
||||
(lambda ()
|
||||
(let ((report (gnc:find-report id))
|
||||
(start-time (gettimeofday)))
|
||||
(start-time (gettimeofday))
|
||||
(html #f))
|
||||
(if report
|
||||
(if (and (not (gnc:report-dirty? report))
|
||||
(gnc:report-ctext report))
|
||||
;; if there's clean cached text, return it
|
||||
(begin
|
||||
(gnc:report-ctext report))
|
||||
|
||||
;; otherwise, rerun the report
|
||||
(let ((template (hash-ref *gnc:_report-templates_*
|
||||
(gnc:report-type report))))
|
||||
(if template
|
||||
(let* ((renderer (gnc:report-template-renderer template))
|
||||
(stylesheet-name
|
||||
(symbol->string (gnc:option-value
|
||||
(gnc:lookup-option
|
||||
(gnc:report-options report)
|
||||
(N_ "General")
|
||||
(N_ "Stylesheet")))))
|
||||
(stylesheet
|
||||
(gnc:html-style-sheet-find stylesheet-name))
|
||||
(doc (renderer report))
|
||||
(html #f)
|
||||
(formlist #f)
|
||||
(collapsed-list #f))
|
||||
|
||||
(gnc:html-document-set-style-sheet! doc stylesheet)
|
||||
(set! formlist (gnc:html-document-render doc))
|
||||
(set! collapsed-list
|
||||
(gnc:report-tree-collapse formlist))
|
||||
(set! html (apply string-append collapsed-list))
|
||||
(gnc:report-set-ctext! report html)
|
||||
(gnc:report-set-dirty?! report #f)
|
||||
|
||||
(display "total time to run report: ")
|
||||
(display (gnc:time-elapsed start-time (gettimeofday)))
|
||||
(newline)
|
||||
|
||||
html)
|
||||
#f)))
|
||||
(begin
|
||||
(set! html (gnc:report-render-html report))
|
||||
(display "total time to run report: ")
|
||||
(display (gnc:time-elapsed start-time (gettimeofday)))
|
||||
(newline)
|
||||
html)
|
||||
#f)))))
|
||||
|
||||
|
||||
(gnc:hook-add-dangler gnc:*main-window-opened-hook* gnc:report-menu-setup)
|
||||
|
||||
|
||||
|
||||
@ -79,20 +79,22 @@
|
||||
;; hash is an attempt to compute how many columnc are
|
||||
;; actually used in a row; items with non-1 rowspans will take
|
||||
;; up cells in the row without actually being in the row.
|
||||
(let* ((report (gnc:find-report (car report-info)))
|
||||
(let* ((subreport (gnc:find-report (car report-info)))
|
||||
(colspan (cadr report-info))
|
||||
(rowspan (caddr report-info))
|
||||
(template (hash-ref *gnc:_report-templates_*
|
||||
(gnc:report-type report)))
|
||||
(renderer (gnc:report-template-renderer template))
|
||||
(report-doc (renderer report))
|
||||
(report-style (gnc:html-document-style report-doc))
|
||||
(report-objects (gnc:html-document-objects report-doc))
|
||||
(toplevel-cell (gnc:make-html-table-cell/size rowspan colspan))
|
||||
(report-table (gnc:make-html-table))
|
||||
(contents-cell
|
||||
(apply gnc:make-html-table-cell report-objects))
|
||||
(toplevel-cell
|
||||
(gnc:make-html-table-cell/size rowspan colspan)))
|
||||
(contents-cell (gnc:make-html-table-cell)))
|
||||
|
||||
;; set the report's style properly ... this way it will
|
||||
;; also get marked as dirty when the stylesheet is edited.
|
||||
(gnc:report-set-stylesheet!
|
||||
subreport (gnc:report-stylesheet report))
|
||||
|
||||
;; render the report body ... hopefully this will DTRT
|
||||
;; and cache when it's ok to cache.
|
||||
(gnc:html-table-cell-append-objects!
|
||||
contents-cell (gnc:report-render-body subreport))
|
||||
|
||||
;; increment the alloc number for each occupied row
|
||||
(let loop ((row current-row-num))
|
||||
@ -103,26 +105,27 @@
|
||||
(if (< (- row current-row-num) rowspan)
|
||||
(loop (+ 1 row)))))
|
||||
|
||||
(gnc:html-table-cell-set-style-internal!
|
||||
contents-cell report-style)
|
||||
|
||||
(gnc:html-table-cell-set-style!
|
||||
toplevel-cell "td"
|
||||
'attribute (list "valign" "top")
|
||||
'inheritable? #f)
|
||||
|
||||
;; put the report in the contents-cell
|
||||
(gnc:html-table-append-row!
|
||||
report-table (list contents-cell))
|
||||
(gnc:html-table-append-row! report-table (list contents-cell))
|
||||
|
||||
;; and a parameter editor
|
||||
;; and a parameter editor link
|
||||
(gnc:html-table-append-row!
|
||||
report-table
|
||||
(list (gnc:make-html-text
|
||||
(gnc:html-markup-anchor
|
||||
(sprintf #f "gnc-options:report-id=%a" (car report-info))
|
||||
"Edit Options"))))
|
||||
|
||||
"Edit Options")
|
||||
" "
|
||||
(gnc:html-markup-anchor
|
||||
(sprintf #f "gnc-report:id=%a" (car report-info))
|
||||
"Single Report"))))
|
||||
|
||||
|
||||
;; add the report-table to the toplevel-cell
|
||||
(gnc:html-table-cell-append-objects!
|
||||
toplevel-cell report-table)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user