[project @ 1998-06-29 14:53:00 by sof]

New functions for getting/setting terminal echo via handles; allow non-std setting/getting of buffering on semi-closed handles

ghc/lib/std/PrelHandle.lhs

@@ -450,10 +450,11 @@ hSetBuffering handle mode =
                 ClosedHandle -> do
 		    writeHandle handle htype
 	            ioe_closedHandle handle
-                SemiClosedHandle _ _ -> do
-		    writeHandle handle htype
-	            ioe_closedHandle handle
                 other -> do
+		    {-
+		      We're being non-standard here, and allow the buffering
+		      of a semi-closed handle to be changed.   -- sof 6/98
+		    -}
                     rc <- _ccall_ setBuffering (filePtr other) bsize
                     if rc == 0 then
                         writeHandle handle ((hcon other) (filePtr other) 
@@ -829,10 +830,11 @@ hGetBuffering handle = do
       ClosedHandle -> do
 	  writeHandle handle htype
           ioe_closedHandle handle
-      SemiClosedHandle _ _ -> do
-	  writeHandle handle htype
-          ioe_closedHandle handle
       other -> do
+	  {-
+	   We're being non-standard here, and allow the buffering
+	   of a semi-closed handle to be queried.   -- sof 6/98
+          -}
 	  other <- getBufferMode other
           case bufferMode other of
             Just v -> do
@@ -867,13 +869,84 @@ hIsSeekable handle = do
 \end{code}
 
 
+%*********************************************************
+%*							*
+\subsection{Changing echo status}
+%*							*
+%*********************************************************
+
+\begin{code}
+hSetEcho :: Handle -> Bool -> IO ()
+hSetEcho hdl on = do
+    isT   <- hIsTerminalDevice hdl
+    if not isT
+     then return ()
+     else do
+      htype <- readHandle hdl
+      case htype of 
+         ErrorHandle ioError ->  do 
+            writeHandle hdl htype
+	    fail ioError
+         ClosedHandle	   ->  do
+            writeHandle hdl htype
+	    ioe_closedHandle hdl
+         other -> do
+            rc <- _ccall_ setTerminalEcho (filePtr htype) (if on then 1 else 0)
+	    writeHandle hdl htype
+	    if rc /= -1
+	     then return ()
+	     else constructErrorAndFail "hSetEcho"
+
+hGetEcho :: Handle -> IO Bool
+hGetEcho hdl = do
+    isT   <- hIsTerminalDevice hdl
+    if not isT
+     then return False
+     else do
+       htype <- readHandle hdl
+       case htype of 
+         ErrorHandle ioError ->  do 
+            writeHandle hdl htype
+	    fail ioError
+         ClosedHandle	   ->  do
+            writeHandle hdl htype
+	    ioe_closedHandle hdl
+         other -> do
+            rc <- _ccall_ getTerminalEcho (filePtr htype)
+	    writeHandle hdl htype
+	    case rc of
+	      1 -> return True
+	      0 -> return False
+	      _ -> constructErrorAndFail "hSetEcho"
+
+hIsTerminalDevice :: Handle -> IO Bool
+hIsTerminalDevice hdl = do
+    htype <- readHandle hdl
+    case htype of 
+       ErrorHandle ioError ->  do 
+            writeHandle hdl htype
+	    fail ioError
+       ClosedHandle	   ->  do
+            writeHandle hdl htype
+	    ioe_closedHandle hdl
+       other -> do
+          rc <- _ccall_ isTerminalDevice (filePtr htype)
+	  writeHandle hdl htype
+	  case rc of
+	    1 -> return True
+	    0 -> return False
+	    _ -> constructErrorAndFail "hIsTerminalDevice"
+\end{code}
+
+
+
 %*********************************************************
 %*							*
 \subsection{Miscellaneous}
 %*							*
 %*********************************************************
 
-These two functions are meant to get things out of @IOErrors@.  They don't!
+These two functions are meant to get things out of @IOErrors@.
 
 \begin{code}
 ioeGetFileName        :: IOError -> Maybe FilePath

ghc/lib/std/cbits/echoAux.lc

+%
+% (c) The GRASP/AQUA Project, Glasgow University, 1998
+%
+\subsection[echoAux.lc]{Support functions for changing echoing}
+
+\begin{code}
+
+#include "rtsdefs.h"
+#include "stgio.h"
+
+#ifdef HAVE_SYS_TYPES_H
+#include <sys/types.h>
+#endif
+
+#ifdef HAVE_SYS_STAT_H
+#include <sys/stat.h>
+#endif
+
+#ifdef HAVE_TERMIOS_H
+#include <termios.h>
+#endif
+
+#ifdef HAVE_FCNTL_H
+#include <fcntl.h>
+#endif
+
+StgInt
+setTerminalEcho(fp, on)
+StgForeignObj fp;
+StgInt on;
+{
+   struct termios tios;
+   int fd, rc;
+
+   while ( (fd = fileno((FILE*)fp)) < 0) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+   while ( (rc = tcgetattr(fd,&tios)) == -1) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+
+   if (on) {
+     tios.c_lflag |= ECHO;
+   } else {
+     tios.c_lflag &= ~ECHO;
+   }
+
+   while ( (rc = tcsetattr(fd,TCSANOW,&tios)) == -1) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+  return 0;
+}
+
+StgInt
+getTerminalEcho(fp)
+StgForeignObj fp;
+{
+   struct termios tios;
+   int fd, rc;
+
+   while ( (fd = fileno((FILE*)fp)) < 0) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+   while ( (rc = tcgetattr(fd,&tios)) == -1) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+   return (tios.c_cflag & ECHO ? 1 : 0);
+}
+
+StgInt
+isTerminalDevice(fp)
+StgForeignObj fp;
+{
+   struct termios tios;
+   int fd, rc;
+
+   while ( (fd = fileno((FILE*)fp)) < 0) {
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+   while ( (rc = tcgetattr(fd,&tios)) == -1) {
+        if (errno == ENOTTY) return 0;
+	if (errno != EINTR) {
+	    cvtErrno();
+	    stdErrno();
+	    return -1;
+	}
+   }
+   return 1;
+}
+
+\end{code}

ghc/lib/std/cbits/stgio.h

@@ -17,6 +17,11 @@ StgInt createDirectory PROTO((StgByteArray));
 StgAddr openDir__ PROTO((StgByteArray));
 StgAddr readDir__ PROTO((StgAddr));
 
+/* echoAux.lc */
+StgInt setTerminalEcho PROTO((StgForeignObj, StgInt));
+StgInt getTerminalEcho PROTO((StgForeignObj));
+StgInt isTerminalDevice PROTO((StgForeignObj));
+
 /* env.lc */
 char *	strDup		PROTO((const char *));
 int	setenviron	PROTO((char **));