paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-06 11:50:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

* gpm now uses a Pascal translation of libgpm instead of linking against

Browse Source 
it.
  * isatty result type changed into boolean
This commit is contained in:
daniel 2004-07-08 13:23:21 +00:00
parent fdbed06377
commit 74f637cb11
10 changed files with 845 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
rtl/darwin/termiosproc.inc
View File

@ -110,23 +110,23 @@ begin
end;
end;
Function TCFlush(fd,qsel:cint):cint;
Function TCFlush(fd,qsel:cint):boolean;
begin
TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
end;
Function IsATTY (Handle:cint):cint;
Function IsATTY (Handle:cint):boolean;
{
Check if the filehandle described by 'handle' is a TTY (Terminal)
}
var
t : Termios;
begin
IsAtty:=TCGetAttr(Handle,t);
IsAtty:=TCGetAttr(Handle,t)<>-1;
end;
Function IsATTY(var f: text):cint;
Function IsATTY(var f: text):boolean;
{
Idem as previous, only now for text variables.
}
@ -136,7 +136,12 @@ end;
{
$Log$
Revision 1.2 2004-02-05 14:00:45 jonas
Revision 1.3 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.2 2004/02/05 14:00:45 jonas
+ some declarations added from other bsds and /usr/include/sys/termios.h
to termios.inc and termiosproc.inc (by Karl-Michael Schindler)
+ added crt, mouse (because required by keyboard), keyboard, termio,

13
rtl/freebsd/termiosproc.inc
View File

@ -111,18 +111,18 @@ begin
TCFlush:=fpIOCtl(fd,TIOCFLUSH,pointer(qsel));
end;
Function IsATTY (Handle:cint):cint;
Function IsATTY (Handle:cint):boolean;
{
Check if the filehandle described by 'handle' is a TTY (Terminal)
}
var
t : Termios;
begin
IsAtty:=TCGetAttr(Handle,t);
IsAtty:=TCGetAttr(Handle,t)<>-1;
end;
Function IsATTY(var f: text):cint;
Function IsATTY(var f: text):boolean;
{
Idem as previous, only now for text variables.
}
@ -132,7 +132,12 @@ end;
{
$Log$
Revision 1.3 2004-01-03 12:18:29 marco
Revision 1.4 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.3 2004/01/03 12:18:29 marco
* a lot of copyright notices and CVS logs added and fixed
Revision 1.2 2003/12/16 19:43:53 marco

3
rtl/linux/Makefile.fpc
View File

@ -281,3 +281,6 @@ callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT)
cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
cthreads$(PPUEXT) : $(UNIXINC)/cthreads.pp $(SYSTEMUNIT)$(PPUEXT) systhrds$(PPUEXT)
gpm$(PPUEXT): $(UNIXINC)/gpm.pp $(UNIXINC)/unix$(PPUEXT) baseunix$(PPUEXT) $(UNIXINC)/sockets$(PPUEXT)
$(COMPILER) -Sg $(UNIXINC)/gpm.pp

6
rtl/linux/termiosproc.inc
View File

@ -140,18 +140,18 @@ begin
{$endif}
end;
Function IsATTY (Handle:cint):cint;
Function IsATTY (Handle:cint):boolean;
{
Check if the filehandle described by 'handle' is a TTY (Terminal)
}
var
t : Termios;
begin
IsAtty:=TCGetAttr(Handle,t);
IsAtty:=TCGetAttr(Handle,t)<>-1;
end;
Function IsATTY(var f: text):cint;
Function IsATTY(var f: text):boolean;
{
Idem as previous, only now for text variables.
}

13
rtl/unix/crt.pp
View File

@ -1257,7 +1257,7 @@ var
c : char;
i : longint;
Begin
if isATTY(F.Handle)<>-1 then
if isATTY(F.Handle) then
begin
F.BufPos := 0;
i := 0;
@ -1566,10 +1566,10 @@ Initialization
Reset(Input);
TextRec(Input).Handle:=StdInputHandle;
{ Are we redirected to a file ? }
OutputRedir:= IsAtty(TextRec(Output).Handle)=-1;
OutputRedir:=not IsAtty(TextRec(Output).Handle);
{ does the input come from another console or from a file? }
InputRedir :=
(IsAtty(TextRec(Input).Handle)=-1) or
not IsAtty(TextRec(Input).Handle) or
(not OutputRedir and
(TTYName(TextRec(Input).Handle) <> TTYName(TextRec(Output).Handle)));
{ Get Size of terminal and set WindMax to the window }
@ -1611,7 +1611,12 @@ Finalization
End.
{
$Log$
Revision 1.17 2004-02-08 16:22:20 michael
Revision 1.18 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.17 2004/02/08 16:22:20 michael
+ Moved CRT interface to common include file
Revision 1.16 2003/11/24 22:27:25 michael

812
rtl/unix/gpm.pp
View File

@ -14,12 +14,28 @@
**********************************************************************}
unit gpm;
interface
{Note: Libgpm is *the* interface for Linux text-mode programs.
Unfortunately it isn't suitable for anything else besides a blocky
cursor on a text mode interface. The GPM protocol suffers from serious
defficiencies and ideally, gpm is abolished as quickly as possible.
With lack of a good alternative, GPM deserves good support. But
please keep this in mind while coding.}
{*****************************************************************************}
interface
{*****************************************************************************}
uses
baseUnix;
{$ifndef use_external}
{$linklib gpm}
{$linklib c}
{$endif}
{$inline on}
const
_PATH_VARRUN = '/var/run/';
@ -59,8 +75,8 @@ const
type
{$PACKRECORDS c}
PGpmEvent = ^TGpmEvent;
TGpmEvent = record
Pgpm_event=^Tgpm_event;
Tgpm_event=record
buttons : byte;
modifiers : byte;
vc : word;
@ -71,7 +87,10 @@ type
EventType : TGpmEType;
clicks : longint;
margin : TGpmMargin;
end;
end;
Pgpmevent=Pgpm_event;
Tgpmevent=Tgpm_event;
TGpmHandler=function(var event:TGpmEvent;clientdata:pointer):longint;cdecl;
@ -79,8 +98,8 @@ type
GPM_MAGIC = $47706D4C;
type
PGpmConnect = ^TGpmConnect;
TGpmConnect = record
Pgpm_connect = ^TGpm_connect;
Tgpm_connect = record
eventMask : word;
defaultMask : word;
minMod : word;
@ -88,23 +107,26 @@ type
pid : longint;
vc : longint;
end;
Pgpmconnect=Pgpm_connect;
Tgpmconnect=Tgpm_connect;
PGpmRoi = ^TGpmRoi;
TGpmRoi = record
xMin : integer;
xMax : integer;
yMin : integer;
yMax : integer;
minMod : word;
maxMod : word;
eventMask : word;
owned : word;
handler : TGpmHandler;
clientdata : pointer;
prev : PGpmRoi;
next : PGpmRoi;
end;
Pgpm_roi=^Tgpm_roi;
Tgpm_roi=record
xmin,xmax:integer;
ymin,ymax:integer;
minmod,maxmod:word;
eventmask:word;
owned:word;
handler:Tgpmhandler;
clientdata:pointer;
prev,next:Pgpm_roi;
end;
Pgpmroi=Pgpm_roi;
Tgpmroi=Tgpm_roi;
{$ifdef external}
var
gpm_flag : longint;cvar;external;
gpm_fd : longint;cvar;external;
@ -125,6 +147,12 @@ var
gpm_current_roi : PGpmRoi;cvar;external;
gpm_consolefd : longint;cvar;external;
Gpm_HandleRoi : TGpmHandler;cvar;external;
{$else}
var gpm_roi:Pgpm_roi;
gpm_handler,gpm_roi_handler:Tgpmhandler;
gpm_current_roi:Pgpm_roi;
gpm_roi_data:pointer;
{$endif}
function Gpm_StrictSingle(EventType : longint) : boolean;
function Gpm_AnySingle(EventType : longint) : boolean;
@ -133,6 +161,7 @@ function Gpm_AnyDouble(EventType : longint) : boolean;
function Gpm_StrictTriple(EventType : longint) : boolean;
function Gpm_AnyTriple(EventType : longint) : boolean;
{$ifdef use_external}
function Gpm_Open(var _para1:TGpmConnect; _para2:longint):longint;cdecl;external;
function Gpm_Close:longint;cdecl;external;
function Gpm_GetEvent(var _para1:TGpmEvent):longint;cdecl;external;
@ -141,25 +170,91 @@ function Gpm_Getchar : longint;}
function Gpm_Repeat(millisec:longint):longint;cdecl;external;
function Gpm_FitValuesM(var x,y:longint; margin:longint):longint;cdecl;external;
function Gpm_FitValues(var x,y:longint):longint;cdecl;external;
{
function GPM_DRAWPOINTER(ePtr : longint) : longint;
}
{function GPM_DRAWPOINTER(ePtr : longint) : longint;}
function Gpm_PushRoi(x1:longint; y1:longint; X2:longint; Y2:longint; mask:longint; fun:TGpmHandler; xtradata:pointer):PGpmRoi;cdecl;external;
function Gpm_PopRoi(which:PGpmRoi):PGpmRoi;cdecl;external;
function Gpm_RaiseRoi(which:PGpmRoi; before:PGpmRoi):PGpmRoi;cdecl;external;
function Gpm_LowerRoi(which:PGpmRoi; after:PGpmRoi):PGpmRoi;cdecl;external;
{function Gpm_Wgetch:longint;cdecl;external;
function Gpm_Getch:longint;}
function Gpm_GetLibVersion(var where:longint):pchar;cdecl;external;
function Gpm_GetServerVersion(var where:longint):pchar;cdecl;external;
function Gpm_GetSnapshot(var ePtr:TGpmEvent):longint;cdecl;external;
{$else}
function gpm_open(var conn:Tgpm_connect;flag:longint):longint;
function gpm_close:longint;
function gpm_getevent(var event:Tgpm_event):longint;
{function Gpm_Getc(_para1:pFILE):longint;cdecl;external;
function Gpm_Getchar : longint;}
function gpm_repeat(millisec:longint):longint;
function gpm_fitvaluesM(var x,y:longint; margin:longint):longint;
function gpm_fitvalues(var x,y:longint):longint;{$ifndef VER1_0}inline;{$endif}
function gpm_pushroi(x1:longint;y1:longint;x2:longint;y2:longint;
mask:longint;fun:Tgpmhandler;xtradata:pointer):Pgpm_roi;
function gpm_poproi(which:Pgpm_roi):Pgpm_roi;
function gpm_raiseroi(which:Pgpm_roi;before:Pgpm_roi):Pgpm_roi;
function gpm_lowerroi(which:Pgpm_roi;after:Pgpm_roi):Pgpm_roi;
{Should be pointer because proc accepts nil.}
function gpm_getsnapshot(eptr:Pgpmevent):longint;
{Overload for compatibility.}
function gpm_getsnapshot(var eptr:Tgpmevent):longint;
{$ifndef VER1_0}inline;{$endif}
{$endif}
implementation
{*****************************************************************************}
implementation
{*****************************************************************************}
{$ifndef use_external}
uses termio,sockets,strings,unix;
type Pgpm_stst=^Tgpm_stst;
Tgpm_stst=record
info:Tgpmconnect;
next:Pgpm_stst;
end;
Pmicetab=^Tmicetab;
Tmicetab=record
next:Pmicetab;
device,protocol,options:Pchar;
end;
string63=string[63];
Toptions=record
autodetect:longint;
mice_count:longint;
repeater:longint;
repeater_type:Pchar;
run_status:longint;
micelist:Pmicetab;
progname,
consolename:string63;
end;
var options:Toptions;
gpm_stack:Pgpm_stst;
gpm_mx,gpm_my:longint;
gpm_saved_winch_hook,gpm_saved_suspend_hook:sigactionrec;
const gpm_flag:boolean=false; {almost unuseful now -- where was it used for ? can
we remove it now ? FIXME}
gpm_tried:boolean=false;
gpm_hflag:boolean=false;
gpm_fd:longint=-1;
gpm_consolefd:longint=-1;
gpm_zerobased:longint=0;
const GPM_DEVFS_CONSOLE='/dev/vc/0';
GPM_OLD_CONSOLE='/dev/tty0';
GPM_REQ_SNAPSHOT=0;
GPM_REQ_BUTTONS=1;
GPM_REQ_CONFIG=2;
GPM_REQ_NOPASTE=3;
{$endif}
function Gpm_StrictSingle(EventType : longint) : boolean;
begin
@ -191,6 +286,7 @@ begin
Gpm_AnyTriple:=(EventType and GPM_TRIPLE<>0);
end;
{$ifdef use_external}
procedure Gpm_CheckVersion;
var
l : longint;
@ -203,10 +299,666 @@ begin
end;
end;
{$else}
const checked_con:boolean=false;
function putdata(where:longint;const what:Tgpmconnect):boolean;
begin
putdata:=true;
if fpwrite(where,what,sizeof(Tgpmconnect))<>sizeof(Tgpmconnect) then
begin
{ gpm_report(GPM_PR_ERR,GPM_MESS_WRITE_ERR,strerror(errno));}
putdata:=false;
end;
end;
function gpm_get_console:string63;
var buf:stat;
begin
{First try the devfs device, because in the next time this will be
the preferred one. If that fails, take the old console.}
{Check for open new console.}
if fpstat(GPM_DEVFS_CONSOLE,buf)=0 then
gpm_get_console:=GPM_DEVFS_CONSOLE
{Failed, try OLD console.}
else if fpstat(GPM_OLD_CONSOLE,buf)=0 then
gpm_get_console:=GPM_OLD_CONSOLE
else
gpm_get_console:='';
end;
procedure gpm_winch_hook(signum:longint);cdecl;
var win:winsize;
begin
if (signalhandler(SIG_IGN)<>gpm_saved_winch_hook.sa_handler) and
(signalhandler(SIG_DFL)<>gpm_saved_winch_hook.sa_handler) then
gpm_saved_winch_hook.sa_handler(signum);
if fpioctl(gpm_consolefd,TIOCGWINSZ,@win)=-1 then
exit;
if (win.ws_col=0) or (win.ws_row=0) then
begin
win.ws_col:=80;
win.ws_row:=25;
end;
gpm_mx:=win.ws_col - gpm_zerobased;
gpm_my:=win.ws_row - gpm_zerobased;
end;
procedure gpm_suspend_hook(signum:longint);cdecl;
var conn:Tgpmconnect;
old_sigset,new_sigset:Tsigset;
sa:sigactionrec;
success:boolean;
begin
fpsigemptyset(new_sigset);
fpsigaddset(new_sigset,SIGTSTP);
fpsigprocmask(SIG_BLOCK,new_sigset,old_sigset);
{Open a completely transparent gpm connection.}
conn.eventmask:=0;
conn.defaultMask:=not 0;
conn.minmod:=not 0;
conn.maxmod:=0;
{cannot do this under xterm, tough}
success:=gpm_open(conn,0)>=0;
{take the default action, whatever it is (probably a stop :)}
fpsigprocmask(SIG_SETMASK,@old_sigset,nil);
fpsigaction(SIGTSTP,@gpm_saved_suspend_hook,nil);
fpkill(fpgetpid,SIGTSTP);
{ in bardo here }
{ Reincarnation. Prepare for another death early. }
fpsigemptyset(sa.sa_mask);
sa.sa_handler:=@gpm_suspend_hook;
sa.sa_flags:=SA_NOMASK;
fpsigaction(SIGTSTP,@sa,nil);
{ Pop the gpm stack by closing the useless connection }
{ but do it only when we know we opened one.. }
if success then
gpm_close;
end;
function gpm_open(var conn:Tgpmconnect;flag:longint):longint;
var tty:string;
flagstr:string[10];
term:Pchar;
i:cardinal;
addr:Tunixsockaddr;
win:Twinsize;
n:Pgpm_stst;
l:byte;
p:byte; {there max 256 console ttys}
buf:stat;
sa:sigactionrec;
label err;
begin
options.consolename:='';
{ gpm_report(GPM_PR_DEBUG,"VC: %d",flag);}
{....................................... First of all, check xterm}
term:=fpgetenv('TERM');
if (term<>nil) and (strcomp(term,'xterm')=0) then
begin
if gpm_tried then
begin
gpm_open:=gpm_fd; { no stack }
exit;
end;
gpm_fd:=-2;
{save old hilit tracking and enable mouse tracking}
write(#27'[?1001s'#27'[?1000h');
flush(output);
gpm_flag:=true;
gpm_open:=gpm_fd;
exit;
end;
{....................................... No xterm, go on}
{ check whether we know what name the console is: what's with the lib??? }
if not checked_con then
begin
options.consolename:=gpm_get_console;
checked_con:=true;
end;
{ So I chose to use the current tty, instead of /dev/console, which
has permission problems. (I am fool, and my console is
readable/writeable by everybody.
However, making this piece of code work has been a real hassle.}
if not gpm_flag and gpm_tried then
begin
gpm_open:=-1;
exit;
end;
gpm_tried:=true; {do or die}
new(n);
n^.next:=gpm_stack;
gpm_stack:=n;
conn.pid:=fpgetpid; { fill obvious values }
if n^.next<>nil then
conn.vc:=n^.next^.info.vc {inherit}
else
begin
conn.vc:=0; { default handler }
if (flag>0) then
begin { forced vc number }
conn.vc:=flag;
str(flag,flagstr);
tty:=options.consolename+flagstr;
end
else
begin {use your current vc}
if isatty(0) then
tty:=ttyname(0); { stdin }
if (tty='') and isatty(1) then
tty:=ttyname(1); { stdout }
if (tty='') and isatty(2) then
tty:=ttyname(2); { stderr }
if (tty='') then
begin
{ gpm_report(GPM_PR_ERR,"checking tty name failed");}
goto err;
end;
conn.vc:=0;
l:=length(tty);
p:=1;
while tty[l] in ['0'..'9'] do
begin
inc(conn.vc,p*(byte(tty[l])-byte('0')));
p:=p*10;
dec(l);
end;
end;
if (gpm_consolefd=-1) then
begin
gpm_consolefd:=fpopen(tty,O_WRONLY);
if gpm_consolefd<0 then
begin
{ gpm_report(GPM_PR_ERR,GPM_MESS_DOUBLE_S,tty,strerror(errno));}
goto err;
end;
end;
end;
n^.info:=conn;
{....................................... Get screen dimensions }
fpioctl(gpm_consolefd, TIOCGWINSZ, @win);
if (win.ws_col or win.ws_row)=0 then
begin
{Hmmmm. The mad terminal didn't return it's size :/ }
{ fprintf(stderr, "libgpm: zero screen dimension, assuming 80x25.\n");}
win.ws_col:=80;
win.ws_row:=25;
end;
gpm_mx:=win.ws_col-gpm_zerobased;
gpm_my:=win.ws_row-gpm_zerobased;
{....................................... Connect to the control socket}
if not gpm_flag then
begin
gpm_fd:=socket(AF_UNIX,SOCK_STREAM,0);
if gpm_fd<0 then
begin
{ gpm_report(GPM_PR_ERR,GPM_MESS_SOCKET,strerror(errno));}
goto err;
end;
end;
fillchar(addr,sizeof(addr),0);
addr.family:=PF_UNIX;
strcopy(addr.path, GPM_NODE_CTL);
i:=sizeof(addr.family)+length(GPM_NODE_CTL);
if fpconnect(gpm_fd,@addr,i)<0 then
begin
{ gpm_report(GPM_PR_INFO,GPM_MESS_DOUBLE_S,GPM_NODE_CTL,strerror(errno));}
{Well, try to open a chr device called /dev/gpmctl. This should
be forward-compatible with a kernel server.}
fpclose(gpm_fd); {the socket}
gpm_fd:=fpopen(GPM_NODE_DEV,O_RDWR);
if gpm_fd=-1 then
begin
{ gpm_report(GPM_PR_ERR,GPM_MESS_DOUBLE_S,GPM_NODE_DEV
,strerror(errno));}
goto err;
end;
if (fpfstat(gpm_fd,buf)=-1) or (buf.st_mode and STAT_IFMT<>STAT_IFCHR) then
goto err;
end;
{....................................... Put your data}
if putdata(gpm_fd,conn) then
begin
{ itz Wed Dec 16 23:22:16 PST 1998 use sigaction, the old
code caused a signal loop under XEmacs }
fpsigemptyset(sa.sa_mask);
{ And the winch (window-resize) hook .. }
sa.sa_handler:=@gpm_winch_hook;
sa.sa_flags:=0;
fpsigaction(SIGWINCH,@sa,@gpm_saved_winch_hook);
if gpm_flag then
begin
{ Install suspend hook }
sa.sa_handler:=signalhandler(SIG_IGN);
fpsigaction(SIGTSTP,@sa,@gpm_saved_suspend_hook);
{if signal was originally ignored, job control is not supported}
if gpm_saved_suspend_hook.sa_handler<>signalhandler(SIG_IGN) then
begin
sa.sa_flags:=SA_NOMASK;
sa.sa_handler:=@gpm_suspend_hook;
fpsigaction(SIGTSTP,@sa,nil);
end;
end;
end;
gpm_open:=gpm_fd;
exit;
{....................................... Error: free all memory}
err:
{ gpm_report(GPM_PR_ERR,'Oh, oh, it''s an error! possibly I die! ');}
repeat
n:=gpm_stack^.next;
dispose(gpm_stack);
gpm_stack:=n;
until gpm_stack=nil;
if gpm_fd>=0 then
fpclose(gpm_fd);
gpm_flag:=false;
gpm_open:=-1;
end;
function gpm_close:longint;
var next:Pgpm_stst;
begin
gpm_tried:=false; { reset the error flag for next time }
if gpm_fd=-2 then { xterm }
begin
write(#27'[?1000l'#27'[?1001r');
flush(output);
end
else { linux }
begin
if not gpm_flag then
gpm_close:=0
else
begin
next:=gpm_stack^.next;
dispose(gpm_stack);
gpm_stack:=next;
if next<>nil then
putdata(gpm_fd,next^.info);
gpm_flag:=false;
end;
end;
if gpm_fd>=0 then
fpclose(gpm_fd);
gpm_fd:=-1;
fpsigaction(SIGTSTP,@gpm_saved_suspend_hook,nil);
fpsigaction(SIGWINCH,@gpm_saved_winch_hook,nil);
fpclose(gpm_consolefd);
gpm_consolefd:=-1;
gpm_close:=0;
end;
function gpm_getevent(var event:Tgpm_event):longint;
var count:longint;
begin
gpm_getevent:=0;
if not gpm_flag then
exit;
count:=fpread(gpm_fd,event,sizeof(Tgpm_event));
if count<>sizeof(Tgpm_event) then
begin
{avoid to send the message if there is no data; sometimes it makes
sense to poll the mouse descriptor any now an then using a
non-blocking descriptor}
{ if (count<>-1) or (errno<>EAGAIN)
gpm_report(GPM_PR_INFO,"Read too few bytes (%i) at %s:%d",
count,__FILE__,__LINE__);}
gpm_getevent:=-1;
exit;
end;
dec(event.x,gpm_zerobased);
dec(event.y,gpm_zerobased);
gpm_getevent:=1;
end;
function gpm_repeat(millisec:longint):longint;
var fd:longint;
selset:Tfdset;
begin
fd:=0; {Default to stdin (xterm).}
if gpm_fd>=0 then
fd:=gpm_fd;
fpFD_ZERO(selset);
fpFD_SET(fd,selset);
gpm_repeat:=fpselect(fd+1,@selset,nil,nil,millisec);
end;
function gpm_fitvaluesM(var x,y:longint;margin:longint):longint;
begin
gpm_fitvaluesM:=0;
if margin=-1 then
begin
if x<gpm_zerobased then
x:=gpm_zerobased
else if x>gpm_mx then
x:=gpm_mx;
if y<gpm_zerobased then
y:=gpm_zerobased
else if y>gpm_my then
y:=gpm_my;
end
else
case margin of
GPM_TOP:
inc(y);
GPM_BOT:
dec(y);
GPM_RGT:
dec(x);
GPM_LFT:
inc(x);
end;
end;
function gpm_fitvalues(var x,y:longint):longint;
{$ifndef VER1_0}inline;{$endif}
begin
gpm_fitvalues:=gpm_fitvalues(x,y);
end;
function gpm_handle_roi(var eptr:Tgpm_event;clientdata:pointer):longint;cdecl;
var backevent:Tgpm_event;
roi:Pgpm_roi;
begin
roi:=gpm_current_roi;
{If motion or press, look for the interested roi.
Drag and release will be reported to the old roi.}
if eptr.eventtype and (GPM_MOVE or GPM_DOWN)<>0 then
begin
roi:=gpm_roi;
while roi<>nil do
begin
if not ((roi^.xmin>eptr.x) or (roi^.xmax<eptr.x)) and
not ((roi^.ymin>eptr.y) or (roi^.ymax<eptr.y)) and
not ((roi^.minmod and eptr.modifiers)<roi^.minmod) and
not ((roi^.maxmod and eptr.modifiers)<eptr.modifiers) then
break;
roi:=roi^.next;
end;
end;
{Now generate the leave/enter events}
if roi<>gpm_current_roi then
begin
if (gpm_current_roi<>nil) and (gpm_current_roi^.eventmask and GPM_LEAVE<>0) then
begin
backevent.eventtype:=GPM_LEAVE;
gpm_current_roi^.handler(backevent,gpm_current_roi^.clientdata);
end;
if (roi<>nil) and (roi^.eventmask and GPM_ENTER<>0) then
begin
backevent.eventtype:=GPM_ENTER;
roi^.handler(backevent,roi^.clientdata);
end;
end;
gpm_current_roi:=roi;
{events not requested are discarded}
if (roi<>nil) and (eptr.eventtype and ($0f or GPM_ENTER or GPM_LEAVE) and roi^.eventmask=0) then
gpm_handle_roi:=0
else
begin
backevent:=eptr; {copy it, so the main one is unchanged}
if roi=nil then
if gpm_roi_handler<>nil then
gpm_handle_roi:=gpm_roi_handler(backevent,gpm_roi_data)
else
gpm_handle_roi:=0
else
begin
{Ok, now report the event as it is, after modifying x and y}
dec(backevent.x,roi^.xmin);
dec(backevent.y,roi^.ymin);
roi^.handler(backevent,roi^.clientdata);
end;
end;
end;
function gpm_pushroi(x1:longint;y1:longint;x2:longint;y2:longint;
mask:longint;fun:Tgpmhandler;xtradata:pointer):Pgpm_roi;
var n:Pgpm_roi;
begin
{create a roi and push it}
new(n);
{use the roi handler, if still null}
if (gpm_roi<>nil) and (gpm_handler<>nil) then
gpm_handler:=@gpm_handle_roi;
n^.xmin:=x1; n^.xmax:=x2;
n^.ymin:=y1; n^.ymax:=y2;
n^.minmod:=0; n^.maxmod:=not 0;
n^.prev:=nil; n^.next:=nil;
n^.eventmask:=mask;
n^.owned:=0; { use dispose }
n^.handler:=fun;
if xtradata=nil then
n^.clientdata:=n
else
n^.clientdata:=xtradata;
gpm_pushroi:=gpm_raiseroi(n,nil);
end;
function gpm_useroi(n:Pgpm_roi):Pgpm_roi;
begin
{ use a Roi by pushing it }
n^.prev:=nil;
n^.next:=nil;
n^.owned:=1;
{ use the roi handler, if still nil }
if (gpm_roi=nil) and (gpm_handler=nil) then
gpm_handler:=@gpm_handle_roi;
gpm_useroi:=gpm_raiseroi(n,nil);
end;
function gpm_poproi(which:Pgpmroi):Pgpmroi;
begin
{extract the Roi and remove it}
if which^.prev<>nil then
which^.prev^.next:=which^.next;
if which^.next<>nil then
which^.next^.prev:=which^.prev;
if gpm_roi=which then
gpm_roi:=which^.next;
if which^.owned=0 then
dispose(which);
if gpm_current_roi=which then
gpm_current_roi:=nil;
gpm_poproi:=gpm_roi; {return the new top-of-stack}
end;
function gpm_raiseroi(which:Pgpmroi;before:Pgpmroi):Pgpmroi;
begin
{raise a Roi above another, or to top-of-stack}
if gpm_roi=nil then
begin
gpm_roi:=which;
gpm_raiseroi:=which;
exit;
end;
if before=nil then
before:=gpm_roi;
if before=which then
begin
gpm_raiseroi:=gpm_roi;
exit;
end;
if which^.prev<>nil then
which^.prev^.next:=which^.next;
if which^.next<>nil then
which^.next^.prev:=which^.prev;
if gpm_roi=which then
gpm_roi:=which^.next;
which^.prev:=before^.prev;
before^.prev:=which;
which^.next:=before;
if which^.prev<>nil then
which^.prev^.next:=which
else
gpm_roi:=which;
gpm_raiseroi:=gpm_roi; { return the new top-of-stack }
end;
function gpm_lowerroi(which:Pgpmroi;after:Pgpmroi):Pgpmroi;
begin
{lower a Roi below another, or to bottom-of-stack}
if after=nil then
begin
after:=gpm_roi;
while after^.next<>nil do
after:=after^.next;
end;
if after=which then
begin
gpm_lowerroi:=gpm_roi;
exit;
end;
if which^.prev<>nil then
which^.prev^.next:=which^.next;
if which^.next<>nil then
which^.next^.prev:=which^.prev;
if gpm_roi=which then
gpm_roi:=which^.next;
which^.next:=after^.next;
after^.next:=which;
which^.prev:=after;
if which^.next<>nil then
which^.next^.prev:=which;
gpm_lowerroi:=gpm_roi; {return the new top-of-stack}
end;
function gpm_getsnapshot(eptr:Pgpm_event):longint;
var conn:Tgpm_connect;
event:Tgpm_event;
sillyset:Tfdset;
i:longint;
begin
conn.pid:=0; { this signals a request }
if eptr<>nil then
conn.vc:=GPM_REQ_SNAPSHOT
else
begin
conn.vc:=GPM_REQ_BUTTONS;
eptr:=@event;
end;
if gpm_fd=-1 then
begin
gpm_getsnapshot:=-1;
exit;
end;
fpFD_ZERO(sillyset);
fpFD_SET(gpm_fd,sillyset);
if fpselect(gpm_fd+1,@sillyset,nil,nil,0)=1 then
gpm_getsnapshot:=0
else
begin
fpwrite(gpm_fd,conn,sizeof(Tgpm_connect));
i:=gpm_getevent(eptr^);
if i<>1 then
gpm_getsnapshot:=-1
else
begin
gpm_getsnapshot:=eptr^.eventtype; { number of buttons }
eptr^.eventtype:=0;
end;
end;
end;
function gpm_getsnapshot(var eptr:Tgpmevent):longint;
{$ifndef VER1_0}inline;{$endif}
begin
gpm_getsnapshot:=gpm_getsnapshot(@eptr);
end;
{$endif}
end.
{
$Log$
Revision 1.6 2003-09-14 20:15:01 marco
Revision 1.7 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.6 2003/09/14 20:15:01 marco
* Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
Revision 1.5 2002/09/07 16:01:27 peter

9
rtl/unix/keyboard.pp
View File

@ -307,7 +307,7 @@ var
begin
IsConsole:=false;
{ check for tty }
if (IsATTY(stdinputhandle)<>-1) then
if IsATTY(stdinputhandle) then
begin
{ running on a tty, find out whether locally or remotely }
ThisTTY:=TTYName(stdinputhandle);
@ -1532,7 +1532,12 @@ begin
end.
{
$Log$
Revision 1.17 2003-11-19 17:11:40 marco
Revision 1.18 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.17 2003/11/19 17:11:40 marco
* termio unit
Revision 1.16 2003/11/17 10:05:51 marco

11
rtl/unix/termiosh.inc
View File

@ -25,14 +25,19 @@ 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 IsATTY (Handle:cint) :boolean;
Function IsATTY (var f:text) :boolean;
function TTYname (Handle:cint):string;
function TTYname (var F:Text) :string;
{
$Log$
Revision 1.1 2003-11-19 17:13:00 marco
Revision 1.2 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.1 2003/11/19 17:13:00 marco
* new termio units

9
rtl/unix/ttyname.inc
View File

@ -72,7 +72,7 @@ var
begin
TTYName:='';
if (fpfstat(handle,st)=-1) and (isatty (handle)<>-1) then
if (fpfstat(handle,st)=-1) and isatty(handle) then
exit;
mydev:=st.st_dev;
myino:=st.st_ino;
@ -90,7 +90,12 @@ end;
{
$Log$
Revision 1.1 2003-11-19 17:13:00 marco
Revision 1.2 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.1 2003/11/19 17:13:00 marco
* new termio units

9
rtl/unix/video.pp
View File

@ -625,7 +625,7 @@ begin
{$endif CPUI386}
{ check for tty }
ThisTTY:=TTYName(stdinputhandle);
if (IsATTY(stdinputhandle)<>-1) then
if IsATTY(stdinputhandle) then
begin
{ save current terminal characteristics and remove rawness }
prepareInitVideo;
@ -899,7 +899,12 @@ initialization
end.
{
$Log$
Revision 1.21 2004-07-03 13:29:23 daniel
Revision 1.22 2004-07-08 13:23:21 daniel
* gpm now uses a Pascal translation of libgpm instead of linking against
it.
* isatty result type changed into boolean
Revision 1.21 2004/07/03 13:29:23 daniel
* Compilation fix.
Revision 1.20 2003/11/19 17:11:40 marco