mirror of
https://github.com/Gnucash/gnucash.git
synced 2026-07-29 23:58:03 -05:00
Fix Bug#342736 by replacing "make-shared-substring" with "substring".
Guile 1.8 automatically shares strings as copy-on-write and no longer provides the "make-shared-substring" procedure. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@14159 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
@@ -94,10 +94,10 @@
|
|||||||
;; Values are URL-encoded, so url:decode must be called on each one.
|
;; Values are URL-encoded, so url:decode must be called on each one.
|
||||||
(define (get-name pair)
|
(define (get-name pair)
|
||||||
(let ((p (string-index pair #\=)))
|
(let ((p (string-index pair #\=)))
|
||||||
(and p (make-shared-substring pair 0 p))))
|
(and p (substring pair 0 p))))
|
||||||
(define (get-value pair)
|
(define (get-value pair)
|
||||||
(let ((p (string-index pair #\=)))
|
(let ((p (string-index pair #\=)))
|
||||||
(and p (url:decode (make-shared-substring pair (+ p 1))))))
|
(and p (url:decode (substring pair (+ p 1))))))
|
||||||
(for-each (lambda (pair)
|
(for-each (lambda (pair)
|
||||||
(let* ((name (get-name pair))
|
(let* ((name (get-name pair))
|
||||||
(value (get-value pair))
|
(value (get-value pair))
|
||||||
@@ -180,6 +180,6 @@
|
|||||||
(str str))
|
(str str))
|
||||||
(let ((pos (string-rindex str ch)))
|
(let ((pos (string-rindex str ch)))
|
||||||
(if pos
|
(if pos
|
||||||
(loop (cons (make-shared-substring str (+ 1 pos)) fields)
|
(loop (cons (substring str (+ 1 pos)) fields)
|
||||||
(make-shared-substring str 0 pos))
|
(substring str 0 pos))
|
||||||
(cons str fields)))))
|
(cons str fields)))))
|
||||||
|
|||||||
@@ -116,9 +116,9 @@
|
|||||||
(define (parse-status-line statline)
|
(define (parse-status-line statline)
|
||||||
(let* ((first (string-index statline #\space))
|
(let* ((first (string-index statline #\space))
|
||||||
(second (string-index statline #\space (1+ first))))
|
(second (string-index statline #\space (1+ first))))
|
||||||
(list (make-shared-substring statline 0 first)
|
(list (substring statline 0 first)
|
||||||
(make-shared-substring statline (1+ first) second)
|
(substring statline (1+ first) second)
|
||||||
(make-shared-substring statline (1+ second)))))
|
(substring statline (1+ second)))))
|
||||||
|
|
||||||
|
|
||||||
;;; HTTP connection management functions.
|
;;; HTTP connection management functions.
|
||||||
@@ -299,4 +299,4 @@
|
|||||||
(set! end (1- end)))
|
(set! end (1- end)))
|
||||||
(if (< end st)
|
(if (< end st)
|
||||||
""
|
""
|
||||||
(make-shared-substring s st end))))
|
(substring s st end))))
|
||||||
|
|||||||
@@ -71,7 +71,7 @@
|
|||||||
|
|
||||||
;; pick the 1-char tag off from the remainder of the line
|
;; pick the 1-char tag off from the remainder of the line
|
||||||
(set! tag (string-ref line 0))
|
(set! tag (string-ref line 0))
|
||||||
(set! value (make-shared-substring line 1))
|
(set! value (substring line 1))
|
||||||
|
|
||||||
;; now do something with the line
|
;; now do something with the line
|
||||||
(if
|
(if
|
||||||
|
|||||||
@@ -28,7 +28,7 @@
|
|||||||
(if (and (string? line)
|
(if (and (string? line)
|
||||||
(not (string=? line "")))
|
(not (string=? line "")))
|
||||||
(let ((tag (string-ref line 0))
|
(let ((tag (string-ref line 0))
|
||||||
(value (make-shared-substring line 1)))
|
(value (substring line 1)))
|
||||||
(set! byte-count (+ (string-length line) byte-count))
|
(set! byte-count (+ (string-length line) byte-count))
|
||||||
(case tag
|
(case tag
|
||||||
((#\^) #t)
|
((#\^) #t)
|
||||||
|
|||||||
@@ -197,8 +197,8 @@ the current value of the path.")
|
|||||||
(gnc:debug "handling arg " item)
|
(gnc:debug "handling arg " item)
|
||||||
|
|
||||||
(if (not (string=? "--"
|
(if (not (string=? "--"
|
||||||
(make-shared-substring item 0
|
(substring item 0
|
||||||
(min (string-length item) 2))))
|
(min (string-length item) 2))))
|
||||||
(begin
|
(begin
|
||||||
(gnc:debug "non-option " item ", assuming file")
|
(gnc:debug "non-option " item ", assuming file")
|
||||||
(set! rest (cdr rest))
|
(set! rest (cdr rest))
|
||||||
@@ -208,7 +208,7 @@ the current value of the path.")
|
|||||||
;; ignore --
|
;; ignore --
|
||||||
(set! rest (cdr rest))
|
(set! rest (cdr rest))
|
||||||
;; Got something that looks like an option...
|
;; Got something that looks like an option...
|
||||||
(let* ((arg-string (make-shared-substring item 2))
|
(let* ((arg-string (substring item 2))
|
||||||
(arg-def (assoc-ref gnc:*arg-defs* arg-string)))
|
(arg-def (assoc-ref gnc:*arg-defs* arg-string)))
|
||||||
|
|
||||||
(if (not arg-def)
|
(if (not arg-def)
|
||||||
|
|||||||
Reference in New Issue
Block a user