+static char *modifier_names[] =
+{
+ "up", 0, 0, 0, 0, 0, 0, "down",
+ "drag", "click", 0, 0, 0, 0, 0, 0,
+ 0, 0, "alt", "super", "hyper", "shift", "control", "meta"
+};
+#define NUM_MOD_NAMES (sizeof (modifier_names) / sizeof (modifier_names[0]))
+
+static Lisp_Object modifier_symbols;
+
+/* Return the list of modifier symbols corresponding to the mask MODIFIERS. */
+static Lisp_Object
+lispy_modifier_list (modifiers)
+ int modifiers;
+{
+ Lisp_Object modifier_list;
+ int i;
+
+ modifier_list = Qnil;
+ for (i = 0; (1<<i) <= modifiers && i < NUM_MOD_NAMES; i++)
+ if (modifiers & (1<<i))
+ modifier_list = Fcons (XVECTOR (modifier_symbols)->contents[i],
+ modifier_list);
+
+ return modifier_list;
+}
+
+
+/* Parse the modifiers on SYMBOL, and return a list like (UNMODIFIED MASK),
+ where UNMODIFIED is the unmodified form of SYMBOL,
+ MASK is the set of modifiers present in SYMBOL's name.
+ This is similar to parse_modifiers_uncached, but uses the cache in
+ SYMBOL's Qevent_symbol_element_mask property, and maintains the
+ Qevent_symbol_elements property. */
+static Lisp_Object
+parse_modifiers (symbol)
+ Lisp_Object symbol;
+{
+ Lisp_Object elements = Fget (symbol, Qevent_symbol_element_mask);
+
+ if (CONSP (elements))
+ return elements;
+ else
+ {
+ int end;
+ int modifiers = parse_modifiers_uncached (symbol, &end);
+ Lisp_Object unmodified
+ = Fintern (make_string (XSYMBOL (symbol)->name->data + end,
+ XSYMBOL (symbol)->name->size - end),
+ Qnil);
+ Lisp_Object mask;
+
+ if (modifiers & ~((1<<VALBITS) - 1))
+ abort ();
+ XFASTINT (mask) = modifiers;
+ elements = Fcons (unmodified, Fcons (mask, Qnil));
+
+ /* Cache the parsing results on SYMBOL. */
+ Fput (symbol, Qevent_symbol_element_mask,
+ elements);
+ Fput (symbol, Qevent_symbol_elements,
+ Fcons (unmodified, lispy_modifier_list (modifiers)));
+
+ /* Since we know that SYMBOL is modifiers applied to unmodified,
+ it would be nice to put that in unmodified's cache.
+ But we can't, since we're not sure that parse_modifiers is
+ canonical. */
+
+ return elements;
+ }
+}
+
+/* Apply the modifiers MODIFIERS to the symbol BASE.
+ BASE must be unmodified.
+
+ This is like apply_modifiers_uncached, but uses BASE's
+ Qmodifier_cache property, if present. It also builds
+ Qevent_symbol_elements properties, since it has that info anyway.
+
+ apply_modifiers copies the value of BASE's Qevent_kind property to
+ the modified symbol. */
+static Lisp_Object
+apply_modifiers (modifiers, base)
+ int modifiers;
+ Lisp_Object base;
+{
+ Lisp_Object cache, index, entry, new_symbol;
+
+ /* Mask out upper bits. We don't know where this value's been. */
+ modifiers &= (1<<VALBITS) - 1;
+
+ /* The click modifier never figures into cache indices. */
+ cache = Fget (base, Qmodifier_cache);
+ XFASTINT (index) = (modifiers & ~click_modifier);
+ entry = Fassq (index, cache);
+
+ if (CONSP (entry))
+ new_symbol = XCONS (entry)->cdr;
+ else
+ {
+ /* We have to create the symbol ourselves. */
+ new_symbol = apply_modifiers_uncached (modifiers,
+ XSYMBOL (base)->name->data,
+ XSYMBOL (base)->name->size);
+
+ /* Add the new symbol to the base's cache. */
+ entry = Fcons (index, new_symbol);
+ Fput (base, Qmodifier_cache, Fcons (entry, cache));
+
+ /* We have the parsing info now for free, so add it to the caches. */
+ XFASTINT (index) = modifiers;
+ Fput (new_symbol, Qevent_symbol_element_mask,
+ Fcons (base, Fcons (index, Qnil)));
+ Fput (new_symbol, Qevent_symbol_elements,
+ Fcons (base, lispy_modifier_list (modifiers)));
+ }
+
+ /* Make sure this symbol is of the same kind as BASE.
+
+ You'd think we could just set this once and for all when we
+ intern the symbol above, but reorder_modifiers may call us when
+ BASE's property isn't set right; we can't assume that just
+ because it has a Qmodifier_cache property it must have its
+ Qevent_kind set right as well. */
+ if (NILP (Fget (new_symbol, Qevent_kind)))
+ {
+ Lisp_Object kind = Fget (base, Qevent_kind);
+
+ if (! NILP (kind))
+ Fput (new_symbol, Qevent_kind, kind);
+ }
+
+ return new_symbol;
+}
+
+
+/* Given a symbol whose name begins with modifiers ("C-", "M-", etc),
+ return a symbol with the modifiers placed in the canonical order.
+ Canonical order is alphabetical, except for down and drag, which
+ always come last. The 'click' modifier is never written out.
+
+ Fdefine_key calls this to make sure that (for example) C-M-foo
+ and M-C-foo end up being equivalent in the keymap. */
+
+Lisp_Object
+reorder_modifiers (symbol)
+ Lisp_Object symbol;
+{
+ /* It's hopefully okay to write the code this way, since everything
+ will soon be in caches, and no consing will be done at all. */
+ Lisp_Object parsed = parse_modifiers (symbol);
+
+ return apply_modifiers (XCONS (XCONS (parsed)->cdr)->car,
+ XCONS (parsed)->car);
+}
+
+