home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mitsch75.zip / scheme-7_5_17-src.zip / scheme-7.5.17 / src / microcode / tterm.c < prev    next >
C/C++ Source or Header  |  2001-03-03  |  4KB  |  139 lines

  1. /* -*-C-*-
  2.  
  3. $Id: tterm.c,v 1.12 2001/03/03 05:17:36 cph Exp $
  4.  
  5. Copyright (c) 1990-2001 Massachusetts Institute of Technology
  6.  
  7. This program is free software; you can redistribute it and/or modify
  8. it under the terms of the GNU General Public License as published by
  9. the Free Software Foundation; either version 2 of the License, or (at
  10. your option) any later version.
  11.  
  12. This program is distributed in the hope that it will be useful, but
  13. WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  15. General Public License for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with this program; if not, write to the Free Software
  19. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. */
  21.  
  22. /* termcap(3) interface for Scheme. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "osterm.h"
  27.  
  28. #ifdef HAVE_LIBNCURSES
  29. #  include <curses.h>
  30. #  include <term.h>
  31. #else
  32.    extern int EXFUN (tgetent, (char *, CONST char *));
  33.    extern int EXFUN (tgetnum, (CONST char *));
  34.    extern int EXFUN (tgetflag, (CONST char *));
  35.    extern char * EXFUN (tgetstr, (CONST char *, char **));
  36.    extern char * EXFUN (tgoto, (CONST char *, int, int));
  37.    extern int EXFUN (tputs, (CONST char *, int, void (*) (int)));
  38. #endif
  39.  
  40. extern char * EXFUN (tparam, (CONST char *, PTR, int, ...));
  41. extern char * BC;
  42. extern char * UP;
  43. extern char PC;
  44. extern speed_t ospeed;
  45.  
  46. #ifndef TERMCAP_BUFFER_SIZE
  47. #define TERMCAP_BUFFER_SIZE 2048
  48. #endif
  49.  
  50. static char termcap_buffer [TERMCAP_BUFFER_SIZE];
  51. static char tgetstr_buffer [TERMCAP_BUFFER_SIZE];
  52. static char * tgetstr_pointer;
  53.  
  54. static char tputs_output [TERMCAP_BUFFER_SIZE];
  55. static char * tputs_output_scan;
  56.  
  57. static int
  58. DEFUN (tputs_write_char, (c), int c)
  59. {
  60.   (*tputs_output_scan++) = c;
  61.   return (c);
  62. }
  63.  
  64. DEFINE_PRIMITIVE ("TERMCAP-INITIALIZE", Prim_termcap_initialize, 1, 1, 0)
  65. {
  66.   PRIMITIVE_HEADER (1);
  67.   tgetstr_pointer = tgetstr_buffer;
  68.   PRIMITIVE_RETURN
  69.     (BOOLEAN_TO_OBJECT ((tgetent (termcap_buffer, (STRING_ARG (1)))) > 0));
  70. }
  71.  
  72. DEFINE_PRIMITIVE ("TERMCAP-GET-NUMBER", Prim_termcap_get_number, 1, 1, 0)
  73. {
  74.   PRIMITIVE_HEADER (1);
  75.   {
  76.     int result = (tgetnum (STRING_ARG (1)));
  77.     PRIMITIVE_RETURN ((result < 0) ? SHARP_F : (long_to_integer (result)));
  78.   }
  79. }
  80.  
  81. DEFINE_PRIMITIVE ("TERMCAP-GET-FLAG", Prim_termcap_get_flag, 1, 1, 0)
  82. {
  83.   PRIMITIVE_HEADER (1);
  84.   PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT ((tgetflag (STRING_ARG (1))) != 0));
  85. }
  86.  
  87. DEFINE_PRIMITIVE ("TERMCAP-GET-STRING", Prim_termcap_get_string, 1, 1, 0)
  88. {
  89.   PRIMITIVE_HEADER (1);
  90.   {
  91.     char * result = (tgetstr ((STRING_ARG (1)), (&tgetstr_pointer)));
  92.     PRIMITIVE_RETURN
  93.       ((result == 0) ? SHARP_F
  94.        : (char_pointer_to_string ((unsigned char *) result)));
  95.   }
  96. }
  97.  
  98. DEFINE_PRIMITIVE ("TERMCAP-PARAM-STRING", Prim_termcap_param_string, 5, 5, 0)
  99. {
  100.   PRIMITIVE_HEADER (5);
  101.   {
  102.     char s [4096];
  103.     (void) tparam
  104.       ((STRING_ARG (1)), s, (sizeof (s)),
  105.        (arg_nonnegative_integer (2)),
  106.        (arg_nonnegative_integer (3)),
  107.        (arg_nonnegative_integer (4)),
  108.        (arg_nonnegative_integer (5)));
  109.     PRIMITIVE_RETURN (char_pointer_to_string ((unsigned char *) s));
  110.   }
  111. }
  112.  
  113. DEFINE_PRIMITIVE ("TERMCAP-GOTO-STRING", Prim_termcap_goto_string, 5, 5, 0)
  114. {
  115.   PRIMITIVE_HEADER (5);
  116.   {
  117.     BC = (((ARG_REF (4)) == SHARP_F) ? 0 : (STRING_ARG (4)));
  118.     UP = (((ARG_REF (5)) == SHARP_F) ? 0 : (STRING_ARG (5)));
  119.     PRIMITIVE_RETURN
  120.       (char_pointer_to_string
  121.        ((unsigned char *)
  122.     (tgoto ((STRING_ARG (1)),
  123.         (arg_nonnegative_integer (2)),
  124.         (arg_nonnegative_integer (3))))));
  125.   }
  126. }
  127.  
  128. DEFINE_PRIMITIVE ("TERMCAP-PAD-STRING", Prim_termcap_pad_string, 4, 4, 0)
  129. {
  130.   PRIMITIVE_HEADER (4);
  131.   ospeed = (arg_baud_index (3));
  132.   PC = (((ARG_REF (4)) == SHARP_F) ? '\0' : ((STRING_ARG (4)) [0]));
  133.   tputs_output_scan = tputs_output;
  134.   tputs ((STRING_ARG (1)), (arg_nonnegative_integer (2)), tputs_write_char);
  135.   PRIMITIVE_RETURN
  136.     (memory_to_string ((tputs_output_scan - tputs_output),
  137.                ((unsigned char *) tputs_output)));
  138. }
  139.