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-2020 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
  22 #include <stdio.h>
  23 #include <sys/stat.h>
  24 #include <ctype.h>
  25 #ifdef HAVE_STRING_H
  26 #include <string.h>
  27 #endif
  28 #ifdef HAVE_STDLIB_H
  29 #include <stdlib.h>
  30 #endif
  31 #ifdef HAVE_UNISTD_H
  32 #include <unistd.h>
  33 #endif
  34
  35 #include "gschem.h"
  36
  37 #include <gdk/gdkkeysyms.h>
  38
  39
  40 /*! Contains the smob tag for key smobs */
  41 static scm_t_bits g_key_smob_tag;
  42 #define G_SCM_IS_KEY(x) SCM_SMOB_PREDICATE (g_key_smob_tag, (x))
  43
  44 /*! Type for keybindings. Used internally by gschem key smobs. */
  45 typedef struct {
  46   guint keyval;
  47   GdkModifierType modifiers;
  48   gchar *str; /* UTF-8. Free with g_free(). */
  49   gchar *disp_str; /* UTF-8. Free with g_free(). */
  50 } GschemKey;
  51
  52 /*! \brief Test if a key is valid.
  53  * \par Function Description
  54  * Test if the key combination defined by \a keyval and \a modifiers
  55  * is valid for key binding.  This is a less restrictive version of
  56  * gtk_accelerator_valid() from GTK 2.
  57  *
  58  * \param keyval     The key that was pressed.
  59  * \param modifiers  The active modifiers when the key was pressed.
  60  *
  61  * \return TRUE if the key combination is valid for keybinding.
  62  */
  63 static gboolean
  64 g_key_is_valid (guint keyval, GdkModifierType modifiers)
  65 {
  66   static const guint invalid_keyvals[] = {
  67     GDK_Shift_L, GDK_Shift_R, GDK_Shift_Lock, GDK_Caps_Lock, GDK_ISO_Lock,
  68     GDK_Control_L, GDK_Control_R, GDK_Meta_L, GDK_Meta_R,
  69     GDK_Alt_L, GDK_Alt_R, GDK_Super_L, GDK_Super_R, GDK_Hyper_L, GDK_Hyper_R,
  70     GDK_ISO_Level3_Shift, GDK_ISO_Next_Group, GDK_ISO_Prev_Group,
  71     GDK_ISO_First_Group, GDK_ISO_Last_Group,
  72     GDK_Mode_switch, GDK_Num_Lock, GDK_Multi_key,
  73     GDK_Scroll_Lock, GDK_Sys_Req,
  74     GDK_Tab, GDK_ISO_Left_Tab, GDK_KP_Tab,
  75     GDK_First_Virtual_Screen, GDK_Prev_Virtual_Screen,
  76     GDK_Next_Virtual_Screen, GDK_Last_Virtual_Screen,
  77     GDK_Terminate_Server, GDK_AudibleBell_Enable,
  78     0
  79   };
  80   const guint *val;
  81
  82   /* Exclude a bunch of control chars */
  83   if (keyval <= 0xFF) return keyval >= 0x20;
  84
  85   /* Exclude special & modifier keys */
  86   val = invalid_keyvals;
  87   while (*val) {
  88     if (keyval == *val++) return FALSE;
  89   }
  90
  91   return TRUE;
  92 }
  93
  94 /*! \brief Create a new bindable key object.
  95  * \par Function Description
  96  * Create and return a new gschem key object from a \a keyval and a
  97  * set of \a modifiers.  If the key combination is invalid, return
  98  * SCM_BOOL_F.
  99  *
 100  * \param keyval     the pressed key.
 101  * \param modifiers  the active modifiers for the key.
 102  *
 103  * \return a new bindable key object, or SCM_BOOL_F.
 104  */
 105 static SCM
 106 g_make_key (guint keyval, GdkModifierType modifiers)
 107 {
 108   SCM result = SCM_BOOL_F;
 109   if (g_key_is_valid (keyval, modifiers)) {
 110     GschemKey *k = g_new0 (GschemKey, 1);
 111     k->keyval = keyval;
 112     k->modifiers = modifiers & GDK_MODIFIER_MASK;
 113     SCM_NEWSMOB (result, g_key_smob_tag, k);
 114   }
 115   return result;
 116 }
 117
 118 /*! \brief Test if a Scheme value is a bindable key object.
 119  * \par Function Description
 120  * Returns SCM_BOOL_T if \a key_s is a gschem key object.  Otherwise,
 121  * returns SCM_BOOL_F.
 122  *
 123  * \note Scheme API: Implements the %key? procedure in the
 124  * (gschem core keymap) module.
 125  *
 126  * \param key_s          value to test
 127  * \return SCM_BOOL_T iff value is a key, otherwise SCM_BOOL_F.
 128  */
 129 SCM_DEFINE (g_keyp, "%key?", 1, 0, 0, (SCM key_s),
 130             "Test if value is a gschem key.")
 131 {
 132   if (G_SCM_IS_KEY (key_s)) {
 133     return SCM_BOOL_T;
 134   } else {
 135     return SCM_BOOL_F;
 136   }
 137 }
 138
 139 /*! \brief Create a bindable key object from a string.
 140  * \par Function Description
 141  * Parse the string key description \a str_s to create and return a
 142  * new gschem key object.  If \a str_s contains syntax errors, or does
 143  * not represent a valid bindable key combination, returns SCM_BOOL_F.
 144  *
 145  * \note Scheme API: Implements the %string-key procedure in the
 146  * (gschem core keymap) module.
 147  *
 148  * \param str_s  string to parse.
 149  * \return a new gschem key object, or SCM_BOOL_F.
 150  */
 151 SCM_DEFINE (g_string_to_key, "%string->key", 1, 0, 0, (SCM str_s),
 152             "Create a gschem key by parsing a string.")
 153 {
 154   SCM_ASSERT (scm_is_string (str_s), str_s, SCM_ARG1, s_g_string_to_key);
 155
 156   guint keyval;
 157   GdkModifierType modifiers;
 158   char *str = scm_to_utf8_string (str_s);
 159   gtk_accelerator_parse (str, &keyval, &modifiers);
 160   if ((keyval == 0) && (modifiers == 0)) return SCM_BOOL_F;
 161   return g_make_key (keyval, modifiers);
 162 }
 163
 164 /*! \brief Convert a bindable key object to a string.
 165  * \par Function Description
 166  * Returns a string representation of the gschem key object \a key_s,
 167  * in a format suitable for parsing with %string->key.
 168  *
 169  * \note Scheme API: Implements the %key->string procedure in the
 170  * (gschem core keymap) module.
 171  *
 172  * \param key_s  Bindable key object to convert to string.
 173  * \return a string representation of the key combination.
 174  */
 175 SCM_DEFINE (g_key_to_string, "%key->string", 1, 0, 0, (SCM key_s),
 176             "Create a string from a gschem key.")
 177 {
 178   SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1, s_g_key_to_string);
 179
 180   GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
 181   if (key->str != NULL) return scm_from_utf8_string (key->str);
 182
 183   key->str = gtk_accelerator_name (key->keyval, key->modifiers);
 184   return scm_from_utf8_string (key->str);
 185 }
 186
 187 /*! \brief Convert a bindable key object to a displayable string.
 188  * \par Function Description
 189  * Returns a string representation of the gschem key object \a key_s,
 190  * in a format suitable for display to the user (e.g. as accelerator
 191  * text in a menu).
 192  *
 193  * \note Scheme API: Implements the %key->display-string procedure in
 194  * the (gschem core keymap) module.
 195  *
 196  * \param key_s  Bindable key object to convert to string.
 197  * \return a string representation of the key combination.
 198  */
 199 SCM_DEFINE (g_key_to_display_string, "%key->display-string", 1, 0, 0,
 200             (SCM key_s), "Create a display string from a gschem key.")
 201 {
 202   SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1,
 203               s_g_key_to_display_string);
 204
 205   GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
 206   if (key->disp_str != NULL) return scm_from_utf8_string (key->disp_str);
 207
 208   key->disp_str = gtk_accelerator_get_label (key->keyval, key->modifiers);
 209   return scm_from_utf8_string (key->disp_str);
 210 }
 211
 212 /*! \brief Print a representation of a key smob
 213  * \par Function Description
 214  * Outputs a string representing the \a smob to a Scheme output \a
 215  * port.  The format used is "#<gschem-key \"Ctrl+A\">".
 216  *
 217  * Used internally to Guile.
 218  */
 219 static int
 220 g_key_print (SCM smob, SCM port, scm_print_state *pstate)
 221 {
 222   scm_puts ("#<gschem-key ", port);
 223   scm_write (g_key_to_display_string (smob), port);
 224   scm_puts (">", port);
 225
 226   /* Non-zero means success */
 227   return 1;
 228 }
 229
 230 /* \brief Test if two key combinations are equivalent.
 231  * \par Function Description
 232  * Tests if the two gschem key objects \a a and \a b represent the
 233  * same key event.
 234  *
 235  * Used internally to Guile.
 236  */
 237 static SCM
 238 g_key_equalp (SCM a, SCM b)
 239 {
 240   GschemKey *akey = (GschemKey *) SCM_SMOB_DATA (a);
 241   GschemKey *bkey = (GschemKey *) SCM_SMOB_DATA (b);
 242   if (akey->keyval != bkey->keyval) return SCM_BOOL_F;
 243   if (akey->modifiers != bkey->modifiers) return SCM_BOOL_F;
 244   return SCM_BOOL_T;
 245 }
 246
 247 /* \brief Destroy a bindable key object
 248  * \par Function Description
 249  * Destroys the contents of a gschem key object on garbage collection.
 250  *
 251  * Used internally to Guile.
 252  */
 253 static size_t
 254 g_key_free (SCM key) {
 255   GschemKey *k = (GschemKey *) SCM_SMOB_DATA (key);
 256   g_free (k->str);
 257   g_free (k->disp_str);
 258   g_free (k);
 259   return 0;
 260 }
 261
 262 SCM_SYMBOL (reset_keys_sym, "reset-keys");
 263 SCM_SYMBOL (press_key_sym, "press-key");
 264 SCM_SYMBOL (prefix_sym, "prefix");
 265
 266 /*! \brief Clear the current key accelerator string.
 267  * \par Function Description
 268  * This function clears the current keyboard accelerator string in
 269  * the status bar of the relevant toplevel.  Called some time after a
 270  * keystroke is pressed.  If the current key sequence was a prefix,
 271  * let it persist.
 272  *
 273  * \param [in] data a pointer to the GschemToplevel to update.
 274  * \return FALSE (this is a one-shot timer).
 275  */
 276 static gboolean clear_keyaccel_string(gpointer data)
 277 {
 278   GschemToplevel *w_current = data;
 279
 280   /* If the window context has disappeared, do nothing. */
 281   if (g_list_find(global_window_list, w_current) == NULL) {
 282     return FALSE;
 283   }
 284
 285   g_free(w_current->keyaccel_string);
 286   w_current->keyaccel_string = NULL;
 287   w_current->keyaccel_string_source_id = 0;
 288   i_show_state(w_current, NULL);
 289   return FALSE;
 290 }
 291
 292 /*! \brief Reset the current key sequence.
 293  * \par Function Description
 294  * If any prefix keys are stored in the current key sequence, clears
 295  * them.
 296  *
 297  * \param w_current  The active #GschemToplevel context.
 298  */
 299 void
 300 g_keys_reset (GschemToplevel *w_current)
 301 {
 302   SCM s_expr = scm_list_1 (reset_keys_sym);
 303
 304   /* Reset the status bar */
 305   g_free (w_current->keyaccel_string);
 306   w_current->keyaccel_string = NULL;
 307   i_show_state(w_current, NULL);
 308
 309   /* Reset the Scheme keybinding state */
 310   scm_dynwind_begin (0);
 311   g_dynwind_window (w_current);
 312   g_scm_eval_protected (s_expr, scm_interaction_environment ());
 313   scm_dynwind_end ();
 314 }
 315
 316 /*! \brief Evaluate a user keystroke.
 317  * \par Function Description
 318  * Evaluates the key combination specified by \a event using the
 319  * current keymap.  Updates the gschem status bar with the current key
 320  * sequence.
 321  *
 322  * \param w_current  The active #GschemToplevel context.
 323  * \param event      A GdkEventKey structure.
 324  *
 325  * \return 1 if a binding was found for the keystroke, 0 otherwise.
 326  */
 327 int
 328 g_keys_execute(GschemToplevel *w_current, GdkEventKey *event)
 329 {
 330   SCM s_retval, s_key, s_expr;
 331   guint key, mods, upper, lower, caps;
 332   GdkDisplay *display;
 333   GdkKeymap *keymap;
 334   GdkModifierType consumed_modifiers;
 335
 336   g_return_val_if_fail (w_current != NULL, 0);
 337   g_return_val_if_fail (event != NULL, 0);
 338
 339   display = gtk_widget_get_display (w_current->main_window);
 340   keymap = gdk_keymap_get_for_display (display);
 341
 342   /* Figure out what modifiers went into determining the key symbol */
 343   gdk_keymap_translate_keyboard_state (keymap,
 344                                        event->hardware_keycode,
 345                                        event->state, event->group,
 346                                        NULL, NULL, NULL, &consumed_modifiers);
 347
 348   key = event->keyval;
 349   gdk_keyval_convert_case (event->keyval, &lower, &upper);
 350   mods = (event->state & gtk_accelerator_get_default_mod_mask ()
 351                 & ~consumed_modifiers);
 352
 353   /* Handle Caps Lock. The idea is to obtain the same keybindings
 354    * whether Caps Lock is enabled or not. */
 355   if (upper != lower) {
 356     caps = gdk_keymap_get_caps_lock_state (keymap);
 357     if ((caps && (key == lower)) || (!caps && (key == upper))) {
 358       mods |= GDK_SHIFT_MASK;
 359     }
 360   }
 361
 362   /* Always process key as lower case */
 363   key = lower;
 364
 365   /* Validate the key -- there are some keystrokes we mask out. */
 366   if (!g_key_is_valid (key, mods)) {
 367     return FALSE;
 368   }
 369
 370   /* Create Scheme key value */
 371   s_key = g_make_key (key, mods);
 372
 373   /* Update key hint string for status bar. */
 374   gchar *keystr = gtk_accelerator_get_label (key, mods);
 375
 376   /* If no current hint string, or the hint string is going to be
 377    * cleared anyway, use key string directly */
 378   if ((w_current->keyaccel_string == NULL) ||
 379       w_current->keyaccel_string_source_id) {
 380     g_free (w_current->keyaccel_string);
 381     w_current->keyaccel_string = keystr;
 382
 383   } else {
 384     gchar *p = w_current->keyaccel_string;
 385     w_current->keyaccel_string = g_strconcat (p, " ", keystr, NULL);
 386     g_free (p);
 387     g_free (keystr);
 388   }
 389
 390   /* Update status bar */
 391   i_show_state(w_current, NULL);
 392
 393   /* Build and evaluate Scheme expression. */
 394   scm_dynwind_begin (0);
 395   g_dynwind_window (w_current);
 396   s_expr = scm_list_2 (press_key_sym, s_key);
 397   s_retval = g_scm_eval_protected (s_expr, scm_interaction_environment ());
 398   scm_dynwind_end ();
 399
 400   /* only start timer if window wasn't destroyed during the action */
 401   if (g_list_find (global_window_list, w_current) != NULL) {
 402     /* If the keystroke was not part of a prefix, start a timer to clear
 403      * the status bar display. */
 404     if (w_current->keyaccel_string_source_id) {
 405       /* Cancel any existing timers that haven't fired yet. */
 406       GSource *timer =
 407         g_main_context_find_source_by_id (NULL,
 408                                           w_current->keyaccel_string_source_id);
 409       g_source_destroy (timer);
 410       w_current->keyaccel_string_source_id = 0;
 411     }
 412     if (!scm_is_eq (s_retval, prefix_sym)) {
 413       w_current->keyaccel_string_source_id =
 414         g_timeout_add(400, clear_keyaccel_string, w_current);
 415     }
 416   }
 417
 418   return !scm_is_false (s_retval);
 419 }
 420
 421 /*! \brief Create the (gschem core keymap) Scheme module
 422  * \par Function Description
 423  * Defines procedures in the (gschem core keymap) module.  The module
 424  * can be accessed using (use-modules (gschem core keymap)).
 425  */
 426 static void
 427 init_module_gschem_core_keymap ()
 428 {
 429   /* Register the functions */
 430   #include "g_keys.x"
 431
 432   /* Add them to the module's public definitions */
 433   scm_c_export (s_g_keyp, s_g_string_to_key, s_g_key_to_string,
 434                 s_g_key_to_display_string, NULL);
 435 }
 436
 437 /*! \brief Initialise the key combination procedures
 438  * \par Function Description
 439  * Registers some Scheme procedures for working with key combinations.
 440  * Should only be called by main_prog().
 441  */
 442 void
 443 g_init_keys ()
 444 {
 445   /* Register key smob type */
 446   g_key_smob_tag = scm_make_smob_type ("gschem-key", 0);
 447   scm_set_smob_print (g_key_smob_tag, g_key_print);
 448   scm_set_smob_equalp (g_key_smob_tag, g_key_equalp);
 449   scm_set_smob_free (g_key_smob_tag, g_key_free);
 450
 451   scm_c_define_module ("gschem core keymap",
 452                        init_module_gschem_core_keymap,
 453                        NULL);
 454 }
 455