Initial commit before publication.

[berthome:berthome.git] / keychain.lua

-- -*- coding: utf-8 -*-
--------------------------------------------------------------------------------
-- @author Nicolas Berthier <nberthier@gmail.com>
-- @copyright 2010 Nicolas Berthier
--------------------------------------------------------------------------------
--
-- This is a module for defining keychains à la emacs in awesome. I was also
-- inspired by ion3 behavior when designing it.
--
-- Remarks:
--
-- - This module does not handle `release' key bindings, but is it useful for
--   keychains?
--
-- - It has not been tested with multiple screens yet.
--
-- - There might (... must) be incompatibilities with the shifty module. Also,
--   defining global and per-client keychains with the same prefix is not
--   allowed (or leads to unspecified behaviors... --- in practice: the
--   per-client ones are ignored). However, I do think separation of per-client
--   and global keys is a bad idea if client keys do not have a higher priority
--   than the global ones...
--
-- Example usage: (TODO)
--
--------------------------------------------------------------------------------

--{{{ Grab environment (mostly aliases)
local setmetatable = setmetatable
local ipairs = ipairs
local type = type
local pairs = pairs
local string = string
local print = print
local error = error
local io = io

local capi = capi
local client = client
local awesome = awesome
local root  = root
local timer = timer

local infoline = require ("infoline")
local akey  = require ("awful.key")
local join = awful.util.table.join
local clone = awful.util.table.clone
--}}}

module ("keychain")

-- Privata data: we use weak keys in order to allow collection of private data
-- if keys (clients) are collected (i.e., no longer used, after having been
-- killed for instance)
local data = setmetatable ({}, { __mode = 'k' })

--{{{ Functional Tuples
-- see http://lua-users.org/wiki/FunctionalTuples for details

--- Creates a keystroke representation to fill the `escape' table configuration
--- property.
-- @param m Modifiers table.
-- @param k The key itself.
-- @return A keystroke representation (only for the escape sequence, for now?).
function keystroke (m, k)
    if type (m) ~= "table" then
        error ("Keystroke modifiers must be given a table (got a "..
               type (m)..")")
    end
    if type (k) ~= "string" then
        error ("Keystroke key must be given a string (got a "..
               type (m)..")")
    end
    return function (fn) return fn (m, k) end
end

-- keystroke accessors
local function ks_mod (_m, _k) return _m end
local function ks_key (_m, _k) return _k end

-- ---

--- Creates a final keychain binding to fill the keychain binding tables,
--- meaning that the given function will be executed at the end of the keychain.
-- @param m Modifiers table.
-- @param k The key.
-- @param cont The function to be bound to the given keys.
-- @return A "final" key binding.
function key (m, k, cont)
    if type (cont) ~= "function" then
        error ("Final binding must be given a function (got a "..
               type (cont)..")")
    end
    return function (fn) return fn (keystroke (m, k), cont, true) end
end

--- Creates an intermediate (prefix) keychain binding.
-- @param m Modifiers table.
-- @param k The key.
-- @param sub The subchain description table to be bound to the given keys.
-- @return An "intermediate" key binding.
function subchain (m, k, sub)
    if type (sub) ~= "table" then
        error ("Subchain binding must be given a table (got a "..
               type (sub)..")")
    end
    return function (fn) return fn (keystroke (m, k), sub, false) end
end

-- key/subchain binding accessors
local function binding_ks   (ks, cont, leaf) return ks end
local function binding_cont (ks, cont, leaf) return cont end
local function binding_leaf (ks, cont, leaf) return leaf end

--}}}

--{{{ Default values

--- Default escape sequences (S-g is inspired by emacs...)
local escape_keystrokes = {
    keystroke ( {        }, "Escape" ),
    keystroke ( { "Mod4" }, "g"      ),
}
--- Default modifier filter
local modfilter = {
    ["Mod1"]    = "M",
    ["Mod4"]    = "S",
    ["Control"] = "C",
    ["Shift"]   = string.upper,
}

-- Defines whether we use bowls or not. Bowls are kind of helpers that can be
-- drawn (at the bottom --- for now) of an area, and displaying the current key
-- prefix. It is inspired by emacs' behavior, that prints prefix keys in the
-- minibuffer after a certain time.
--
-- I call it `bowl' as a reference to the bowl that one might have at home,
-- where one puts its actual keys... A more serious name would be `hint' or
-- `tooltip' (but they do not fit well for this usage).
-- 
-- Note one could emit signals, observable by a specific object, that would then
-- print the keychain prefix somewhere else... (in the titlebar, for instance).
local use_bowls = true

-- Timers configuration
local use_timers = true
local timeout = 2.0

--}}}

--{{{ Keychain pretty-printing

local function mod_to_string (mods, k)
    local ret, k = "", k
    for _, mod in ipairs (mods) do
        if modfilter[mod] then
            local t = type (modfilter[mod])
            if t == "function" then
                k = modfilter[mod](k)
            elseif t == "string" then
                ret = ret .. modfilter[mod] .. "-"
            else
                error ("Invalid modifier key filter: got a " .. t)
            end
        else
            ret = ret .. mod .. "-"
        end
    end
    return ret, k
end

local function ks_to_string (m, k)
    local m, k = mod_to_string (m, k)
    return m .. k
end

--}}}

--{{{ Timer management

local function delete_timer_maybe (d)
    if d.timer then             -- stop and remove the timer
        d.timer:remove_signal ("timeout", d.timer_function)
        d.timer:stop ()
        d.timer = nil
        d.timer_expired = true
    end
end

local function delayed_call_maybe (d, f)
    if use_timers then
        if not d.timer_expired and not d.timer then
            -- create and start the timer
            d.timer = timer ({ timeout = timeout })
            d.timer_function = function () f (); delete_timer_maybe (d) end
            d.timer:add_signal ("timeout", d.timer_function)
            d.timer:start ()
            d.timer_expired = false
        elseif not d.timer_expired then
            -- restart the timer...

            -- XXX: What is the actual semantics of the call to `start' (ie,
            -- does it restart the timer with the initial timeout)?
            d.timer:stop ()
            d.timer.timeout = timeout -- reset timeout
            d.timer:start ()
        end
    else                        -- timers disabled
        f ()                    -- call the given function directly
    end
end

--}}}

--{{{ Key table management facilities

local function set_keys (c, k)
    if c == root then root.keys (k) else c:keys (k) end
end

local function keys_of (c)
    if c == root then return root.keys () else return c:keys () end
end

--}}}

--{{{ Client/Root-related state management

local function retrieve_or_init_client_state (w)
    if data[w] then return data[w] end
    local d = { }
    d.keys = keys_of (w)        -- save client keys
    if use_bowls then           -- create bowl if needed 
        -- XXX: Note the prefix text could be customizable...
        d.bowl = infoline.new (" ")
        -- TODO: ...:signal_emit ("keychain:enter", ...)
    end
    data[w] = d                 -- register client
    return d
end

local function restore_client_state (c)
    local w = c or root
    set_keys (w, data[w].keys)  -- restore client keys
    data[w] = nil               -- unregister client
end

local function dispose (c)
    local w = c or root
    local d = data[w]

    -- Destroy bowl and delete timer if needed
    if d and use_bowls then
        if d.bowl then          -- if bowl was enabled...
            infoline.dispose (d.bowl)
            d.bowl = nil
            -- TODO: ...:signal_emit ("keychain:dispose", ...)
        end
        delete_timer_maybe (d)
    end
end

-- force disposal of resources when clients are killed 
client.add_signal ("unmanage", dispose)

--}}}

--{{{ Key binding tree access helpers

local function make_on_entering (m, k, subchain)
    local pretty_ks = ks_to_string (m, k) .. " "
    return
    function (c)
        local w = c or root

        -- Register and initialize client state, if not already in a keychain
        local d = retrieve_or_init_client_state (w)

        -- Update bowl text, and trigger its drawing if necessary
        if use_bowls then
            infoline.set_text (d.bowl, infoline.get_text (d.bowl) .. pretty_ks)

            local function enable_bowl ()
                -- XXX: is there a possible bad interleaving that could make
                -- this function execute while the bowl has already been
                -- disposed of? in which case the condition should be checked
                -- first...

                -- if d.bowl then
                infoline.attach (d.bowl, w)
                -- end
            end

            delayed_call_maybe (d, enable_bowl)

            -- TODO: ...:signal_emit ("keychain:update", ...)
        end

        -- Setup subchain
        set_keys (w, subchain)
    end
end

local function on_leaving (c)
    -- Trigger disposal routine
    dispose (c)

    -- Restore initial key mapping of client
    restore_client_state (c)
end

--}}}

--{{{ Configuration

-- Flag to detect late initialization error
local already_used = false

-- Escape binding table built once upon initialization
local escape_bindings = { }

--- Fills the escape bindings table with actual `awfull.key' elements triggering
--- execution of `on_leaving'.
local function init_escape_bindings ()
    escape_bindings = { }
    for _, e in ipairs (escape_keystrokes) do
        escape_bindings = join (escape_bindings,
                                akey (e (ks_mod), e (ks_key), on_leaving))
    end
end

-- Call it once upon module loading to initialize escape_bindings (in case
-- `init' is not called).
init_escape_bindings ()

--- Initializes the keychain module, with given properties; to be called before
--- ANY other function of this module.
-- Configurations fields include:
--
-- `escapes': A table of keystrokes (@see keychain.keystroke) escaping keychains
-- (defaults are `Mod4-g' and `Escape').
--
-- `use_bowls': A boolean defining whether bowls are enabled or not (default is
-- true).
--
-- `use_timers', `timeout': A boolean defining whether bowls drawing should be
-- delayed, along with a number being this time shift, in seconds (Default
-- values are `true' and `2').
--
-- `modfilter': A table associating modifiers (Mod1, Mod4, Control, Shift, etc.)
-- with either a string (in this case it will replace the modifier when printed
-- in heplers) or functions (in this case the key string will be repaced by a
-- call to this function with the key string as parameter). Default value is:
-- { ["Mod1"] = "M", ["Mod4"] = "S", ["Control"] = "C", ["Shift"] =
-- string.upper }
--
-- @param c The table of properties.
function init (c)
    local c = c or { }

    if already_used then
        -- heum... just signal the error: "print" or "error"?
        return print ("E: keychain: Call to `init' AFTER having bound keys!")
    end

    escape_keystrokes = c.escapes and c.escapes or escape_keystrokes
    if c.use_bowls ~= nil then use_bowls = c.use_bowls end

    if use_bowls then
        modfilter = c.modfilter and c.modfilter or modfilter
        if c.use_timers ~= nil then use_timers = c.use_timers end
        if use_timers then
            timeout = c.timeout ~= nil and c.timeout or timeout
        end
    end

    -- Now, fill the escape bindings table again with actual `awfull.key'
    -- elements triggering `on_leaving' executions, in case escape keys has
    -- changed.
    init_escape_bindings ()
end

--}}}

--{{{ Keychain creation

--- Creates a new keychain binding.
-- @param m Modifiers table.
-- @param k The key.
-- @param chains A table of keychains, describing either final bindings (see
-- key constructor) or subchains (see subchain constructor).
-- @return A key binding for the `awful.key' module.
-- @see awful.key
function new (m, k, chains)

    -- This table will contain the keys to be mapped upon <m, k> keystroke. It
    -- initially contains the escape bindings, so that one can still rebind them
    -- differently in `chains'.
    local subchain = clone (escape_bindings)

    already_used = true         -- subsequent init avoidance flag...

    -- For each entry of the given chains, add a corresponding `awful.key'
    -- element in the subchain
    for _, e in ipairs (chains) do
        local ks = e (binding_ks)
        if e (binding_leaf) then
            -- We encountered a lead in the chains.
            local function on_leaf (c) on_leaving (c); e (binding_cont) (c) end
            subchain = join (subchain, akey (ks (ks_mod), ks (ks_key), on_leaf))
        else
            -- Recursively call subchain creation. "Funny" detail: I think there
            -- is no way of creating ill-structured keychain descriptors that
            -- would produce infinite recursive calls here, since we control
            -- their creation with functional tuples, that cannot lead to cyclic
            -- structures...
            local subch = new (ks (ks_mod), ks (ks_key), e (binding_cont))
            subchain = join (subchain, subch)
        end
    end

    -- Then return an actual `awful.key', triggering the `on_entering' routine
    return akey (m, k, make_on_entering (m, k, subchain))
end
--}}}

-- Setup `__call' entry in module's metatable so that we can create new prefix
-- binding using `keychain (m, k, ...)' directly.
setmetatable (_M, { __call = function (_, ...) return new (...) end })

-- Local variables:
-- indent-tabs-mode: nil
-- fill-column: 80
-- lua-indent-level: 4
-- End:
-- vim: filetype=lua:expandtab:shiftwidth=4:tabstop=8:softtabstop=4:encoding=utf-8:textwidth=80