Coverage report: /home/ellis/comp/core/lib/cli/ansi.lisp

KindCoveredAll%
expression14275 5.1
branch014 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; lib/cli/ansi.lisp --- ANSI X3.64 Control Sequences
2
 
3
 ;; based on https://github.com/McParen/croatoan/tree/master
4
 
5
 ;;; Code:
6
 (in-package :cli/ansi)
7
 
8
 ;;; Basic terminal control functions based on 7bit escape sequences
9
 ;;; according to ANSI X3.64 / ECMA 48 / ISO/IEC 6429 / VT10X / XTerm
10
 
11
 ;; ECMA-6: 7bit character set 0-127
12
 ;; ECMA-35: Bit notation 01/07
13
 ;; ECMA-48: ANSI escape sequences
14
 
15
 ;; 1-char 7bit controls C0
16
 ;; 1-char 8bit controls C1
17
 ;; escape sequences
18
 ;; 7bit CSI sequences
19
 ;; 8bit CSI sequences
20
 
21
 ;; Acronym Character Decimal Octal  Hexadecimal Code
22
 ;; DEL     #\rubout  127     #o177  #x7f        07/15
23
 ;; ESC     #\esc      27     #o33   #x1b        01/11
24
 ;; SP      #\space    32     #o40   #x20        02/00
25
 
26
 ;; code x/y = column/line
27
 ;; 7bit code table = x-column 0-7 / y-line 0-15
28
 
29
 ;; x/y:        x       y
30
 ;; Bit:    7 6 5 4 3 2 1
31
 ;; Weight: 4 2 1 8 4 2 1
32
 
33
 ;; ESC [ Pn1 ; Pn2 H
34
 ;; CSI Pn1 ; Pn2 H
35
 ;; CSI n ; m H
36
 ;; CUP
37
 ;; cursor-position
38
 
39
 ;; See 5.4 for the overall format of control sequences
40
 
41
 ;; Set:        C1
42
 ;; Section:    8.3.16
43
 ;; Name:       Control Sequence Introducer
44
 ;; Mnemonic:   CSI
45
 ;; 7bit Chars: ESC [
46
 ;; 7bit Byte:  01/11 05/11
47
 ;; 8bit Byte:  09/11 (not used here)
48
 (defparameter *csi* (coerce (list #\esc #\[) 'string)
49
   "A two-character string representing the 7bit control sequence introducer CSI.")
50
 
51
 (defun esc (&rest params)
52
   "Write an ESC control sequence. The parameters are not separated."
53
   (format t "~A~{~A~}" #\esc params))
54
 
55
 (defun csi (final-char &rest params)
56
   "Write a CSI control sequence. The params are separated by a semicolon."
57
   ;; only the params are separated with ; the other chars are not separated.
58
   ;; ~^; = add ; to every list item except the last
59
   (format t "~A~{~A~^;~}~A" *csi* params final-char))
60
 
61
 ;; Sequence Syntax
62
 ;; C   A single character
63
 ;; Ps  A single numeric parameter
64
 ;; Pm  Several numeric parameters Ps separated by a semicolon ;
65
 
66
 ;;; ESC sequences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
67
 
68
 ;; Name:       Reset to initial state
69
 ;; Mnemonic:   RIS
70
 ;; Final char: c
71
 ;; Final byte: 06/03
72
 ;; Sequence:   ESC c
73
 ;; Parameters: none
74
 ;; Default:    none
75
 ;; Reference:  ANSI 5.72, ECMA 8.3.105
76
 (defun .ris ()
77
   "Reset the terminal to its initial state.
78
 
79
 In particular, turn on cooked and echo modes and newline translation,
80
 turn off raw and cbreak modes, reset any unset special characters.
81
 
82
 A reset is useful after a program crashes and leaves the terminal in
83
 an undefined, unusable state."
84
   (esc "c"))
85
 
86
 ;;; CSI sequences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87
 
88
 ;;; Cursor control functions
89
 
90
 ;; Name:       Cursor up
91
 ;; Mnemonic:   CUU
92
 ;; Final char: A
93
 ;; Final byte: 04/01
94
 ;; Sequence:   CSI Pn A
95
 ;; Parameters: Pn = m
96
 ;; Default:    Pn = 1
97
 ;; Reference:  ANSI 5.17, ECMA 8.3.22
98
 (defun .cuu (&optional (m 1))
99
   "Move the cursor m lines up."
100
   (csi "A" m))
101
 
102
 ;; Name:       Cursor down
103
 ;; Mnemonic:   CUD
104
 ;; Final char: B
105
 ;; Final byte: 04/02
106
 ;; Sequence:   CSI Pn B
107
 ;; Parameters: Pn = m
108
 ;; Default:    Pn = 1
109
 ;; Reference:  ANSI 5.14, ECMA 8.3.19
110
 (defun .cud (&optional (m 1))
111
   "Move the cursor m lines down."
112
   (csi "B" m))
113
 
114
 ;; Name:       Cursor forward
115
 ;; Mnemonic:   CUF
116
 ;; Final char: C
117
 ;; Final byte: 04/03
118
 ;; Sequence:   CSI Pn C
119
 ;; Parameters: Pn = n
120
 ;; Default:    Pn = 1
121
 ;; Reference:  ANSI 5.15, ECMA 8.3.20
122
 ;; Notice:     ECMA name: Cursor right
123
 (defun .cuf (&optional (n 1))
124
   "Move the cursor n columns in the forward direction (to the right)."
125
   (csi "C" n))
126
 
127
 ;; Name:       Cursor backward
128
 ;; Mnemonic:   CUB
129
 ;; Final char: D
130
 ;; Final byte: 04/04
131
 ;; Sequence:   CSI Pn D
132
 ;; Parameters: Pn = n
133
 ;; Default:    Pn = 1
134
 ;; Reference:  ANSI 5.13, ECMA 8.3.18
135
 ;; Notice:     ECMA name: Cursor left
136
 (defun .cub (&optional (n 1))
137
   "Move the cursor n columns in the backward direction (to the left)."
138
   (csi "D" n))
139
 
140
 ;; Name:       Cursor next line
141
 ;; Mnemonic:   CNL
142
 ;; Final char: E
143
 ;; Final byte: 04/05
144
 ;; Sequence:   CSI Pn E
145
 ;; Parameters: Pn = m
146
 ;; Default:    Pn = 1
147
 ;; Reference:  ANSI 5.7, ECMA 8.3.12
148
 (defun .cnl (&optional (m 1))
149
   "Move the cursor m columns down to column 1."
150
   (csi "E" m))
151
 
152
 ;; Name:       Cursor preceding line
153
 ;; Mnemonic:   CPL
154
 ;; Final char: F
155
 ;; Final byte: 04/06
156
 ;; Sequence:   CSI Pn F
157
 ;; Parameters: Pn = m
158
 ;; Default:    Pn = 1
159
 ;; Reference:  ANSI 5.8, ECMA 8.3.13
160
 (defun .cpl (&optional (m 1))
161
   "Move the cursor m columns up to column 1."
162
   (csi "F" m))
163
 
164
 ;; Name:       Cursor horizontal absolute
165
 ;; Mnemonic:   CHA
166
 ;; Final char: G
167
 ;; Final byte: 04/07
168
 ;; Sequence:   CSI Pn G
169
 ;; Parameters: Pn = n
170
 ;; Default:    Pn = 1
171
 ;; Reference:  ANSI 5.5, ECMA 8.3.9
172
 ;; Notice:     ECMA name: Cursor character absolute
173
 (defun .cha (&optional (n 1))
174
   "Set the cursor horizontal position to the n-th column in the current line."
175
   (csi "G" n))
176
 
177
 ;; Name:       Cursor position
178
 ;; Mnemonic:   CUP
179
 ;; Final char: H
180
 ;; Final byte: 04/08
181
 ;; Sequence:   CSI Pn1 ; Pn2 H
182
 ;; Parameters: Pn1 = m line, Pn2 = n column
183
 ;; Defaults:   Pn1 = 1; Pn2 = 1
184
 ;; Reference:  ANSI 5.16, ECMA 8.3.21
185
 (defun .cup (&optional (line 1) (column 1))
186
   "Move the cursor to m-th line and n-th column of the screen.
187
 
188
 The line and column numbering is one-based.
189
 
190
 Without arguments, the cursor is placed in the home position (1 1),
191
 the top left corner."
192
   (csi "H" line column))
193
 
194
 ;; Name:       Vertical position absolute
195
 ;; Mnemonic:   VPA
196
 ;; Final char: d
197
 ;; Final byte: 06/04
198
 ;; Sequence:   CSI Pn d
199
 ;; Parameters: Pn = m
200
 ;; Default:    Pn = 1
201
 ;; Reference:  ANSI 5.96, ECMA 8.3.158
202
 ;; Notice:     ECMA name: Line position absolute
203
 (defun .vpa (&optional (m 1))
204
   "Set the cursor vertical position to the m-th line in the current column."
205
   (csi "d" m))
206
 
207
 ;; Name:       Vertical position relative
208
 ;; Mnemonic:   VPR
209
 ;; Final char: e
210
 ;; Final byte: 06/05
211
 ;; Sequence:   CSI Pn e
212
 ;; Parameters: Pn = m
213
 ;; Default:    Pn = 1
214
 ;; Reference:  ANSI 5.97, ECMA 8.3.160
215
 ;; Notice:     ECMA name: Line position forward
216
 (defun .vpr (&optional (m 1))
217
   "Move the cursor vertical position down by m lines in the current column.
218
 
219
 This has the same effect as cursor-down (cud)."
220
   (csi "e" m))
221
 
222
 ;; Name:       Vertical position backward
223
 ;; Mnemonic:   VPB
224
 ;; Final char: k
225
 ;; Final byte: 06/11
226
 ;; Sequence:   CSI Pn k
227
 ;; Parameters: Pn = m
228
 ;; Default:    Pn = 1
229
 ;; Reference:  ECMA 8.3.159
230
 ;; Notice:     ECMA name: Line position backward
231
 (defun .vpb (&optional (m 1))
232
   "Move the cursor vertical position up by m lines in the current column.
233
 
234
 This has the same effect as cursor-up (cuu)."
235
   (csi "k" m))
236
 
237
 (defun .scosc ()
238
   "Save cursor position. Move cursor to the saved position using .SCORC."
239
   (csi "s"))
240
 
241
 (defun .scorc ()
242
   "Move cursor to the position saved using .SCOSC."
243
   (csi "u"))
244
 
245
 ;; Name:       Erase in display
246
 ;; Mnemonic:   ED
247
 ;; Final char: J
248
 ;; Final byte: 04/10
249
 ;; Sequence:   CSI Ps J
250
 ;; Parameters: Ps = mode
251
 ;; Defaults:   Ps = 0
252
 ;; Reference:  ANSI 5.29, ECMA 8.3.39
253
 ;; Notice:     ECMA name: Erase in page
254
 (defun .ed (&optional (mode 0))
255
   "Erase some or all characters on the screen depending on the selected mode.
256
 
257
 Mode 0 (erase-below, default) erases all characters from the cursor to
258
 the end of the screen.
259
 
260
 Mode 1 (erase-above) erases all characters from the beginning of the
261
 screen to the cursor.
262
 
263
 Mode 2 (erase) erases all characters on the screen.
264
 
265
 Mode 3 (erase-saved-lines, xterm) erases all characters on the screen
266
 including the scrollback buffer."
267
   (csi "J" mode))
268
 
269
 (defun erase-below ()
270
   "Erases all characters from the cursor to the end of the screen."
271
   (.ed 0))
272
 
273
 (defun erase-above ()
274
   "Erases all characters from the beginning of the screen to the cursor."
275
   (.ed 1))
276
 (eval-always
277
   (defun erase ()
278
     "Erase all characters on the screen."
279
     (.ed 2)))
280
 
281
 (defun erase-saved-lines ()
282
   "Erase all characters on the screen including the scrollback buffer."
283
   (.ed 3))
284
 
285
 ;; Name:       Erase in line
286
 ;; Mnemonic:   EL
287
 ;; Final char: K
288
 ;; Final byte: 04/11
289
 ;; Sequence:   CSI Ps K
290
 ;; Parameters: Ps = mode
291
 ;; Defaults:   Ps = 0
292
 ;; Reference:  ANSI 5.31, ECMA 8.3.41
293
 (defun .el (&optional (mode 0))
294
   "Erase some or all characters on the current line depending on the selected mode.
295
 
296
 Mode 0 (erase-right, default) erases all characters from the cursor to
297
 the end of the line.
298
 
299
 Mode 1 (erase-left) erases all characters from the beginning of the
300
 line to the cursor.
301
 
302
 Mode 2 (erase-line) erases all characters on the line."
303
   (csi "K" mode))
304
 
305
 (defun erase-right ()
306
   "Erases all characters from the cursor to the end of the line."
307
   (.el 0))
308
 
309
 (defun erase-left ()
310
   "Erases all characters from the beginning of the line to the cursor."
311
   (.el 1))
312
 
313
 (defun erase-line ()
314
   "Erases all characters on the current line."
315
   (.el 2))
316
 
317
 ;; Name:        Select Graphic Rendition
318
 ;; Mnemonic:    SGR
319
 ;; Final char:  m
320
 ;, Final byte:  06/13
321
 ;; Sequence:    CSI Pm m
322
 ;; Parameters:  See documentation string.
323
 ;; Defaults:    Pm = 0
324
 ;; Reference:   ANSI 5.77, ECMA 8.3.117
325
 (defun .sgr (&rest params)
326
   "Set character attributes and foreground and background colors.
327
 
328
  0  turn off all previous attributes, set normal, default rendition
329
 
330
  1  bold, increased intensity
331
  2  faint, dim, decreased intensity
332
  3  italic, standout
333
  4  single underline
334
  5  slow blinking
335
  6  rapid blinking
336
  7  negative, reverse image
337
  8  invisible, hidden, concealed
338
  9  crossed-out
339
 21  double underline
340
 
341
 22  turn off bold and faint/dim, set normal intensity
342
 23  turn off italic, standout
343
 24  turn off single, double underline
344
 25  turn off blinking
345
 27  turn off negative, reverse image
346
 28  turn off hidden, invisible
347
 29  turn off crossed-out
348
 
349
 Foreground colors:
350
 
351
 30  black
352
 31  red
353
 32  green
354
 33  yellow
355
 34  blue
356
 35  magenta
357
 36  cyan
358
 37  white
359
 39  default foreground color
360
 
361
 38 5 n      set the color n from a default 256-color palette
362
 38 2 r g b  set the color by directly giving its RGB components
363
 
364
 Background colors:
365
 
366
 40  black
367
 41  red
368
 42  green
369
 43  yellow
370
 44  blue
371
 45  magenta
372
 46  cyan
373
 47  white
374
 49  default background color
375
 
376
 48 5 n      set the color n from a default 256-color palette
377
 48 2 r g b  set the color by directly giving its RGB components"
378
   (apply #'csi "m" params))
379
 
380
 ;; Name:        Device Status Report
381
 ;; Mnemonic:    DSR
382
 ;; Final char:  n
383
 ;, Final byte:  06/14
384
 ;; Sequence:    CSI Ps n
385
 ;; Parameters:  Ps = status command to send to the terminal
386
 ;; Defaults:    n = 6
387
 ;; Reference:   ECMA 8.3.35
388
 (defun .dsr (&optional (n 6))
389
   "The terminal responds by sending a Cursor Position Report (CPR) to the standard input
390
 as if we read it through read-line from the user."
391
   (csi "n" n))
392
 
393
 ;; Name:        Cursor Position Report
394
 ;; Mnemonic:    CPR
395
 ;; Final char:  R
396
 ;, Final byte:  05/02
397
 ;; Sequence:    CSI Pm ; Pn R
398
 ;; Parameters:  Pm = line, Pn = column
399
 ;; Defaults:    Pm = 1, Pn = 1
400
 ;; Reference:   ECMA 8.3.14
401
 ;; Description: Response of the terminal to a Device Status Report (DSR)
402
 ;;              sent to be read from the standard input.
403
 
404
 ;;; DEC private mode
405
 
406
 ;; Set (enable, turn on)
407
 
408
 (defun .decset (mode)
409
   "Set (turn on, enable) a DEC private mode.
410
 
411
 Implemented modes:
412
 
413
   25 show or hide the cursor
414
 1047 alternate or normal screen buffer"
415
   (csi "h" "?" mode))
416
 
417
 (defun show-cursor ()
418
   (.decset 25))
419
 
420
 (defun use-alternate-screen-buffer ()
421
   (.decset 1047))
422
 
423
 ;; Reset (disable, turn off)
424
 
425
 (defun .decrst (mode)
426
   "Reset (turn off, disable) a DEC private mode."
427
   (csi "l" "?" mode))
428
 
429
 (defun hide-cursor ()
430
   (.decrst 25))
431
 
432
 (defun use-normal-screen-buffer ()
433
   (.decrst 1047))
434
 
435
 ;;; Common
436
 (defun home ()
437
   "Move the cursor to the home position, the top left corner."
438
   (.cup))
439
 
440
 (defun clear ()
441
   "Erase the whole screen, then move the cursor to the home position."
442
   (erase)
443
   (home))
444
 
445
 ;;; STTY
446
 #|
447
 
448
 From /usr/include/x86_64-linux-gnu/bits/termios.h
449
 
450
 typedef unsigned char   cc_t;
451
 typedef unsigned int    speed_t;
452
 typedef unsigned int    tcflag_t;
453
 
454
 #define NCCS 32
455
 
456
 struct termios
457
   {
458
     tcflag_t c_iflag;           /* input mode flags */
459
     tcflag_t c_oflag;           /* output mode flags */
460
     tcflag_t c_cflag;           /* control mode flags */
461
     tcflag_t c_lflag;           /* local mode flags */
462
     cc_t c_line;                /* line discipline */
463
     cc_t c_cc[NCCS];            /* control characters */
464
     speed_t c_ispeed;           /* input speed */
465
     speed_t c_ospeed;           /* output speed */
466
   };
467
 
468
 |#
469
 
470
 (defun mode-type (mode)
471
   "Return the keyword designating the type of the terminal mode:
472
 
473
 :input, :output, :control, :local, :character, :combination."
474
   (let ((iflags
475
           '(:IGNBRK :BRKINT :IGNPAR :PARMRK :INPCK :ISTRIP :INLCR :IGNCR
476
             :ICRNL :IUCLC :IXON :IXANY :IXOFF :IMAXBEL :IUTF8))
477
         (oflags
478
           '(:OPOST :OLCUC :ONLCR :OCRNL :ONOCR :ONLRET :OFILL :OFDEL :NLDLY
479
             :NL0 :NL1 :CRDLY :CR0 :CR1 :CR2 :CR3 :TABDLY :TAB0 :TAB1 :TAB2
480
             :TAB3 :BSDLY :BS0 :BS1 :FFDLY :FF0 :FF1 :VTDLY :VT0 :VT1 :XTABS))
481
         (cflags
482
           '(:CBAUD :B0 :B50 :B75 :B110 :B134 :B150 :B200 :B300 :B600 :B1200
483
             :B1800 :B2400 :B4800 :B9600 :B19200 :B38400 :CSIZE :CS5 :CS6
484
             :CS7 :CS8 :CSTOPB :CREAD :PARENB :PARODD :HUPCL :CLOCAL :CBAUDEX
485
             :B57600 :B115200 :B230400 :B460800 :B500000 :B576000 :B921600
486
             :B1000000 :B1152000 :B1500000 :B2000000 :B2500000 :B3000000
487
             :B3500000 :B4000000 :CIBAUD :CMSPAR :CRTSCTS))
488
         (lflags
489
           '(:ISIG :ICANON :XCASE :ECHO :ECHOE :ECHOK :ECHONL :NOFLSH :TOSTOP
490
             :ECHOCTL :ECHOPRT :ECHOKE :FLUSHO :PENDIN :IEXTEN :EXTPROC))
491
         (cc
492
           '(:VINTR :VQUIT :VERASE :VKILL :VEOF :VTIME :VMIN :VSWTC :VSTART
493
             :VSTOP :VSUSP :VEOL :VREPRINT :VDISCARD :VWERASE :VLNEXT :VEOL2))
494
         (combination
495
           '(:COOKED :RAW)))
496
     (cond ((member mode iflags) :iflag)
497
           ((member mode oflags) :oflag)
498
           ((member mode cflags) :cflag)
499
           ((member mode lflags) :lflag)
500
           ((member mode cc) :cc)
501
           ((member mode combination) :combination)
502
           (t nil))))
503
 
504
 (defun mode-accessor (mode)
505
   "Return the appropriate accessor depending on the mode type."
506
   (case (mode-type mode)
507
     (:iflag 'sb-posix:termios-iflag)
508
     (:oflag 'sb-posix:termios-oflag)
509
     (:cflag 'sb-posix:termios-cflag)
510
     (:lflag 'sb-posix:termios-lflag)
511
     (:cc    'sb-posix:termios-cc)
512
     (t nil)))
513
 
514
 (defun stream-fd (stream)
515
   "Return the posix file descriptor associated with the lisp stream."
516
   (etypecase stream
517
     (fixnum stream)
518
     ;; *standard-input*, *standard-output*, *terminal-io*, etc.
519
     (synonym-stream (sb-sys:fd-stream-fd (symbol-value (synonym-stream-symbol stream))))
520
     ;; sb-sys:*stdin*, *stdout*, *tty*, etc.
521
     (file-stream (sb-sys:fd-stream-fd stream))
522
     (t (sb-sys:fd-stream-fd (symbol-value (synonym-stream-symbol *standard-input*))))))
523
 
524
 ;; ncurses:
525
 ;; cooked: ixon brkint parmrk
526
 ;; raw =   -cooked -icanon -isig -iexten
527
 ;; noraw =  cooked  icanon  isig  iexten 
528
 
529
 ;; stty:
530
 ;; raw    = -ignbrk -brkint -ignpar -parmrk  -inpck  -istrip  -inlcr -igncr  -icrnl  -ixon  -ixoff -icanon -opost -isig -iuclc -ixany -imaxbel -xcase min 1 time 0
531
 ;; cooked =          brkint  ignpar                   istrip                  icrnl   ixon          icanon  opost  isig                               eof ^D eol 0
532
 
533
 (defparameter *combinations*
534
   '(((:raw t)
535
      :ignbrk nil :brkint nil :ignpar nil :parmrk nil :inpck nil :istrip nil
536
      :inlcr nil :igncr nil :icrnl nil :ixon nil :ixoff nil :icanon nil
537
      :opost nil :isig nil
538
      ;; not available in sb-posix:
539
      ;;:iuclc nil :ixany nil :imaxbel nil :xcase nil
540
      :iexten nil :csize nil :parenb nil :vmin 1 :vtime 0)
541
     ((:raw nil)
542
      :brkint t :ignpar t :istrip t :icrnl t :ixon t :icanon t :opost t
543
      :isig t :veol 0)
544
     ((:cooked t)
545
      :raw nil)
546
     ((:cooked nil)
547
      :raw t)))
548
 
549
 (defun mode-combination (mode value)
550
   "If mode is a combination, return its contents as a plist."
551
   (cdr (assoc (list mode value) *combinations* :test #'equal)))
552
 
553
 (defun set-termios-flag (termios mode value)
554
   "Take a termios struct, a flag and a value, update the termios struct in place."
555
   (let* (;; get the appropriate accessor for the flag
556
          (read-flag (fdefinition (mode-accessor mode)))
557
          (write-flag (fdefinition (list 'setf (mode-accessor mode))))         
558
          ;; get the current bitmask
559
          (old-flag (funcall read-flag termios))
560
          ;; get the new mode bitmask from the constants in sb-posix
561
          ;; TODO 200609: what to do with constants not available in sb-posix?
562
          (new-flag (symbol-value (find-symbol (symbol-name mode) 'sb-posix))))
563
     ;; write the new values to the termios struct
564
     ;; (funcall #'(setf acc) val obj) = (setf (acc obj) val)
565
     (funcall write-flag
566
              ;; the value for a flag can be t or nil
567
              (if value
568
                  ;; if t, add new flag to old flag
569
                  (logior old-flag new-flag)
570
                  ;; if nil, remove new flag from old
571
                  (logand old-flag (lognot new-flag)))
572
              termios)))
573
 
574
 (defun set-termios-param (termios mode value)
575
   "Take a termios struct, a cc key and a value, update the termios struct in place."
576
   ;; the mode flags are 32bit unsigned integers
577
   ;; get the cc array
578
   (let ((cc-array (sb-posix:termios-cc termios))
579
         ;; the param name translates to an array index
580
         (cc-param (symbol-value (find-symbol (symbol-name mode) 'sb-posix))))
581
     (setf (aref cc-array cc-param) value)))
582
 
583
 (defun update-termios (termios modes)
584
   "Update the settings in the termios struct in place with the values in modes plist."
585
   (loop for (mode value) on modes by #'cddr do
586
     (case (mode-type mode)
587
       (:combination
588
        (update-termios termios (mode-combination mode value)))
589
       ((:iflag :oflag :cflag :lflag)
590
        (set-termios-flag termios mode value))
591
       (:cc
592
        (set-termios-param termios mode value)))))
593
 
594
 ;; Examples: t06, t07
595
 (defun set-tty-mode (stream &rest modes)
596
   "Enable or disable one or more tty modes."
597
   (let* ((stream (if (eq stream t) *standard-input* stream))
598
          (fd (stream-fd stream))
599
          ;; get the current attributes in a termios object
600
          (termios (sb-posix:tcgetattr fd)))
601
     ;; Update the termios struct in place.
602
     (print (update-termios termios modes))
603
     ;; write the new termios struct to the fd of the tty now.
604
     (sb-alien:with-alien ((term sb-posix::alien-termios))
605
       (sb-posix::termios-to-alien termios (sb-alien:addr term))
606
       (tcsetattr* fd sb-posix:tcsanow (sb-alien:addr term)))))