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_close)
 159 DEFINE_G_KEYS(page_revert)
 160 DEFINE_G_KEYS(page_print)
 161 DEFINE_G_KEYS(add_component)
 162 DEFINE_G_KEYS(add_attribute)
 163 DEFINE_G_KEYS(add_net)
 164 DEFINE_G_KEYS(add_bus)
 165 DEFINE_G_KEYS(add_text)
 166 DEFINE_G_KEYS(add_line)
 167 DEFINE_G_KEYS(add_path)
 168 DEFINE_G_KEYS(add_box)
 169 DEFINE_G_KEYS(add_picture)
 170 DEFINE_G_KEYS(add_circle)
 171 DEFINE_G_KEYS(add_arc)
 172 DEFINE_G_KEYS(add_pin)
 173 DEFINE_G_KEYS(hierarchy_down_schematic)
 174 DEFINE_G_KEYS(hierarchy_down_symbol)
 175 DEFINE_G_KEYS(hierarchy_up)
 176 DEFINE_G_KEYS(attributes_attach)
 177 DEFINE_G_KEYS(attributes_detach)
 178 DEFINE_G_KEYS(attributes_show_name)
 179 DEFINE_G_KEYS(attributes_show_value)
 180 DEFINE_G_KEYS(attributes_show_both)
 181 DEFINE_G_KEYS(attributes_visibility_toggle)
 182
 183 /* i_callback_script_console is not currently implemented */
 184 DEFINE_G_KEYS(script_console)
 185
 186 /* repeat last command doesn't make sense on options either??? (does
 187  * it?) */
 188 DEFINE_G_KEYS(options_text_size)
 189
 190 /* repeat last command doesn't make sense on options either??? (does
 191  * it?) */
 192 DEFINE_G_KEYS(options_afeedback)
 193 DEFINE_G_KEYS(options_grid)
 194 DEFINE_G_KEYS(options_snap)
 195 DEFINE_G_KEYS(options_snap_size)
 196 DEFINE_G_KEYS(options_scale_up_snap_size)
 197 DEFINE_G_KEYS(options_scale_down_snap_size)
 198 DEFINE_G_KEYS(options_rubberband)
 199 DEFINE_G_KEYS(options_magneticnet)
 200 DEFINE_G_KEYS(options_show_log_window)
 201 DEFINE_G_KEYS(options_show_coord_window)
 202
 203 DEFINE_G_KEYS(help_about)
 204 DEFINE_G_KEYS(help_hotkeys)
 205
 206 /* be sure that you don't use the widget parameter in this one, since it is
 207 being called with a null, I suppose we should call it with the right param.
 208 hack */
 209 DEFINE_G_KEYS(cancel)
 210
 211 /*! Contains the smob tag for key smobs */
 212 static scm_t_bits g_key_smob_tag;
 213 #define G_SCM_IS_KEY(x) SCM_SMOB_PREDICATE (g_key_smob_tag, (x))
 214
 215 /*! Type for keybindings. Used internally by gschem key smobs. */
 216 typedef struct {
 217   guint keyval;
 218   GdkModifierType modifiers;
 219   gchar *str; /* UTF-8. Free with g_free(). */
 220   gchar *disp_str; /* UTF-8. Free with g_free(). */
 221 } GschemKey;
 222
 223 /*! \brief Test if a key is valid.
 224  * \par Function Description
 225  * Test if the key combination defined by \a keyval and \a modifiers
 226  * is valid for key binding.  This is a less restrictive version of
 227  * gtk_accelerator_valid() from GTK 2.
 228  *
 229  * \param keyval     The key that was pressed.
 230  * \param modifiers  The active modifiers when the key was pressed.
 231  *
 232  * \return TRUE if the key combination is valid for keybinding.
 233  */
 234 static gboolean
 235 g_key_is_valid (guint keyval, GdkModifierType modifiers)
 236 {
 237   static const guint invalid_keyvals[] = {
 238     GDK_Shift_L, GDK_Shift_R, GDK_Shift_Lock, GDK_Caps_Lock, GDK_ISO_Lock,
 239     GDK_Control_L, GDK_Control_R, GDK_Meta_L, GDK_Meta_R,
 240     GDK_Alt_L, GDK_Alt_R, GDK_Super_L, GDK_Super_R, GDK_Hyper_L, GDK_Hyper_R,
 241     GDK_ISO_Level3_Shift, GDK_ISO_Next_Group, GDK_ISO_Prev_Group,
 242     GDK_ISO_First_Group, GDK_ISO_Last_Group,
 243     GDK_Mode_switch, GDK_Num_Lock, GDK_Multi_key,
 244     GDK_Scroll_Lock, GDK_Sys_Req,
 245     GDK_Tab, GDK_ISO_Left_Tab, GDK_KP_Tab,
 246     GDK_First_Virtual_Screen, GDK_Prev_Virtual_Screen,
 247     GDK_Next_Virtual_Screen, GDK_Last_Virtual_Screen,
 248     GDK_Terminate_Server, GDK_AudibleBell_Enable,
 249     0
 250   };
 251   const guint *val;
 252
 253   /* Exclude a bunch of control chars */
 254   if (keyval <= 0xFF) return keyval >= 0x20;
 255
 256   /* Exclude special & modifier keys */
 257   val = invalid_keyvals;
 258   while (*val) {
 259     if (keyval == *val++) return FALSE;
 260   }
 261
 262   return TRUE;
 263 }
 264
 265 /*! \brief Create a new bindable key object.
 266  * \par Function Description
 267  * Create and return a new gschem key object from a \a keyval and a
 268  * set of \a modifiers.  If the key combination is invalid, return
 269  * SCM_BOOL_F.
 270  *
 271  * \param keyval     the pressed key.
 272  * \param modifiers  the active modifiers for the key.
 273  *
 274  * \return a new bindable key object, or SCM_BOOL_F.
 275  */
 276 static SCM
 277 g_make_key (guint keyval, GdkModifierType modifiers)
 278 {
 279   SCM result = SCM_BOOL_F;
 280   if (g_key_is_valid (keyval, modifiers)) {
 281     GschemKey *k = g_new0 (GschemKey, 1);
 282     k->keyval = keyval;
 283     k->modifiers = modifiers & GDK_MODIFIER_MASK;
 284     SCM_NEWSMOB (result, g_key_smob_tag, k);
 285   }
 286   return result;
 287 }
 288
 289 /*! \brief Test if a Scheme value is a bindable key object.
 290  * \par Function Description
 291  * Returns SCM_BOOL_T if \a key_s is a gschem key object.  Otherwise,
 292  * returns SCM_BOOL_F.
 293  *
 294  * \note Scheme API: Implements the %key? procedure in the
 295  * (gschem core keymap) module.
 296  *
 297  * \param key_s          value to test
 298  * \return SCM_BOOL_T iff value is a key, otherwise SCM_BOOL_F.
 299  */
 300 SCM_DEFINE (g_keyp, "%key?", 1, 0, 0, (SCM key_s),
 301             "Test if value is a gschem key.")
 302 {
 303   if (G_SCM_IS_KEY (key_s)) {
 304     return SCM_BOOL_T;
 305   } else {
 306     return SCM_BOOL_F;
 307   }
 308 }
 309
 310 /*! \brief Create a bindable key object from a string.
 311  * \par Function Description
 312  * Parse the string key description \a str_s to create and return a
 313  * new gschem key object.  If \a str_s contains syntax errors, or does
 314  * not represent a valid bindable key combination, returns SCM_BOOL_F.
 315  *
 316  * \note Scheme API: Implements the %string-key procedure in the
 317  * (gschem core keymap) module.
 318  *
 319  * \param str_s  string to parse.
 320  * \return a new gschem key object, or SCM_BOOL_F.
 321  */
 322 SCM_DEFINE (g_string_to_key, "%string->key", 1, 0, 0, (SCM str_s),
 323             "Create a gschem key by parsing a string.")
 324 {
 325   SCM_ASSERT (scm_is_string (str_s), str_s, SCM_ARG1, s_g_string_to_key);
 326
 327   guint keyval;
 328   GdkModifierType modifiers;
 329   char *str = scm_to_utf8_string (str_s);
 330   gtk_accelerator_parse (str, &keyval, &modifiers);
 331   if ((keyval == 0) && (modifiers == 0)) return SCM_BOOL_F;
 332   return g_make_key (keyval, modifiers);
 333 }
 334
 335 /*! \brief Convert a bindable key object to a string.
 336  * \par Function Description
 337  * Returns a string representation of the gschem key object \a key_s,
 338  * in a format suitable for parsing with %string->key.
 339  *
 340  * \note Scheme API: Implements the %key->string procedure in the
 341  * (gschem core keymap) module.
 342  *
 343  * \param key_s  Bindable key object to convert to string.
 344  * \return a string representation of the key combination.
 345  */
 346 SCM_DEFINE (g_key_to_string, "%key->string", 1, 0, 0, (SCM key_s),
 347             "Create a string from a gschem key.")
 348 {
 349   SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1, s_g_key_to_string);
 350
 351   GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
 352   if (key->str != NULL) return scm_from_utf8_string (key->str);
 353
 354   key->str = gtk_accelerator_name (key->keyval, key->modifiers);
 355   return scm_from_utf8_string (key->str);
 356 }
 357
 358 /*! \brief Convert a bindable key object to a displayable string.
 359  * \par Function Description
 360  * Returns a string representation of the gschem key object \a key_s,
 361  * in a format suitable for display to the user (e.g. as accelerator
 362  * text in a menu).
 363  *
 364  * \note Scheme API: Implements the %key->display-string procedure in
 365  * the (gschem core keymap) module.
 366  *
 367  * \param key_s  Bindable key object to convert to string.
 368  * \return a string representation of the key combination.
 369  */
 370 SCM_DEFINE (g_key_to_display_string, "%key->display-string", 1, 0, 0,
 371             (SCM key_s), "Create a display string from a gschem key.")
 372 {
 373   SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1,
 374               s_g_key_to_display_string);
 375
 376   GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
 377   if (key->disp_str != NULL) return scm_from_utf8_string (key->disp_str);
 378
 379   key->disp_str = gtk_accelerator_get_label (key->keyval, key->modifiers);
 380   return scm_from_utf8_string (key->disp_str);
 381 }
 382
 383 /*! \brief Print a representation of a key smob
 384  * \par Function Description
 385  * Outputs a string representing the \a smob to a Scheme output \a
 386  * port.  The format used is "#<gschem-key \"Ctrl+A\">".
 387  *
 388  * Used internally to Guile.
 389  */
 390 static int
 391 g_key_print (SCM smob, SCM port, scm_print_state *pstate)
 392 {
 393   scm_puts ("#<gschem-key ", port);
 394   scm_write (g_key_to_display_string (smob), port);
 395   scm_puts (">", port);
 396
 397   /* Non-zero means success */
 398   return 1;
 399 }
 400
 401 /* \brief Test if two key combinations are equivalent.
 402  * \par Function Description
 403  * Tests if the two gschem key objects \a a and \a b represent the
 404  * same key event.
 405  *
 406  * Used internally to Guile.
 407  */
 408 static SCM
 409 g_key_equalp (SCM a, SCM b)
 410 {
 411   GschemKey *akey = (GschemKey *) SCM_SMOB_DATA (a);
 412   GschemKey *bkey = (GschemKey *) SCM_SMOB_DATA (b);
 413   if (akey->keyval != bkey->keyval) return SCM_BOOL_F;
 414   if (akey->modifiers != bkey->modifiers) return SCM_BOOL_F;
 415   return SCM_BOOL_T;
 416 }
 417
 418 /* \brief Destroy a bindable key object
 419  * \par Function Description
 420  * Destroys the contents of a gschem key object on garbage collection.
 421  *
 422  * Used internally to Guile.
 423  */
 424 static size_t
 425 g_key_free (SCM key) {
 426   GschemKey *k = (GschemKey *) SCM_SMOB_DATA (key);
 427   g_free (k->str);
 428   g_free (k->disp_str);
 429   g_free (k);
 430   return 0;
 431 }
 432
 433 SCM_SYMBOL (reset_keys_sym, "reset-keys");
 434 SCM_SYMBOL (press_key_sym, "press-key");
 435 SCM_SYMBOL (prefix_sym, "prefix");
 436
 437 /*! \brief Clear the current key accelerator string.
 438  * \par Function Description
 439  * This function clears the current keyboard accelerator string in
 440  * the status bar of the relevant toplevel.  Called some time after a
 441  * keystroke is pressed.  If the current key sequence was a prefix,
 442  * let it persist.
 443  *
 444  * \param [in] data a pointer to the GSCHEM_TOPLEVEL to update.
 445  * \return FALSE (this is a one-shot timer).
 446  */
 447 static gboolean clear_keyaccel_string(gpointer data)
 448 {
 449   GSCHEM_TOPLEVEL *w_current = data;
 450
 451   /* If the window context has disappeared, do nothing. */
 452   if (g_list_find(global_window_list, w_current) == NULL) {
 453     return FALSE;
 454   }
 455
 456   g_free(w_current->keyaccel_string);
 457   w_current->keyaccel_string = NULL;
 458   w_current->keyaccel_string_source_id = 0;
 459   i_show_state(w_current, NULL);
 460   return FALSE;
 461 }
 462
 463 /*! \brief Reset the current key sequence.
 464  * \par Function Description
 465  * If any prefix keys are stored in the current key sequence, clears
 466  * them.
 467  *
 468  * \param w_current  The active #GSCHEM_TOPLEVEL context.
 469  */
 470 void
 471 g_keys_reset (GSCHEM_TOPLEVEL *w_current)
 472 {
 473   SCM s_expr = scm_list_1 (reset_keys_sym);
 474
 475   /* Reset the status bar */
 476   g_free (w_current->keyaccel_string);
 477   w_current->keyaccel_string = NULL;
 478   i_show_state(w_current, NULL);
 479
 480   /* Reset the Scheme keybinding state */
 481   scm_dynwind_begin (0);
 482   g_dynwind_window (w_current);
 483   g_scm_eval_protected (s_expr, scm_interaction_environment ());
 484   scm_dynwind_end ();
 485 }
 486
 487 /*! \brief Evaluate a user keystroke.
 488  * \par Function Description
 489  * Evaluates the key combination specified by \a event using the
 490  * current keymap.  Updates the gschem status bar with the current key
 491  * sequence.
 492  *
 493  * \param w_current  The active #GSCHEM_TOPLEVEL context.
 494  * \param event      A GdkEventKey structure.
 495  *
 496  * \return 1 if a binding was found for the keystroke, 0 otherwise.
 497  */
 498 int
 499 g_keys_execute(GSCHEM_TOPLEVEL *w_current, GdkEventKey *event)
 500 {
 501   SCM s_retval, s_key, s_expr;
 502   guint key, mods, upper, lower, caps;
 503   GdkDisplay *display;
 504   GdkKeymap *keymap;
 505   GdkModifierType consumed_modifiers;
 506
 507   g_return_val_if_fail (w_current != NULL, 0);
 508   g_return_val_if_fail (event != NULL, 0);
 509
 510   display = gtk_widget_get_display (w_current->main_window);
 511   keymap = gdk_keymap_get_for_display (display);
 512
 513   /* Figure out what modifiers went into determining the key symbol */
 514   gdk_keymap_translate_keyboard_state (keymap,
 515                                        event->hardware_keycode,
 516                                        event->state, event->group,
 517                                        NULL, NULL, NULL, &consumed_modifiers);
 518
 519   key = event->keyval;
 520   gdk_keyval_convert_case (event->keyval, &lower, &upper);
 521   mods = (event->state & gtk_accelerator_get_default_mod_mask ()
 522                 & ~consumed_modifiers);
 523
 524   /* Handle Caps Lock. The idea is to obtain the same keybindings
 525    * whether Caps Lock is enabled or not. */
 526   if (upper != lower) {
 527     caps = gdk_keymap_get_caps_lock_state (keymap);
 528     if ((caps && (key == lower)) || (!caps && (key == upper))) {
 529       mods |= GDK_SHIFT_MASK;
 530     }
 531   }
 532
 533   /* Always process key as lower case */
 534   key = lower;
 535
 536   /* Validate the key -- there are some keystrokes we mask out. */
 537   if (!g_key_is_valid (key, mods)) {
 538     return FALSE;
 539   }
 540
 541   /* Create Scheme key value */
 542   s_key = g_make_key (key, mods);
 543
 544   /* Update key hint string for status bar. */
 545   gchar *keystr = gtk_accelerator_get_label (key, mods);
 546
 547   /* If no current hint string, or the hint string is going to be
 548    * cleared anyway, use key string directly */
 549   if ((w_current->keyaccel_string == NULL) ||
 550       w_current->keyaccel_string_source_id) {
 551     g_free (w_current->keyaccel_string);
 552     w_current->keyaccel_string = keystr;
 553
 554   } else {
 555     gchar *p = w_current->keyaccel_string;
 556     w_current->keyaccel_string = g_strconcat (p, " ", keystr, NULL);
 557     g_free (p);
 558     g_free (keystr);
 559   }
 560
 561   /* Update status bar */
 562   i_show_state(w_current, NULL);
 563
 564   /* Build and evaluate Scheme expression. */
 565   scm_dynwind_begin (0);
 566   g_dynwind_window (w_current);
 567   s_expr = scm_list_2 (press_key_sym, s_key);
 568   s_retval = g_scm_eval_protected (s_expr, scm_interaction_environment ());
 569   scm_dynwind_end ();
 570
 571   /* If the keystroke was not part of a prefix, start a timer to clear
 572    * the status bar display. */
 573   if (w_current->keyaccel_string_source_id) {
 574     /* Cancel any existing timers that haven't fired yet. */
 575     GSource *timer =
 576       g_main_context_find_source_by_id (NULL,
 577                                         w_current->keyaccel_string_source_id);
 578     g_source_destroy (timer);
 579     w_current->keyaccel_string_source_id = 0;
 580   }
 581   if (!scm_is_eq (s_retval, prefix_sym)) {
 582     w_current->keyaccel_string_source_id =
 583       g_timeout_add(400, clear_keyaccel_string, w_current);
 584   }
 585
 586   return !scm_is_false (s_retval);
 587 }
 588
 589 /*! \brief Exports the keymap in Scheme to a GtkListStore
 590  *  \par Function Description
 591  *  This function converts the list of key sequence/action pairs
 592  *  returned by the Scheme function \c dump-global-keymap into a
 593  *  GtkListStore with two columns.  The first column contains the name
 594  *  of the action executed by the keybinding as a string, and the
 595  *  second contains the keybinding itself as a string suitable for
 596  *  display.
 597  *
 598  *  The returned value must be freed by caller.
 599  *
 600  *  \return A GtkListStore containing keymap data.
 601   */
 602 GtkListStore *
 603 g_keys_to_list_store (void)
 604 {
 605   SCM s_expr;
 606   SCM s_lst;
 607   SCM s_iter;
 608   GtkListStore *list_store;
 609
 610   /* Call Scheme procedure to dump global keymap into list */
 611   s_expr = scm_list_1 (scm_from_utf8_symbol ("dump-global-keymap"));
 612   s_lst = g_scm_eval_protected (s_expr, scm_interaction_environment ());
 613
 614   g_return_val_if_fail (scm_is_true (scm_list_p (s_lst)), NULL);
 615
 616   /* Convert to  */
 617   scm_dynwind_begin (0);
 618   list_store = gtk_list_store_new (2, G_TYPE_STRING, G_TYPE_STRING);
 619   scm_dynwind_unwind_handler (g_object_unref, list_store, 0);
 620
 621   for (s_iter = s_lst; !scm_is_null (s_iter); s_iter = scm_cdr (s_iter)) {
 622     SCM s_binding = scm_caar (s_iter);
 623     SCM s_keys = scm_cdar (s_iter);
 624     char *binding, *keys;
 625     GtkTreeIter iter;
 626
 627     scm_dynwind_begin (0);
 628
 629     binding = scm_to_utf8_string (s_binding);
 630     scm_dynwind_free (binding);
 631
 632     keys = scm_to_utf8_string (s_keys);
 633     scm_dynwind_free (keys);
 634
 635     gtk_list_store_insert_with_values (list_store, &iter, -1,
 636                                        0, binding,
 637                                        1, keys,
 638                                        -1);
 639
 640     scm_dynwind_end ();
 641   }
 642
 643   scm_dynwind_end ();
 644   return list_store;
 645 }
 646
 647 /*! \brief Create the (gschem core keymap) Scheme module
 648  * \par Function Description
 649  * Defines procedures in the (gschem core keymap) module.  The module
 650  * can be accessed using (use-modules (gschem core keymap)).
 651  */
 652 static void
 653 init_module_gschem_core_keymap ()
 654 {
 655   /* Register the functions */
 656   #include "g_keys.x"
 657
 658   /* Add them to the module's public definitions */
 659   scm_c_export (s_g_keyp, s_g_string_to_key, s_g_key_to_string,
 660                 s_g_key_to_display_string, NULL);
 661 }
 662
 663 /*! \brief Initialise the key combination procedures
 664  * \par Function Description
 665  * Registers some Scheme procedures for working with key combinations.
 666  * Should only be called by main_prog().
 667  */
 668 void
 669 g_init_keys ()
 670 {
 671   /* Register key smob type */
 672   g_key_smob_tag = scm_make_smob_type ("gschem-key", 0);
 673   scm_set_smob_print (g_key_smob_tag, g_key_print);
 674   scm_set_smob_equalp (g_key_smob_tag, g_key_equalp);
 675   scm_set_smob_free (g_key_smob_tag, g_key_free);
 676
 677   scm_c_define_module ("gschem core keymap",
 678                        init_module_gschem_core_keymap,
 679                        NULL);
 680 }
 681