IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

[eguile-gnc] fix whitespace

Browse Source
This commit is contained in:
Christopher Lam 2019-07-28 14:30:58 +08:00
parent 955a5651d8
commit c81e9354f7
1 changed files with 41 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
gnucash/report/report-system/eguile-gnc.scm
View File

@ -134,44 +134,40 @@
;; display either code or text ;; display either code or text
(define (display-it t code?) (define (display-it t code?)
(if code? (if code?
(display t) (display t)
(display-text t))) (display-text t)))
(define stop textstop) ; text to output at end of current section (define stop textstop) ; text to output at end of current section
;; switch between code and text modes ;; switch between code and text modes
(define (switch-mode code? dmodifier?) (define (switch-mode code? dmodifier?)
(display stop) (display stop)
(if code? (cond
(begin ; code mode to text mode (code? (display textstart)
(display textstart) (set! stop textstop))
(set! stop textstop)) (dmodifier? (display dcodestart)
(begin ; text mode to code mode (set! stop dcodestop))
(if dmodifier? (else (display codestart)
(begin (set! stop codestop))))
(display dcodestart)
(set! stop dcodestop))
(begin
(display codestart)
(set! stop codestop))))))
;; recursively process input stream ;; recursively process input stream
(define (loop inp needle other code? line) (define (loop inp needle other code? line)
(if (equal? line "") (when (string-null? line)
(set! line (read-line inp 'concat))) (set! line (read-line inp 'concat)))
(if (not (eof-object? line)) (unless (eof-object? line)
(let ((match (regexp-exec needle line))) (cond
(if match ((regexp-exec needle line)
(let ((dmodifier? #f)) => (lambda (rmatch)
(display-it (match:prefix match) code?) (let ((dmodifier? #f))
(if (not code?) (display-it (match:prefix rmatch) code?)
; switching from text to code -- check for modifier (unless code?
(set! dmodifier? (match:substring match 1))) ;; switching from text to code -- check for modifier
(switch-mode code? dmodifier?) (set! dmodifier? (match:substring rmatch 1)))
(loop inp other needle (not code?) (match:suffix match))) (switch-mode code? dmodifier?)
(begin ; no match - output whole line and continue (loop inp other needle (not code?) (match:suffix rmatch)))))
(display-it line code?) (else ; no match - output whole line and continue
(loop inp needle other code? "")))))) (display-it line code?)
(loop inp needle other code? "")))))
(display textstart) (display textstart)
(loop (current-input-port) startre endre #f "") (loop (current-input-port) startre endre #f "")
@ -182,7 +178,7 @@
;; Evaluate input containing Scheme code, trapping errors ;; Evaluate input containing Scheme code, trapping errors
;; e.g. (display "Text ")(display (+ x 2))(display ".") -> Text 42. ;; e.g. (display "Text ")(display (+ x 2))(display ".") -> Text 42.
;; Parameters: ;; Parameters:
;; env - environment in which to do the evaluation; ;; env - environment in which to do the evaluation;
;; if #f, (the-environment) will be used ;; if #f, (the-environment) will be used
(define (script->output env) (define (script->output env)
; Placeholder for the normal stack and error stack in case of an error ; Placeholder for the normal stack and error stack in case of an error
@ -195,7 +191,7 @@
; Capture the current stack, so we can detect from where we ; Capture the current stack, so we can detect from where we
; need to display the stack trace ; need to display the stack trace
(set! good-stack (make-stack #t)) (set! good-stack (make-stack #t))
(local-eval s-expression (or env (the-environment))) (local-eval s-expression (or env (the-environment)))
(set! s-expression (read))))) (set! s-expression (read)))))
; Error handler to display any errors while evaluating the template ; Error handler to display any errors while evaluating the template
@ -221,7 +217,10 @@
(error-length (stack-length error-stack))) (error-length (stack-length error-stack)))
; Show the backtrace. Remove one extra from the "first" ; Show the backtrace. Remove one extra from the "first"
; argument, since that is an index, not a count. ; argument, since that is an index, not a count.
(display-backtrace error-stack (current-output-port) (- (- error-length remove-top) 1) (- (- error-length remove-top) remove-bottom))) (display-backtrace error-stack
(current-output-port)
(- (- error-length remove-top) 1)
(- (- error-length remove-top) remove-bottom)))
(display "</pre><br>")) (display "</pre><br>"))
; This handler will be called by catch before unwinding the ; This handler will be called by catch before unwinding the
@ -249,15 +248,18 @@
;; Process a template file and return the result as a string ;; Process a template file and return the result as a string
(define (eguile-file-to-string infile environment) (define (eguile-file-to-string infile environment)
(if (not (access? infile R_OK)) (cond
(format #f (_ "Template file \"~a\" can not be read") infile) ((not (access? infile R_OK))
(let ((script (with-input-from-file (format #f (_ "Template file \"~a\" can not be read") infile))
infile (else
(lambda () (with-output-to-string template->script))))) (let ((script (with-input-from-file infile
(lambda ()
(with-output-to-string template->script)))))
(with-output-to-string (with-output-to-string
(lambda () (with-input-from-string (lambda ()
script (with-input-from-string script
(lambda () (script->output environment)))))))) (lambda ()
(script->output environment)))))))))
(export eguile-file-to-string) (export eguile-file-to-string)