Skip to content

Commit 3d045d2

Browse files
eschulteeschulte
committed
Keep terminal in this repository, use new API
1 parent 132a92f commit 3d045d2

6 files changed

+238
-4
lines changed

‎.qlfile.grammatech

-1
Original file line numberDiff line numberDiff line change
@@ -5,4 +5,3 @@ git stefil+ https://github.com/GrammaTech/stefil-.git main
55
git cffi https://github.com/death/cffi
66
git cl-tree-sitter https://github.com/death/cl-tree-sitter
77
git serapeum https://github.com/ruricolist/serapeum
8-
git terminal http://git.grammatech.com/synthesis/terminal.git

‎software-evolution-library.asd

+10
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,16 @@ techniques."
3333
:depends-on (fare-quasiquote-extras)
3434
:components ((:file "components/serapi-io")))
3535

36+
(defsystem "software-evolution-library/terminal"
37+
:author "Eric Schulte and GrammaTech"
38+
:licence "GPL V3"
39+
:description "Primitives for inspecting and working with a terminal."
40+
:depends-on (:gt :cffi :cl-interpol)
41+
:defsystem-depends-on (:cffi-grovel)
42+
:components ((:file "terminal-package")
43+
(:cffi-grovel-file "terminal-grovel")
44+
(:file "terminal-impl")))
45+
3646

3747
;;;; Tests and binaries.
3848

‎terminal-grovel.lisp

+12
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,12 @@
1+
;;;; grovel.lisp --- CFFI groveler for ioctl.h
2+
(include "sys/ioctl.h" "stdio.h" "unistd.h")
3+
4+
(in-package :software-evolution-library/terminal)
5+
6+
(constant (STDOUT-FILENO "STDOUT_FILENO"))
7+
(constant (TIOCGWINSZ "TIOCGWINSZ"))
8+
(cstruct winsize "struct winsize"
9+
(row "ws_row" :type :unsigned-short)
10+
(col "ws_col" :type :unsigned-short)
11+
(xpixel "ws_xpixel" :type :unsigned-short)
12+
(ypixel "ws_ypixel" :type :unsigned-short))

‎terminal-impl.lisp

+163
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,163 @@
1+
(in-package :software-evolution-library/terminal)
2+
(enable-interpol-syntax)
3+
4+
(defun make-terminal-raw ()
5+
"Place the terminal into 'raw' mode, no echo or delete.
6+
This allows characters to be read directly without waiting for a newline.
7+
See 'man 3 termios' for more information."
8+
#+win32 (error "`make-terminal-raw' not implemented for windows.")
9+
#-sbcl (error "`make-terminal-raw' not implemented for non-SBCL.")
10+
#+sbcl
11+
(let ((options (sb-posix:tcgetattr 0)))
12+
(setf (sb-posix:termios-lflag options)
13+
(logand (sb-posix:termios-lflag options)
14+
(lognot (logior sb-posix:icanon
15+
sb-posix:echo
16+
sb-posix:echoe
17+
sb-posix:echok
18+
sb-posix:echonl))))
19+
(sb-posix:tcsetattr 0 sb-posix:TCSANOW options)))
20+
21+
(defun make-terminal-unraw ()
22+
"Place the terminal out of 'raw' mode, with echo and delete.
23+
This allows characters to be read directly without waiting for a newline.
24+
See 'man 3 termios' for more information."
25+
#+win32 (error "`make-terminal-raw' not implemented for windows.")
26+
#-sbcl (error "`make-terminal-raw' not implemented for non-SBCL.")
27+
#+sbcl
28+
(let ((options (sb-posix:tcgetattr 0)))
29+
(setf (sb-posix:termios-lflag options)
30+
(logior (sb-posix:termios-lflag options)
31+
sb-posix:icanon
32+
sb-posix:echo
33+
sb-posix:echoe
34+
sb-posix:echok
35+
sb-posix:echonl))
36+
(sb-posix:tcsetattr 0 sb-posix:TCSANOW options)))
37+
38+
39+
;;; Terminal size with CFFI and ioctl.
40+
;;; Adapted from:
41+
;;; https://github.com/cffi/cffi/blob/master/examples/gettimeofday.lisp
42+
(define-foreign-type ioctl-result-type ()
43+
()
44+
(:actual-type :int)
45+
(:simple-parser ioctl-result))
46+
47+
(define-condition ioctl (error)
48+
((ret :initarg :ret :initform nil :reader ret))
49+
(:report (lambda (condition stream)
50+
(format stream "IOCTL call failed with return value ~d~%~
51+
(NOTE: IOCTL fails when called from slime.)"
52+
(ret condition)))))
53+
54+
(defmethod translate-from-foreign (value (type ioctl-result-type))
55+
(if (minusp value)
56+
(error (make-condition 'ioctl :ret value))
57+
value))
58+
59+
(defcfun ("ioctl" %ioctl) ioctl-result
60+
(fd :int)
61+
(request :unsigned-long)
62+
(winsz (:pointer (:struct winsize))))
63+
64+
(defun term-size ()
65+
"Return terminal size information.
66+
The following are returned in a property list row, col, xpixels,
67+
ypixels. See `man 2 ioctl` for more inforamtion. Note ioctl and thus
68+
`term-size' will throw an error of type IOCTL when called from SLIME."
69+
(restart-case
70+
(with-foreign-object (wnsz '(:struct winsize))
71+
(%ioctl STDOUT-FILENO TIOCGWINSZ wnsz)
72+
(with-foreign-slots ((row col xpixel ypixel) wnsz (:struct winsize))
73+
`(:row ,row
74+
:col ,col
75+
:xpixel ,xpixel
76+
:ypixel ,ypixel)))
77+
(return-no-extent-term ()
78+
:report "Return info for a terminal with no extent."
79+
'(:row 0
80+
:col 0
81+
:xpixel 0
82+
:ypixel 0))))
83+
84+
85+
;;; Color and control sequences
86+
(eval-when (:compile-toplevel :load-toplevel :execute)
87+
(defvar *view-stream* t
88+
"Dynamically bind to use modify."))
89+
90+
(mapc (lambda (triple)
91+
(destructuring-bind (name value documentation) triple
92+
(eval `(define-constant ,name ,value :test 'equalp
93+
:documentation ,documentation))))
94+
'((+set-G1+ #?"\x1b)0" "Set G1 for box drawing")
95+
(+reset-G1+ #?"\x1b)B" "Reset G1 to ASCII")
96+
(+b-start+ #?"\x0e" "Enter G1 drawing mode")
97+
(+b-stop+ #?"\x0f" "Leave G1 drawing mode")
98+
(+b-h+ #\q "Horizontal line")
99+
(+b-v+ #\x "Vertical line")
100+
(+b-lt+ #\l "Left top corner")
101+
(+b-rt+ #\k "Right top corner")
102+
(+b-lb+ #\m "Left bottom corner")
103+
(+b-rb+ #\j "Right bottom corner")
104+
(+b-x+ #\n "Cross")
105+
(+b-vr+ #\t "Vertical, branch right")
106+
(+b-vl+ #\u "Vertical, branch left")
107+
(+b-ht+ #\v "Horizontal, branch top")
108+
(+b-hb+ #\w "Horizontal, branch bottom")
109+
(+term-home+ #?"\x1b[H" "Set terminal back to home (top left).")
110+
(+term-clear+ #?"\x1b[H" "Clear terminal.")
111+
(+ceol+ #?"\x1b[0K" "Clear to end of line.")
112+
(+cursor-hide+ #?"\x1b[?25l" "Hide the cursor.")
113+
(+cursor-show+ #?"\x1b[?25h" "Show the cursor.")
114+
;; Colors
115+
(+color-BLK+ #?"\x1b[0;30m" "Color BLK.")
116+
(+color-RED+ #?"\x1b[0;31m" "Color RED.")
117+
(+color-GRN+ #?"\x1b[0;32m" "Color GRN.")
118+
(+color-BRN+ #?"\x1b[0;33m" "Color BRN.")
119+
(+color-BLU+ #?"\x1b[0;34m" "Color BLU.")
120+
(+color-MGN+ #?"\x1b[0;35m" "Color MGN.")
121+
(+color-CYA+ #?"\x1b[0;36m" "Color CYA.")
122+
(+color-NOR+ #?"\x1b[0;37m" "Color NOR.")
123+
(+color-GRA+ #?"\x1b[1;30m" "Color GRA.")
124+
(+color-LRD+ #?"\x1b[1;31m" "Color LRD.")
125+
(+color-LGN+ #?"\x1b[1;32m" "Color LGN.")
126+
(+color-YEL+ #?"\x1b[1;33m" "Color YEL.")
127+
(+color-LBL+ #?"\x1b[1;34m" "Color LBL.")
128+
(+color-PIN+ #?"\x1b[1;35m" "Color PIN.")
129+
(+color-LCY+ #?"\x1b[1;36m" "Color LCY.")
130+
(+color-BRI+ #?"\x1b[1;37m" "Color BRI.")
131+
(+color-RST+ #?"\x1b[0m" "Color RST.")))
132+
133+
134+
;;; Utility functions
135+
136+
(defun clear-terminal ()
137+
(format *view-stream* "~a" +term-clear+))
138+
139+
(defun hide-cursor ()
140+
(format *view-stream* "~a" +cursor-hide+))
141+
142+
(defun show-cursor ()
143+
(format *view-stream* "~a" +cursor-show+))
144+
145+
(defmacro with-line-printing (&rest body)
146+
`(unwind-protect
147+
(progn (format ,*view-stream* "~a" +set-G1+)
148+
(format ,*view-stream* "~a" +b-start+)
149+
,@body)
150+
(format ,*view-stream* "~a" +b-stop+)
151+
(format ,*view-stream* "~a" +reset-G1+)))
152+
153+
(defmacro with-color-printing (color &rest body)
154+
`(unwind-protect
155+
(progn (format ,*view-stream* "~a" ,color) ,@body)
156+
(format ,*view-stream* "~a" +color-RST+)))
157+
158+
(defun string-output-stream-p (stream)
159+
(typep stream
160+
#+sbcl 'sb-impl::string-output-stream
161+
#+ccl 'ccl:string-output-stream
162+
#- (or sbcl ccl)
163+
(error "`string-output-stream-p' only supported for SBCL and CCL")))

‎terminal-package.lisp

+46
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
(defpackage :software-evolution-library/terminal
2+
(:use :gt :cffi :cl-interpol)
3+
(:export :make-terminal-raw
4+
:make-terminal-unraw
5+
:ioctl
6+
:term-size
7+
:return-no-extent-term
8+
:*view-stream*
9+
;; Colors and control sequences.
10+
:+set-G1+
11+
:+reset-G1+
12+
:+b-start+
13+
:+b-stop+
14+
:+b-h+
15+
:+b-v+
16+
:+b-lt+
17+
:+b-rt+
18+
:+b-lb+
19+
:+b-rb+
20+
:+b-x+
21+
:+b-vr+
22+
:+b-vl+
23+
:+b-ht+
24+
:+b-hb+
25+
:+term-home+
26+
:+term-clear+
27+
:+ceol+
28+
:+cursor-hide+
29+
:+cursor-show+
30+
:+color-BLK+
31+
:+color-RED+
32+
:+color-GRN+
33+
:+color-BRN+
34+
:+color-BLU+
35+
:+color-MGN+
36+
:+color-CYA+
37+
:+color-NOR+
38+
:+color-GRA+
39+
:+color-LRD+
40+
:+color-LGN+
41+
:+color-YEL+
42+
:+color-LBL+
43+
:+color-PIN+
44+
:+color-LCY+
45+
:+color-BRI+
46+
:+color-RST+))

‎view.lisp

+7-3
Original file line numberDiff line numberDiff line change
@@ -27,10 +27,10 @@
2727
(:use
2828
:gt/full
2929
:diff
30-
:terminal
30+
:cl-interpol
3131
:software-evolution-library
32-
:software-evolution-library/utility/debug
33-
:terminal)
32+
:software-evolution-library/terminal
33+
:software-evolution-library/utility/debug)
3434
(:shadow :diff)
3535
(:shadowing-import-from :arrow-macros :-<>> :-<> :<>) ; FIXME: Remove.
3636
(:export :*view-stream*
@@ -67,6 +67,8 @@
6767
:view-controller-start))
6868
(in-package :software-evolution-library/view)
6969
(in-readtable :curry-compose-reader-macros)
70+
(eval-when (:compile-toplevel :load-toplevel :execute)
71+
(enable-interpol-syntax))
7072

7173
(defvar *view-length*
7274
(handler-case (nth-value 2 (term-size))
@@ -112,6 +114,8 @@ For example a description of the evolution target.")
112114
(subseq line 0 (- *view-length* less))
113115
line))
114116

117+
(define-constant +golden-ratio+ 21/34)
118+
115119

116120
;;; View functions.
117121

0 commit comments

Comments
 (0)