From 74f637cb11232081eff8ce08075d1518a882e68d Mon Sep 17 00:00:00 2001 From: daniel Date: Thu, 8 Jul 2004 13:23:21 +0000 Subject: [PATCH] * gpm now uses a Pascal translation of libgpm instead of linking against it. * isatty result type changed into boolean --- rtl/darwin/termiosproc.inc | 15 +- rtl/freebsd/termiosproc.inc | 13 +- rtl/linux/Makefile.fpc | 3 + rtl/linux/termiosproc.inc | 6 +- rtl/unix/crt.pp | 13 +- rtl/unix/gpm.pp | 812 ++++++++++++++++++++++++++++++++++-- rtl/unix/keyboard.pp | 9 +- rtl/unix/termiosh.inc | 11 +- rtl/unix/ttyname.inc | 9 +- rtl/unix/video.pp | 9 +- 10 files changed, 845 insertions(+), 55 deletions(-) diff --git a/rtl/darwin/termiosproc.inc b/rtl/darwin/termiosproc.inc index fb2ac55f4e..22cff1f93a 100644 --- a/rtl/darwin/termiosproc.inc +++ b/rtl/darwin/termiosproc.inc @@ -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, diff --git a/rtl/freebsd/termiosproc.inc b/rtl/freebsd/termiosproc.inc index ee6e2372f7..0e6f9d7cc2 100644 --- a/rtl/freebsd/termiosproc.inc +++ b/rtl/freebsd/termiosproc.inc @@ -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 diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc index 0fb0394b10..145ccd35fc 100644 --- a/rtl/linux/Makefile.fpc +++ b/rtl/linux/Makefile.fpc @@ -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 diff --git a/rtl/linux/termiosproc.inc b/rtl/linux/termiosproc.inc index f24f4dd9c4..993ebd3796 100644 --- a/rtl/linux/termiosproc.inc +++ b/rtl/linux/termiosproc.inc @@ -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. } diff --git a/rtl/unix/crt.pp b/rtl/unix/crt.pp index 7c6c107c6e..1c007f416f 100644 --- a/rtl/unix/crt.pp +++ b/rtl/unix/crt.pp @@ -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 diff --git a/rtl/unix/gpm.pp b/rtl/unix/gpm.pp index 6ac4c1394d..a237d690b4 100644 --- a/rtl/unix/gpm.pp +++ b/rtl/unix/gpm.pp @@ -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 xgpm_mx then + x:=gpm_mx; + if ygpm_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^.xmaxeptr.y) or (roi^.ymaxgpm_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 diff --git a/rtl/unix/keyboard.pp b/rtl/unix/keyboard.pp index b65940769a..b4f227b9b0 100644 --- a/rtl/unix/keyboard.pp +++ b/rtl/unix/keyboard.pp @@ -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 diff --git a/rtl/unix/termiosh.inc b/rtl/unix/termiosh.inc index 47dcfc2cbb..657da93e81 100644 --- a/rtl/unix/termiosh.inc +++ b/rtl/unix/termiosh.inc @@ -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 diff --git a/rtl/unix/ttyname.inc b/rtl/unix/ttyname.inc index 264a43e768..1f669050c4 100644 --- a/rtl/unix/ttyname.inc +++ b/rtl/unix/ttyname.inc @@ -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 diff --git a/rtl/unix/video.pp b/rtl/unix/video.pp index 969379a90f..b5ccc1e7b6 100644 --- a/rtl/unix/video.pp +++ b/rtl/unix/video.pp @@ -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