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

    it.
  * isatty result type changed into boolean

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,

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

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

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.
 }

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

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;
-
-     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;
-
+     
+     Pgpmconnect=Pgpm_connect;
+     Tgpmconnect=Tgpm_connect;
+
+     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;
-
-
-implementation
+{$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
+{*****************************************************************************}
+
+{$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

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

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
 
 

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
 
 

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