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

[price-quotes] compact gnc:fq-get-quotes

Browse Source
This commit is contained in:
Christopher Lam
2019-08-09 22:49:31 +08:00
parent d5122c97ea
commit 5e8663772a
1 changed files with 30 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
libgnucash/scm/price-quotes.scm
View File

@@ -144,50 +144,43 @@
;; was unparsable. See the gnc-fq-helper for more details
;; about it's output.
(let ((quoter '())
(to-child #f)
(from-child #f))
(let ((quoter #f))
(define (start-quoter)
(if (not (string-null? gnc:*finance-quote-helper*))
(set! quoter (gnc-spawn-process-async
(list "perl" "-w" gnc:*finance-quote-helper*) #t))))
(set! quoter
(gnc-spawn-process-async (list "perl" "-w" gnc:*finance-quote-helper*) #t)))
(define (get-quotes)
(if (not (null? quoter))
(let ((results #f))
(set! to-child (fdes->outport (gnc-process-get-fd quoter 0)))
(set! from-child (fdes->inport (gnc-process-get-fd quoter 1)))
(map
(lambda (request)
(catch
#t
(lambda ()
(gnc:debug "handling-request: " request)
;; we need to display the first element (the method, so it
;; won't be quoted) and then write the rest
(display #\( to-child)
(display (car request) to-child)
(display " " to-child)
(for-each (lambda (x) (write x to-child)) (cdr request))
(display #\) to-child)
(newline to-child)
(force-output to-child)
(set! results (read from-child))
(gnc:debug "results: " results)
results)
(lambda (key . args)
key)))
requests))))
(when quoter
(map
(lambda (request)
(catch #t
(lambda ()
(gnc:debug "handling-request: " request)
;; we need to display the first element (the method,
;; so it won't be quoted) and then write the rest
(with-output-to-port (fdes->outport (gnc-process-get-fd quoter 0))
(lambda ()
(display #\()
(display (car request))
(display " ")
(for-each write (cdr request))
(display #\))
(newline)
(force-output)))
(let ((results (read (fdes->inport (gnc-process-get-fd quoter 1)))))
(gnc:debug "results: " results)
results))
(lambda (key . args) key)))
requests)))
(define (kill-quoter)
(if (not (null? quoter))
(gnc-detach-process quoter #t)))
(when quoter
(gnc-detach-process quoter #t)
(set! quoter #f)))
(dynamic-wind
start-quoter
get-quotes
kill-quoter)))
(dynamic-wind start-quoter get-quotes kill-quoter)))
(define (gnc:book-add-quotes window book)