git.iko.soy/vty
on d64ff96 help sign in
vty/src/Graphics/Vty/Input/Terminfo.hs
184 lines 5.3 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 and
11-- then adds on a terminal-dependent 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-- Terminfo is incomplete. The vim source implies that terminfo is also
24-- incorrect. Vty assumes that the internal terminfo table added to the
25-- system-provided terminfo table is correct.
26--
27-- The procedure used here is:
28--
29-- 1. Build terminfo table for all caps. Missing caps are not added.
30--
31-- 2. Add tables for visible chars, esc, del, ctrl, and meta.
32--
33-- 3. Add internally-defined table for given terminal type.
34--
35-- Precedence is currently implicit in the 'compile' algorithm.
36classifyMapForTerm :: String -> Terminal -> ClassifyMap
37classifyMapForTerm termName term =
38 concat $ capsClassifyMap term keysFromCapsTable
39 : universalTable
40 : termSpecificTables termName
42-- | The key table applicable to all terminals.
43--
44-- Note that some of these entries are probably only applicable to
45-- 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
54-- terminfo.
55--
56-- Note that this adds the ANSI/VT100/VT50 tables regardless of term
57-- identifier.
58termSpecificTables :: String -> [ClassifyMap]
59termSpecificTables _termName = ANSIVT.classifyTable
61-- | Visible characters in the ISO-8859-1 and UTF-8 common set.
62--
63-- We limit to < 0xC1. The UTF8 sequence detector will catch all values
64-- 0xC2 and above before this classify table is reached.
65visibleChars :: ClassifyMap
66visibleChars = [ ([x], EvKey (KChar x) [])
67 | x <- [' ' .. toEnum 0xC1]
68 ]
70-- | Non-printable characters in the ISO-8859-1 and UTF-8 common set
71-- translated to ctrl + char.
72--
73-- This treats CTRL-i 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-- | A classification table directly generated from terminfo cap
100-- strings. 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
153keysFromCapsTable :: ClassifyMap
154keysFromCapsTable =
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 ] ++ functionKeyCapsTable
182-- | Cap names for function keys.
183functionKeyCapsTable :: ClassifyMap
184functionKeyCapsTable = flip map [0..63] $ \n -> ("kf" ++ show n, EvKey (KFun n) [])