l4/pkg/ocaml/contrib/byterun/terminfo.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: terminfo.c 6045 2004-01-01 16:42:43Z doligez $ */
  15
  16 /* Read and output terminal commands */
  17
  18 #include "config.h"
  19 #include "alloc.h"
  20 #include "fail.h"
  21 #include "io.h"
  22 #include "mlvalues.h"
  23
  24 #define Uninitialised (Val_int(0))
  25 #define Bad_term (Val_int(1))
  26 #define Good_term_tag 0
  27
  28 #if defined (HAS_TERMCAP) && !defined (NATIVE_CODE)
  29
  30 extern int tgetent (char * buffer, char * name);
  31 extern char * tgetstr (char * id, char ** area);
  32 extern int tgetnum (char * id);
  33 extern int tputs (char * str, int count, int (*outchar)(int c));
  34
  35 static struct channel *chan;
  36 static char area [1024];
  37 static char *area_p = area;
  38 static int num_lines;
  39 static char *up = NULL;
  40 static char *down = NULL;
  41 static char *standout = NULL;
  42 static char *standend = NULL;
  43
  44 CAMLprim value caml_terminfo_setup (value vchan)
  45 {
  46   value result;
  47   static char buffer[1024];
  48   char *term;
  49
  50   chan = Channel (vchan);
  51
  52   term = getenv ("TERM");
  53   if (term == NULL) return Bad_term;
  54   if (tgetent(buffer, term) != 1) return Bad_term;
  55
  56   num_lines = tgetnum ("li");
  57   up = tgetstr ("up", &area_p);
  58   down = tgetstr ("do", &area_p);
  59   standout = tgetstr ("us", &area_p);
  60   standend = tgetstr ("ue", &area_p);
  61   if (standout == NULL || standend == NULL){
  62     standout = tgetstr ("so", &area_p);
  63     standend = tgetstr ("se", &area_p);
  64   }
  65   Assert (area_p <= area + 1024);
  66   if (num_lines == -1 || up == NULL || down == NULL
  67       || standout == NULL || standend == NULL){
  68     return Bad_term;
  69   }
  70   result = caml_alloc_small (1, Good_term_tag);
  71   Field (result, 0) = Val_int (num_lines);
  72   return result;
  73 }
  74
  75 static int terminfo_putc (int c)
  76 {
  77   putch (chan, c);
  78   return c;
  79 }
  80
  81 CAMLprim value caml_terminfo_backup (value lines)
  82 {
  83   int i;
  84
  85   for (i = 0; i < Int_val (lines); i++){
  86     tputs (up, 1, terminfo_putc);
  87   }
  88   return Val_unit;
  89 }
  90
  91 CAMLprim value caml_terminfo_standout (value start)
  92 {
  93   tputs (Bool_val (start) ? standout : standend, 1, terminfo_putc);
  94   return Val_unit;
  95 }
  96
  97 CAMLprim value caml_terminfo_resume (value lines)
  98 {
  99   int i;
 100
 101   for (i = 0; i < Int_val (lines); i++){
 102     tputs (down, 1, terminfo_putc);
 103   }
 104   return Val_unit;
 105 }
 106
 107 #else /* defined (HAS_TERMCAP) && !defined (NATIVE_CODE) */
 108
 109 CAMLexport value caml_terminfo_setup (value vchan)
 110 {
 111   return Bad_term;
 112 }
 113
 114 CAMLexport value caml_terminfo_backup (value lines)
 115 {
 116   caml_invalid_argument("Terminfo.backup");
 117   return Val_unit;
 118 }
 119
 120 CAMLexport value caml_terminfo_standout (value start)
 121 {
 122   caml_invalid_argument("Terminfo.standout");
 123   return Val_unit;
 124 }
 125
 126 CAMLexport value caml_terminfo_resume (value lines)
 127 {
 128   caml_invalid_argument("Terminfo.resume");
 129   return Val_unit;
 130 }
 131
 132 #endif /* defined (HAS_TERMCAP) && !defined (NATIVE_CODE) */