Retropikzel
/
foreign-c-libraries
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fixes to pstk tempfile naming

This commit is contained in:
retropikzel 2025-12-14 10:17:43 +02:00
parent f88ed911c2
commit 35da7bc0f0
1 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
retropikzel/pstk.scm
View File

@ -1,10 +1,15 @@
(random-source-randomize! default-random-source)
(define (temp-name) (define (temp-name)
(string-append "pstk-" (let ((file (string-append "/tmp/pstk-"
(number->string (random-integer 1000)) (number->string (random-integer 1000))
"-" "-"
(number->string (random-integer 1000)) (number->string (random-integer 1000))
"-" "-"
(number->string (random-integer 1000)))) (number->string (random-integer 1000)))))
(if (file-exists? file)
(temp-name)
file)))
(define wish-display pipe-write-string) (define wish-display pipe-write-string)
(define wish-read (lambda (pipe) (define wish-read (lambda (pipe)
@ -12,6 +17,10 @@
(if (eof-object? result) (if (eof-object? result)
result result
(read (open-input-string result)))))) (read (open-input-string result))))))
(define (shell-command program output-path input-path)
(string-append program " < " output-path " 1> " input-path " & "))
(define wish-newline (define wish-newline
(lambda (pipe) (lambda (pipe)
(pipe-write-char #\newline pipe))) (pipe-write-char #\newline pipe)))
@ -19,18 +28,10 @@
(define wish-read-line pipe-read-line) (define wish-read-line pipe-read-line)
(define (run-program program) (define (run-program program)
(let* ((input-path (temp-name)) (let* ((input-path (temp-name))
(output-path (temp-name)) (output-path (temp-name)))
(shell-command (string-append program
" < "
output-path
" 1> "
input-path
;" 2> "
;input-path
" & ")))
(create-pipe input-path 0777) (create-pipe input-path 0777)
(create-pipe output-path 0777) (create-pipe output-path 0777)
(system shell-command) (system (shell-command program output-path input-path))
(list (open-input-pipe input-path) (list (open-input-pipe input-path)
(open-output-pipe output-path)))) (open-output-pipe output-path))))