Ticket #635: pstk-noapplyhack.patch.txt

File pstk-noapplyhack.patch.txt, 2.2 KB (added by Jim Ursetto, 10 years ago)
Line 
1Index: pstk.scm
2===================================================================
3--- pstk.scm    (revision 24318)
4+++ pstk.scm    (working copy)
5@@ -155,7 +155,9 @@
6     )
7   (import scheme chicken posix)
8 
9-  (use posix)
10+  (use posix
11+       (only data-structures string-intersperse)
12+       (only srfi-13 string-concatenate))
13 
14   (define *wish-program* "tclsh8.5")
15   (define *wish-debug-input* #f)
16@@ -247,10 +249,7 @@
17      (ttk-widget-map '())
18 
19      (tk-init-string
20-       (apply string-append
21-              (apply append
22-                     (map (lambda (s)
23-                            (list s (string #\newline)))
24+       (string-intersperse
25                           '("package require Tk"
26                             "if {[package version tile] != \"\"} {"
27                             "    package require tile"
28@@ -321,7 +320,8 @@
29                             "        puts \"(return \\\"[string map [list \\\\ \\\\\\\\ \\\" \\\\\\\"] $result]\\\")\""
30                             "    }"
31                             "    flush stdout"
32-                            "}")))))
33+                            "}")
34+                          nl))
35 
36      (report-error
37        (lambda (x)
38@@ -380,7 +380,7 @@
39                ((null? x) "()")
40                ((pair? x)
41                 (string-append "("
42-                               (apply string-append
43+                               (string-concatenate
44                                       (improper-list->string x #t))
45                                ")"))
46                ((eof-object? x) "#<eof>")
47@@ -615,7 +615,7 @@
48 
49      (scheme-arglist->tk-argstring
50        (lambda (args)
51-         (apply string-append
52+         (string-concatenate
53                 (map scheme-arg->tk-arg
54                      args))))
55 
56@@ -662,7 +662,7 @@
57            ((collect-chars
58               (lambda (c s)
59                 (cond ((or (eof-object? c) (char=? c #\newline))
60-                       (apply string (reverse s)))
61+                       (reverse-list->string s))
62                       (else (collect-chars (read-char in) (cons c s))))))
63             (first-char
64               (read-char in)))