gschem/src/g_keys.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * gschem - gEDA Schematic Capture
   3  * Copyright (C) 1998-2010 Ales Hvezda
   4  * Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
   5  *
   6  * This program is free software; you can redistribute it and/or modify
   7  * it under the terms of the GNU General Public License as published by
   8  * the Free Software Foundation; either version 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program is distributed in the hope that it will be useful,
  12  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  * GNU General Public License for more details.
  15  *
  16  * You should have received a copy of the GNU General Public License
  17  * along with this program; if not, write to the Free Software
  18  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19  */
  20 #include <config.h>
  21 #include <missing.h>
  22
  23 #include <stdio.h>
  24 #include <sys/stat.h>
  25 #include <ctype.h>
  26 #ifdef HAVE_STRING_H
  27 #include <string.h>
  28 #endif
  29 #ifdef HAVE_STDLIB_H
  30 #include <stdlib.h>
  31 #endif
  32 #ifdef HAVE_UNISTD_H
  33 #include <unistd.h>
  34 #endif
  35
  36 #include "gschem.h"
  37
  38 #ifdef HAVE_LIBDMALLOC
  39 #include <dmalloc.h>
  40 #endif
  41
  42 #include <gdk/gdkkeysyms.h>
  43
  44
  45 #define DEFINE_G_KEYS(name)                             \
  46 SCM g_keys_ ## name(SCM rest)                           \
  47 {                                                       \
  48    GSCHEM_TOPLEVEL *w_current = g_current_window ();    \
  49    i_callback_ ## name(w_current, 0, NULL);                   \
  50    return SCM_BOOL_T;                           \
  51 }
  52
  53 /*! \brief test-comment
  54  * test-comment
  55  */
  56 DEFINE_G_KEYS(file_new)
  57
  58 DEFINE_G_KEYS(file_new_window)
  59
  60 /* don't use the widget parameter on this function, or do some checking... */
  61 /* since there is a call: widget = NULL, data = 0 (will be w_current) */
  62 /* This should be renamed to page_open perhaps... */
  63 DEFINE_G_KEYS(file_open)
  64
  65 /* don't use the widget parameter on this function, or do some checking... */
  66 /* since there is a call: widget = NULL, data = 0 (will be w_current) */
  67 DEFINE_G_KEYS(file_script)
  68
  69 /* don't use the widget parameter on this function, or do some checking... */
  70 /* since there is a call: widget = NULL, data = 0 (will be w_current) */
  71 DEFINE_G_KEYS(file_save)
  72 DEFINE_G_KEYS(file_save_as)
  73 DEFINE_G_KEYS(file_save_all)
  74 DEFINE_G_KEYS(file_print)
  75 DEFINE_G_KEYS(file_write_png)
  76
  77 /* don't use the widget parameter on this function, or do some checking... */
  78 /* since there is a call: widget = NULL, data = 0 (will be w_current) */
  79 /* this function closes a window */
  80 DEFINE_G_KEYS(file_close)
  81 DEFINE_G_KEYS(file_quit)
  82
  83 /* Select also does not update the middle button shortcut */
  84 DEFINE_G_KEYS(edit_undo)
  85 DEFINE_G_KEYS(edit_redo)
  86 DEFINE_G_KEYS(edit_select)
  87 DEFINE_G_KEYS(edit_select_all)
  88 DEFINE_G_KEYS(edit_deselect)
  89 DEFINE_G_KEYS(edit_copy)
  90 DEFINE_G_KEYS(edit_mcopy)
  91 DEFINE_G_KEYS(edit_move)
  92 DEFINE_G_KEYS(edit_delete)
  93 DEFINE_G_KEYS(edit_rotate_90)
  94 DEFINE_G_KEYS(edit_mirror)
  95 DEFINE_G_KEYS(edit_slot)
  96 DEFINE_G_KEYS(edit_color)
  97 DEFINE_G_KEYS(edit_edit)
  98 DEFINE_G_KEYS(edit_pin_type)
  99 DEFINE_G_KEYS(edit_text)
 100 DEFINE_G_KEYS(edit_lock)
 101 DEFINE_G_KEYS(edit_unlock)
 102 DEFINE_G_KEYS(edit_linetype)
 103 DEFINE_G_KEYS(edit_filltype)
 104 DEFINE_G_KEYS(edit_translate)
 105 DEFINE_G_KEYS(edit_invoke_macro)
 106 DEFINE_G_KEYS(edit_embed)
 107 DEFINE_G_KEYS(edit_unembed)
 108 DEFINE_G_KEYS(edit_update)
 109 DEFINE_G_KEYS(edit_show_hidden)
 110 DEFINE_G_KEYS(edit_find)
 111 DEFINE_G_KEYS(edit_show_text)
 112 DEFINE_G_KEYS(edit_hide_text)
 113 DEFINE_G_KEYS(edit_autonumber_text)
 114
 115 DEFINE_G_KEYS(clipboard_copy)
 116 DEFINE_G_KEYS(clipboard_cut)
 117 DEFINE_G_KEYS(clipboard_paste)
 118
 119 DEFINE_G_KEYS(buffer_copy1)
 120 DEFINE_G_KEYS(buffer_copy2)
 121 DEFINE_G_KEYS(buffer_copy3)
 122 DEFINE_G_KEYS(buffer_copy4)
 123 DEFINE_G_KEYS(buffer_copy5)
 124 DEFINE_G_KEYS(buffer_cut1)
 125 DEFINE_G_KEYS(buffer_cut2)
 126 DEFINE_G_KEYS(buffer_cut3)
 127 DEFINE_G_KEYS(buffer_cut4)
 128 DEFINE_G_KEYS(buffer_cut5)
 129 DEFINE_G_KEYS(buffer_paste1)
 130 DEFINE_G_KEYS(buffer_paste2)
 131 DEFINE_G_KEYS(buffer_paste3)
 132 DEFINE_G_KEYS(buffer_paste4)
 133 DEFINE_G_KEYS(buffer_paste5)
 134
 135 /* repeat middle shortcut doesn't make sense on redraw, just hit right
 136  * button */
 137 DEFINE_G_KEYS(view_redraw)
 138
 139 /* for these functions, repeat middle shortcut would get into the way
 140  * of what user is try to do */
 141 DEFINE_G_KEYS(view_zoom_full)
 142 DEFINE_G_KEYS(view_zoom_extents)
 143 DEFINE_G_KEYS(view_zoom_in)
 144 DEFINE_G_KEYS(view_zoom_out)
 145
 146 DEFINE_G_KEYS(view_zoom_box)
 147 DEFINE_G_KEYS(view_pan)
 148 DEFINE_G_KEYS(view_pan_left)
 149 DEFINE_G_KEYS(view_pan_right)
 150 DEFINE_G_KEYS(view_pan_up)
 151 DEFINE_G_KEYS(view_pan_down)
 152 DEFINE_G_KEYS(view_dark_colors)
 153 DEFINE_G_KEYS(view_light_colors)
 154 DEFINE_G_KEYS(view_bw_colors)
 155 DEFINE_G_KEYS(page_manager)
 156 DEFINE_G_KEYS(page_next)
 157 DEFINE_G_KEYS(page_prev)
 158 DEFINE_G_KEYS(page_new)
 159 DEFINE_G_KEYS(page_close)
 160 DEFINE_G_KEYS(page_revert)
 161 DEFINE_G_KEYS(page_print)
 162 DEFINE_G_KEYS(add_component)
 163 DEFINE_G_KEYS(add_attribute)
 164 DEFINE_G_KEYS(add_net)
 165 DEFINE_G_KEYS(add_bus)
 166 DEFINE_G_KEYS(add_text)
 167 DEFINE_G_KEYS(add_line)
 168 DEFINE_G_KEYS(add_path)
 169 DEFINE_G_KEYS(add_box)
 170 DEFINE_G_KEYS(add_picture)
 171 DEFINE_G_KEYS(add_circle)
 172 DEFINE_G_KEYS(add_arc)
 173 DEFINE_G_KEYS(add_pin)
 174 DEFINE_G_KEYS(hierarchy_down_schematic)
 175 DEFINE_G_KEYS(hierarchy_down_symbol)
 176 DEFINE_G_KEYS(hierarchy_up)
 177 DEFINE_G_KEYS(attributes_attach)
 178 DEFINE_G_KEYS(attributes_detach)
 179 DEFINE_G_KEYS(attributes_show_name)
 180 DEFINE_G_KEYS(attributes_show_value)
 181 DEFINE_G_KEYS(attributes_show_both)
 182 DEFINE_G_KEYS(attributes_visibility_toggle)
 183
 184 /* i_callback_script_console is not currently implemented */
 185 DEFINE_G_KEYS(script_console)
 186
 187 /* repeat last command doesn't make sense on options either??? (does
 188  * it?) */
 189 DEFINE_G_KEYS(options_text_size)
 190
 191 /* repeat last command doesn't make sense on options either??? (does
 192  * it?) */
 193 DEFINE_G_KEYS(options_afeedback)
 194 DEFINE_G_KEYS(options_grid)
 195 DEFINE_G_KEYS(options_snap)
 196 DEFINE_G_KEYS(options_snap_size)
 197 DEFINE_G_KEYS(options_scale_up_snap_size)
 198 DEFINE_G_KEYS(options_scale_down_snap_size)
 199 DEFINE_G_KEYS(options_rubberband)
 200 DEFINE_G_KEYS(options_magneticnet)
 201 DEFINE_G_KEYS(options_show_log_window)
 202 DEFINE_G_KEYS(options_show_coord_window)
 203 DEFINE_G_KEYS(misc)
 204 DEFINE_G_KEYS(misc2)
 205 DEFINE_G_KEYS(misc3)
 206
 207 DEFINE_G_KEYS(help_about)
 208 DEFINE_G_KEYS(help_hotkeys)
 209
 210 /* be sure that you don't use the widget parameter in this one, since it is
 211 being called with a null, I suppose we should call it with the right param.
 212 hack */
 213 DEFINE_G_KEYS(cancel)
 214
 215 /*! Contains the smob tag for key smobs */
 216 static scm_t_bits g_key_smob_tag;
 217 #define G_SCM_IS_KEY(x) SCM_SMOB_PREDICATE (g_key_smob_tag, (x))
 218
 219 /*! Type for keybindings. Used internally by gschem key smobs. */
 220 typedef struct {
 221   guint keyval;
 222   GdkModifierType modifiers;
 223   gchar *str; /* UTF-8. Free with g_free(). */
 224   gchar *disp_str; /* UTF-8. Free with g_free(). */
 225 } GschemKey;
 226
 227 /*! \brief Test if a key is valid.
 228  * \par Function Description
 229  * Test if the key combination defined by \a keyval and \a modifiers
 230  * is valid for key binding.  This is a less restrictive version of
 231  * gtk_accelerator_valid() from GTK 2.
 232  *
 233  * \param keyval     The key that was pressed.
 234  * \param modifiers  The active modifiers when the key was pressed.
 235  *
 236  * \return TRUE if the key combination is valid for keybinding.
 237  */
 238 static gboolean
 239 g_key_is_valid (guint keyval, GdkModifierType modifiers)
 240 {
 241   static const guint invalid_keyvals[] = {
 242     GDK_Shift_L, GDK_Shift_R, GDK_Shift_Lock, GDK_Caps_Lock, GDK_ISO_Lock,
 243     GDK_Control_L, GDK_Control_R, GDK_Meta_L, GDK_Meta_R,
 244     GDK_Alt_L, GDK_Alt_R, GDK_Super_L, GDK_Super_R, GDK_Hyper_L, GDK_Hyper_R,
 245     GDK_ISO_Level3_Shift, GDK_ISO_Next_Group, GDK_ISO_Prev_Group,
 246     GDK_ISO_First_Group, GDK_ISO_Last_Group,
 247     GDK_Mode_switch, GDK_Num_Lock, GDK_Multi_key,
 248     GDK_Scroll_Lock, GDK_Sys_Req,
 249     GDK_Tab, GDK_ISO_Left_Tab, GDK_KP_Tab,
 250     GDK_First_Virtual_Screen, GDK_Prev_Virtual_Screen,
 251     GDK_Next_Virtual_Screen, GDK_Last_Virtual_Screen,
 252     GDK_Terminate_Server, GDK_AudibleBell_Enable,
 253     0
 254   };
 255   const guint *val;
 256
 257   /* Exclude a bunch of control chars */
 258   if (keyval <= 0xFF) return keyval >= 0x20;
 259
 260   /* Exclude special & modifier keys */
 261   val = invalid_keyvals;
 262   while (*val) {
 263     if (keyval == *val++) return FALSE;
 264   }
 265
 266   return TRUE;
 267 }
 268
 269 /*! \brief Create a new bindable key object.
 270  * \par Function Description
 271  * Create and return a new gschem key object from a \a keyval and a
 272  * set of \a modifiers.  If the key combination is invalid, return
 273  * SCM_BOOL_F.
 274  *
 275  * \param keyval     the pressed key.
 276  * \param modifiers  the active modifiers for the key.
 277  *
 278  * \return a new bindable key object, or SCM_BOOL_F.
 279  */
 280 static SCM
 281 g_make_key (guint keyval, GdkModifierType modifiers)
 282 {
 283   SCM result = SCM_BOOL_F;
 284   if (g_key_is_valid (keyval, modifiers)) {
 285     GschemKey *k = g_new0 (GschemKey, 1);
 286     k->keyval = keyval;
 287     k->modifiers = modifiers & GDK_MODIFIER_MASK;
 288     SCM_NEWSMOB (result, g_key_smob_tag, k);
 289   }
 290   return result;
 291 }
 292
 293 /*! \brief Test if a Scheme value is a bindable key object.
 294  * \par Function Description
 295  * Returns SCM_BOOL_T if \a key_s is a gschem key object.  Otherwise,
 296  * returns SCM_BOOL_F.
 297  *
 298  * \note Scheme API: Implements the %key? procedure in the
 299  * (gschem core keymap) module.
 300  *
 301  * \param key_s          value to test
 302  * \return SCM_BOOL_T iff value is a key, otherwise SCM_BOOL_F.
 303  */
 304 SCM_DEFINE (g_keyp, "%key?", 1, 0, 0, (SCM key_s),
 305             "Test if value is a gschem key.")
 306 {
 307   if (G_SCM_IS_KEY (key_s)) {
 308     return SCM_BOOL_T;
 309   } else {
 310     return SCM_BOOL_F;
 311   }
 312 }
 313
 314 /*! \brief Create a bindable key object from a string.
 315  * \par Function Description
 316  * Parse the string key description \a str_s to create and return a
 317  * new gschem key object.  If \a str_s contains syntax errors, or does
 318  * not represent a valid bindable key combination, returns SCM_BOOL_F.
 319  *
 320  * \note Scheme API: Implements the %string-key procedure in the
 321  * (gschem core keymap) module.
 322  *
 323  * \param str_s  string to parse.
 324  * \return a new gschem key object, or SCM_BOOL_F.
 325  */
 326 SCM_DEFINE (g_string_to_key, "%string->key", 1, 0, 0, (SCM str_s),
 327             "Create a gschem key by parsing a string.")
 328 {
 329   SCM_ASSERT (scm_is_string (str_s), str_s, SCM_ARG1, s_g_string_to_key);
 330
 331   guint keyval;
 332   GdkModifierType modifiers;
 333   char *str = scm_to_utf8_string (str_s);
 334   gtk_accelerator_parse (str, &keyval, &modifiers);
 335   if ((keyval == 0) && (modifiers == 0)) return SCM_BOOL_F;
 336   return g_make_key (keyval, modifiers);
 337 }
 338
 339 /*! \brief Convert a bindable key object to a string.
 340  * \par Function Description
 341  * Returns a string representation of the gschem key object \a key_s,
 342  * in a format suitable for parsing with %string->key.
 343  *
 344  * \note Scheme API: Implements the %key->string procedure in the
 345  * (gschem core keymap) module.
 346  *
 347  * \param key_s  Bindable key object to convert to string.
 348  * \return a string representation of the key combination.
 349  */
 350 SCM_DEFINE (g_key_to_string, "%key->string", 1, 0, 0, (SCM key_s),
 351             "Create a string from a gschem key.")
 352 {
 353   SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1, s_g_key_to_string);
 354
 355   GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
 356   if (key->str != NULL) return scm_from_utf8_string (key->str);
 357
 358   key->str = gtk_accelerator_name (key->keyval, key->modifiers);
 359   return scm_from_utf8_string (key->str);
 360 }
 361
 362 /*! \brief Convert a bindable key object to a displayable string.
 363  * \par Function Description
 364  * Returns a string representation of the gschem key object \a key_s,
 365  * in a format suitable for display to the user (e.g. as accelerator
 366  * text in a menu).
 367  *
 368  * \note Scheme API: Implements the %key->display-string procedure in
 369  * the (gschem core keymap) module.
 370  *
 371  * \param key_s  Bindable key object to convert to string.
 372  * \return a string representation of the key combination.
 373  */
 374 SCM_DEFINE (g_key_to_display_string, "%key->display-string", 1, 0, 0,
 375             (SCM key_s), "Create a display string from a gschem key.")
 376 {
 377   SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1,
 378               s_g_key_to_display_string);
 379
 380   GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
 381   if (key->disp_str != NULL) return scm_from_utf8_string (key->disp_str);
 382
 383   key->disp_str = gtk_accelerator_get_label (key->keyval, key->modifiers);
 384   return scm_from_utf8_string (key->disp_str);
 385 }
 386
 387 /*! \brief Print a representation of a key smob
 388  * \par Function Description
 389  * Outputs a string representing the \a smob to a Scheme output \a
 390  * port.  The format used is "#<gschem-key \"Ctrl+A\">".
 391  *
 392  * Used internally to Guile.
 393  */
 394 static int
 395 g_key_print (SCM smob, SCM port, scm_print_state *pstate)
 396 {
 397   scm_puts ("#<gschem-key ", port);
 398   scm_write (g_key_to_display_string (smob), port);
 399   scm_puts (">", port);
 400
 401   /* Non-zero means success */
 402   return 1;
 403 }
 404
 405 /* \brief Test if two key combinations are equivalent.
 406  * \par Function Description
 407  * Tests if the two gschem key objects \a a and \a b represent the
 408  * same key event.
 409  *
 410  * Used internally to Guile.
 411  */
 412 static SCM
 413 g_key_equalp (SCM a, SCM b)
 414 {
 415   GschemKey *akey = (GschemKey *) SCM_SMOB_DATA (a);
 416   GschemKey *bkey = (GschemKey *) SCM_SMOB_DATA (b);
 417   if (akey->keyval != bkey->keyval) return SCM_BOOL_F;
 418   if (akey->modifiers != bkey->modifiers) return SCM_BOOL_F;
 419   return SCM_BOOL_T;
 420 }
 421
 422 /* \brief Destroy a bindable key object
 423  * \par Function Description
 424  * Destroys the contents of a gschem key object on garbage collection.
 425  *
 426  * Used internally to Guile.
 427  */
 428 static size_t
 429 g_key_free (SCM key) {
 430   GschemKey *k = (GschemKey *) SCM_SMOB_DATA (key);
 431   g_free (k->str);
 432   g_free (k->disp_str);
 433   g_free (k);
 434   return 0;
 435 }
 436
 437 SCM_SYMBOL (reset_keys_sym, "reset-keys");
 438 SCM_SYMBOL (press_key_sym, "press-key");
 439 SCM_SYMBOL (prefix_sym, "prefix");
 440
 441 /*! \brief Clear the current key accelerator string.
 442  * \par Function Description
 443  * This function clears the current keyboard accelerator string in
 444  * the status bar of the relevant toplevel.  Called some time after a
 445  * keystroke is pressed.  If the current key sequence was a prefix,
 446  * let it persist.
 447  *
 448  * \param [in] data a pointer to the GSCHEM_TOPLEVEL to update.
 449  * \return FALSE (this is a one-shot timer).
 450  */
 451 static gboolean clear_keyaccel_string(gpointer data)
 452 {
 453   GSCHEM_TOPLEVEL *w_current = data;
 454
 455   /* If the window context has disappeared, do nothing. */
 456   if (g_list_find(global_window_list, w_current) == NULL) {
 457     return FALSE;
 458   }
 459
 460   g_free(w_current->keyaccel_string);
 461   w_current->keyaccel_string = NULL;
 462   w_current->keyaccel_string_source_id = 0;
 463   i_show_state(w_current, NULL);
 464   return FALSE;
 465 }
 466
 467 /*! \brief Reset the current key sequence.
 468  * \par Function Description
 469  * If any prefix keys are stored in the current key sequence, clears
 470  * them.
 471  *
 472  * \param w_current  The active #GSCHEM_TOPLEVEL context.
 473  */
 474 void
 475 g_keys_reset (GSCHEM_TOPLEVEL *w_current)
 476 {
 477   SCM s_expr = scm_list_1 (reset_keys_sym);
 478
 479   /* Reset the status bar */
 480   g_free (w_current->keyaccel_string);
 481   w_current->keyaccel_string = NULL;
 482   i_show_state(w_current, NULL);
 483
 484   /* Reset the Scheme keybinding state */
 485   scm_dynwind_begin (0);
 486   g_dynwind_window (w_current);
 487   g_scm_eval_protected (s_expr, scm_interaction_environment ());
 488   scm_dynwind_end ();
 489 }
 490
 491 /*! \brief Evaluate a user keystroke.
 492  * \par Function Description
 493  * Evaluates the key combination specified by \a event using the
 494  * current keymap.  Updates the gschem status bar with the current key
 495  * sequence.
 496  *
 497  * \param w_current  The active #GSCHEM_TOPLEVEL context.
 498  * \param event      A GdkEventKey structure.
 499  *
 500  * \return 1 if a binding was found for the keystroke, 0 otherwise.
 501  */
 502 int
 503 g_keys_execute(GSCHEM_TOPLEVEL *w_current, GdkEventKey *event)
 504 {
 505   SCM s_retval, s_key, s_expr;
 506   guint key, mods, upper, lower, caps;
 507   GdkDisplay *display;
 508   GdkKeymap *keymap;
 509   GdkModifierType consumed_modifiers;
 510
 511   g_return_val_if_fail (w_current != NULL, 0);
 512   g_return_val_if_fail (event != NULL, 0);
 513
 514   display = gtk_widget_get_display (w_current->main_window);
 515   keymap = gdk_keymap_get_for_display (display);
 516
 517   /* Figure out what modifiers went into determining the key symbol */
 518   gdk_keymap_translate_keyboard_state (keymap,
 519                                        event->hardware_keycode,
 520                                        event->state, event->group,
 521                                        NULL, NULL, NULL, &consumed_modifiers);
 522
 523   key = event->keyval;
 524   gdk_keyval_convert_case (event->keyval, &lower, &upper);
 525   mods = (event->state & gtk_accelerator_get_default_mod_mask ()
 526                 & ~consumed_modifiers);
 527
 528   /* Handle Caps Lock. The idea is to obtain the same keybindings
 529    * whether Caps Lock is enabled or not. */
 530   if (upper != lower) {
 531     caps = gdk_keymap_get_caps_lock_state (keymap);
 532     if ((caps && (key == lower)) || (!caps && (key == upper))) {
 533       mods |= GDK_SHIFT_MASK;
 534     }
 535   }
 536
 537   /* Always process key as lower case */
 538   key = lower;
 539
 540   /* Validate the key -- there are some keystrokes we mask out. */
 541   if (!g_key_is_valid (key, mods)) {
 542     return FALSE;
 543   }
 544
 545   /* Create Scheme key value */
 546   s_key = g_make_key (key, mods);
 547
 548   /* Update key hint string for status bar. */
 549   gchar *keystr = gtk_accelerator_get_label (key, mods);
 550
 551   /* If no current hint string, or the hint string is going to be
 552    * cleared anyway, use key string directly */
 553   if ((w_current->keyaccel_string == NULL) ||
 554       w_current->keyaccel_string_source_id) {
 555     g_free (w_current->keyaccel_string);
 556     w_current->keyaccel_string = keystr;
 557
 558   } else {
 559     gchar *p = w_current->keyaccel_string;
 560     w_current->keyaccel_string = g_strconcat (p, " ", keystr, NULL);
 561     g_free (p);
 562     g_free (keystr);
 563   }
 564
 565   /* Update status bar */
 566   i_show_state(w_current, NULL);
 567
 568   /* Build and evaluate Scheme expression. */
 569   scm_dynwind_begin (0);
 570   g_dynwind_window (w_current);
 571   s_expr = scm_list_2 (press_key_sym, s_key);
 572   s_retval = g_scm_eval_protected (s_expr, scm_interaction_environment ());
 573   scm_dynwind_end ();
 574
 575   /* If the keystroke was not part of a prefix, start a timer to clear
 576    * the status bar display. */
 577   if (w_current->keyaccel_string_source_id) {
 578     /* Cancel any existing timers that haven't fired yet. */
 579     GSource *timer =
 580       g_main_context_find_source_by_id (NULL,
 581                                         w_current->keyaccel_string_source_id);
 582     g_source_destroy (timer);
 583     w_current->keyaccel_string_source_id = 0;
 584   }
 585   if (!scm_is_eq (s_retval, prefix_sym)) {
 586     w_current->keyaccel_string_source_id =
 587       g_timeout_add(400, clear_keyaccel_string, w_current);
 588   }
 589
 590   return !scm_is_false (s_retval);
 591 }
 592
 593 /*! \brief Exports the keymap in Scheme to a GtkListStore
 594  *  \par Function Description
 595  *  This function converts the list of key sequence/action pairs
 596  *  returned by the Scheme function \c dump-global-keymap into a
 597  *  GtkListStore with two columns.  The first column contains the name
 598  *  of the action executed by the keybinding as a string, and the
 599  *  second contains the keybinding itself as a string suitable for
 600  *  display.
 601  *
 602  *  The returned value must be freed by caller.
 603  *
 604  *  \return A GtkListStore containing keymap data.
 605   */
 606 GtkListStore *
 607 g_keys_to_list_store (void)
 608 {
 609   SCM s_expr;
 610   SCM s_lst;
 611   SCM s_iter;
 612   GtkListStore *list_store;
 613
 614   /* Call Scheme procedure to dump global keymap into list */
 615   s_expr = scm_list_1 (scm_from_utf8_symbol ("dump-global-keymap"));
 616   s_lst = g_scm_eval_protected (s_expr, scm_interaction_environment ());
 617
 618   g_return_val_if_fail (scm_is_true (scm_list_p (s_lst)), NULL);
 619
 620   /* Convert to  */
 621   scm_dynwind_begin (0);
 622   list_store = gtk_list_store_new (2, G_TYPE_STRING, G_TYPE_STRING);
 623   scm_dynwind_unwind_handler (g_object_unref, list_store, 0);
 624
 625   for (s_iter = s_lst; !scm_is_null (s_iter); s_iter = scm_cdr (s_iter)) {
 626     SCM s_binding = scm_caar (s_iter);
 627     SCM s_keys = scm_cdar (s_iter);
 628     char *binding, *keys;
 629     GtkTreeIter iter;
 630
 631     scm_dynwind_begin (0);
 632
 633     binding = scm_to_utf8_string (s_binding);
 634     scm_dynwind_free (binding);
 635
 636     keys = scm_to_utf8_string (s_keys);
 637     scm_dynwind_free (keys);
 638
 639     gtk_list_store_insert_with_values (list_store, &iter, -1,
 640                                        0, binding,
 641                                        1, keys,
 642                                        -1);
 643
 644     scm_dynwind_end ();
 645   }
 646
 647   scm_dynwind_end ();
 648   return list_store;
 649 }
 650
 651 /*! \brief Create the (gschem core keymap) Scheme module
 652  * \par Function Description
 653  * Defines procedures in the (gschem core keymap) module.  The module
 654  * can be accessed using (use-modules (gschem core keymap)).
 655  */
 656 static void
 657 init_module_gschem_core_keymap ()
 658 {
 659   /* Register the functions */
 660   #include "g_keys.x"
 661
 662   /* Add them to the module's public definitions */
 663   scm_c_export (s_g_keyp, s_g_string_to_key, s_g_key_to_string,
 664                 s_g_key_to_display_string, NULL);
 665 }
 666
 667 /*! \brief Initialise the key combination procedures
 668  * \par Function Description
 669  * Registers some Scheme procedures for working with key combinations.
 670  * Should only be called by main_prog().
 671  */
 672 void
 673 g_init_keys ()
 674 {
 675   /* Register key smob type */
 676   g_key_smob_tag = scm_make_smob_type ("gschem-key", 0);
 677   scm_set_smob_print (g_key_smob_tag, g_key_print);
 678   scm_set_smob_equalp (g_key_smob_tag, g_key_equalp);
 679   scm_set_smob_free (g_key_smob_tag, g_key_free);
 680
 681   scm_c_define_module ("gschem core keymap",
 682                        init_module_gschem_core_keymap,
 683                        NULL);
 684 }
 685