[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

diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index ee00d07..91ba00a 100644 (file)
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/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
@@ -869,11 +871,82 @@ hIsSeekable handle = do
 
 %*********************************************************
 %*                                                     *
+\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

diff --git a/ghc/lib/std/cbits/echoAux.lc b/ghc/lib/std/cbits/echoAux.lc
new file mode 100644 (file)
index 0000000..ce4b659
--- /dev/null
+++ b/ghc/lib/std/cbits/echoAux.lc
@@ -0,0 +1,115 @@
+%
+% (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}

diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h
index e5f62df..0302009 100644 (file)
--- a/ghc/lib/std/cbits/stgio.h
+++ b/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 **));