diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-04-25 20:35:26 +0200 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2019-04-25 20:35:26 +0200 |
| commit | fc61ab9fb1dbf51c7f96f7e08d9e52f2c9a58b51 (patch) | |
| tree | 7347202d91527dc326ff36f004621a71d35ea212 | |
| parent | Made day-stream slightly less buggy. (diff) | |
| download | calp-fc61ab9fb1dbf51c7f96f7e08d9e52f2c9a58b51.tar.gz calp-fc61ab9fb1dbf51c7f96f7e08d9e52f2c9a58b51.tar.xz | |
Move statprof to encompass all.
| -rwxr-xr-x | module/main.scm | 28 | ||||
| -rw-r--r-- | module/output/none.scm | 16 | ||||
| -rw-r--r-- | src/guile_interface.scm.c | 2 |
3 files changed, 26 insertions, 20 deletions
diff --git a/module/main.scm b/module/main.scm index 924a846c..d6b1d358 100755 --- a/module/main.scm +++ b/module/main.scm @@ -45,7 +45,8 @@ (map generate-recurrence-set repeating)))))) (define options - '((mode (value #t) (single-char #\m)))) + '((mode (value #t) (single-char #\m)) + (statprof (value #f)))) (define (ornull a b) (if (null? a) @@ -53,13 +54,20 @@ (define (main args) (let ((opts (getopt-long args options #:stop-at-first-non-option #t))) - (init - (lambda (c e) - (let ((ropt (ornull (option-ref opts '() '()) - '("term")))) - ((case (string->symbol (car ropt)) - ((none) none-main) - ((html) html-main) - ((term) terminal-main)) - c e ropt)))) + ((lambda (thunk) (if (option-ref opts 'statprof #f) + ((@ (statprof) statprof) + thunk + #:count-calls? #t + #:display-style 'tree) + (thunk))) + (lambda () + (init + (lambda (c e) + (let ((ropt (ornull (option-ref opts '() '()) + '("term")))) + ((case (string->symbol (car ropt)) + ((none) none-main) + ((html) html-main) + ((term) terminal-main)) + c e ropt)))))) (newline))) diff --git a/module/output/none.scm b/module/output/none.scm index 2380438b..757ee8bd 100644 --- a/module/output/none.scm +++ b/module/output/none.scm @@ -1,19 +1,17 @@ (define-module (output none) - #:use-module (statprof) #:use-module (vcomponent group) #:use-module (srfi srfi-41) #:use-module (srfi srfi-19) + #:use-module (srfi srfi-19 setters) #:use-module (srfi srfi-19 util) #:use-module (util) #:export (none-main)) (define (none-main calendars events args) (define date (drop-time (current-date))) - (statprof - (lambda () - (group->event-list - (stream-car - ;; TODO reusing the same grouping causes it to lose events. - ;; I currently have no idea why, but it's BAD. - (get-groups-between (group-stream events) - date date)))))) + (group->event-list + (stream-car + ;; TODO reusing the same grouping causes it to lose events. + ;; I currently have no idea why, but it's BAD. + (get-groups-between (group-stream events) + date date)))) diff --git a/src/guile_interface.scm.c b/src/guile_interface.scm.c index 63d3f737..b8830be4 100644 --- a/src/guile_interface.scm.c +++ b/src/guile_interface.scm.c @@ -54,7 +54,7 @@ SCM_DEFINE (vcomponent_get_attribute, "%vcomponent-get-attribute", 2, 0, 0, free(key); - SCM val, attrlist = SCM_EOL, proplist; + SCM val, proplist, attrlist = SCM_EOL; LLIST(strbuf) *triekeys, *trievals; /* For every instance of a line */ FOR (LLIST, content_set, v, c) { |