From 1aff3a7138de894f0098d8beac14990aa11d9089 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Wed, 1 May 2019 21:09:00 +0200 Subject: Add options to --statprof. --- module/main.scm | 27 +++++++++++++++++---------- 1 file changed, 17 insertions(+), 10 deletions(-) diff --git a/module/main.scm b/module/main.scm index d6b1d358..24fdf193 100755 --- a/module/main.scm +++ b/module/main.scm @@ -28,8 +28,8 @@ ;; given procedure @var{proc}. ;; ;; Given as a sepparate function from main to ease debugging. -(define (init proc) - (define calendars (map make-vcomponent (calendar-files))) +(define* (init proc #:key (calendar-files (calendar-files))) + (define calendars (map make-vcomponent calendar-files)) (define events (concatenate (map (cut children <> 'VEVENT) calendars))) (let* ((repeating regular (partition repeating? events))) @@ -46,7 +46,8 @@ (define options '((mode (value #t) (single-char #\m)) - (statprof (value #f)))) + (files (value #t) (single-char #\f)) + (statprof (value optional)))) (define (ornull a b) (if (null? a) @@ -54,12 +55,15 @@ (define (main args) (let ((opts (getopt-long args options #:stop-at-first-non-option #t))) - ((lambda (thunk) (if (option-ref opts 'statprof #f) - ((@ (statprof) statprof) - thunk - #:count-calls? #t - #:display-style 'tree) - (thunk))) + ((lambda (thunk) + (let ((stprof (option-ref opts 'statprof #f))) + (if stprof + ((@ (statprof) statprof) thunk + #:count-calls? #t + #:port (current-error-port) + #:display-style (if (boolean? stprof) 'flat (string->symbol stprof))) + (thunk)))) + (lambda () (init (lambda (c e) @@ -69,5 +73,8 @@ ((none) none-main) ((html) html-main) ((term) terminal-main)) - c e ropt)))))) + c e ropt))) + #:calendar-files (or (and=> (option-ref opts 'files #f) + list) + (calendar-files))))) (newline))) -- cgit v1.2.3