/*  Part of XPCE --- The SWI-Prolog GUI toolkit

    Author:        Jan Wielemaker and Anjo Anjewierden
    E-mail:        jan@swi-prolog.org
    WWW:           https://www.swi-prolog.org/projects/xpce/
    Copyright (c)  1985-2025, University of Amsterdam
			      SWI-Prolog Solutions b.v.
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

#include <h/kernel.h>
#include <h/graphics.h>

static HashTable BindingTable;		/* name --> table: @key_bindings */

static status	resetKeyBinding(KeyBinding kb, Any receiver);
static status	initPredefinedKeyBinding(KeyBinding kb);
static status	bindResourcesKeyBinding(KeyBinding kb, Name name);
static status	applyPreferencesKeyBinding(KeyBinding kb);

static status
initialiseKeyBinding(KeyBinding kb, Name name, int argc, KeyBinding *argv)
{ initialiseRecogniser((Recogniser) kb);

  assign(kb, bindings, newObjectv(ClassSheet, 0, NULL));
  assign(kb, defaults, newObjectv(ClassChain, 0, NULL));

  resetKeyBinding(kb, NIL);
  obtainClassVariablesObject(kb);	/* actually, argument is a conflict! */

  if ( notDefault(name) )
  { assign(kb, name, name);
    appendHashTable(BindingTable, name, kb);
    protectObject(kb);
  }

  for( ; argc > 0; argc--, argv++ )
    appendChain(kb->defaults, argv[0]);

  if ( notDefault(name) && argc == 0 )
    initPredefinedKeyBinding(kb);

  succeed;
}


static KeyBinding
getLookupKeyBinding(Any ctx, Name name, int argc, KeyBinding *argv)
{ KeyBinding kb;

  if ( (kb = getMemberHashTable(BindingTable, name)) )
  { TRY(initialiseKeyBinding(kb, name, argc, argv));

    answer(kb);
  }

  fail;
}


static KeyBinding
getConvertKeyBinding(Any ctx, Name name)
{ KeyBinding kb;

  if ( (kb = getMemberHashTable(BindingTable, name)) )
    answer(kb);

  answer(newObject(ClassKeyBinding, name, EAV));
}


static status
receiverKeyBinding(KeyBinding kb, Any receiver)
{ if ( getHyperedObject(kb, NAME_receiver, DEFAULT) != receiver )
    freeHypersObject(kb, NAME_receiver, DEFAULT);

  if ( notNil(receiver) )
    newObject(ClassHyper, kb, receiver, NAME_receiver, NAME_keyBinding, EAV);

  succeed;
}


static Any
getReceiverKeyBinding(KeyBinding kb)
{ return getHyperedObject(kb, NAME_receiver, DEFAULT);
}


static status
resetKeyBinding(KeyBinding kb, Any receiver)
{ if ( isDefault(receiver) )
    receiver = NIL;

  receiverKeyBinding(kb, receiver);
  assign(kb, prefix,   NAME_);
  assign(kb, argument, DEFAULT);

  succeed;
}


static Any
get_function_key_binding(KeyBinding kb, Name key)
{ Any cmd;
  Cell cell;

  if ( (cmd = getValueSheet(kb->bindings, key)) )
    answer(cmd);
  for_cell(cell, kb->defaults)
    if ( (cmd = get_function_key_binding(cell->value, key)) )
      answer(cmd);

  fail;
}


static Any
get_default_function_key_binding(KeyBinding kb, Name key)
{ Any cmd;
  Cell cell;

  if ( notNil(kb->default_function) )
    answer(kb->default_function);

  for_cell(cell, kb->defaults)
  { if ( (cmd = get_default_function_key_binding(cell->value, key)) )
      answer(cmd);
  }

  fail;
}


Any
getFunctionKeyBinding(KeyBinding kb, EventId id)
{ Any cmd;
  Name key = characterName(id);

  if ( (cmd = get_function_key_binding(kb, key)) )
    answer(cmd);

					/* deal with UNICODE characters */
  if ( key->data.s_size == 1 )
  { int c = str_fetch(&key->data, 0);

    if ( c >= 128 )
      return NAME_insertSelf;
  }

  answer(get_default_function_key_binding(kb, key));
}


static void
add_matching_bindings(KeyBinding kb, Any function, Chain ch)
{ Cell cell;

  for_cell(cell, kb->bindings->attributes)
  { Attribute a = cell->value;
    if ( a->value == function && !memberChain(ch, a->name) )
      appendChain(ch, a->name);
  }
  for_cell(cell, kb->defaults)
  { add_matching_bindings(cell->value, function, ch);
  }
}

static Chain
getBindingKeyBinding(KeyBinding kb, Any function)
{ Chain ch = answerObject(ClassChain, EAV);

  add_matching_bindings(kb, function, ch);
  answer(ch);
}


status
functionKeyBinding(KeyBinding kb, EventId id, Any f)
{ return valueSheet(kb->bindings, id, f);
}


		/********************************
		*       EVENT PROCESSING	*
		********************************/

static status
reportStatusKeybinding(KeyBinding kb, Any receiver)
{ static Name fmt = NULL;
  Any str;

  if ( notDefault(kb->argument) )
  { if ( !fmt )
      fmt = CtoName("%d %s");

    str = newObject(ClassString, fmt,
		    kb->argument, kb->prefix, EAV);
  } else
  { str = kb->prefix;
  }
  send(receiver, NAME_report, NAME_status, name_procent_s, str, EAV);
  doneObject(str);

  succeed;
}


static status
eventKeyBinding(KeyBinding kb, EventObj ev)
{ if ( isAEvent(ev, NAME_keyboard) &&
       (isNil(kb->condition) ||
	forwardReceiverCode(kb->condition, kb, ev, EAV)) )
    return send(kb, NAME_typed, ev, ev->receiver, EAV);

  fail;
}


#define RESET_COLUMN   1
#define RESET_ARGUMENT 2
#define RESET_STATUS   4

#define MAX_ARGS 16

static status
cuaKeyAsPrefixKeyBinding(KeyBinding kb, EventObj ev, Graphical receiver)
{ if ( hasSendMethodObject(receiver, NAME_cuaKeyAsPrefix) &&
       send(receiver, NAME_cuaKeyAsPrefix, ev, EAV) )
    succeed;

  fail;
}


status
typedKeyBinding(KeyBinding kb, Any id, Graphical receiver)
{ Name key;
  Any cmd;
  Any crec = getReceiverKeyBinding(kb);
  Any argv[MAX_ARGS];
  int argc = 0;
  int reset = 0;
  status rval = FAIL;
  EventObj ev = id;
  int clearstatus = (notDefault(kb->argument) || kb->prefix != NAME_);

  if ( notDefault(receiver) )
  { if ( receiver != crec )
      resetKeyBinding(kb, receiver);
  } else if ( crec )
  { receiver = crec;
  } else
    errorPce(kb, NAME_noReceiver);

  key = getAppendName(kb->prefix, characterName(id));
  DEBUG(NAME_keyBinding, writef("%O: Key = %s\n", kb, key));
  if ( instanceOfObject(id, ClassEvent) )
    id = ((EventObj)id)->id;

  if ( kb->status == NAME_quotedInsert )
  { cmd = NAME_insertQuoted;
    reset |= RESET_STATUS;
  } else
  { cmd = get(kb, NAME_function, key, EAV);
  }

  if ( cmd )
  { if ( isName(cmd) )
    { int cmdi;

      argv[argc++]        = id;
      argv[argc++]        = receiver;
      argv[(cmdi=argc++)] = cmd;

      if ( cmd == NAME_prefix )		/* Prefix (multikey)  */
      { assign(kb, prefix, key);
	rval = SUCCEED;
      } else if ( cmd == NAME_prefixOrCopy ) /* \\C-c: See above */
      { if ( cuaKeyAsPrefixKeyBinding(kb, ev, receiver) )
	{ cmd = NAME_prefix;
	  assign(kb, prefix, key);
	} else
	{ cmd = NAME_copy;
	}
	argv[cmdi] = cmd;
	rval = SUCCEED;
      } else if ( cmd == NAME_prefixOrCut ) /* \\C-x: See above */
      { if ( cuaKeyAsPrefixKeyBinding(kb, ev, receiver) )
	{ cmd = NAME_prefix;
	  assign(kb, prefix, key);
	} else
	{ cmd = NAME_cut;
	}
	argv[cmdi] = cmd;
	rval = SUCCEED;
      } else if ( cmd == NAME_keyboardQuit )
      { resetKeyBinding(kb, receiver);
	rval = SUCCEED;
      } else if ( cmd == NAME_nextLine ||
		  cmd == NAME_previousLine ||
		  cmd == NAME_cursorUp ||
		  cmd == NAME_cursorDown )
      { Any rec;
	Method impl = resolveSendMethodObject(receiver, NULL, cmd, &rec);
	Type argt;

	argv[argc++] = kb->argument;

	if ( impl &&
	     instanceOfObject(impl, ClassSendMethod) &&
	     (argt = getArgumentTypeMethod(impl, toInt(2))) &&
	     includesType(argt, TypeInt) )
	{ if ( isNil(kb->saved_column) &&
	       hasGetMethodObject(receiver, NAME_upDownColumn) )
	    assign(kb, saved_column, get(receiver, NAME_upDownColumn, EAV));
	  argv[argc++] = kb->saved_column;
	}

	reset |= RESET_ARGUMENT;
					/* Universal argument specification */
      } else if ( cmd == NAME_digitArgument && isInteger(id) )
      { if ( valInt(id) == Meta('-') && isDefault(kb->argument) )
	  assign(kb, argument, toInt(-1));
	else
	{ int chr = valInt(id) - Meta('0');

	  if ( chr >= 0 && chr <= 9 )
	  { if ( isDefault(kb->argument) )
	      assign(kb, argument, toInt(chr));
	    else
	      assign(kb, argument, toInt(valInt(kb->argument) * 10 + chr));
	  }
	}
	rval = SUCCEED;
      } else if ( cmd == NAME_universalArgument )
      { if ( isDefault(kb->argument) )
	{ assign(kb, argument, toInt(4));
	  assign(kb, status, NAME_universalArgument);
	} else
	  assign(kb, argument, toInt(valInt(kb->argument) * 4));
	rval = SUCCEED;
      } else if ( notDefault(kb->argument) &&
		  isInteger(id) && valInt(id) <= 0xff && isdigit(valInt(id)) )
      { if ( kb->status == NAME_universalArgument )
	{ assign(kb, argument, toInt(valInt(id) - '0'));
	  assign(kb, status, NIL);
	} else
	  assign(kb, argument, toInt(valInt(kb->argument) * 10 +
				     valInt(id) - '0'));
	cmd = NAME_universalArgument;
	argv[cmdi] = cmd;
	rval = SUCCEED;
      } else if ( cmd == NAME_quotedInsert )
      { assign(kb, status, NAME_quotedInsert );
      } else
      { reset |= (RESET_ARGUMENT|RESET_COLUMN);
      }

      if ( clearstatus )
	send(receiver, NAME_report, NAME_status, NAME_, EAV);
      rval = sendv(kb, NAME_fillArgumentsAndExecute, argc, argv);
    } else if ( instanceOfObject(cmd, ClassCode) )
    { if ( clearstatus )
	send(receiver, NAME_report, NAME_status, NAME_, EAV);
      rval = forwardReceiverCode(cmd, receiver, kb->argument, id, EAV);
    }
  } else
  { reset = (RESET_COLUMN|RESET_ARGUMENT|RESET_STATUS);
  }

  if ( reset & RESET_COLUMN )
    assign(kb, saved_column, NIL);
  if ( reset & RESET_ARGUMENT )
    assign(kb, argument, DEFAULT);
  if ( reset & RESET_STATUS )
    assign(kb, status, NIL);

  if ( cmd != NAME_prefix )
    assign(kb, prefix, NAME_);

  if ( notDefault(kb->argument) || kb->prefix != NAME_ )
    reportStatusKeybinding(kb, receiver);

  return rval;
}


static status
fillArgumentsAndExecuteKeyBinding(KeyBinding kb,
				  EventId id, Any receiver, Name cmd,
				  int ac, Any av[])
{ Tuple t;
  Any impl;

  t = get(receiver, NAME_sendMethod, cmd, EAV);
  if ( !t && cmd == NAME_insertQuoted )
  { cmd = NAME_insertSelf;
    t = get(receiver, NAME_sendMethod, cmd, EAV);
  }
  if ( t )
  { impl = t->second;
    doneObject(t);
  } else
    impl = NULL;

  DEBUG(NAME_keyBinding, Cprintf("%s: impl of %s is %s\n",
				 pp(kb), pp(cmd), pp(impl)));

  if ( impl )
  { Type type;
    Any val;
    int argc=0; Any theargv[MAX_ARGS];
    Any *argv = &theargv[2];

    theargv[0] = receiver;
    theargv[1] = cmd;
    for(; argc<ac; argc++)
    { argv[argc] = av[argc];
    }

    while( (type = get(impl, NAME_argumentType, toInt(argc+1), EAV)) &&
	   argc < MAX_ARGS )
    { if ( includesType(type, toType(NAME_eventId)) ||
	   (includesType(type, toType(NAME_char)) && isInteger(id)) )
	argv[argc++] = id;
      else if ( includesType(type, toType(NAME_int)) &&
		notDefault(kb->argument))
	argv[argc++] = kb->argument;
      else if ( includesType(type, toType(NAME_default)) )
	argv[argc++] = DEFAULT;
      else if ( hasGetMethodObject(receiver, NAME_interactiveArgument) )
      { if ( (val = get(receiver, NAME_interactiveArgument,
			impl, toInt(argc+1), EAV)) )
	{ if ( (val = checkType(val, type, receiver)) )
	    argv[argc++] = val;
	  else
	    return errorPce(kb, NAME_noArgument, toInt(argc+1), impl);
	} else
	  fail;
      } else
        return errorPce(kb, NAME_noArgument, toInt(argc+1), impl);
    }

    return sendv(kb, NAME_execute, argc+2, theargv);
  } else
  { if ( cmd != NAME_digitArgument &&
	 cmd != NAME_universalArgument &&
	 cmd != NAME_keyboardQuit &&
	 cmd != NAME_quotedInsert &&
	 cmd != NAME_prefix )
      errorPce(receiver, NAME_noTextBehaviour, cmd);
    else
      succeed;
  }

  fail;
}


static status
executeKeyBinding(KeyBinding kb, Any receiver, Name cmd, int argc, Any argv[])
{ return sendv(receiver, cmd, argc, argv);
}

		 /*******************************
		 *	 CLASS DECLARATION	*
		 *******************************/

/* Type declarations */

static char *T_typed[] =
        { "id=event|event_id", "for=[object]" };
static char *T_fillArgumentsAndExecute[] =
        { "id=event_id", "receiver=object", "selector=name", "arguments=any ..." };
static char *T_function[] =
        { "key=name|event_id", "action=name|code" };
static char *T_initialise[] =
        { "name=[name]*", "super=key_binding ..." };
static char *T_lookup[] =
        { "name", "key_binding ..." };
static char *T_execute[] =
        { "receiver=object", "selector=name", "arguments=any ..." };

/* Instance Variables */

static vardecl var_keyBinding[] =
{ IV(NAME_name, "name*", IV_GET,
     NAME_name, "Name of this binding-table"),
  IV(NAME_bindings, "sheet", IV_GET,
     NAME_binding, "Sheet mappings keys to functions"),
  IV(NAME_defaults, "chain", IV_BOTH,
     NAME_default, "Chain with key_bindings to inherit from"),
  IV(NAME_defaultFunction, "name|code*", IV_BOTH,
     NAME_binding, "Default function to perform"),
  IV(NAME_prefix, "name", IV_GET,
     NAME_event, "Currently parsed prefix"),
  IV(NAME_argument, "[int]", IV_GET,
     NAME_argument, "Universal (numerical) argument"),
  IV(NAME_status, "{universal_argument,quoted_insert}*", IV_NONE,
     NAME_event, "Internal flag"),
  IV(NAME_savedColumn, "int*", IV_GET,
     NAME_caret, "Saved {next_line,previous_line} column"),
  IV(NAME_condition, "code*", IV_BOTH,
     NAME_event, "Activation condition")
};

/* Send Methods */

static senddecl send_keyBinding[] =
{ SM(NAME_initialise, 2, T_initialise, initialiseKeyBinding,
     DEFAULT, "Create named binding-table with defaults"),
  SM(NAME_reset, 1, "[graphical]*", resetKeyBinding,
     NAME_abort, "Reset <-receiver and <-prefix"),
  SM(NAME_function, 2, T_function, functionKeyBinding,
     NAME_binding, "Append function association"),
  SM(NAME_receiver, 1, "graphical*", receiverKeyBinding,
     NAME_client, "Client of the key_binding object"),
  SM(NAME_event, 1, "event", eventKeyBinding,
     NAME_event, "Process keyboard event"),
  SM(NAME_execute, 3, T_execute, executeKeyBinding,
     NAME_event, "Invoke `selector' on `receiver' with args"),
  SM(NAME_fillArgumentsAndExecute, 4, T_fillArgumentsAndExecute, fillArgumentsAndExecuteKeyBinding,
     NAME_event, "Collect additional arguments and ->execute"),
  SM(NAME_typed, 2, T_typed, typedKeyBinding,
     NAME_event, "Process event-id (of keyboard event)"),
  SM(NAME_bindResources, 1, "[name]", bindResourcesKeyBinding,
     NAME_preferences, "Apply preferences from class-variables"),
  SM(NAME_applyPreferences, 0, NULL, applyPreferencesKeyBinding,
     NAME_preferences, "Apply user preferences")
};

/* Get Methods */

static getdecl get_keyBinding[] =
{ GM(NAME_receiver, 0, "graphical", NULL, getReceiverKeyBinding,
     NAME_client, "Client of the key_binding object"),
  GM(NAME_convert, 1, "key_binding", "name", getConvertKeyBinding,
     NAME_conversion, "Lookup existing table or create new named table"),
  GM(NAME_binding, 1, "chain", "function=name|code", getBindingKeyBinding,
     NAME_meta, "Find key-bindings from function"),
  GM(NAME_function, 1, "name|code", "event|name|event_id", getFunctionKeyBinding,
     NAME_meta, "Get function for given event-id"),
  GM(NAME_lookup, 2, "key_binding", T_lookup, getLookupKeyBinding,
     NAME_oms, "Lookup existing table")
};

/* Resources */

static classvardecl rc_keyBinding[] =
{ RC(NAME_insert,           "chain", "[]", "Bind printable to ->insert_self"),
  RC(NAME_argument,         "chain", "[]", "C-u and M-digit binding"),
  RC(NAME_emacsSpecial,     "chain", "[]", "argument, prefix, quote and quit"),
  RC(NAME_emacsCaretBasics, "chain", "[]", "Basic caret movement"),
  RC(NAME_emacsPage,        "chain", "[]", "Moving by pages"),
  RC(NAME_emacsEditBasics,  "chain", "[]", "Basic emacs editing commands"),
  RC(NAME_emacsViewBasics,  "chain", "[]", "Basic emacs browse commands"),
  RC(NAME_emacsBasics,      "chain", "[]", "All emacs basic commands"),
  RC(NAME_editor,           "chain", "[]", "Default editor binding"),
  RC(NAME_text,             "chain", "[]", "Default text binding"),
  RC(NAME_textItem,         "chain", "[]", "Default text_item binding"),
  RC(NAME_textItemView,     "chain", "[]", "Default non-editible text_item"),
  RC(NAME_listBrowser,      "chain", "[]", "Default list_browser binding")
};

/* Class Declaration */

static Name keyBinding_termnames[] = { NAME_name };

ClassDecl(keyBinding_decls,
          var_keyBinding, send_keyBinding, get_keyBinding, rc_keyBinding,
          1, keyBinding_termnames,
          "$Rev$");



status
makeClassKeyBinding(Class class)
{ declareClass(class, &keyBinding_decls);

  BindingTable = globalObject(NAME_keyBindings, ClassHashTable, EAV);

  succeed;
}


		/********************************
		*           TABLES		*
		********************************/

static status
initInsertKeyBinding(KeyBinding kb)
{ int i;

  functionKeyBinding(kb, characterName(toInt('\t')), NAME_insertSelf);
  functionKeyBinding(kb, characterName(toInt('\n')), NAME_newline);
  functionKeyBinding(kb, characterName(toInt('\r')), NAME_newline);

  for(i = ' '; i < DEL; i++ )
    functionKeyBinding(kb, characterName(toInt(i)), NAME_insertSelf);

  succeed;
}


static status
initArgumentKeyBinding(KeyBinding kb)
{ int i;

  for(i = Meta('0'); i <= Meta('9'); i++ )
    functionKeyBinding(kb, characterName(toInt(i)), NAME_digitArgument);

  functionKeyBinding(kb, characterName(toInt(Meta('-'))),
		     NAME_digitArgument);
  functionKeyBinding(kb, characterName(toInt(Control('u'))),
		     NAME_universalArgument);

  succeed;
}


typedef struct
{ char *key;
  Name function;
} kbDef, *KbDef;

#define SUPER ((char *) -1)
#define DEFAULT_FUNCTION ((char *) -2)

static kbDef emacs_special[] =
{ { SUPER,		NAME_argument },

  { "\\C-c",		NAME_prefixOrCopy },
  { "\\C-g",		NAME_keyboardQuit },
  { "\\C-q",		NAME_quotedInsert },
  { "\\C-x",		NAME_prefixOrCut },
  { "\\e",		NAME_prefix },

  { NULL,		NULL }
};

static kbDef emacs_caret_basics[] =
{ { "\\C-a",		NAME_beginningOfLine },
  { "\\C-b",		NAME_backwardChar },
  { "\\C-e",		NAME_endOfLine },
  { "\\C-f",		NAME_forwardChar },
  { "\\C-n",		NAME_nextLine },
  { "\\C-p",		NAME_previousLine },

  { "\\eb",		NAME_backwardWord },
  { "\\ef",		NAME_forwardWord },

  { "<cursor_up>",	NAME_previousLine },
  { "<cursor_down>",	NAME_nextLine },
  { "<cursor_right>",	NAME_forwardChar },
  { "<cursor_left>",	NAME_backwardChar },
  { "<cursor_home>",	NAME_beginningOfLine },
  { "<end>",		NAME_endOfLine },

  { NULL,		NULL }
};


static kbDef emacs_edit_basics[] =
{ { SUPER,		NAME_insert },

  { "BS",		NAME_cutOrBackwardDeleteChar },
  { "\\C-d",		NAME_deleteChar },
  { "DEL",		NAME_cutOrDeleteChar },
  { "\\C-t",		NAME_transposeChars },
  { "\\C-k",		NAME_killLine },
  { "\\C-o",		NAME_openLine },

  { "\\ed",		NAME_killWord },
  { "\\eBS",		NAME_backwardKillWord },
  { "\\e\\C-h",		NAME_backwardKillWord }, /* TBD: better abstraction */

  { NULL,		NULL }
};


static kbDef emacs_basics[] =
{ { SUPER,		NAME_emacsSpecial },
  { SUPER,		NAME_emacsCaretBasics },
  { SUPER,		NAME_emacsEditBasics },

  { NULL,		NULL }
};


static kbDef emacs_view_basics[] =
{ { SUPER,		NAME_emacsSpecial },
  { SUPER,		NAME_emacsCaretBasics },

  { NULL,		NULL }
};


static kbDef text[] =
{ { SUPER,		NAME_emacsBasics },

  { "\\C-u",		NAME_clear },
  { "\\C-c",		NAME_copy },
  { "\\C-v",		NAME_paste },
  { "\\C-y",		NAME_paste },

  { NULL,		NULL }
};


static kbDef text_item[] =
{ { SUPER,		NAME_emacsBasics },

  { "\\C-c",		NAME_copy },
  { "\\C-v",		NAME_paste },
  { "\\C-y",		NAME_paste },
  { "\\C-u",		NAME_clear },
  { "\\C-g",		NAME_keyboardQuit },
  { "RET",		NAME_enter },
  { "LFD",		NAME_enter },
  { "TAB",		NAME_next },
  { "SPC",		NAME_complete },

  { NULL,		NULL }
};


static kbDef text_item_view[] =
{ { SUPER,		NAME_emacsViewBasics },
  { "\\C-c",		NAME_copy },
  { "TAB",		NAME_next },

  { NULL,		NULL }
};


static kbDef list_browser[] =
{ { SUPER,		NAME_insert },
  { SUPER,		NAME_emacsPage },

  { "\\C-g",		NAME_keyboardQuit },
  { "\\e",		NAME_keyboardQuit },
  { "RET",		NAME_enter },
  { "LFD",		NAME_enter },
  { "BS",		NAME_backwardDeleteChar },
  { "DEL",		NAME_backwardDeleteChar },
  { "TAB",		NAME_extendPrefixOrNext },
  { "\\C-w",		NAME_extendToCurrent },
  { "\\C-s",		NAME_repeatSearch },
  { "\\C-n",		NAME_nextLine },
  { "<cursor_down>",	NAME_nextLine },
  { "\\C-p",		NAME_previousLine },
  { "<cursor_up>",	NAME_previousLine },

/*{ DEFAULT_FUNCTION,	NAME_alert },*/

  { NULL,		NULL }
};

static kbDef emacs_page[] =
{ { "\\C-v",		NAME_scrollUp },
  { "\\ev",		NAME_scrollDown },
  { "\\C-l",		NAME_recenter },
  { "<page_up>",	NAME_scrollDown },
  { "<page_down>",	NAME_scrollUp },

  { NULL,		NULL }
};

static kbDef editor[] =
{ { SUPER,		      NAME_emacsBasics },
  { SUPER,		      NAME_emacsPage },

  { "\\C-\\S-a",	      NAME_beginningOfLine },
  { "\\C-\\S-b",	      NAME_backwardChar },
  { "\\C-\\S-e",	      NAME_endOfLine },
  { "\\C-\\S-f",	      NAME_forwardChar },
  { "\\C-\\S-n",	      NAME_nextLine },
  { "\\C-\\S-p",	      NAME_previousLine },

  // The cursor commands detect their action based
  // on the event buttons.   That is how it was.
  // It is probably cleaner to create 4 different
  // methods that decide on how much the cursor moves
  // as well as whether or not the selection is extended.
  { "<cursor_up>",	      NAME_cursorUp },
  { "<cursor_down>",	      NAME_cursorDown },
  { "<cursor_right>",	      NAME_cursorRight },
  { "<cursor_left>",	      NAME_cursorLeft },
  { "<end>",		      NAME_cursorEnd },
  { "<cursor_home>",	      NAME_cursorHome },
  { "<page_up>",	      NAME_cursorPageUp },
  { "<page_down>",	      NAME_cursorPageDown },

  { "\\C-<cursor_up>",	      NAME_cursorUp },
  { "\\C-<cursor_down>",      NAME_cursorDown },
  { "\\C-<cursor_right>",     NAME_cursorRight },
  { "\\C-<cursor_left>",      NAME_cursorLeft },
  { "\\C-<end>",	      NAME_cursorEnd },
  { "\\C-<cursor_home>",      NAME_cursorHome },
  { "\\C-<page_up>",	      NAME_cursorPageUp },
  { "\\C-<page_down>",	      NAME_cursorPageDown },

  { "\\S-<cursor_up>",	      NAME_cursorUp },
  { "\\S-<cursor_down>",      NAME_cursorDown },
  { "\\S-<cursor_right>",     NAME_cursorRight },
  { "\\S-<cursor_left>",      NAME_cursorLeft },
  { "\\S-<end>",	      NAME_cursorEnd },
  { "\\S-<cursor_home>",      NAME_cursorHome },
  { "\\S-<page_up>",	      NAME_cursorPageUp },
  { "\\S-<page_down>",	      NAME_cursorPageDown },

  { "\\C-\\S-<cursor_up>",    NAME_cursorUp },
  { "\\C-\\S-<cursor_down>",  NAME_cursorDown },
  { "\\C-\\S-<cursor_right>", NAME_cursorRight },
  { "\\C-\\S-<cursor_left>",  NAME_cursorLeft },
  { "\\C-\\S-<end>",	      NAME_cursorEnd },
  { "\\C-\\S-<cursor_home>",  NAME_cursorHome },
  { "\\C-\\S-<page_up>",      NAME_cursorPageUp },
  { "\\C-\\S-<page_down>",    NAME_cursorPageDown },

  { "\\C-SPC",		      NAME_setMark },
  { "LFD",		      NAME_newlineAndIndent },
  { "\\C-j",		      NAME_newlineAndIndent },
  { "\\C-r",		      NAME_isearchBackward },
  { "\\C-s",		      NAME_isearchForward },
  { "<f3>",		      NAME_isearchForward },
  { "\\C-w",		      NAME_killOrGrabRegion },
  { "\\C-y",		      NAME_yank },
  { "\\C-_",		      NAME_undo },
  { "\\C-z",		      NAME_undo },

  { "\\e\\C-b",		      NAME_backwardTerm },
  { "\\e\\C-f",		      NAME_forwardTerm },
  { "\\e\\C-k",		      NAME_killTerm },
  { "\\e\\C-t",		      NAME_transposeTerms },
  { "\\eSPC",		      NAME_justOneSpace },
  { "\\ea",		      NAME_backwardSentence },
  { "\\ec",		      NAME_capitaliseWord },
  { "\\ed",		      NAME_killWord },
  { "\\ee",		      NAME_forwardSentence },
  { "\\eg",		      NAME_fillRegion },
  { "\\ek",		      NAME_killSentence },
  { "\\el",		      NAME_downcaseWord },
  { "\\eq",		      NAME_fillParagraph },
  { "\\et",		      NAME_transposeWord },
  { "\\eu",		      NAME_upcaseWord },
  { "\\e[",		      NAME_backwardParagraph },
  { "\\e]",		      NAME_forwardParagraph },
  { "\\e<",		      NAME_pointToTopOfFile },
  { "\\e>",		      NAME_pointToBottomOfFile },
  { "\\e/",		      NAME_dabbrevExpand },
  { "\\eDEL",		      NAME_backwardKillWord },

  { "\\C-x\\C-x",	      NAME_exchangePointAndMark },
  { "\\C-xh",		      NAME_markWholeBuffer },
  { "\\C-x\\C-o",	      NAME_deleteBlankLines },
  { "\\C-x\\C-t",	      NAME_transposeLines },
  { "\\C-x\\C-l",	      NAME_downcaseRegion },
  { "\\C-x\\C-u",	      NAME_upcaseRegion },
  { "\\C-x\\C-s",	      NAME_saveBuffer },
  { "\\C-xu",		      NAME_undo },

  { DEFAULT_FUNCTION,	      NAME_undefined },

  { NULL,		      NULL }
};

static kbDef terminal[] =
{ { "<end>",		NAME_cursorEnd },
  { "<cursor_home>",	NAME_cursorHome },
  { "<page_up>",	NAME_cursorPageUp },
  { "<page_down>",	NAME_cursorPageDown },
  { "\\C-c",		NAME_copyOrInterrupt },
  { "\\C-v",		NAME_paste },
  { "\\C-v",		NAME_paste },
  { "\\C-\\S-a",	NAME_selectAll },
  { NULL,		NULL }
};

static status
bindResourcesKeyBinding(KeyBinding kb, Name name)
{ Chain ch;

  if ( isDefault(name) )
    name = kb->name;
  if ( !isName(name) )
    succeed;

  ch = getClassVariableValueObject(kb, name);

  if ( instanceOfObject(ch, ClassChain) )
  { Cell cell;

    for_cell(cell, ch)
    { Binding b = cell->value;

      if ( instanceOfObject(b, ClassBinding) &&
	   isName(b->name) && isName(b->value) )
      { functionKeyBinding(kb, b->name, b->value);
      }
    }
  }

  succeed;
}


static status
applyPreferencesKeyBinding(KeyBinding kb)
{ return bindResourcesKeyBinding(kb, kb->name);
}



static status
initPredefinedKeyBinding(KeyBinding kb)
{ KbDef table;

  if ( kb->name == NAME_insert )
    return initInsertKeyBinding(kb);
  if ( kb->name == NAME_argument )
    return initArgumentKeyBinding(kb);

  if ( kb->name == NAME_emacsSpecial )
    table = emacs_special;
  else if ( kb->name == NAME_emacsCaretBasics )
    table = emacs_caret_basics;
  else if ( kb->name == NAME_emacsPage )
    table = emacs_page;
  else if ( kb->name == NAME_emacsEditBasics )
    table = emacs_edit_basics;
  else if ( kb->name == NAME_emacsBasics )
    table = emacs_basics;
  else if ( kb->name == NAME_emacsViewBasics )
    table = emacs_view_basics;
  else if ( kb->name == NAME_editor )
    table = editor;
  else if ( kb->name == NAME_terminal )
    table = terminal;
  else if ( kb->name == NAME_text )
    table = text;
  else if ( kb->name == NAME_textItem )
    table = text_item;
  else if ( kb->name == NAME_textItemView )
    table = text_item_view;
  else if ( kb->name == NAME_listBrowser )
    table = list_browser;
  else
    succeed;

  for( ; table->key; table++ )
  { if ( table->key == SUPER )
    { KeyBinding kb2 = newObject(ClassKeyBinding, table->function, EAV);

      if ( kb2 )
	appendChain(kb->defaults, kb2);
      else
	errorPce(kb, NAME_noKeyBinding, table->function);
    } else if ( table->key == DEFAULT_FUNCTION )
    { assign(kb, default_function, table->function);
    } else
      functionKeyBinding(kb,
			 table->key[0] == '\\' ? CtoName(table->key)
					       : CtoKeyword(table->key),
			 table->function);
  }

  return send(kb, NAME_applyPreferences, EAV);
}

		/********************************
		*         C-USED TABLES		*
		********************************/


KeyBinding
KeyBindingText(void)
{ static KeyBinding kb = NULL;

  if ( !kb )
    kb = globalObject(NIL, ClassKeyBinding, NAME_text, EAV);

  return kb;
}


KeyBinding
KeyBindingTextItem(void)
{ static KeyBinding kb = NULL;

  if ( !kb )
    kb = globalObject(NIL, ClassKeyBinding, NAME_textItem, EAV);

  return kb;
}


KeyBinding
KeyBindingTextItemView(void)
{ static KeyBinding kb = NULL;

  if ( !kb )
    kb = globalObject(NIL, ClassKeyBinding, NAME_textItemView, EAV);

  return kb;
}
