Procházet zdrojové kódy

* new termio units

marco před 22 roky
rodič
revize
0f6af75554
2 změnil soubory, kde provedl 136 přidání a 0 odebrání
  1. 39 0
      rtl/unix/termiosh.inc
  2. 97 0
      rtl/unix/ttyname.inc

+ 39 - 0
rtl/unix/termiosh.inc

@@ -0,0 +1,39 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2001 by Free Pascal development team
+
+    Termios basic prototypes
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ ***********************************************************************}
+
+Function  TCGetAttr   (fd:cint;var tios:TermIOS):cint;
+Function  TCSetAttr   (fd:cint;OptAct:cint;const tios:TermIOS):cint;
+Procedure CFSetISpeed (var tios:TermIOS;speed:Cardinal);
+Procedure CFSetOSpeed (var tios:TermIOS;speed:Cardinal);
+Procedure CFMakeRaw   (var tios:TermIOS);
+Function  TCSendBreak (fd,duration:cint):cint;
+Function  TCSetPGrp   (fd,id:cint)  :cint;
+Function  TCGetPGrp   (fd:cint;var id:cint):cint;
+Function  TCFlush     (fd,qsel:cint):cint;
+Function  TCDrain     (fd:cint)     :cint;
+Function  TCFlow      (fd,act:cint) :cint;
+Function  IsATTY      (Handle:cint) :cint;
+Function  IsATTY      (var f:text)  :cint;
+function  TTYname     (Handle:cint):string;
+function  TTYname     (var F:Text) :string;
+
+{
+    $Log$
+    Revision 1.1  2003-11-19 17:13:00  marco
+     * new termio units
+
+
+}

+ 97 - 0
rtl/unix/ttyname.inc

@@ -0,0 +1,97 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 1999-2000 by Peter Vreman
+    member of the Free Pascal development team.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    A generic implementation of ttyname functionality. 
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+
+function TTYName(Handle:cint):string;
+{
+  Return the name of the current tty described by handle f.
+  returns empty string in case of an error.
+}
+var
+  mydev     : dev_t;
+  myino     : ino_t;
+  st        : stat;
+
+  function mysearch(n:string): boolean;
+  {searches recursively for the device in the directory given by n,
+    returns true if found and sets the name of the device in ttyname}
+  var dirstream : pdir;
+      d         : pdirent;
+      name      : string;
+      st        : stat;
+  begin
+    dirstream:=fpopendir(n);
+    if (dirstream=nil) then
+     exit(false);
+    d:=fpReaddir(dirstream^);
+    while (d<>nil) do
+     begin
+       name:=n+'/'+strpas(@(d^.d_name));
+     //  fpstat(name,st);
+       if fpstat(name,st)=0 then
+        begin
+          if (fpS_ISDIR(st.st_mode)) and  { if it is a directory }
+             (strpas(@(d^.d_name))<>'.') and    { but not ., .. and fd subdirs }
+             (strpas(@(d^.d_name))<>'..') and
+             (strpas(@(d^.d_name))<>'') and
+             (strpas(@(d^.d_name))<>'fd') then
+           begin                      {we found a directory, search inside it}
+             if mysearch(name) then
+              begin                 {the device is here}
+                fpclosedir(dirstream^);  {then don't continue searching}
+                mysearch:=true;
+                exit;
+              end;
+           end
+          else if (ino_t(d^.d_fileno)=myino) and (st.st_dev=mydev) then
+           begin
+             fpclosedir(dirstream^);
+             ttyname:=name;
+             mysearch:=true;
+             exit;
+           end;
+        end;
+       d:=fpReaddir(dirstream^);
+     end;
+    fpclosedir(dirstream^);
+    mysearch:=false;
+  end;
+
+begin
+  TTYName:='';
+  if (fpfstat(handle,st)=-1) and (isatty (handle)<>-1) then
+   exit;
+  mydev:=st.st_dev;
+  myino:=st.st_ino;
+  mysearch('/dev');
+end;
+
+
+function TTYName(var F:Text):string;
+{
+  Idem as previous, only now for text variables;
+}
+begin
+  TTYName:=TTYName(textrec(f).handle);
+end;
+
+{
+  $Log$
+  Revision 1.1  2003-11-19 17:13:00  marco
+   * new termio units
+
+
+}