comparison src/keymap.c @ 109235:d53d2e9bef4f

Merge from mainline.

109234:810852b2385b

   For example:

   initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */

void
initial_define_key (keymap, key, defname)
     Lisp_Object keymap;
     int key;
     char *defname;
{
  store_in_keymap (keymap, make_number (key), intern_c_string (defname));
}

void
initial_define_lispy_key (keymap, keyname, defname)
     Lisp_Object keymap;
     char *keyname;
     char *defname;
{
  store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
}

DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,

   This function can GC when AUTOLOAD is non-zero, because it calls
   do_autoload which can GC.  */

Lisp_Object
get_keymap (object, error, autoload)
     Lisp_Object object;
     int error, autoload;
{
  Lisp_Object tem;

 autoload_retry:
  if (NILP (object))


/* Return the parent map of KEYMAP, or nil if it has none.
   We assume that KEYMAP is a valid keymap.  */

Lisp_Object
keymap_parent (keymap, autoload)
     Lisp_Object keymap;
     int autoload;
{
  Lisp_Object list;

  keymap = get_keymap (keymap, 1, autoload);

  return keymap_parent (keymap, 1);
}

/* Check whether MAP is one of MAPS parents.  */
int
keymap_memberp (map, maps)
     Lisp_Object map, maps;
{
  if (NILP (map)) return 0;
  while (KEYMAPP (maps) && !EQ (map, maps))
    maps = keymap_parent (maps, 0);
  return (EQ (map, maps));

/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
   if EVENT is also a prefix in MAP's parent,
   make sure that SUBMAP inherits that definition as its own parent.  */

static void
fix_submap_inheritance (map, event, submap)
     Lisp_Object map, event, submap;
{
  Lisp_Object map_parent, parent_entry;

  /* SUBMAP is a cons that we found as a key binding.
     Discard the other things found in a menu key binding.  */

   If T_OK is zero, bindings for Qt are not treated specially.

   If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */

Lisp_Object
access_keymap (map, idx, t_ok, noinherit, autoload)
     Lisp_Object map;
     Lisp_Object idx;
     int t_ok;
     int noinherit;
     int autoload;
{
  Lisp_Object val;

  /* Qunbound in VAL means we have found no binding yet.  */
  val = Qunbound;

    return get_keyelt (t_binding, autoload);
  }
}

static void
map_keymap_item (fun, args, key, val, data)
     map_keymap_function_t fun;
     Lisp_Object args, key, val;
     void *data;
{
  /* We should maybe try to detect bindings shadowed by previous
     ones and things like that.  */
  if (EQ (val, Qt))
    val = Qnil;
  (*fun) (key, val, args, data);
}

static void
map_keymap_char_table_item (args, key, val)
     Lisp_Object args, key, val;
{
  if (!NILP (val))
    {
      map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
      args = XCDR (args);

  UNGCPRO;
  return tail;
}

static void
map_keymap_call (key, val, fun, dummy)
     Lisp_Object key, val, fun;
     void *dummy;
{
  call2 (fun, key, val);
}

/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
   A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded.  */
void
map_keymap (map, fun, args, data, autoload)
     map_keymap_function_t fun;
     Lisp_Object map, args;
     void *data;
     int autoload;
{
  struct gcpro gcpro1;
  GCPRO1 (args);
  map = get_keymap (map, 1, autoload);
  while (CONSP (map))

Lisp_Object Qkeymap_canonicalize;

/* Same as map_keymap, but does it right, properly eliminating duplicate
   bindings due to inheritance.   */
void
map_keymap_canonical (map, fun, args, data)
     map_keymap_function_t fun;
     Lisp_Object map, args;
     void *data;
{
  struct gcpro gcpro1;
  GCPRO1 (args);
  /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
     so be careful to ignore errors and to inhibit redisplay.  */

   that are referred to with indirection.

   This can GC because menu_item_eval_property calls Feval.  */

Lisp_Object
get_keyelt (object, autoload)
     Lisp_Object object;
     int autoload;
{
  while (1)
    {
      if (!(CONSP (object)))
	/* This is really the value.  */

	}
    }
}

static Lisp_Object
store_in_keymap (keymap, idx, def)
     Lisp_Object keymap;
     register Lisp_Object idx;
     Lisp_Object def;
{
  /* Flush any reverse-map cache.  */
  where_is_cache = Qnil;
  where_is_cache_keymaps = Qt;

}

EXFUN (Fcopy_keymap, 1);

Lisp_Object
copy_keymap_item (elt)
     Lisp_Object elt;
{
  Lisp_Object res, tem;

  if (!CONSP (elt))
    return elt;

    }
  return res;
}

static void
copy_keymap_1 (chartable, idx, elt)
     Lisp_Object chartable, idx, elt;
{
  Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
}

DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,

/* Make KEYMAP define event C as a keymap (i.e., as a prefix).
   Assume that currently it does not define C at all.
   Return the keymap.  */

static Lisp_Object
define_as_prefix (keymap, c)
     Lisp_Object keymap, c;
{
  Lisp_Object cmd;

  cmd = Fmake_sparse_keymap (Qnil);
  /* If this key is defined as a prefix in an inherited keymap,

}

/* Append a key to the end of a key sequence.  We always make a vector.  */

Lisp_Object
append_key (key_sequence, key)
     Lisp_Object key_sequence, key;
{
  Lisp_Object args[2];

  args[0] = key_sequence;

/* Given a event type C which is a symbol,
   signal an error if is a mistake such as RET or M-RET or C-DEL, etc.  */

static void
silly_event_symbol_error (c)
     Lisp_Object c;
{
  Lisp_Object parsed, base, name, assoc;
  int modifiers;

  parsed = parse_modifiers (c);

   which would call this function again, resulting in an infinite
   loop.  Instead, we'll use realloc/malloc and silently truncate the
   list, let the key sequence be read, and hope some other piece of
   code signals the error.  */
int
current_minor_maps (modeptr, mapptr)
     Lisp_Object **modeptr, **mapptr;
{
  int i = 0;
  int list_number = 0;
  Lisp_Object alist, assoc, var, val;
  Lisp_Object emulation_alists;

  /* Does the current sequence end in the meta-prefix-char?  */
  int is_metized;
};

static void
accessible_keymaps_1 (key, cmd, args, data)
     Lisp_Object key, cmd, args;
     /* Use void* to be compatible with map_keymap_function_t.  */
     void *data;
{
  struct accessible_keymaps_data *d = data; /* Cast! */
  Lisp_Object maps = d->maps;
  Lisp_Object tail = d->tail;
  Lisp_Object thisseq = d->thisseq;

  goto next_list;
}


char *
push_key_description (c, p, force_multibyte)
     register unsigned int c;
     register char *p;
     int force_multibyte;
{
  unsigned c2;

  /* Clear all the meaningless bits above the meta bit.  */
  c &= meta_modifier | ~ - meta_modifier;

    error ("KEY must be an integer, cons, symbol, or string");
  return Qnil;
}

char *
push_text_char_description (c, p)
     register unsigned int c;
     register char *p;
{
  if (c >= 0200)
    {
      *p++ = 'M';
      *p++ = '-';

/* Return 0 if SEQ uses non-preferred modifiers or non-char events.
   Else, return 2 if SEQ uses the where_is_preferred_modifier,
   and 1 otherwise.  */
static int
preferred_sequence_p (seq)
     Lisp_Object seq;
{
  int i;
  int len = XINT (Flength (seq));
  int result = 1;

}

/* This function can GC because get_keyelt can.  */

static void
where_is_internal_1 (key, binding, args, data)
     Lisp_Object key, binding, args;
     void *data;
{
  struct where_is_internal_data *d = data; /* Cast! */
  Lisp_Object definition = d->definition;
  int noindirect = d->noindirect;
  Lisp_Object this = d->this;

}

static int previous_description_column;

static void
describe_command (definition, args)
     Lisp_Object definition, args;
{
  register Lisp_Object tem1;
  int column = (int) current_column (); /* iftc */
  int description_column;

  else
    insert_string ("??\n");
}

static void
describe_translation (definition, args)
     Lisp_Object definition, args;
{
  register Lisp_Object tem1;

  Findent_to (make_number (16), make_number (1));

/* qsort comparison function for sorting `struct describe_map_elt' by
   the event field.  */

static int
describe_map_compare (aa, bb)
     const void *aa, *bb;
{
  const struct describe_map_elt *a = aa, *b = bb;
  if (INTEGERP (a->event) && INTEGERP (b->event))
    return ((XINT (a->event) > XINT (b->event))
	    - (XINT (a->event) < XINT (b->event)));

  UNGCPRO;
}

static void
describe_vector_princ (elt, fun)
     Lisp_Object elt, fun;
{
  Findent_to (make_number (16), make_number (1));
  call1 (fun, elt);
  Fterpri (Qnil);
}

/* Apropos - finding all symbols whose names match a regexp.		*/
static Lisp_Object apropos_predicate;
static Lisp_Object apropos_accumulate;

static void
apropos_accum (symbol, string)
     Lisp_Object symbol, string;
{
  register Lisp_Object tem;

  tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
  if (!NILP (tem) && !NILP (apropos_predicate))

  apropos_predicate = Qnil;
  return tem;
}

void
syms_of_keymap ()
{
  Qkeymap = intern_c_string ("keymap");
  staticpro (&Qkeymap);
  staticpro (&apropos_predicate);
  staticpro (&apropos_accumulate);

  defsubr (&Sdescribe_buffer_bindings);
  defsubr (&Sapropos_internal);
}

void
keys_of_keymap ()
{
  initial_define_key (global_map, 033, "ESC-prefix");
  initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
}

109235:d53d2e9bef4f

   For example:

   initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark");  */

void
initial_define_key (Lisp_Object keymap, int key, char *defname)
{
  store_in_keymap (keymap, make_number (key), intern_c_string (defname));
}

void
initial_define_lispy_key (Lisp_Object keymap, char *keyname, char *defname)
{
  store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
}

DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,

   This function can GC when AUTOLOAD is non-zero, because it calls
   do_autoload which can GC.  */

Lisp_Object
get_keymap (Lisp_Object object, int error, int autoload)
{
  Lisp_Object tem;

 autoload_retry:
  if (NILP (object))


/* Return the parent map of KEYMAP, or nil if it has none.
   We assume that KEYMAP is a valid keymap.  */

Lisp_Object
keymap_parent (Lisp_Object keymap, int autoload)
{
  Lisp_Object list;

  keymap = get_keymap (keymap, 1, autoload);

  return keymap_parent (keymap, 1);
}

/* Check whether MAP is one of MAPS parents.  */
int
keymap_memberp (Lisp_Object map, Lisp_Object maps)
{
  if (NILP (map)) return 0;
  while (KEYMAPP (maps) && !EQ (map, maps))
    maps = keymap_parent (maps, 0);
  return (EQ (map, maps));

/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
   if EVENT is also a prefix in MAP's parent,
   make sure that SUBMAP inherits that definition as its own parent.  */

static void
fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap)
{
  Lisp_Object map_parent, parent_entry;

  /* SUBMAP is a cons that we found as a key binding.
     Discard the other things found in a menu key binding.  */

   If T_OK is zero, bindings for Qt are not treated specially.

   If NOINHERIT, don't accept a subkeymap found in an inherited keymap.  */

Lisp_Object
access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
{
  Lisp_Object val;

  /* Qunbound in VAL means we have found no binding yet.  */
  val = Qunbound;

    return get_keyelt (t_binding, autoload);
  }
}

static void
map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
{
  /* We should maybe try to detect bindings shadowed by previous
     ones and things like that.  */
  if (EQ (val, Qt))
    val = Qnil;
  (*fun) (key, val, args, data);
}

static void
map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
{
  if (!NILP (val))
    {
      map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
      args = XCDR (args);

  UNGCPRO;
  return tail;
}

static void
map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
{
  call2 (fun, key, val);
}

/* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
   A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded.  */
void
map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload)
{
  struct gcpro gcpro1;
  GCPRO1 (args);
  map = get_keymap (map, 1, autoload);
  while (CONSP (map))

Lisp_Object Qkeymap_canonicalize;

/* Same as map_keymap, but does it right, properly eliminating duplicate
   bindings due to inheritance.   */
void
map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
{
  struct gcpro gcpro1;
  GCPRO1 (args);
  /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
     so be careful to ignore errors and to inhibit redisplay.  */

   that are referred to with indirection.

   This can GC because menu_item_eval_property calls Feval.  */

Lisp_Object
get_keyelt (Lisp_Object object, int autoload)
{
  while (1)
    {
      if (!(CONSP (object)))
	/* This is really the value.  */

	}
    }
}

static Lisp_Object
store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
{
  /* Flush any reverse-map cache.  */
  where_is_cache = Qnil;
  where_is_cache_keymaps = Qt;

}

EXFUN (Fcopy_keymap, 1);

Lisp_Object
copy_keymap_item (Lisp_Object elt)
{
  Lisp_Object res, tem;

  if (!CONSP (elt))
    return elt;

    }
  return res;
}

static void
copy_keymap_1 (Lisp_Object chartable, Lisp_Object idx, Lisp_Object elt)
{
  Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
}

DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,

/* Make KEYMAP define event C as a keymap (i.e., as a prefix).
   Assume that currently it does not define C at all.
   Return the keymap.  */

static Lisp_Object
define_as_prefix (Lisp_Object keymap, Lisp_Object c)
{
  Lisp_Object cmd;

  cmd = Fmake_sparse_keymap (Qnil);
  /* If this key is defined as a prefix in an inherited keymap,

}

/* Append a key to the end of a key sequence.  We always make a vector.  */

Lisp_Object
append_key (Lisp_Object key_sequence, Lisp_Object key)
{
  Lisp_Object args[2];

  args[0] = key_sequence;

/* Given a event type C which is a symbol,
   signal an error if is a mistake such as RET or M-RET or C-DEL, etc.  */

static void
silly_event_symbol_error (Lisp_Object c)
{
  Lisp_Object parsed, base, name, assoc;
  int modifiers;

  parsed = parse_modifiers (c);

   which would call this function again, resulting in an infinite
   loop.  Instead, we'll use realloc/malloc and silently truncate the
   list, let the key sequence be read, and hope some other piece of
   code signals the error.  */
int
current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
{
  int i = 0;
  int list_number = 0;
  Lisp_Object alist, assoc, var, val;
  Lisp_Object emulation_alists;

  /* Does the current sequence end in the meta-prefix-char?  */
  int is_metized;
};

static void
accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data)
/* Use void* data to be compatible with map_keymap_function_t.  */
{
  struct accessible_keymaps_data *d = data; /* Cast! */
  Lisp_Object maps = d->maps;
  Lisp_Object tail = d->tail;
  Lisp_Object thisseq = d->thisseq;

  goto next_list;
}


char *
push_key_description (register unsigned int c, register char *p, int force_multibyte)
{
  unsigned c2;

  /* Clear all the meaningless bits above the meta bit.  */
  c &= meta_modifier | ~ - meta_modifier;

    error ("KEY must be an integer, cons, symbol, or string");
  return Qnil;
}

char *
push_text_char_description (register unsigned int c, register char *p)
{
  if (c >= 0200)
    {
      *p++ = 'M';
      *p++ = '-';

/* Return 0 if SEQ uses non-preferred modifiers or non-char events.
   Else, return 2 if SEQ uses the where_is_preferred_modifier,
   and 1 otherwise.  */
static int
preferred_sequence_p (Lisp_Object seq)
{
  int i;
  int len = XINT (Flength (seq));
  int result = 1;

}

/* This function can GC because get_keyelt can.  */

static void
where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data)
{
  struct where_is_internal_data *d = data; /* Cast! */
  Lisp_Object definition = d->definition;
  int noindirect = d->noindirect;
  Lisp_Object this = d->this;

}

static int previous_description_column;

static void
describe_command (Lisp_Object definition, Lisp_Object args)
{
  register Lisp_Object tem1;
  int column = (int) current_column (); /* iftc */
  int description_column;

  else
    insert_string ("??\n");
}

static void
describe_translation (Lisp_Object definition, Lisp_Object args)
{
  register Lisp_Object tem1;

  Findent_to (make_number (16), make_number (1));

/* qsort comparison function for sorting `struct describe_map_elt' by
   the event field.  */

static int
describe_map_compare (const void *aa, const void *bb)
{
  const struct describe_map_elt *a = aa, *b = bb;
  if (INTEGERP (a->event) && INTEGERP (b->event))
    return ((XINT (a->event) > XINT (b->event))
	    - (XINT (a->event) < XINT (b->event)));

  UNGCPRO;
}

static void
describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
{
  Findent_to (make_number (16), make_number (1));
  call1 (fun, elt);
  Fterpri (Qnil);
}

/* Apropos - finding all symbols whose names match a regexp.		*/
static Lisp_Object apropos_predicate;
static Lisp_Object apropos_accumulate;

static void
apropos_accum (Lisp_Object symbol, Lisp_Object string)
{
  register Lisp_Object tem;

  tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
  if (!NILP (tem) && !NILP (apropos_predicate))

  apropos_predicate = Qnil;
  return tem;
}

void
syms_of_keymap (void)
{
  Qkeymap = intern_c_string ("keymap");
  staticpro (&Qkeymap);
  staticpro (&apropos_predicate);
  staticpro (&apropos_accumulate);

  defsubr (&Sdescribe_buffer_bindings);
  defsubr (&Sapropos_internal);
}

void
keys_of_keymap (void)
{
  initial_define_key (global_map, 033, "ESC-prefix");
  initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
}