brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Finish new progress.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-20 16:34:44 +01:00
parent 08ad923f6a
commit a21de657d0
3 changed files with 25 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -115,7 +115,7 @@ ansi.import.scm: $(ANSI-SOURCES)
MEMBER-FILE-SOURCES=member-file.scm dictionary.import.scm \ MEMBER-FILE-SOURCES=member-file.scm dictionary.import.scm \
ansi.import.scm month.import.scm period.import.scm \ ansi.import.scm month.import.scm period.import.scm \
listing.import.scm testing.import.scm \ listing.import.scm testing.import.scm \
configuration.import.scm configuration.import.scm progress.import.scm
member-file.so: member-file.o member-file.so: member-file.o
member-file.o: member-file.import.scm member-file.o: member-file.import.scm

6
member-file.scm
View file

@ -46,7 +46,8 @@
testing testing
listing listing
ansi ansi
configuration) configuration
progress)
;; Specification of known keys for various types of parsing ;; Specification of known keys for various types of parsing
(define known-keys '(nick mail phone name born joined destroyed (define known-keys '(nick mail phone name born joined destroyed
@ -92,12 +93,13 @@
;; *member-file-check-syntax* parameter. ;; *member-file-check-syntax* parameter.
(define (report-line-error file-name lines highlight message) (define (report-line-error file-name lines highlight message)
(when (not (eq? (*member-file-check-syntax*) 'quiet)) (when (not (eq? (*member-file-check-syntax*) 'quiet))
(progress-break
(print "Error in " file-name ": " message) (print "Error in " file-name ": " message)
(newline) (newline)
(print-source-listing lines (list highlight) (print-source-listing lines (list highlight)
(*member-file-context*) (*member-file-context*)
a:error a:default a:error a:default
"" "" "...")) "" "" "...")))
(if (eq? (*member-file-check-syntax*) 'error) (if (eq? (*member-file-check-syntax*) 'error)
(exit 1) (exit 1)
(list member-file-error-symbol (list member-file-error-symbol

15
progress.scm
View file

@ -31,6 +31,8 @@
run-with-progress run-with-progress
progress-advance progress-advance
with-progress with-progress
run-progress-break
progress-break
) )
(import scheme (import scheme
@ -63,12 +65,25 @@
(print post-msg)) (print post-msg))
result))) result)))
;; Allows printing output when progress is advancing.
(define (run-progress-break thunk)
(when (*current-progress*)
(display "\r\x1b[K"))
(thunk)
(print-current-progress))
;; Friendly syntax wrapper. ;; Friendly syntax wrapper.
(define-syntax with-progress (define-syntax with-progress
(syntax-rules () (syntax-rules ()
((_ echo? pre post body ...) ((_ echo? pre post body ...)
(run-with-progress echo? pre post (lambda () body ...))))) (run-with-progress echo? pre post (lambda () body ...)))))
;; Evaluate some expressions without progress.
(define-syntax progress-break
(syntax-rules ()
((_ body ...)
(run-progress-break (lambda () body ...)))))
;; If the program uses progress module, disable buffering ;; If the program uses progress module, disable buffering
(set-buffering-mode! (current-output-port) #:none) (set-buffering-mode! (current-output-port) #:none)