/usr/lib/s9fes/get-line.scm is in scheme9 2010.11.13-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 | ; Scheme 9 from Empty Space, Function Library
; By Nils M Holm, 2010
; See the LICENSE file of the S9fES package for terms of use
;
; (get-line integer1 integer2 string1 string2) ==> string | #f
;
; GET-LINE edits a single line of text interactively.
;
; INTEGER1 (y) and INTEGER2 (x) specify the coordinates of the
; visual editing buffer on the screen. STRING2 is the initial
; content of the buffer, and STRING2 is a prompt that will be
; displayed in front of the buffer. The length of the buffer
; is unlimited; its visual representation extends to the end
; of the row on the screen. GET-LINE returns a new string with
; the edited content or #F when editing is aborted.
;
; GET-LINE renders the initial content and places the cursor
; at the end of the buffer. Characters typed will be inserted
; into the buffer at cursor position. In addition, GET-LINE
; accepts the following editing commands ([^A] = [control]+[A]):
;
; [^A] go to beginning of buffer.
; [^E] go to end of buffer.
; [^B] move back one character (also [Left]).
; [^D] delete character under cursor.
; [^F] move forward one character (also [Right]).
; [ESC] end editing, return string (also [Enter]).
; [Backspace] delete character to the left.
; [^U] delete all characters in buffer.
; [^C] Abort editing, return #F (also [^G]).
;
; (Example): (begin (curs:initscr)
; (curs:raw)
; (curs:noecho)
; (curs:nonl)
; (get-line 0 0 "" "Enter text here: "))
(require-extension curses)
(define (get-line y x buf prompt)
(let* ((lim 256)
(cols (- (curs:cols) x))
(rk 0)
(s buf)
(o (string-length prompt))
(i (string-length s))
(z i)
(t 0))
(curs:move y x)
(curs:clrtoeol)
(curs:standout)
(curs:addstr prompt)
(curs:standend)
(let loop ()
(if (> (- i t) (- cols o 2))
(set! t (- i (- cols o 2))))
(if (< i t)
(set! t i))
(curs:mvaddstr y o (substring s t (+ t (min (- z t)
(- cols o 2)))))
(curs:clrtoeol)
(curs:move y (+ o (- i t)))
(let ((k (curs:getch)))
(cond ((or (= k 27)
(= k 13))
(curs:move y x)
(curs:clrtoeol)
s)
((and (<= 32 k 126)
(< z (- lim 1)))
(set! s (string-append (substring s 0 i)
(string (integer->char k))
(substring s i z)))
(set! i (+ 1 i))
(set! z (+ 1 z))
(loop))
((= k curs:key-backspace)
(cond ((zero? i)
(cond ((zero? z)
(curs:move y x)
(curs:clrtoeol)
#f)
(else
(curs:beep)
(loop))))
(else
(set! i (- i 1))
(set! s (string-append (substring s 0 i)
(substring s (+ 1 i) z)))
(set! z (- z 1))
(loop))))
((= k 4)
(cond ((>= i z)
(curs:beep)
(loop))
(else
(set! s (string-append (substring s 0 i)
(substring s (+ 1 i) z)))
(set! z (- z 1))
(loop))))
((= k 1)
(set! i 0)
(loop))
((= k 5)
(set! i z)
(loop))
((or (= k 3)
(= k 7))
#f)
((= k 21)
(set! i 0)
(set! z 0)
(set! s "")
(loop))
((and (< i z)
(or (= k curs:key-right)
(= k 6)))
(set! i (+ 1 i))
(loop))
((and (positive? i)
(or (= k curs:key-left)
(= k 2)))
(set! i (- i 1))
(loop))
(else
(curs:beep)
(loop)))))))
|