git.iko.soy/vty
on 7448ab8 help sign in
vty/src/Graphics/Vty/Input/Terminfo.hs
185 lines 5.4 kB history raw
1{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
2module Graphics.Vty.Input.Terminfo where
4import Graphics.Vty.Input.Events
5import qualified Graphics.Vty.Input.Terminfo.ANSIVT as ANSIVT
7import Control.Arrow
8import System.Console.Terminfo
10-- | queries the terminal for all capability based input sequences then adds on a terminal dependent
11-- input sequence mapping.
12--
13-- For reference see:
14--
15-- * http://vimdoc.sourceforge.net/htmldoc/term.html
16--
17-- * vim74/src/term.c
18--
19-- * http://invisible-island.net/vttest/
20--
21-- * http://aperiodic.net/phil/archives/Geekery/term-function-keys.html
22--
23-- This is painful. Terminfo is incomplete. The vim source implies that terminfo is also incorrect.
24-- Vty assumes that the an internal terminfo table added to the system provided terminfo table is
25-- correct.
26--
27-- 1. build terminfo table for all caps. Missing caps are not added.
28--
29-- 2. add tables for visible chars, esc, del plus ctrl and meta
30--
31-- 3. add internally defined table for given terminal type.
32--
33-- Precedence is currently implicit in the 'compile' algorithm. Which is a bit odd.
34--
35-- \todo terminfo meta is not supported.
36-- \todo no 8bit
37classifyMapForTerm :: String -> Terminal -> ClassifyMap
38classifyMapForTerm termName term =
39 concat $ capsClassifyMap term keysFromCapsTable
40 : universalTable
41 : termSpecificTables termName
43-- | key table applicable to all terminals.
44--
45-- TODO: some probably only applicable to ANSI/VT100 terminals.
46universalTable :: ClassifyMap
47universalTable = concat [visibleChars, ctrlChars, ctrlMetaChars, specialSupportKeys]
49capsClassifyMap :: Terminal -> [(String,Event)] -> ClassifyMap
50capsClassifyMap terminal table = [(x,y) | (Just x,y) <- map extractCap table]
51 where extractCap = first (getCapability terminal . tiGetStr)
53-- | tables specific to a given terminal that are not derivable from terminfo.
54--
55-- TODO: Adds the ANSI/VT100/VT50 tables regardless of term identifier.
56termSpecificTables :: String -> [ClassifyMap]
57termSpecificTables _termName = ANSIVT.classifyTable
59-- | Visible characters in the ISO-8859-1 and UTF-8 common set.
60--
61-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
62-- classify table is reached.
63--
64-- TODO: resolve
65-- 1. start at ' '. The earlier characters are all 'ctrlChar'
66visibleChars :: ClassifyMap
67visibleChars = [ ([x], EvKey (KChar x) [])
68 | x <- [' ' .. toEnum 0xC1]
69 ]
71-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.
72--
73-- \todo resolve CTRL-i is the same as tab
74ctrlChars :: ClassifyMap
75ctrlChars =
76 [ ([toEnum x],EvKey (KChar y) [MCtrl])
77 | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_'])
78 , y /= 'i' -- Resolve issue #3 where CTRL-i hides TAB.
79 , y /= 'h' -- CTRL-h should not hide BS
80 ]
82-- | Ctrl+Meta+Char
83ctrlMetaChars :: ClassifyMap
84ctrlMetaChars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrlChars
86-- | esc, meta esc, delete, meta delete, enter, meta enter
87specialSupportKeys :: ClassifyMap
88specialSupportKeys =
89 [ -- special support for ESC
90 ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
91 -- Special support for backspace
92 , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])
93 -- Special support for Enter
94 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])
95 -- explicit support for tab
96 , ("\t", EvKey (KChar '\t') [])
97 ]
99-- | classify table directly generated from terminfo cap strings
100--
101-- these are:
102--
103-- * ka1 - keypad up-left
104--
105-- * ka3 - keypad up-right
106--
107-- * kb2 - keypad center
108--
109-- * kbs - keypad backspace
110--
111-- * kbeg - begin
112--
113-- * kcbt - back tab
114--
115-- * kc1 - keypad left-down
116--
117-- * kc3 - keypad right-down
118--
119-- * kdch1 - delete
120--
121-- * kcud1 - down
122--
123-- * kend - end
124--
125-- * kent - enter
126--
127-- * kf0 - kf63 - function keys
128--
129-- * khome - KHome
130--
131-- * kich1 - insert
132--
133-- * kcub1 - left
134--
135-- * knp - next page (page down)
136--
137-- * kpp - previous page (page up)
138--
139-- * kcuf1 - right
140--
141-- * kDC - shift delete
142--
143-- * kEND - shift end
144--
145-- * kHOM - shift home
146--
147-- * kIC - shift insert
148--
149-- * kLFT - shift left
150--
151-- * kRIT - shift right
152--
153-- * kcuu1 - up
154keysFromCapsTable :: ClassifyMap
155keysFromCapsTable =
156 [ ("ka1", EvKey KUpLeft [])
157 , ("ka3", EvKey KUpRight [])
158 , ("kb2", EvKey KCenter [])
159 , ("kbs", EvKey KBS [])
160 , ("kbeg", EvKey KBegin [])
161 , ("kcbt", EvKey KBackTab [])
162 , ("kc1", EvKey KDownLeft [])
163 , ("kc3", EvKey KDownRight [])
164 , ("kdch1", EvKey KDel [])
165 , ("kcud1", EvKey KDown [])
166 , ("kend", EvKey KEnd [])
167 , ("kent", EvKey KEnter [])
168 , ("khome", EvKey KHome [])
169 , ("kich1", EvKey KIns [])
170 , ("kcub1", EvKey KLeft [])
171 , ("knp", EvKey KPageDown [])
172 , ("kpp", EvKey KPageUp [])
173 , ("kcuf1", EvKey KRight [])
174 , ("kDC", EvKey KDel [MShift])
175 , ("kEND", EvKey KEnd [MShift])
176 , ("kHOM", EvKey KHome [MShift])
177 , ("kIC", EvKey KIns [MShift])
178 , ("kLFT", EvKey KLeft [MShift])
179 , ("kRIT", EvKey KRight [MShift])
180 , ("kcuu1", EvKey KUp [])
181 ] ++ functionKeyCapsTable
183-- | cap names for function keys
184functionKeyCapsTable :: ClassifyMap
185functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])