From 691505fdff3db83ced34d8791e959f323adefda8 Mon Sep 17 00:00:00 2001 From: sof Date: Mon, 29 Jun 1998 14:53:04 +0000 Subject: [PATCH] [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 | 87 +++++++++++++++++++++++++++++--- ghc/lib/std/cbits/echoAux.lc | 115 ++++++++++++++++++++++++++++++++++++++++++ ghc/lib/std/cbits/stgio.h | 5 ++ 3 files changed, 200 insertions(+), 7 deletions(-) create mode 100644 ghc/lib/std/cbits/echoAux.lc diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs index ee00d07..91ba00a 100644 --- 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 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 +#endif + +#ifdef HAVE_SYS_STAT_H +#include +#endif + +#ifdef HAVE_TERMIOS_H +#include +#endif + +#ifdef HAVE_FCNTL_H +#include +#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 --- 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 **)); -- 1.7.10.4