Ticket #4415: haskeline.patch

File haskeline.patch, 3.7 KB (added by fryguybob, 5 years ago)

Patch to http://darcs.haskell.org/ghc-7.0/packages/haskeline

Line 
11 patch for repository http://darcs.haskell.org/ghc-7.0/packages/haskeline:
2
3Mon Feb 21 14:35:22 Eastern Standard Time 2011  [email protected]
4  * Change clearLayout on Win32 to address ticket #4415.
5
6New patches:
7
8[Change clearLayout on Win32 to address ticket #4415.
9[email protected]**20110221193522
10 Ignore-this: 2870e46b187299484d7ccd97f2ac3b51
11] {
12hunk ./System/Console/Haskeline/Backend/Win32.hsc 187
13 getPosition = withScreenBufferInfo $
14     (#peek CONSOLE_SCREEN_BUFFER_INFO, dwCursorPosition)
15 
16+getAttribute :: HANDLE -> IO WORD
17+getAttribute = withScreenBufferInfo $
18+    (#peek CONSOLE_SCREEN_BUFFER_INFO, wAttributes)
19+
20 withScreenBufferInfo :: (Ptr () -> IO a) -> HANDLE -> IO a
21 withScreenBufferInfo f h = allocaBytes (#size CONSOLE_SCREEN_BUFFER_INFO)
22                                 $ \infoPtr -> do
23hunk ./System/Console/Haskeline/Backend/Win32.hsc 216
24   where
25     tstr = map (toEnum . fromEnum) str
26 
27+foreign import ccall "FillConsoleChar" c_FillConsoleChar
28+    :: HANDLE -> TCHAR -> DWORD -> Ptr Coord -> Ptr DWORD -> IO Bool
29+
30+fillConsoleChar :: HANDLE -> Char -> Int -> Coord -> IO ()
31+fillConsoleChar h c n coord = with coord $ \coord' -> alloca $ \numWritten -> do
32+    failIfFalse_ "FillConsoleOutputCharacter"
33+        $ c_FillConsoleChar h (toEnum . fromEnum $ c) (toEnum n) coord' numWritten
34+
35+foreign import ccall "FillConsoleAttribute" c_FillConsoleAttribute
36+    :: HANDLE -> TCHAR -> DWORD -> Ptr Coord -> Ptr DWORD -> IO Bool
37+
38+fillConsoleAttribute :: HANDLE -> WORD -> Int -> Coord -> IO ()
39+fillConsoleAttribute h c n coord = with coord $ \coord' -> alloca $ \numWritten -> do
40+    failIfFalse_ "FillConsoleOutputAttribute"
41+        $ c_FillConsoleAttribute h (toEnum . fromEnum $ c) (toEnum n) coord' numWritten
42+
43 foreign import stdcall "windows.h MessageBeep" c_messageBeep :: UINT -> IO Bool
44 
45 messageBeep :: IO ()
46hunk ./System/Console/Haskeline/Backend/Win32.hsc 281
47     h <- asks hOut
48     liftIO (setPosition h c)
49 
50+getAttr :: MonadIO m => Draw m WORD
51+getAttr = asks hOut >>= liftIO . getAttribute
52+
53+fillChar :: MonadIO m => Char -> Int -> Coord -> Draw m ()
54+fillChar c n coord = do
55+    h <- asks hOut
56+    liftIO (fillConsoleChar h c n coord)
57+   
58+fillAttr :: MonadIO m => WORD -> Int -> Coord -> Draw m ()
59+fillAttr c n coord = do
60+    h <- asks hOut
61+    liftIO (fillConsoleAttribute h c n coord)
62+
63 printText :: MonadIO m => String -> Draw m ()
64 printText txt = do
65     h <- asks hOut
66hunk ./System/Console/Haskeline/Backend/Win32.hsc 340
67     
68     clearLayout = do
69         lay <- ask
70-        setPos (Coord 0 0)
71-        printText (replicate (width lay * height lay) ' ')
72-        setPos (Coord 0 0)
73+        let n = width lay * height lay
74+        let z = Coord 0 0
75+        fillChar ' ' n z
76+        attr <- getAttr
77+        fillAttr attr n z
78+        setPos z
79     
80     moveToNextLine s = do
81         movePos (lengthToEnd s)
82hunk ./cbits/win_console.c 7
83     return SetConsoleCursorPosition(h,*c);
84 }
85 
86+BOOL FillConsoleChar(HANDLE h, TCHAR c, DWORD l, COORD* p, LPDWORD n) {
87+    return FillConsoleOutputCharacter(h,c,l,*p,n);
88+}
89+
90+BOOL FillConsoleAttribute(HANDLE h, WORD a, DWORD l, COORD* p, LPDWORD n) {
91+    return FillConsoleOutputAttribute(h,a,l,*p,n);
92+}
93+
94hunk ./includes/win_console.h 6
95 #include <windows.h>
96 
97 BOOL SetPosition(HANDLE h, COORD* c);
98+BOOL FillConsoleChar(HANDLE h, TCHAR c, DWORD l, COORD* p, LPDWORD n);
99+BOOL FillConsoleAttribute(HANDLE h, WORD a, DWORD l, COORD* p, LPDWORD n);
100 
101 #endif
102}
103
104Context:
105
106[TAG GHC 7.0.1 release
107Ian Lynagh <[email protected]>**20101117140120
108 Ignore-this: ab67d9afbac504b07dd14d94d6f03da2
109]
110Patch bundle hash:
11146efbdaf4b1517e33612af0edb33b5702ce91564