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

Make pstk use libraries instead of (foreign c) directly

This commit is contained in:
retropikzel 2025-12-14 08:13:36 +02:00
parent 472b4dbc6d
commit f88ed911c2
3 changed files with 12 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
retropikzel/pstk.scm
View File

@ -1,10 +1,11 @@
(define-c-library libc (define (temp-name)
'("stdlib.h" "stdio.h" "unistd.h") (string-append "pstk-"
libc-name (number->string (random-integer 1000))
'((additional-versions ("0" "6")))) "-"
(number->string (random-integer 1000))
"-"
(number->string (random-integer 1000))))
(define-c-procedure c-tempnam libc 'tempnam 'pointer '(pointer pointer))
(define-c-procedure c-system libc 'system 'int '(pointer))
(define wish-display pipe-write-string) (define wish-display pipe-write-string)
(define wish-read (lambda (pipe) (define wish-read (lambda (pipe)
(let ((result (pipe-read pipe))) (let ((result (pipe-read pipe)))
@ -17,11 +18,7 @@
(define wish-flush (lambda () #t)) ; No need to do anything (define wish-flush (lambda () #t)) ; No need to do anything
(define wish-read-line pipe-read-line) (define wish-read-line pipe-read-line)
(define (run-program program) (define (run-program program)
(let* ((temp-prefix (string->c-utf8 "npcmd")) (let* ((input-path (temp-name))
(temp-name (lambda ()
(c-utf8->string (c-tempnam (make-c-null)
temp-prefix))))
(input-path (temp-name))
(output-path (temp-name)) (output-path (temp-name))
(shell-command (string-append program (shell-command (string-append program
" < " " < "
@ -33,7 +30,7 @@
" & "))) " & ")))
(create-pipe input-path 0777) (create-pipe input-path 0777)
(create-pipe output-path 0777) (create-pipe output-path 0777)
(c-system (string->c-utf8 shell-command)) (system shell-command)
(list (open-input-pipe input-path) (list (open-input-pipe input-path)
(open-output-pipe output-path)))) (open-output-pipe output-path))))

5
retropikzel/pstk.sld
View File

@ -106,8 +106,9 @@
(scheme file) (scheme file)
(scheme write) (scheme write)
(scheme process-context) (scheme process-context)
(foreign c) (retropikzel named-pipes)
(retropikzel named-pipes)) (retropikzel system)
(srfi 27))
(export tk-eval (export tk-eval
tk-id->widget tk-id->widget
tk-var tk-var

3
retropikzel/pstk/test.scm
View File

@ -1,6 +1,3 @@
(import (scheme base)
(scheme write)
(retropikzel pstk))
(let ((tk (tk-start))) (let ((tk (tk-start)))
(tk/pack (tk 'create-widget (tk/pack (tk 'create-widget