Add progress skeleton.
This commit is contained in:
parent
dd0e572676
commit
ce348ae901
2 changed files with 80 additions and 4 deletions
14
Makefile
14
Makefile
|
@ -33,22 +33,22 @@ BRMSAPTOOL-DEPS=brmsaptool.scm testing.import.scm listing.import.scm \
|
||||||
ansi.import.scm member-file.import.scm \
|
ansi.import.scm member-file.import.scm \
|
||||||
command-line.import.scm members-base.import.scm \
|
command-line.import.scm members-base.import.scm \
|
||||||
utils.import.scm primes.import.scm member-record.import.scm \
|
utils.import.scm primes.import.scm member-record.import.scm \
|
||||||
configuration.import.scm
|
configuration.import.scm progress.import.scm
|
||||||
|
|
||||||
BRMSAPTOOL-SOURCES=brmsaptool.scm testing.scm listing.scm \
|
BRMSAPTOOL-SOURCES=brmsaptool.scm testing.scm listing.scm \
|
||||||
dictionary.scm month.scm period.scm ansi.scm member-file.scm \
|
dictionary.scm month.scm period.scm ansi.scm member-file.scm \
|
||||||
command-line.scm members-base.scm utils.scm primes.scm \
|
command-line.scm members-base.scm utils.scm primes.scm \
|
||||||
member-record.scm configuration.scm
|
member-record.scm configuration.scm progress.scm
|
||||||
|
|
||||||
BRMSAPTOOL-OBJS=testing.o listing.o month.o period.o ansi.o \
|
BRMSAPTOOL-OBJS=testing.o listing.o month.o period.o ansi.o \
|
||||||
member-file.o dictionary.o command-line.o \
|
member-file.o dictionary.o command-line.o \
|
||||||
members-base.o utils.o primes.o member-record.o \
|
members-base.o utils.o primes.o member-record.o \
|
||||||
configuration.o
|
configuration.o progress.o
|
||||||
|
|
||||||
BRMSAPTOOL-SHARED=testing.so listing.so month.so period.so ansi.so \
|
BRMSAPTOOL-SHARED=testing.so listing.so month.so period.so ansi.so \
|
||||||
member-file.so dictionary.so command-line.so \
|
member-file.so dictionary.so command-line.so \
|
||||||
members-base.so utils.so primes.so member-record.so \
|
members-base.so utils.so primes.so member-record.so \
|
||||||
configuration.so
|
configuration.so progress.so
|
||||||
|
|
||||||
brmsaptool: $(BRMSAPTOOL-DEPS)
|
brmsaptool: $(BRMSAPTOOL-DEPS)
|
||||||
$(CSC) -o $@ $<
|
$(CSC) -o $@ $<
|
||||||
|
@ -162,3 +162,9 @@ CONFIGURATION-SOURCES=configuration.scm month.import.scm
|
||||||
configuration.so: configuration.o
|
configuration.so: configuration.o
|
||||||
configuration.o: configuration.import.scm
|
configuration.o: configuration.import.scm
|
||||||
configuration.import.scm: $(CONFIGURATION-SOURCES)
|
configuration.import.scm: $(CONFIGURATION-SOURCES)
|
||||||
|
|
||||||
|
PROGRESS-SOURCES=progress.scm
|
||||||
|
|
||||||
|
progress.so: progress.o
|
||||||
|
progress.o: progress.import.scm
|
||||||
|
progress.import.scm: $(PROGRESS-SOURCES)
|
||||||
|
|
70
progress.scm
Normal file
70
progress.scm
Normal file
|
@ -0,0 +1,70 @@
|
||||||
|
;;
|
||||||
|
;; progress.scm
|
||||||
|
;;
|
||||||
|
;; Progress reporting.
|
||||||
|
;;
|
||||||
|
;; ISC License
|
||||||
|
;;
|
||||||
|
;; Copyright 2023 Brmlab, z.s.
|
||||||
|
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
|
||||||
|
;;
|
||||||
|
;; Permission to use, copy, modify, and/or distribute this software
|
||||||
|
;; for any purpose with or without fee is hereby granted, provided
|
||||||
|
;; that the above copyright notice and this permission notice appear
|
||||||
|
;; in all copies.
|
||||||
|
;;
|
||||||
|
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
|
||||||
|
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
|
||||||
|
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
|
||||||
|
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
|
||||||
|
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
|
||||||
|
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
|
||||||
|
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
|
||||||
|
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||||
|
;;
|
||||||
|
|
||||||
|
(declare (unit configuration))
|
||||||
|
|
||||||
|
(module
|
||||||
|
progress
|
||||||
|
(
|
||||||
|
run-with-progress
|
||||||
|
progress-advance
|
||||||
|
with-progress
|
||||||
|
)
|
||||||
|
|
||||||
|
(import scheme
|
||||||
|
(chicken base)
|
||||||
|
(chicken format)
|
||||||
|
(chicken port))
|
||||||
|
|
||||||
|
;; Parameterized current progress string
|
||||||
|
(define *current-progress* (make-parameter #f))
|
||||||
|
|
||||||
|
;; Prints current progress.
|
||||||
|
(define (print-current-progress . args)
|
||||||
|
(display (sprintf "\r\x1b[K~A" (*current-progress*))))
|
||||||
|
|
||||||
|
;; Adds something to current progress and refreshes the display.
|
||||||
|
(define (progress-advance str)
|
||||||
|
(*current-progress* (string-append (*current-progress*) (sprintf "~A" str)))
|
||||||
|
(print-current-progress))
|
||||||
|
|
||||||
|
;; Runs given procedure within progress environment
|
||||||
|
(define (run-with-progress pre-msg post-msg thunk)
|
||||||
|
(parameterize ((*current-progress* pre-msg))
|
||||||
|
(print-current-progress)
|
||||||
|
(thunk)
|
||||||
|
(print-current-progress)
|
||||||
|
(print post-msg)))
|
||||||
|
|
||||||
|
;; Friendly syntax wrapper.
|
||||||
|
(define-syntax with-progress
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ pre post body ...)
|
||||||
|
(run-with-progress pre post (lambda () body ...)))))
|
||||||
|
|
||||||
|
;; If the program uses progress module, disable buffering
|
||||||
|
(set-buffering-mode! (current-output-port) #:none)
|
||||||
|
|
||||||
|
)
|
Loading…
Add table
Add a link
Reference in a new issue