Initial commit before publication.
[berthome:berthome.git] / keychain.lua
1 -- -*- coding: utf-8 -*-
2 --------------------------------------------------------------------------------
3 -- @author Nicolas Berthier <nberthier@gmail.com>
4 -- @copyright 2010 Nicolas Berthier
5 --------------------------------------------------------------------------------
6 --
7 -- This is a module for defining keychains à la emacs in awesome. I was also
8 -- inspired by ion3 behavior when designing it.
9 --
10 -- Remarks:
11 --
12 -- - This module does not handle `release' key bindings, but is it useful for
13 --   keychains?
14 --
15 -- - It has not been tested with multiple screens yet.
16 --
17 -- - There might (... must) be incompatibilities with the shifty module. Also,
18 --   defining global and per-client keychains with the same prefix is not
19 --   allowed (or leads to unspecified behaviors... --- in practice: the
20 --   per-client ones are ignored). However, I do think separation of per-client
21 --   and global keys is a bad idea if client keys do not have a higher priority
22 --   than the global ones...
23 --
24 -- Example usage: (TODO)
25 --
26 --------------------------------------------------------------------------------
27
28 --{{{ Grab environment (mostly aliases)
29 local setmetatable = setmetatable
30 local ipairs = ipairs
31 local type = type
32 local pairs = pairs
33 local string = string
34 local print = print
35 local error = error
36 local io = io
37
38 local capi = capi
39 local client = client
40 local awesome = awesome
41 local root  = root
42 local timer = timer
43
44 local infoline = require ("infoline")
45 local akey  = require ("awful.key")
46 local join = awful.util.table.join
47 local clone = awful.util.table.clone
48 --}}}
49
50 module ("keychain")
51
52 -- Privata data: we use weak keys in order to allow collection of private data
53 -- if keys (clients) are collected (i.e., no longer used, after having been
54 -- killed for instance)
55 local data = setmetatable ({}, { __mode = 'k' })
56
57 --{{{ Functional Tuples
58 -- see http://lua-users.org/wiki/FunctionalTuples for details
59
60 --- Creates a keystroke representation to fill the `escape' table configuration
61 --- property.
62 -- @param m Modifiers table.
63 -- @param k The key itself.
64 -- @return A keystroke representation (only for the escape sequence, for now?).
65 function keystroke (m, k)
66     if type (m) ~= "table" then
67         error ("Keystroke modifiers must be given a table (got a "..
68                type (m)..")")
69     end
70     if type (k) ~= "string" then
71         error ("Keystroke key must be given a string (got a "..
72                type (m)..")")
73     end
74     return function (fn) return fn (m, k) end
75 end
76
77 -- keystroke accessors
78 local function ks_mod (_m, _k) return _m end
79 local function ks_key (_m, _k) return _k end
80
81 -- ---
82
83 --- Creates a final keychain binding to fill the keychain binding tables,
84 --- meaning that the given function will be executed at the end of the keychain.
85 -- @param m Modifiers table.
86 -- @param k The key.
87 -- @param cont The function to be bound to the given keys.
88 -- @return A "final" key binding.
89 function key (m, k, cont)
90     if type (cont) ~= "function" then
91         error ("Final binding must be given a function (got a "..
92                type (cont)..")")
93     end
94     return function (fn) return fn (keystroke (m, k), cont, true) end
95 end
96
97 --- Creates an intermediate (prefix) keychain binding.
98 -- @param m Modifiers table.
99 -- @param k The key.
100 -- @param sub The subchain description table to be bound to the given keys.
101 -- @return An "intermediate" key binding.
102 function subchain (m, k, sub)
103     if type (sub) ~= "table" then
104         error ("Subchain binding must be given a table (got a "..
105                type (sub)..")")
106     end
107     return function (fn) return fn (keystroke (m, k), sub, false) end
108 end
109
110 -- key/subchain binding accessors
111 local function binding_ks   (ks, cont, leaf) return ks end
112 local function binding_cont (ks, cont, leaf) return cont end
113 local function binding_leaf (ks, cont, leaf) return leaf end
114
115 --}}}
116
117 --{{{ Default values
118
119 --- Default escape sequences (S-g is inspired by emacs...)
120 local escape_keystrokes = {
121     keystroke ( {        }, "Escape" ),
122     keystroke ( { "Mod4" }, "g"      ),
123 }
124 --- Default modifier filter
125 local modfilter = {
126     ["Mod1"]    = "M",
127     ["Mod4"]    = "S",
128     ["Control"] = "C",
129     ["Shift"]   = string.upper,
130 }
131
132 -- Defines whether we use bowls or not. Bowls are kind of helpers that can be
133 -- drawn (at the bottom --- for now) of an area, and displaying the current key
134 -- prefix. It is inspired by emacs' behavior, that prints prefix keys in the
135 -- minibuffer after a certain time.
136 --
137 -- I call it `bowl' as a reference to the bowl that one might have at home,
138 -- where one puts its actual keys... A more serious name would be `hint' or
139 -- `tooltip' (but they do not fit well for this usage).
140 -- 
141 -- Note one could emit signals, observable by a specific object, that would then
142 -- print the keychain prefix somewhere else... (in the titlebar, for instance).
143 local use_bowls = true
144
145 -- Timers configuration
146 local use_timers = true
147 local timeout = 2.0
148
149 --}}}
150
151 --{{{ Keychain pretty-printing
152
153 local function mod_to_string (mods, k)
154     local ret, k = "", k
155     for _, mod in ipairs (mods) do
156         if modfilter[mod] then
157             local t = type (modfilter[mod])
158             if t == "function" then
159                 k = modfilter[mod](k)
160             elseif t == "string" then
161                 ret = ret .. modfilter[mod] .. "-"
162             else
163                 error ("Invalid modifier key filter: got a " .. t)
164             end
165         else
166             ret = ret .. mod .. "-"
167         end
168     end
169     return ret, k
170 end
171
172 local function ks_to_string (m, k)
173     local m, k = mod_to_string (m, k)
174     return m .. k
175 end
176
177 --}}}
178
179 --{{{ Timer management
180
181 local function delete_timer_maybe (d)
182     if d.timer then             -- stop and remove the timer
183         d.timer:remove_signal ("timeout", d.timer_function)
184         d.timer:stop ()
185         d.timer = nil
186         d.timer_expired = true
187     end
188 end
189
190 local function delayed_call_maybe (d, f)
191     if use_timers then
192         if not d.timer_expired and not d.timer then
193             -- create and start the timer
194             d.timer = timer ({ timeout = timeout })
195             d.timer_function = function () f (); delete_timer_maybe (d) end
196             d.timer:add_signal ("timeout", d.timer_function)
197             d.timer:start ()
198             d.timer_expired = false
199         elseif not d.timer_expired then
200             -- restart the timer...
201
202             -- XXX: What is the actual semantics of the call to `start' (ie,
203             -- does it restart the timer with the initial timeout)?
204             d.timer:stop ()
205             d.timer.timeout = timeout -- reset timeout
206             d.timer:start ()
207         end
208     else                        -- timers disabled
209         f ()                    -- call the given function directly
210     end
211 end
212
213 --}}}
214
215 --{{{ Key table management facilities
216
217 local function set_keys (c, k)
218     if c == root then root.keys (k) else c:keys (k) end
219 end
220
221 local function keys_of (c)
222     if c == root then return root.keys () else return c:keys () end
223 end
224
225 --}}}
226
227 --{{{ Client/Root-related state management
228
229 local function retrieve_or_init_client_state (w)
230     if data[w] then return data[w] end
231     local d = { }
232     d.keys = keys_of (w)        -- save client keys
233     if use_bowls then           -- create bowl if needed 
234         -- XXX: Note the prefix text could be customizable...
235         d.bowl = infoline.new (" ")
236         -- TODO: ...:signal_emit ("keychain:enter", ...)
237     end
238     data[w] = d                 -- register client
239     return d
240 end
241
242 local function restore_client_state (c)
243     local w = c or root
244     set_keys (w, data[w].keys)  -- restore client keys
245     data[w] = nil               -- unregister client
246 end
247
248 local function dispose (c)
249     local w = c or root
250     local d = data[w]
251
252     -- Destroy bowl and delete timer if needed
253     if d and use_bowls then
254         if d.bowl then          -- if bowl was enabled...
255             infoline.dispose (d.bowl)
256             d.bowl = nil
257             -- TODO: ...:signal_emit ("keychain:dispose", ...)
258         end
259         delete_timer_maybe (d)
260     end
261 end
262
263 -- force disposal of resources when clients are killed 
264 client.add_signal ("unmanage", dispose)
265
266 --}}}
267
268 --{{{ Key binding tree access helpers
269
270 local function make_on_entering (m, k, subchain)
271     local pretty_ks = ks_to_string (m, k) .. " "
272     return
273     function (c)
274         local w = c or root
275
276         -- Register and initialize client state, if not already in a keychain
277         local d = retrieve_or_init_client_state (w)
278
279         -- Update bowl text, and trigger its drawing if necessary
280         if use_bowls then
281             infoline.set_text (d.bowl, infoline.get_text (d.bowl) .. pretty_ks)
282
283             local function enable_bowl ()
284                 -- XXX: is there a possible bad interleaving that could make
285                 -- this function execute while the bowl has already been
286                 -- disposed of? in which case the condition should be checked
287                 -- first...
288
289                 -- if d.bowl then
290                 infoline.attach (d.bowl, w)
291                 -- end
292             end
293
294             delayed_call_maybe (d, enable_bowl)
295
296             -- TODO: ...:signal_emit ("keychain:update", ...)
297         end
298
299         -- Setup subchain
300         set_keys (w, subchain)
301     end
302 end
303
304 local function on_leaving (c)
305     -- Trigger disposal routine
306     dispose (c)
307
308     -- Restore initial key mapping of client
309     restore_client_state (c)
310 end
311
312 --}}}
313
314 --{{{ Configuration
315
316 -- Flag to detect late initialization error
317 local already_used = false
318
319 -- Escape binding table built once upon initialization
320 local escape_bindings = { }
321
322 --- Fills the escape bindings table with actual `awfull.key' elements triggering
323 --- execution of `on_leaving'.
324 local function init_escape_bindings ()
325     escape_bindings = { }
326     for _, e in ipairs (escape_keystrokes) do
327         escape_bindings = join (escape_bindings,
328                                 akey (e (ks_mod), e (ks_key), on_leaving))
329     end
330 end
331
332 -- Call it once upon module loading to initialize escape_bindings (in case
333 -- `init' is not called).
334 init_escape_bindings ()
335
336 --- Initializes the keychain module, with given properties; to be called before
337 --- ANY other function of this module.
338 -- Configurations fields include:
339 --
340 -- `escapes': A table of keystrokes (@see keychain.keystroke) escaping keychains
341 -- (defaults are `Mod4-g' and `Escape').
342 --
343 -- `use_bowls': A boolean defining whether bowls are enabled or not (default is
344 -- true).
345 --
346 -- `use_timers', `timeout': A boolean defining whether bowls drawing should be
347 -- delayed, along with a number being this time shift, in seconds (Default
348 -- values are `true' and `2').
349 --
350 -- `modfilter': A table associating modifiers (Mod1, Mod4, Control, Shift, etc.)
351 -- with either a string (in this case it will replace the modifier when printed
352 -- in heplers) or functions (in this case the key string will be repaced by a
353 -- call to this function with the key string as parameter). Default value is:
354 -- { ["Mod1"] = "M", ["Mod4"] = "S", ["Control"] = "C", ["Shift"] =
355 -- string.upper }
356 --
357 -- @param c The table of properties.
358 function init (c)
359     local c = c or { }
360
361     if already_used then
362         -- heum... just signal the error: "print" or "error"?
363         return print ("E: keychain: Call to `init' AFTER having bound keys!")
364     end
365
366     escape_keystrokes = c.escapes and c.escapes or escape_keystrokes
367     if c.use_bowls ~= nil then use_bowls = c.use_bowls end
368
369     if use_bowls then
370         modfilter = c.modfilter and c.modfilter or modfilter
371         if c.use_timers ~= nil then use_timers = c.use_timers end
372         if use_timers then
373             timeout = c.timeout ~= nil and c.timeout or timeout
374         end
375     end
376
377     -- Now, fill the escape bindings table again with actual `awfull.key'
378     -- elements triggering `on_leaving' executions, in case escape keys has
379     -- changed.
380     init_escape_bindings ()
381 end
382
383 --}}}
384
385 --{{{ Keychain creation
386
387 --- Creates a new keychain binding.
388 -- @param m Modifiers table.
389 -- @param k The key.
390 -- @param chains A table of keychains, describing either final bindings (see
391 -- key constructor) or subchains (see subchain constructor).
392 -- @return A key binding for the `awful.key' module.
393 -- @see awful.key
394 function new (m, k, chains)
395
396     -- This table will contain the keys to be mapped upon <m, k> keystroke. It
397     -- initially contains the escape bindings, so that one can still rebind them
398     -- differently in `chains'.
399     local subchain = clone (escape_bindings)
400
401     already_used = true         -- subsequent init avoidance flag...
402
403     -- For each entry of the given chains, add a corresponding `awful.key'
404     -- element in the subchain
405     for _, e in ipairs (chains) do
406         local ks = e (binding_ks)
407         if e (binding_leaf) then
408             -- We encountered a lead in the chains.
409             local function on_leaf (c) on_leaving (c); e (binding_cont) (c) end
410             subchain = join (subchain, akey (ks (ks_mod), ks (ks_key), on_leaf))
411         else
412             -- Recursively call subchain creation. "Funny" detail: I think there
413             -- is no way of creating ill-structured keychain descriptors that
414             -- would produce infinite recursive calls here, since we control
415             -- their creation with functional tuples, that cannot lead to cyclic
416             -- structures...
417             local subch = new (ks (ks_mod), ks (ks_key), e (binding_cont))
418             subchain = join (subchain, subch)
419         end
420     end
421
422     -- Then return an actual `awful.key', triggering the `on_entering' routine
423     return akey (m, k, make_on_entering (m, k, subchain))
424 end
425 --}}}
426
427 -- Setup `__call' entry in module's metatable so that we can create new prefix
428 -- binding using `keychain (m, k, ...)' directly.
429 setmetatable (_M, { __call = function (_, ...) return new (...) end })
430
431 -- Local variables:
432 -- indent-tabs-mode: nil
433 -- fill-column: 80
434 -- lua-indent-level: 4
435 -- End:
436 -- vim: filetype=lua:expandtab:shiftwidth=4:tabstop=8:softtabstop=4:encoding=utf-8:textwidth=80