From the manual:
"Guile goes beyond the rather austere language presented in R5RS,
extending it with a module system, full access to POSIX system calls ..."
Now, full access to "POSIX system calls" means more and less than that.
When you want to have a look at my current terminal application driver
you will see it's current shortcomings: missing a general (Linux
specific) /ioctl/ primitive it uses the /stty/ command to set raw and
sane mode of terminal operation. Try to read out the dimension of the
terminal with /get-dimensions/: for me this surprisingly works
flawlessly in the modern Gnome Terminal - but it remains stuck in the
response reader on a Linux tty and even in XTerm itsself although the
escape sequence used stems from it's documentation (ctlseqs.txt). Well,
probably window control sequences are turned off on my Ubuntu system and
I should revert to the Linux specific ioctl.
What I wanted to tell the RnRS folks: the current POSIX interface still
is based heavily on Scsh's flat "wrapper" with out any semantics.
Accessing regular files works great but the UNIX file system is system
namespace. The entries usually held in "/dev" can be accessed like
regular files but denote *devices*. Each and every device has it's own
semantics - I don't know if terminals are one of the worst class of
devices but at least these virtual devices have a very long history
(100+ years) of being useful teletypewriters in Telex and other uses.
Escape sequences do work great but today it's not enough. I would like
to suggest rethinking the POSIX interface to allow it to be extended
with device semantics, i.e. meaningful entries. In the case of the
virtual terminal a well crafted terminal device application driver
allows to do without the C-specific readline and ncurses libraries and
it would allow to write real applications capable of treating the
terminal as the keyboard+screen that it is instead of abusing it as
stdio like a typewriter from 100 years ago.
Please respect the semantics of devices especially when they may look
like files. POSIX isn't that important or useful anymore but "full
access to POSIX system calls" it has never been. And especially on Linux
(but probably on Darwin, too) one might try to ask to add a more Scheme
friendly system interface to the kernel - but ioctl's complexity arises
from the diversity of the controlled devices and their capabilities.
There is a preliminary incomplete implementation of such a meaningful
device driver attached. It's very incomplete but nonetheless useful.
(define-module (terminal)
:use-module (oop goops)
:use-module (pretext)
:use-module (characters)
:export (<terminal> full-reset
tty-raw-mode tty-sane-mode
SRM-echo-off SRM-echo-on
cursor-home
cursor-up cursor-down
cursor-forward cursor-backward
erase-line erase-display
get-dimensions
start-event-loop print))
;;
;; Terminal Class Interface Implementation
;;
(define-class <terminal> ()
(port #:init-value #f
#:getter get-port
#:init-keyword #:port))
(define-method (control (terminal <terminal>) control-characters)
(display (list->string control-characters) (get-port terminal)))
(define-method (full-reset (terminal <terminal>))
(control terminal '(#\esc #\c)))
;;
;; Control Sequence Introduction
(define CSI '(#\esc #\[))
;;
;; SRM: Send Receive Mode
;; turn terminal echo on or off
(define-method (SRM-echo-off (terminal <terminal>))
(control terminal (append CSI '(#\1 #\2 #\h))))
(define-method (SRM-echo-on (terminal <terminal>))
(control terminal (append CSI '(#\1 #\2 #\l))))
;;
;; CSI: Cursor Control
(define-method (cursor-home (terminal <terminal>))
(control terminal (append CSI '(#\0 #\; #\0 #\f))))
(define-method (cursor-up (terminal <terminal>))
(control terminal (append CSI '(#\A))))
(define-method (cursor-down (terminal <terminal>))
(control terminal (append CSI '(#\B))))
(define-method (cursor-forward (terminal <terminal>))
(control terminal (append CSI '(#\C))))
(define-method (cursor-backward (terminal <terminal>))
(control terminal (append CSI '(#\D))))
;;
;; CSI: Erase
(define-method (erase-line (terminal <terminal>))
(control terminal (append CSI '(#\2 #\K))))
(define-method (erase-display (terminal <terminal>))
(control terminal (append CSI '(#\2 #\J))))
;;
;; CSI: Window Control (dtterm&extensions, XTerm)
(define (CSI-window-control string)
(append CSI (string->list string)))
(define-method (get-dimensions (terminal <terminal>)) ;XXX XXX XXX
(let ((response-introduction (append CSI '(#\9)))
(port (get-port terminal))
(x '()) (y '()))
(control terminal (append CSI (string->list "18t")))
(my-debug " READ CHAR AHEAD")
(let response-reader ((char (read-char port)))
(my-debug " RED CHAR ")
(if (null? response-introduction)
(begin
(let y-value ((char (read-char port)))
(if (not (eq? char #\;))
(begin
(set! y (append y (list char)))
(y-value (read-char port)))))
(let x-value ((char (read-char port)))
(if (not (eq? char #\t))
(begin
(set! x (append x (list char)))
(x-value (read-char port)))) ))
(begin
(set! response-introduction (cdr response-introduction))
(response-reader (read-char) ))) )
(values (string->number (list->string x))
(string->number (list->string y))) ))
(define (private/tty-raw-mode tty)
(system (string-append "stty --file=" (ttyname tty) " "
"raw" " "
"-echo")))
(define (private/tty-sane-mode tty)
(system (string-append "stty --file=" (ttyname tty) " "
"sane")))
(define-method (tty-raw-mode (terminal <terminal>))
(private/tty-raw-mode (get-port terminal)))
(define-method (tty-sane-mode (terminal <terminal>))
(private/tty-sane-mode (get-port terminal)))
(define (print . args) ;; this is not even virtual print vt220 terms
(for-each display args))
(define (print-safely char)
(if (printable? char)
(print char)
(print "#" (char->integer char))))
(define (convert-csi-input port)
(let ((char (read-char port)))
(case char
((#\A) 'up)
((#\B) 'down)
((#\C) 'right)
((#\D) 'left)
((#\H) 'home)
((#\F) 'end)
((#\3) 'delete)
;((#\5) 'page-up) ; XXX there appears a "~" behind these
;((#\6) 'page-down)
(else ; unknown CSI input follow-up XXX just beep
(print " CSI ")
(print-safely char)) )))
(define (convert-escape-sequence port)
(let ((char (read-char port)))
(if (eq? #\[ char)
(convert-csi-input port)
(begin ; unknown escape sequence input XXX just beep
(display " ESC-SEQ ")
(print-safely char)) )))
(define (dispatch-on-escape port)
(if (not (char-ready? port))
#\esc ; user typed escape goes to event handler
(convert-escape-sequence port) ))
(define-method (start-event-loop (terminal <terminal>) event-handler)
(let ((port (get-port terminal)))
(let event-loop ((char (read-char port)))
(if (is-unicode-c0? (char->byte char))
(event-handler (case char
((#\esc) (dispatch-on-escape port))
(else char)))
;else beep perhaps
)
(event-loop (read-char port)) )))
;;
;; Protocol Key Event
;;
;; A key event is either a character or a symbol corresponding to the
;; respective keys.
;; '(up down forward backward home end delete ;page-up page-down)
(use-modules (oop goops) (terminal))
(define terminal (make <terminal>
#:port (fdopen (port->fdes (current-output-port))
"r+0b")))
(define (test-dispatcher key-code)
(case key-code
((#\esc) (cursor-home)
(erase-display terminal)
(tty-sane-mode terminal)
(quit))
((home) (cursor-home terminal))
((up) (cursor-up terminal))
((down) (cursor-down terminal))
(else
(display "."))))
(define (start)
(tty-raw-mode terminal)
(start-event-loop terminal test-dispatcher))
(define-module (characters))
(define-public (char->byte char)
(char->integer char))
;;
;; Unicode C0 Classes
(define-public (byte? number)
"Return true if the parameter number is a valid byte value."
(and (exact? number)
(integer? number)
(and (>= 0 byte) (<= byte 255))) ) ; beware of the evil minus
(define-public (is-unicode-c0? byte)
"Return true if the byte value is part of Unicode C0."
(and (>= byte 0) (<= byte 127)))
(define-public (is-unicode-c0-printable? byte)
"Return true if the byte value is a printable character in Unicode C0."
(and (>= byte 33) (<= byte 126)))
(define-public (printable? character) ; convenience abbreviation
(is-unicode-c0-printable? (char->integer character)))
(define-public (control-code? character)
(not (printable? character)))
;;
;; Pretext
;;
(define-module (pretext))
; #:replace (list-head))
;;
;; Runtime Environment Options
;;
(debug-set! stack (* 2 (expt 10 7)))
(debug-set! depth 200)
(debug-set! maxdepth (expt 10 6))
(define (natural-number? n)
(and (exact? n)
(integer? n) ; 'integer?' does not check for exactness ...
(> n 0)))
(define-public (repeat n closure)
"Execute closure n times."
(if (not (or (natural-number? n) (= n 0)))
(error "repeat: the parameter n must be an exact natural number or zero.")
(let loop ((i 0))
(if (< i n)
(begin
(closure)
(loop (1+ i)))) )))
(define-public from-module @)
(define-public (my-debug . args)
(for-each (lambda (arg) (display arg))
args)
(newline))
;(define-public debug my-debug)
(define-public (my-list-head list n)
(if (or (null? list) (<= n 0))
'()
(cons (car list) (my-list-head (cdr list) (- n 1)))))
(define (my-take list n)
(if (< n 0)
(error "take: the parameter n has to be an exact natural number or zero"))
(cond ((and (not (null? list)) (= n 0)) '())
((and (null? list) (not (= n 0)))
(error "take: argument out of range: n was greater than the length of the list."))
((and (not (null? list)) (> n 0))
(cons (car list)
(take (cdr list) (- n 1)) ))
(else
(error "take: Oh dear, we failed!"))) )
