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
128
|
/***********************************************************************/
/* */
/* Objective Caml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* en Automatique. All rights reserved. This file is distributed */
/* under the terms of the GNU Library General Public License. */
/* */
/***********************************************************************/
/* $Id$ */
/* Read and output terminal commands */
#include "config.h"
#include "alloc.h"
#include "fail.h"
#include "io.h"
#include "mlvalues.h"
#define Uninitialised Val_int(0)
#define Bad_term Val_int(1)
#define Good_term_tag 0
#ifdef HAS_TERMCAP
extern int tgetent (char * buffer, char * name);
extern char * tgetstr (char * id, char ** area);
extern int tgetnum (char * id);
extern int tputs (char * str, int count, int (*outchar)(int c));
static struct channel *chan;
static char area [1024];
static char *area_p = area;
static int num_lines;
static char *up = NULL;
static char *down = NULL;
static char *standout = NULL;
static char *standend = NULL;
value terminfo_setup (value vchan) /* ML */
{
value result;
static char buffer[1024];
chan = Channel (vchan);
if (tgetent(buffer, getenv("TERM")) != 1) return Bad_term;
num_lines = tgetnum ("li");
up = tgetstr ("up", &area_p);
down = tgetstr ("do", &area_p);
standout = tgetstr ("us", &area_p);
standend = tgetstr ("ue", &area_p);
if (standout == NULL || standend == NULL){
standout = tgetstr ("so", &area_p);
standend = tgetstr ("se", &area_p);
}
Assert (area_p <= area + 1024);
if (num_lines == -1 || up == NULL || down == NULL
|| standout == NULL || standend == NULL){
return Bad_term;
}
result = alloc_small (1, Good_term_tag);
Field (result, 0) = Val_int (num_lines);
return result;
}
static int terminfo_putc (int c)
{
putch (chan, c);
return c;
}
value terminfo_backup (value lines) /* ML */
{
int i;
for (i = 0; i < Int_val (lines); i++){
tputs (up, 1, terminfo_putc);
}
return Val_unit;
}
value terminfo_standout (value start) /* ML */
{
tputs (Bool_val (start) ? standout : standend, 1, terminfo_putc);
return Val_unit;
}
value terminfo_resume (value lines) /* ML */
{
int i;
for (i = 0; i < Int_val (lines); i++){
tputs (down, 1, terminfo_putc);
}
return Val_unit;
}
#else /* HAS_TERMCAP */
value terminfo_setup (value vchan)
{
return Bad_term;
}
value terminfo_backup (value lines)
{
invalid_argument("Terminfo.backup");
return Val_unit;
}
value terminfo_standout (value start)
{
invalid_argument("Terminfo.standout");
return Val_unit;
}
value terminfo_resume (value lines)
{
invalid_argument("Terminfo.resume");
return Val_unit;
}
#endif /* HAS_TERMCAP */
|
