mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 05:39:29 +01:00
98 lines
2.6 KiB
PHP
98 lines
2.6 KiB
PHP
{
|
|
$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
|
|
|
|
|
|
}
|