git.iko.soy/vty
on 00a6a4f help sign in
vty/src/Graphics/Vty/Input/Terminfo.hs
184 lines 5.5 kB history raw
1module Graphics.Vty.Input.Terminfo where
3import Graphics.Vty.Input.Events
4import qualified Graphics.Vty.Input.Terminfo.ANSI as ANSI
5import qualified Graphics.Vty.Input.Terminfo.XTerm7Bit as XTerm7Bit
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-- The override is currently done in 'compile'. Which is a bit odd.
34--
35-- \todo terminfo meta is not supported.
36-- \todo no 8bit
37classify_table_for_term :: String -> Terminal -> ClassifyTable
38classify_table_for_term term_name term =
39 concat $ caps_classify_table term keys_from_caps_table
40 : universal_table
41 : term_specific_tables term_name
43-- | key table assumed to be applicable to all terminals.
44universal_table :: ClassifyTable
45universal_table = concat [visible_chars, ctrl_chars, ctrl_meta_chars, special_support_keys]
47caps_classify_table :: Terminal -> [(String,Event)] -> ClassifyTable
48caps_classify_table terminal table = [(x,y) | (Just x,y) <- map extract_cap table]
49 where extract_cap = first (getCapability terminal . tiGetStr)
51-- | tables specific to a given terminal that are not derivable from terminfo.
52term_specific_tables :: String -> [ClassifyTable]
53term_specific_tables term_name
54 | ANSI.supports term_name = ANSI.tables
55 | XTerm7Bit.supports term_name = XTerm7Bit.tables
56 | otherwise = []
58-- | Visible characters in the ISO-8859-1 and UTF-8 common set.
59--
60-- we limit to < 0xC1. The UTF8 sequence detector will catch all values 0xC2 and above before this
61-- classify table is reached.
62--
63-- TODO: resolve
64-- 1. start at ' '. The earlier characters are all ctrl_char_keys
65visible_chars :: ClassifyTable
66visible_chars = [ ([x], EvKey (KChar x) [])
67 | x <- [' ' .. toEnum 0xC1]
68 ]
70-- | Non visible characters in the ISO-8859-1 and UTF-8 common set translated to ctrl + char.
71--
72-- \todo resolve CTRL-i is the same as tab
73ctrl_chars :: ClassifyTable
74ctrl_chars =
75 [ ([toEnum x],EvKey (KChar y) [MCtrl])
76 | (x,y) <- zip ([0..31]) ('@':['a'..'z']++['['..'_']),
77 y /= 'i', -- Resolve issue #3 where CTRL-i hides TAB.
78 y /= 'h' -- CTRL-h should not hide BS
79 ]
81-- | Ctrl+Meta+Char
82ctrl_meta_chars :: ClassifyTable
83ctrl_meta_chars = map (\(s,EvKey c m) -> ('\ESC':s, EvKey c (MMeta:m))) ctrl_chars
85-- | esc, meta esc, delete, meta delete, enter, meta enter
86special_support_keys :: ClassifyTable
87special_support_keys =
88 [ -- special support for ESC
89 ("\ESC",EvKey KEsc []), ("\ESC\ESC",EvKey KEsc [MMeta])
90 -- Special support for backspace
91 , ("\DEL",EvKey KBS []), ("\ESC\DEL",EvKey KBS [MMeta])
92 -- Special support for Enter
93 , ("\ESC\^J",EvKey KEnter [MMeta]), ("\^J",EvKey KEnter [])
94 -- explicit support for tab
95 , ("\t", EvKey (KChar '\t') [])
96 ]
98-- | classify table directly generated from terminfo cap strings
99--
100-- these are:
101--
102-- * ka1 - keypad up-left
103--
104-- * ka3 - keypad up-right
105--
106-- * kb2 - keypad center
107--
108-- * kbs - keypad backspace
109--
110-- * kbeg - begin
111--
112-- * kcbt - back tab
113--
114-- * kc1 - keypad left-down
115--
116-- * kc3 - keypad right-down
117--
118-- * kdch1 - delete
119--
120-- * kcud1 - down
121--
122-- * kend - end
123--
124-- * kent - enter
125--
126-- * kf0 - kf63 - function keys
127--
128-- * khome - KHome
129--
130-- * kich1 - insert
131--
132-- * kcub1 - left
133--
134-- * knp - next page (page down)
135--
136-- * kpp - previous page (page up)
137--
138-- * kcuf1 - right
139--
140-- * kDC - shift delete
141--
142-- * kEND - shift end
143--
144-- * kHOM - shift home
145--
146-- * kIC - shift insert
147--
148-- * kLFT - shift left
149--
150-- * kRIT - shift right
151--
152-- * kcuu1 - up
153keys_from_caps_table :: ClassifyTable
154keys_from_caps_table =
155 [ ("ka1", EvKey KUpLeft [])
156 , ("ka3", EvKey KUpRight [])
157 , ("kb2", EvKey KCenter [])
158 , ("kbs", EvKey KBS [])
159 , ("kbeg", EvKey KBegin [])
160 , ("kcbt", EvKey KBackTab [])
161 , ("kc1", EvKey KDownLeft [])
162 , ("kc3", EvKey KDownRight [])
163 , ("kdch1", EvKey KDel [])
164 , ("kcud1", EvKey KDown [])
165 , ("kend", EvKey KEnd [])
166 , ("kent", EvKey KEnter [])
167 , ("khome", EvKey KHome [])
168 , ("kich1", EvKey KIns [])
169 , ("kcub1", EvKey KLeft [])
170 , ("knp", EvKey KPageDown [])
171 , ("kpp", EvKey KPageUp [])
172 , ("kcuf1", EvKey KRight [])
173 , ("kDC", EvKey KDel [MShift])
174 , ("kEND", EvKey KEnd [MShift])
175 , ("kHOM", EvKey KHome [MShift])
176 , ("kIC", EvKey KIns [MShift])
177 , ("kLFT", EvKey KLeft [MShift])
178 , ("kRIT", EvKey KRight [MShift])
179 , ("kcuu1", EvKey KUp [])
180 ] ++ function_key_caps_table
182-- | cap names for function keys
183function_key_caps_table :: ClassifyTable
184function_key_caps_table = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])