termiosproc.inc 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177
  1. {
  2. This file is part of the Free Pascal run time library.
  3. (c) 2000-2003 by Marco van de Voort
  4. member of the Free Pascal development team.
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. Termios implementation for FreeBSD
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY;without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  11. }
  12. {******************************************************************************
  13. IOCtl and Termios calls
  14. ******************************************************************************}
  15. Function TCGetAttr(fd:cint;var tios:TermIOS):cint;
  16. begin
  17. TCGETAttr:=fpIoCtl(Fd,TIOCGETA,@tios);
  18. end;
  19. Function TCSetAttr(fd:cint;OptAct:cint;const tios:TermIOS):cint;
  20. var
  21. nr:TIOCtlRequest;
  22. begin
  23. case OptAct of
  24. TCSANOW : nr:=TIOCSETA;
  25. TCSADRAIN : nr:=TIOCSETAW;
  26. TCSAFLUSH : nr:=TIOCSETAF;
  27. else
  28. begin
  29. fpsetErrNo(ESysEINVAL);
  30. TCSetAttr:=-1;
  31. exit;
  32. end;
  33. end;
  34. TCSetAttr:=fpIOCtl(fd,nr,@Tios);
  35. end;
  36. Procedure CFSetISpeed(var tios:TermIOS;speed:Cardinal);
  37. begin
  38. tios.c_ispeed:=speed; {Probably the Bxxxx speed constants}
  39. end;
  40. Procedure CFSetOSpeed(var tios:TermIOS;speed:Cardinal);
  41. begin
  42. tios.c_ospeed:=speed;
  43. end;
  44. Procedure CFMakeRaw(var tios:TermIOS);
  45. begin
  46. with tios do
  47. begin
  48. c_iflag:=c_iflag and (not (IMAXBEL or IXOFF or INPCK or BRKINT or
  49. PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON or
  50. IGNPAR));
  51. c_iflag:=c_iflag OR IGNBRK;
  52. c_oflag:=c_oflag and (not OPOST);
  53. c_lflag:=c_lflag and (not (ECHO or ECHOE or ECHOK or ECHONL or ICANON or
  54. ISIG or IEXTEN or NOFLSH or TOSTOP or PENDIN));
  55. c_cflag:=(c_cflag and (not (CSIZE or PARENB))) or (CS8 OR cread);
  56. c_cc[VMIN]:=1;
  57. c_cc[VTIME]:=0;
  58. end;
  59. end;
  60. Function TCSendBreak(fd,duration:cint):cint; {$ifdef VER2_0}inline;{$endif}
  61. var
  62. sleepytime : ttimeval;
  63. begin
  64. sleepytime.tv_sec := 0;
  65. sleepytime.tv_usec := 400000;
  66. if fpioctl(fd, TIOCSBRK, nil) = -1 then
  67. exit(-1);
  68. fpselect(0, nil, nil, nil, @sleepytime);
  69. if fpioctl(fd, TIOCCBRK, nil) = -1 then
  70. exit(-1);
  71. TCSendBreak:=0;
  72. end;
  73. Function TCSetPGrp(fd,id:cint):cint;
  74. begin
  75. TCSetPGrp:=fpIOCtl(fd,TIOCSPGRP,pointer(id));
  76. end;
  77. Function TCGetPGrp(fd:cint;var id:cint):cint;
  78. begin
  79. TCGetPGrp:=fpIOCtl(fd,TIOCGPGRP,@id);
  80. end;
  81. Function TCDrain(fd:cint):cint;
  82. begin
  83. TCDrain:=fpIOCtl(fd,TIOCDRAIN,nil); {Should set timeout to 1 first?}
  84. end;
  85. const
  86. _POSIX_VDISABLE = $ff;
  87. Function TCFlow(fd,act:cint):cint; {$ifdef VER2_0}inline;{$endif}
  88. var
  89. term:Termios;
  90. c : cuchar;
  91. tmp : cint;
  92. begin
  93. case act OF
  94. TCOOFF : TCFlow:=fpIoctl(fd,TIOCSTOP,nil);
  95. TCOOn : TCFlow:=fpIOctl(Fd,TIOCStart,nil);
  96. TCION,
  97. TCIOFF : begin
  98. if tcgetattr(fd, term) = -1 then
  99. exit(-1);
  100. if act=TCIOFF then
  101. tmp:=VSTOP
  102. else
  103. tmp:=VSTART;
  104. c:=term.c_cc[tmp];
  105. if (c <> _POSIX_VDISABLE) and
  106. (fpwrite(fd, c, sizeof(c)) = -1) then
  107. exit (-1);
  108. TCFlow:=0;
  109. end;
  110. else
  111. begin
  112. errno := esysEINVAL;
  113. exit(-1);
  114. end;
  115. end;
  116. end;
  117. const FREAD = 1; // marked "BSD visible"
  118. FWRITE = 2;
  119. Function TCFlush(fd,qsel:cint):cint; {$ifdef VER2_0}inline;{$endif}
  120. var comval : cint;
  121. begin
  122. case qsel of
  123. TCIFlush : comval:=FREAD;
  124. TCOFlush : comval:=FWRITE;
  125. TCIOFlush : comval:=FREAD or FWRITE;
  126. else
  127. begin
  128. errno:=ESysEINVAL;
  129. exit(-1);
  130. end;
  131. end;
  132. TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(@comval));
  133. end;
  134. Function IsATTY (Handle:cint):cint;
  135. {
  136. Check if the filehandle described by 'handle' is a TTY (Terminal)
  137. }
  138. var
  139. t : Termios;
  140. begin
  141. IsAtty:=ord(TCGetAttr(Handle,t) <> -1);
  142. end;
  143. Function IsATTY(var f: text):cint;
  144. {
  145. Idem as previous, only now for text variables.
  146. }
  147. begin
  148. IsATTY:=IsaTTY(textrec(f).handle);
  149. end;