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 / prosterm.c < prev    next >
C/C++ Source or Header  |  1999-01-02  |  6KB  |  194 lines
  1. /* -*-C-*-
  2.  
  3. $Id: prosterm.c,v 1.16 1999/01/02 06:11:34 cph Exp $
  4.  
  5. Copyright (c) 1990-1999 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. /* Primitives to control terminal devices. */
  23.  
  24. #include "scheme.h"
  25. #include "prims.h"
  26. #include "osterm.h"
  27. #include "osio.h"
  28.  
  29. Tchannel
  30. DEFUN (arg_terminal, (argument_number), int argument_number)
  31. {
  32.   Tchannel channel = (arg_channel (argument_number));
  33.   enum channel_type type = (OS_channel_type (channel));
  34.   if (! ((type == channel_type_terminal)
  35.      || (type == channel_type_unix_pty_master)
  36.      || (type == channel_type_os2_console)))
  37.     error_bad_range_arg (argument_number);
  38.   return (channel);
  39. }
  40.  
  41. DEFINE_PRIMITIVE ("TERMINAL-GET-ISPEED", Prim_terminal_get_ispeed, 1, 1, 0)
  42. {
  43.   PRIMITIVE_HEADER (1);
  44.   PRIMITIVE_RETURN
  45.     (long_to_integer (OS_terminal_get_ispeed (arg_terminal (1))));
  46. }
  47.  
  48. DEFINE_PRIMITIVE ("TERMINAL-GET-OSPEED", Prim_terminal_get_ospeed, 1, 1, 0)
  49. {
  50.   PRIMITIVE_HEADER (1);
  51.   PRIMITIVE_RETURN
  52.     (long_to_integer (OS_terminal_get_ospeed (arg_terminal (1))));
  53. }
  54.  
  55. DEFINE_PRIMITIVE ("TERMINAL-SET-ISPEED", Prim_terminal_set_ispeed, 2, 2, 0)
  56. {
  57.   PRIMITIVE_HEADER (2);
  58.   OS_terminal_set_ispeed ((arg_terminal (1)), (arg_baud_index (2)));
  59.   PRIMITIVE_RETURN (UNSPECIFIC);
  60. }
  61.  
  62. DEFINE_PRIMITIVE ("TERMINAL-SET-OSPEED", Prim_terminal_set_ospeed, 2, 2, 0)
  63. {
  64.   PRIMITIVE_HEADER (2);
  65.   OS_terminal_set_ospeed ((arg_terminal (1)), (arg_baud_index (2)));
  66.   PRIMITIVE_RETURN (UNSPECIFIC);
  67. }
  68.  
  69. DEFINE_PRIMITIVE ("BAUD-INDEX->RATE", Prim_baud_index_to_rate, 1, 1, 0)
  70. {
  71.   PRIMITIVE_HEADER (1);
  72.   PRIMITIVE_RETURN
  73.     (long_to_integer (OS_baud_index_to_rate (arg_baud_index (1))));
  74. }
  75.  
  76. DEFINE_PRIMITIVE ("BAUD-RATE->INDEX", Prim_baud_rate_to_index, 1, 1, 0)
  77. {
  78.   PRIMITIVE_HEADER (1);
  79.   {
  80.     int index = (OS_baud_rate_to_index (arg_nonnegative_integer (1)));
  81.     if (index < 0)
  82.       error_bad_range_arg (1);
  83.     PRIMITIVE_RETURN (long_to_integer (index));
  84.   }
  85. }
  86.  
  87. DEFINE_PRIMITIVE ("TERMINAL-GET-STATE", Prim_terminal_get_state, 1, 1, 0)
  88. {
  89.   PRIMITIVE_HEADER (1);
  90.   {
  91.     SCHEME_OBJECT result = (allocate_string (OS_terminal_state_size ()));
  92.     OS_terminal_get_state ((arg_terminal (1)), (STRING_LOC (result, 0)));
  93.     PRIMITIVE_RETURN (result);
  94.   }
  95. }
  96.  
  97. DEFINE_PRIMITIVE ("TERMINAL-SET-STATE", Prim_terminal_set_state, 2, 2, 0)
  98. {
  99.   PRIMITIVE_HEADER (2);
  100.   CHECK_ARG (2, STRING_P);
  101.   {
  102.     SCHEME_OBJECT state = (ARG_REF (2));
  103.     if (((unsigned int) (STRING_LENGTH (state)))
  104.     != (OS_terminal_state_size ()))
  105.       error_bad_range_arg (2);
  106.     OS_terminal_set_state ((arg_terminal (1)), (STRING_LOC (state, 0)));
  107.   }
  108.   PRIMITIVE_RETURN (UNSPECIFIC);
  109. }
  110.  
  111. DEFINE_PRIMITIVE ("TERMINAL-COOKED-OUTPUT?", Prim_terminal_cooked_output_p, 1, 1,
  112.   "Return #F iff TERMINAL is not in cooked output mode.")
  113. {
  114.   PRIMITIVE_HEADER (1);
  115.   PRIMITIVE_RETURN
  116.     (BOOLEAN_TO_OBJECT (OS_terminal_cooked_output_p (arg_terminal (1))));
  117. }
  118.  
  119. DEFINE_PRIMITIVE ("TERMINAL-RAW-OUTPUT", Prim_terminal_raw_output, 1, 1,
  120.   "Put TERMINAL into raw output mode.")
  121. {
  122.   PRIMITIVE_HEADER (1);
  123.   OS_terminal_raw_output (arg_terminal (1));
  124.   PRIMITIVE_RETURN (UNSPECIFIC);
  125. }
  126.  
  127. DEFINE_PRIMITIVE ("TERMINAL-COOKED-OUTPUT", Prim_terminal_cooked_output, 1, 1,
  128.   "Put TERMINAL into cooked output mode.")
  129. {
  130.   PRIMITIVE_HEADER (1);
  131.   OS_terminal_cooked_output (arg_terminal (1));
  132.   PRIMITIVE_RETURN (UNSPECIFIC);
  133. }
  134.  
  135. DEFINE_PRIMITIVE ("TERMINAL-BUFFERED?", Prim_terminal_buffered_p, 1, 1,
  136.   "Return #F iff TERMINAL is not in buffered mode.")
  137. {
  138.   PRIMITIVE_HEADER (1);
  139.   PRIMITIVE_RETURN
  140.     (BOOLEAN_TO_OBJECT (OS_terminal_buffered_p (arg_terminal (1))));
  141. }
  142.  
  143. DEFINE_PRIMITIVE ("TERMINAL-BUFFERED", Prim_terminal_buffered, 1, 1,
  144.   "Put TERMINAL into buffered mode.")
  145. {
  146.   PRIMITIVE_HEADER (1);
  147.   OS_terminal_buffered (arg_terminal (1));
  148.   PRIMITIVE_RETURN (UNSPECIFIC);
  149. }
  150.  
  151. DEFINE_PRIMITIVE ("TERMINAL-NONBUFFERED", Prim_terminal_nonbuffered, 1, 1,
  152.   "Put TERMINAL into nonbuffered mode.")
  153. {
  154.   PRIMITIVE_HEADER (1);
  155.   OS_terminal_nonbuffered (arg_terminal (1));
  156.   PRIMITIVE_RETURN (UNSPECIFIC);
  157. }
  158.  
  159. DEFINE_PRIMITIVE ("TERMINAL-FLUSH-INPUT", Prim_terminal_flush_input, 1, 1,
  160.   "Discard any characters in TERMINAL's input buffer.")
  161. {
  162.   PRIMITIVE_HEADER (1);
  163.   OS_terminal_flush_input (arg_terminal (1));
  164.   PRIMITIVE_RETURN (UNSPECIFIC);
  165. }
  166.  
  167. DEFINE_PRIMITIVE ("TERMINAL-FLUSH-OUTPUT", Prim_terminal_flush_output, 1, 1,
  168.   "Discard any characters in TERMINAL's output buffer.")
  169. {
  170.   PRIMITIVE_HEADER (1);
  171.   OS_terminal_flush_output (arg_terminal (1));
  172.   PRIMITIVE_RETURN (UNSPECIFIC);
  173. }
  174.  
  175. DEFINE_PRIMITIVE ("TERMINAL-DRAIN-OUTPUT", Prim_terminal_drain_output, 1, 1,
  176.   "Wait until all characters in TERMINAL's output buffer have been sent.")
  177. {
  178.   PRIMITIVE_HEADER (1);
  179.   OS_terminal_drain_output (arg_terminal (1));
  180.   PRIMITIVE_RETURN (UNSPECIFIC);
  181. }
  182.  
  183. DEFINE_PRIMITIVE ("OS-JOB-CONTROL?", Prim_os_job_control_p, 0, 0, 0)
  184. {
  185.   PRIMITIVE_HEADER (0);
  186.   PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (OS_job_control_p ()));
  187. }
  188.  
  189. DEFINE_PRIMITIVE ("HAVE-PTYS?", Prim_have_ptys_p, 0, 0, 0)
  190. {
  191.   PRIMITIVE_HEADER (0);
  192.   PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (OS_have_ptys_p ()));
  193. }
  194.