[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: gaf.git: branch: master updated (1.7.1-20110619-197-g61c6201)
The branch, master has been updated
via 61c6201ef1b07f3f9d8c76fb2ffa725c142bdf2a (commit)
via ef8cf3e9cd75779d17927c5a4ce51104d42a0ada (commit)
via 70be3926b8f0604faadbe59651a1a7384fddb873 (commit)
via 54bb85c55e147a0222a41f415e3200194d3e70ac (commit)
via d29eb4d67b08065be7e7961725d9b40a234ef1f7 (commit)
via 675c01fe262c1bbc912a43a74c3c96ca78dc88e2 (commit)
via 5a3917a2fe89a1b3e43d0fe9f7ee6a466f65e57c (commit)
via b34be3c923c680efac20e3fafc68f9f820eb7255 (commit)
from 579fbb4828a71ae2c78f270c3e7d1779c52e8997 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
=========
Summary
=========
NEWS | 24 ++
docs/scheme-api/geda-scheme.texi | 151 ++++++++++
gschem/include/prototype.h | 5 +-
gschem/lib/system-gschemrc.scm | 383 ++++++++++++-------------
gschem/scheme/Makefile.am | 3 +-
gschem/scheme/gschem.scm | 224 ++++++--------
gschem/scheme/gschem/deprecated.scm | 2 +-
gschem/scheme/gschem/keymap.scm | 194 ++++++++++++
gschem/src/Makefile.am | 1 +
gschem/src/g_keys.c | 561 ++++++++++++++++++++++++++---------
gschem/src/gschem.c | 9 +-
gschem/src/x_dialog.c | 31 +--
gschem/src/x_event.c | 3 +-
gschem/src/x_menus.c | 15 +-
14 files changed, 1100 insertions(+), 506 deletions(-)
create mode 100644 gschem/scheme/gschem/keymap.scm
=================
Commit Messages
=================
commit 61c6201ef1b07f3f9d8c76fb2ffa725c142bdf2a
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
Update NEWS.
:100644 100644 eca4ac8... c03e9af... M NEWS
commit ef8cf3e9cd75779d17927c5a4ce51104d42a0ada
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Use new keymaps.
Modify gschem to use the new keymaps throughout. This is a fairly
intrusive change, requiring changes to the keybinding syntax for
configuration files. The new syntax one is *much* simpler and easier
to understand for people who are not familiar to Scheme, and lends
itself well to modifications in user and local gschemrc files.
Major improvements include:
* gschem now behaves properly when the user accidentally hits Caps
Lock. This has been a source of great annoyance to me in the past,
when gschem would stop responding to keystrokes for no obvious
reason, only for me to realise that Caps Lock was on. Now
keybindings ignore Caps Lock entirely.
* Menus now show the same symbols as should appear on a user's
keyboard, instead of raw X keynames. This is much more accessible
and user-friendly than having to remember which bracket
"bracketright" refers to.
* The heavy lifting of parsing key specification strings, and of
converting keystrokes to a correctly-internationalised
representation for display, is now carried out by GTK+. This also
cheaply provides support for extended modifiers such as Super
("Windows" key on most keyboards).
* Changing the keybinding to show documentation to "Ctrl+D"
is now as simple as adding:
(global-set-key "<Ctrl>D" 'hierarchy-documentation)
to my "~/.gEDA/gschemrc", rather than some more complex Scheme code
to patch it correctly into the tree constructed by
"system-gschemrc".
:100644 100644 34cc2de... eca4ac8... M NEWS
:100644 100644 089adf2... b55c4c8... M gschem/include/prototype.h
:100644 100644 cc2dc1e... 6008dc5... M gschem/lib/system-gschemrc.scm
:100644 100644 d4ee404... db19279... M gschem/scheme/gschem.scm
:100644 100644 f3a4177... 45bd971... M gschem/src/g_keys.c
:100644 100644 3c673c7... c596174... M gschem/src/x_dialog.c
:100644 100644 6f130e6... 58dfe28... M gschem/src/x_event.c
:100644 100644 595b1a3... a02e94a... M gschem/src/x_menus.c
commit 70be3926b8f0604faadbe59651a1a7384fddb873
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Load `gschem.scm' earlier in boot process.
`gschem.scm' provides several core services to gschem, particularly
w.r.t. key- and stroke-bindings. Since rc files may wish to override
or make use of these functions, gschem.scm needs to be loaded *before*
the rc files are.
:100644 100644 93b3e64... f2776a0... M gschem/src/gschem.c
commit 54bb85c55e147a0222a41f415e3200194d3e70ac
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Recursive keymaps.
Adds the bind-keys! and lookup-keys functions, which are
used to work with key sequences and sub-keymaps.
:100644 100644 6f38597... 5b2068b... M docs/scheme-api/geda-scheme.texi
:100644 100644 dada972... db17842... M gschem/scheme/gschem/keymap.scm
commit d29eb4d67b08065be7e7961725d9b40a234ef1f7
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Basic keymaps.
Adds a basic keymap type. A keymap maps key combinations to "bindable
objects", which at the moment are expected (but not required) to be
thunks or other keymaps.
:100644 100644 4edf37f... 6f38597... M docs/scheme-api/geda-scheme.texi
:100644 100644 e2b87f0... dada972... M gschem/scheme/gschem/keymap.scm
commit 675c01fe262c1bbc912a43a74c3c96ca78dc88e2
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Key sequences.
Adds some Scheme API functions for working with key sequences. A key
sequence is a vector of key combinations.
:100644 100644 84dd13f... 4edf37f... M docs/scheme-api/geda-scheme.texi
:100644 100644 6fddb0f... e2b87f0... M gschem/scheme/gschem/keymap.scm
commit 5a3917a2fe89a1b3e43d0fe9f7ee6a466f65e57c
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Key combinations as first-class objects.
Adds a new Scheme type to gschem that represents a key combination
(e.g. Ctrl+Shift+A). The interface for working with them simply wraps
the GTK+ accelerator handling API, which means it's easy to convert
the key combination smobs either into a precise representation for
storing or into a properly-translated "pretty" representation for
display.
:100644 100644 ac02d47... 84dd13f... M docs/scheme-api/geda-scheme.texi
:100644 100644 463c709... 089adf2... M gschem/include/prototype.h
:100644 100644 53902d1... 6c60a63... M gschem/scheme/Makefile.am
:000000 100644 0000000... 6fddb0f... A gschem/scheme/gschem/keymap.scm
:100644 100644 8437633... 44e7cd1... M gschem/src/Makefile.am
:100644 100644 55344b3... f3a4177... M gschem/src/g_keys.c
:100644 100644 ec3452a... 93b3e64... M gschem/src/gschem.c
commit b34be3c923c680efac20e3fafc68f9f820eb7255
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
scheme-api: Fix parse-attrib usage in deprecated set-attribute-value!
:100644 100644 8a90e7d... 802513c... M gschem/scheme/gschem/deprecated.scm
=========
Changes
=========
commit 61c6201ef1b07f3f9d8c76fb2ffa725c142bdf2a
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
Update NEWS.
diff --git a/NEWS b/NEWS
index eca4ac8..c03e9af 100644
--- a/NEWS
+++ b/NEWS
@@ -28,6 +28,17 @@ Notable changes in gEDA/gaf 1.7.2
the `global-set-key' function. See notes in `system-gschemrc' for
examples.
+* The `bom' and `bom2' backends to `gnetlist' now give error messages
+ if no attribute file can be found. The `-O attrib_file=FILE' and
+ `-O attribs=ATTRIB,ATTRIB...' options have also been added.
+
+* A new `ewnet' backend has been added to `gnetlist'. This outputs
+ netlists for use with the National Instruments ULTIboard layout
+ tool.
+
+* `gsch2pcb' no longer supports the `m4_command' parameter in project
+ files.
+
Notable changes in gEDA/gaf 1.7.1
=================================
commit ef8cf3e9cd75779d17927c5a4ce51104d42a0ada
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Use new keymaps.
Modify gschem to use the new keymaps throughout. This is a fairly
intrusive change, requiring changes to the keybinding syntax for
configuration files. The new syntax one is *much* simpler and easier
to understand for people who are not familiar to Scheme, and lends
itself well to modifications in user and local gschemrc files.
Major improvements include:
* gschem now behaves properly when the user accidentally hits Caps
Lock. This has been a source of great annoyance to me in the past,
when gschem would stop responding to keystrokes for no obvious
reason, only for me to realise that Caps Lock was on. Now
keybindings ignore Caps Lock entirely.
* Menus now show the same symbols as should appear on a user's
keyboard, instead of raw X keynames. This is much more accessible
and user-friendly than having to remember which bracket
"bracketright" refers to.
* The heavy lifting of parsing key specification strings, and of
converting keystrokes to a correctly-internationalised
representation for display, is now carried out by GTK+. This also
cheaply provides support for extended modifiers such as Super
("Windows" key on most keyboards).
* Changing the keybinding to show documentation to "Ctrl+D"
is now as simple as adding:
(global-set-key "<Ctrl>D" 'hierarchy-documentation)
to my "~/.gEDA/gschemrc", rather than some more complex Scheme code
to patch it correctly into the tree constructed by
"system-gschemrc".
diff --git a/NEWS b/NEWS
index 34cc2de..eca4ac8 100644
--- a/NEWS
+++ b/NEWS
@@ -15,6 +15,19 @@ Notable changes in gEDA/gaf 1.7.2
details. Existing extensions may need to be modified to load the
`(geda deprecated)' or `(gschem deprecated)' modules.
+* `gschem' keybinding improvements:
+
+ - Keybindings are now unaffected by Caps Lock.
+
+ - Keystrokes are displayed using the same characters as on keycaps
+ (e.g. `:' instead of `colon').
+
+ - Keystrokes may use extended modifiers (Super, Hyper and Meta).
+
+ - Key bindings can be modified in any rc file or interactively using
+ the `global-set-key' function. See notes in `system-gschemrc' for
+ examples.
+
Notable changes in gEDA/gaf 1.7.1
=================================
diff --git a/gschem/include/prototype.h b/gschem/include/prototype.h
index 089adf2..b55c4c8 100644
--- a/gschem/include/prototype.h
+++ b/gschem/include/prototype.h
@@ -38,8 +38,8 @@ void g_run_hook_object (const char *name, OBJECT *obj);
void g_run_hook_object_list (const char *name, GList *obj_lst);
void g_run_hook_page (const char *name, PAGE *page);
/* g_keys.c */
-int g_keys_execute(GSCHEM_TOPLEVEL *w_current, int state, int keyval);
-GArray *g_keys_dump_keymap (void);
+int g_keys_execute(GSCHEM_TOPLEVEL *w_current, GdkEventKey *event);
+GtkListStore *g_keys_to_list_store (void);
SCM g_keys_file_new(SCM rest);
SCM g_keys_file_new_window(SCM rest);
SCM g_keys_file_open(SCM rest);
diff --git a/gschem/lib/system-gschemrc.scm b/gschem/lib/system-gschemrc.scm
index cc2dc1e..6008dc5 100644
--- a/gschem/lib/system-gschemrc.scm
+++ b/gschem/lib/system-gschemrc.scm
@@ -1149,206 +1149,189 @@
; Start of keymapping related keywords
;
-; Keymapping rules:
-;
-; - Everything is case sensitive
-; - For a -- "a"
-; - For Shift-A -- "Shift A"
-; - For Control-a -- "Control a"
-; - For Alt-a -- "Alt a"
-; - Keys must be unique in each keymap, especially the global one
-; - Strings (without any modifers) are the same strings specified
-; for the keys in the file /usr/lib/X11/XKeysymDB (at least on
-; a linux box)
-;
-
-; All keys in this keymap *must* be unique
-(define file-keymap
- '(("w" . file-new-window)
- ("n" . file-new)
- ("o" . file-open)
- ("s" . file-save)
- ("e" . page-close) ; yes this is okay; reusing page-close
- ("a" . file-save-as)
- ("l" . file-save-all)
- ("p" . file-print)
- ("r" . page-revert) ; yes this is okay; resuing page-revert
- ("i" . file-image)
- ("t" . file-script)
- ("c" . file-close-window)
- ("q" . file-quit)))
-
-; All keys in this keymap *must* be unique
-(define edit-keymap
- '(("Shift U" . edit-undo)
- ("Shift R" . edit-redo)
- ("s" . edit-select)
- ("c" . edit-copy-hotkey) ; This can also just be edit-copy and then
- ("e" . edit-edit) ; you must pick the anchor point
- ("y" . edit-mcopy-hotkey) ; This can also just be edit-mcopy
- ("x" . edit-text)
- ("m" . edit-move-hotkey) ; This can also just be edit-move
- ("d" . edit-delete)
- ("r" . edit-rotate-90-hotkey)
- ("i" . edit-mirror-hotkey)
- ("Shift S" . edit-slot)
- ("o" . edit-color)
- ("l" . edit-lock)
- ("Shift L" . edit-unlock)
- ("w" . edit-linetype)
- ("f" . edit-filltype)
- ("t" . edit-translate)
- (":" . edit-invoke-macro)
- ("b" . edit-embed)
- ("u" . edit-unembed)
- ("p" . edit-update)
- ("n" . edit-show-hidden)))
-
-
-;;; ("h" . edit-stretch-hotkey) Obsolete
-
-; All keys in this keymap *must* be unique
-(define view-keymap
- '(("r" . view-redraw)
- ("b" . view-zoom-box-hotkey)
- ("f" . view-zoom-full)
- ("e" . view-zoom-extents)
- ("p" . view-pan-hotkey)
- ("o" . view-zoom-out-hotkey)
- ("i" . view-zoom-in-hotkey)
- ("d" . view-dark-colors)
- ("l" . view-light-colors)
- ("w" . view-bw-colors)
- ))
-
-(define buffer-keymap
- '(("c" . buffer-copy1)
- ("u" . buffer-cut1)
- ("p" . buffer-paste1-hotkey)))
-
-; All keys in this keymap *must* be unique
-(define page-keymap
- '(("m" . page-manager)
- ("n" . page-next)
- ("p" . page-prev)
- ("e" . page-new)
- ("r" . page-revert)
- ("c" . page-close)
- ("d" . page-discard)
- ("Shift P" . page-print)))
-
-; All keys in this keymap *must* be unique
-(define add-keymap
- '(("c" . add-component)
- ("a" . add-attribute-hotkey)
- ("n" . add-net-hotkey)
- ("u" . add-bus-hotkey)
- ("t" . add-text)
- ("l" . add-line-hotkey)
- ("b" . add-box-hotkey)
- ("i" . add-circle-hotkey)
- ("r" . add-arc-hotkey)
- ("p" . add-pin-hotkey)
- ("g" . add-picture-hotkey)))
-
-; All keys in this keymap *must* be unique
-(define hierarchy-keymap
- '(("d" . hierarchy-down-schematic)
- ("s" . hierarchy-down-symbol)
- ("u" . hierarchy-up)
- ("o" . hierarchy-documentation)))
-
-; All keys in this keymap *must* be unique
-(define attributes-keymap
- '(("a" . attributes-attach)
- ("d" . attributes-detach)
- ("n" . attributes-show-name)
- ("v" . attributes-show-value)
- ("b" . attributes-show-both)
- ("t" . attributes-visibility-toggle)
- ("Shift F" . edit-find-text)
- ("h" . edit-hide-text)
- ("Shift H" . edit-show-text)
- ("u" . edit-autonumber)))
-
-; All keys in this keymap *must* be unique
-(define options-keymap
- '(("t" . options-text-size)
- ("a" . options-action-feedback)
- ("g" . options-grid)
- ("s" . options-snap)
- ("r" . options-rubberband)
- ("m" . options-magneticnet)
- ("Shift S" . options-snap-size)
- ("l" . options-show-log-window)
- ("c" . options-show-coord-window)))
-
-; All keys in this keymap *must* be unique
-(define help-keymap
- '(("a" . help-about)
- ("m" . help-manual)
- ("f" . help-faq)
- ("w" . help-wiki)
- ("h" . help-hotkeys)
- ("c" . hierarchy-documentation))) ; yes this is okay; reusing
-
-; All keys in the global-keymap *must* be unique
-(define global-keymap
- '(("Escape" . cancel)
- ("a" . add-keymap)
- ("b" . add-box-hotkey)
- ("c" . edit-copy-hotkey)
- ("d" . edit-delete)
- ("e" . edit-keymap)
- ("f" . file-keymap)
- ("h" . help-keymap)
- ("i" . add-component)
- ("l" . add-line-hotkey)
- ("m" . edit-move-hotkey)
- ("n" . add-net-hotkey)
- ("o" . options-keymap)
- ("bracketright" . options-scale-up-snap-size)
- ("bracketleft" . options-scale-down-snap-size)
- ("p" . page-keymap)
- ("r" . view-redraw)
- ("s" . edit-select)
- ("t" . attributes-keymap)
- ("u" . edit-undo)
- ("v" . view-keymap)
- ("w" . view-zoom-box-hotkey)
- ("x" . view-pan-hotkey)
- ("Left" . view-pan-left)
- ("Right" . view-pan-right)
- ("Up" . view-pan-up)
- ("Down" . view-pan-down)
- ("y" . buffer-keymap)
- ("z" . view-zoom-in-hotkey)
- ("period" . repeat-last-command)
- ("Shift colon" . edit-invoke-macro)
- ("comma" . misc-misc)
- ("equal" . misc-misc2)
- ("Shift plus" . misc-misc3)
- ("Delete" . edit-delete)
- ("Shift greater" . page-next) ; Deprecated; preserved for backward compat
- ("Page_Down" . page-next)
- ("Shift less" . page-prev) ; Deprecated; preserved for backward compat
- ("Page_Up" . page-prev)
- ("Alt q" . file-quit)
- ("Shift B" . add-bus-hotkey)
- ("Shift H" . hierarchy-keymap)
- ("Shift U" . edit-undo)
- ("Shift R" . edit-redo)
- ("Shift Z" . view-zoom-out-hotkey)
- ("Control x" . clipboard-cut)
- ("Control c" . clipboard-copy)
- ("Control v" . clipboard-paste-hotkey)
- ("Control z" . edit-undo)
- ("Control y" . edit-redo)
- ("Control a" . edit-select-all)
- ("Control Shift A" . edit-deselect)))
-
-; finally set the keymap point to the newly created datastructure
-(define current-keymap global-keymap)
+;;;; Keymapping
+;;
+;; Everything is case-sensitive. Any number of keys may be bound in
+;; sequence, and each keystroke consists of a non-modifier key with
+;; some number of modifiers applied. Examples:
+;;
+;; * (global-set-key "F N" 'file-new-window)
+;;
+;; The "New Window" command will be run when an <F> is typed,
+;; followed by an <A>.
+;;
+;; * (global-set-key "<Control><Shift>A" 'edit-deselect)
+;;
+;; The "Deselect All" command will be run when the <Ctrl> and
+;; <Shift> keys are held down, and the <A> key is pressed.
+;;
+;; * (global-set-key "O <Shift>S" 'options-snapsize)
+;;
+;; The "Snap Size" dialog box will be shown when an <O> is typed,
+;; followed by an <S> typed with the <Shift> key held down.
+;;
+;; Key names can be found in /usr/include/gtk-2.0/gdk/gdkkeysyms.h on
+;; most Linux systems. For other systems, please see your platform
+;; documentation.
+;;
+;; Later keybindings override earlier ones.
+
+(global-set-key "A C" 'add-component)
+(global-set-key "A A" 'add-attribute-hotkey)
+(global-set-key "A N" 'add-net-hotkey)
+(global-set-key "A U" 'add-bus-hotkey)
+(global-set-key "A T" 'add-text)
+(global-set-key "A L" 'add-line-hotkey)
+(global-set-key "A B" 'add-box-hotkey)
+(global-set-key "A I" 'add-circle-hotkey)
+(global-set-key "A R" 'add-arc-hotkey)
+(global-set-key "A P" 'add-pin-hotkey)
+(global-set-key "A G" 'add-picture-hotkey)
+
+(global-set-key "<Control>A" 'edit-select-all)
+(global-set-key "<Control><Shift>A" 'edit-deselect)
+
+(global-set-key "B" 'add-box-hotkey)
+(global-set-key "<Shift>B" 'add-bus-hotkey)
+(global-set-key "C" 'edit-copy-hotkey)
+(global-set-key "<Control>C" 'clipboard-copy)
+(global-set-key "D" 'edit-delete)
+
+(global-set-key "E <Shift>U" 'edit-undo)
+(global-set-key "E <Shift>R" 'edit-redo)
+(global-set-key "E S" 'edit-select)
+(global-set-key "E C" 'edit-copy-hotkey)
+(global-set-key "E E" 'edit-edit)
+(global-set-key "E Y" 'edit-mcopy-hotkey)
+(global-set-key "E X" 'edit-text)
+(global-set-key "E M" 'edit-move-hotkey)
+(global-set-key "E D" 'edit-delete)
+(global-set-key "E R" 'edit-rotate-90-hotkey)
+(global-set-key "E I" 'edit-mirror-hotkey)
+(global-set-key "E <Shift>S" 'edit-slot)
+(global-set-key "E O" 'edit-color)
+(global-set-key "E L" 'edit-lock)
+(global-set-key "E <Shift>L" 'edit-unlock)
+(global-set-key "E W" 'edit-linetype)
+(global-set-key "E F" 'edit-filltype)
+(global-set-key "E T" 'edit-translate)
+(global-set-key "E <Shift>colon" 'edit-invoke-macro)
+(global-set-key "E B" 'edit-embed)
+(global-set-key "E U" 'edit-unembed)
+(global-set-key "E P" 'edit-update)
+(global-set-key "E N" 'edit-show-hidden)
+
+(global-set-key "F W" 'file-new-window)
+(global-set-key "F N" 'file-new)
+(global-set-key "F O" 'file-open)
+(global-set-key "F S" 'file-save)
+(global-set-key "F E" 'page-close)
+(global-set-key "F A" 'file-save-as)
+(global-set-key "F L" 'file-save-all)
+(global-set-key "F P" 'file-print)
+(global-set-key "F R" 'page-revert)
+(global-set-key "F I" 'file-image)
+(global-set-key "F T" 'file-script)
+(global-set-key "F C" 'file-close-window)
+(global-set-key "F Q" 'file-quit)
+
+(global-set-key "H A" 'help-about)
+(global-set-key "H M" 'help-manual)
+(global-set-key "H F" 'help-faq)
+(global-set-key "H W" 'help-wiki)
+(global-set-key "H H" 'help-hotkeys)
+(global-set-key "H C" 'hierarchy-documentation)
+
+(global-set-key "<Shift>H D" 'hierarchy-down-schematic)
+(global-set-key "<Shift>H S" 'hierarchy-down-symbol)
+(global-set-key "<Shift>H U" 'hierarchy-up)
+(global-set-key "<Shift>H O" 'hierarchy-documentation)
+
+(global-set-key "I" 'add-component)
+(global-set-key "L" 'add-line-hotkey)
+(global-set-key "M" 'edit-move-hotkey)
+(global-set-key "N" 'add-net-hotkey)
+
+(global-set-key "O T" 'options-text-size)
+(global-set-key "O A" 'options-action-feedback)
+(global-set-key "O G" 'options-grid)
+(global-set-key "O S" 'options-snap)
+(global-set-key "O R" 'options-rubberband)
+(global-set-key "O M" 'options-magneticnet)
+(global-set-key "O <Shift>S" 'options-snap-size)
+(global-set-key "O L" 'options-show-log-window)
+(global-set-key "O C" 'options-show-coord-window)
+
+(global-set-key "P M" 'page-manager)
+(global-set-key "P N" 'page-next)
+(global-set-key "P P" 'page-prev)
+(global-set-key "P E" 'page-new)
+(global-set-key "P R" 'page-revert)
+(global-set-key "P C" 'page-close)
+(global-set-key "P D" 'page-discard)
+(global-set-key "P <Shift>P" 'page-print)
+
+(global-set-key "<Alt>Q" 'file-quit)
+(global-set-key "R" 'view-redraw)
+(global-set-key "<Shift>R" 'edit-redo)
+(global-set-key "S" 'edit-select)
+
+(global-set-key "T A" 'attributes-attach)
+(global-set-key "T D" 'attributes-detach)
+(global-set-key "T N" 'attributes-show-name)
+(global-set-key "T V" 'attributes-show-value)
+(global-set-key "T B" 'attributes-show-both)
+(global-set-key "T T" 'attributes-visibility-toggle)
+(global-set-key "T <Shift>F" 'edit-find-text)
+(global-set-key "T H" 'edit-hide-text)
+(global-set-key "T <Shift>H" 'edit-show-text)
+(global-set-key "T U" 'edit-autonumber)
+
+(global-set-key "U" 'edit-undo)
+(global-set-key "<Shift>U" 'edit-undo)
+
+(global-set-key "V R" 'view-redraw)
+(global-set-key "V B" 'view-zoom-box-hotkey)
+(global-set-key "V F" 'view-zoom-full)
+(global-set-key "V E" 'view-zoom-extents)
+(global-set-key "V P" 'view-pan-hotkey)
+(global-set-key "V O" 'view-zoom-out-hotkey)
+(global-set-key "V I" 'view-zoom-in-hotkey)
+(global-set-key "V D" 'view-dark-colors)
+(global-set-key "V L" 'view-light-colors)
+(global-set-key "V W" 'view-bw-colors)
+
+(global-set-key "<Control>V" 'clipboard-paste-hotkey)
+(global-set-key "W" 'view-zoom-box-hotkey)
+(global-set-key "X" 'view-pan-hotkey)
+(global-set-key "<Control>X" 'clipboard-cut)
+
+(global-set-key "Y C" 'buffer-copy1)
+(global-set-key "Y U" 'buffer-cut1)
+(global-set-key "Y P" 'buffer-paste1-hotkey)
+
+(global-set-key "<Control>Y" 'edit-redo)
+(global-set-key "Z" 'view-zoom-in-hotkey)
+(global-set-key "<Shift>Z" 'view-zoom-out-hotkey)
+(global-set-key "<Control>Z" 'edit-undo)
+
+(global-set-key "Escape" 'cancel)
+(global-set-key "bracketright" 'options-scale-up-snap-size)
+(global-set-key "bracketleft" 'options-scale-down-snap-size)
+(global-set-key "Left" 'view-pan-left)
+(global-set-key "Right" 'view-pan-right)
+(global-set-key "Up" 'view-pan-up)
+(global-set-key "Down" 'view-pan-down)
+(global-set-key "period" 'repeat-last-command)
+(global-set-key "colon" 'edit-invoke-macro)
+(global-set-key "comma" 'misc-misc)
+(global-set-key "equal" 'misc-misc2)
+(global-set-key "plus" 'misc-misc3)
+(global-set-key "Delete" 'edit-delete)
+(global-set-key "greater" 'page-next)
+(global-set-key "Page_Down" 'page-next)
+(global-set-key "less" 'page-prev)
+(global-set-key "Page_Up" 'page-prev)
;
; Here are the definitions for the top pull down menu bar
diff --git a/gschem/scheme/gschem.scm b/gschem/scheme/gschem.scm
index d4ee404..db19279 100644
--- a/gschem/scheme/gschem.scm
+++ b/gschem/scheme/gschem.scm
@@ -1,7 +1,7 @@
;;; gEDA - GPL Electronic Design Automation
;;; gschem - gEDA Schematic Capture
;;; Copyright (C) 1998-2010 Ales Hvezda
-;;; Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
+;;; Copyright (C) 1998-2011 gEDA Contributors (see ChangeLog for details)
;;;
;;; This program is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
@@ -17,57 +17,80 @@
;;; along with this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+(use-modules (gschem keymap))
-; guile 1.4/1.6 compatibility: Define an eval-in-currentmodule procedure
-; If this version of guile has an R5RS-compatible eval (that requires a
-; second argument specfying the environment), and a current-module function
-; (like 1.6) use them to define eval-cm. else define eval-cm to eval (for 1.4)
-(define eval-cm
- (if (false-if-exception (eval 'display (current-module)))
- (lambda (exp) (eval exp (current-module)))
- eval))
+;; Define an eval-in-currentmodule procedure
+(define (eval-cm expr) (eval expr (current-module)))
-(define last-command-sequence #f)
-(define current-command-sequence '())
+(define last-action #f)
+(define current-keys '())
-; Doers
+(define %global-keymap (make-keymap))
+(define current-keymap %global-keymap)
+
+;; Set a global keybinding
+(define (global-set-key key binding)
+ (bind-keys! %global-keymap key binding))
+
+;; Called from C code to evaluate keys.
(define (press-key key)
(eval-pressed-key current-keymap key))
+;; Does the work of evaluating a key. Adds the key to the current key
+;; sequence, then looks up the key sequence in the current keymap. If
+;; the key sequence resolves to an action, calls the action. If the
+;; key sequence can be resolved (either to a keymap or an action),
+;; returns #t; otherwise, returns #f. If the key is #f, clears the
+;; current key sequence.
(define (eval-pressed-key keymap key)
- (and keymap
- (let ((lookup (assoc key keymap)))
- (cond ((pair? lookup)
- (if (not (equal? 'repeat-last-command (cdr lookup)))
- (set! current-command-sequence
- (cons key current-command-sequence)))
- (perform-action (cdr lookup)))
- (else
- (set! current-keymap global-keymap)
- ;(display "No keymap found")
- ;(newline)
- #f
- )))))
-
-(define (perform-action action)
- (let ((local-action (eval-cm action)))
- (cond ((list? local-action)
- (set! current-keymap local-action))
- ((equal? 'repeat-last-command action)
- (repeat-last-command))
- (else
- (set! last-command-sequence current-command-sequence)
- (set! current-command-sequence '())
- (local-action)
- (set! current-keymap global-keymap)))))
-
-(define (repeat-last-command)
- ;; need to `reverse' because the sequence was "push"ed initially
- ;(display last-command-sequence)
- ;(newline)
- (and last-command-sequence
- (not (null? last-command-sequence))
- (for-each press-key (reverse last-command-sequence))))
+ ;; Function for resetting current key sequence
+ (define (reset-keys) (set! current-keys '()) #f)
+
+ (if key
+ (begin
+ ;; Add key to current key sequence
+ (set! current-keys (cons key current-keys))
+ (let* ((keys (list->vector (reverse current-keys)))
+ (bound (lookup-keys keymap keys)))
+ (cond
+ ;; Keys are a prefix -- do nothing successfully
+ ((keymap? bound) #t)
+ ;; Keys are bound to something -- reset current key
+ ;; sequence, then try to run the action
+ (bound (begin
+ (reset-keys)
+ (eval-keymap-action bound)))
+ ;; No binding
+ (else (reset-keys)))))
+
+ (reset-keys)))
+
+;; Evaluates a keymap action. A keymap action is expected to be a
+;; symbol naming a thunk variable in the current module.
+;;
+;; The special-case symbol repeat-last-command causes the last action
+;; executed via keypress to be repeated.
+(define (eval-keymap-action action)
+ (define (invalid-action-error)
+ (error "~S is not a valid action for keybinding." action))
+
+ (cond
+ ;; Handle repeat-last-command
+ ((equal? 'repeat-last-command action)
+ (eval-keymap-action last-action))
+
+ ;; Normal actions
+ ((symbol? action)
+ (let ((proc (false-if-exception (eval-cm action))))
+ (if (thunk? proc)
+ (begin
+ (set! last-action action)
+ (proc)
+ #t)
+ (invalid-action-error))))
+
+ ;; Otherwise, fail
+ (else (invalid-action-error))))
(define (eval-stroke stroke)
(let ((action (assoc stroke strokes)))
@@ -82,87 +105,38 @@
((eval-cm (cdr action)))
#t))))
-
-;; Search the keymap for a particular scheme function and return the keys
-;; which execute this hotkey
-(define foundkey "")
-(define temp "")
-
-(define find-key-lowlevel
- (let ((keys '()))
- (lambda (keymap function)
- (for-each
- (lambda (mapped-key) ; Receives a pair
- (if (list? (eval-cm (cdr mapped-key)))
- (begin
- (set! temp (car mapped-key))
- (find-key-lowlevel (eval-cm (cdr mapped-key)) function)
- (set! temp "")
- )
- (if (eq? (cdr mapped-key) function)
- (set! foundkey (string-append temp (car mapped-key)))
-
- )
- )
- )
- keymap))))
-
-(define find-key
- (lambda(function)
- (set! temp "")
- (set! foundkey "")
-;; (display function) (newline)
- (find-key-lowlevel global-keymap function)
- (if (eq? (string-length foundkey) 0)
- #f
- foundkey
- )
- ))
+;; Search the global keymap for a particular symbol and return the
+;; keys which execute this hotkey, as a string suitable for display to
+;; the user. This is used by the gschem menu system.
+(define (find-key action)
+ (let ((keys (lookup-binding %global-keymap action)))
+ (and keys (keys->display-string keys))))
;; Printing out current key bindings for gEDA (gschem)
+(define (dump-global-keymap)
+ (dump-keymap %global-keymap))
-(define (dump-current-keymap)
- (dump-keymap global-keymap))
-
-(use-modules (srfi srfi-13))
(define (dump-keymap keymap)
- (let loop ((keymap keymap)
- (keys '()))
- (if (null? keymap)
- '()
- (let* ((entry (car keymap))
- (key (car entry))
- (action (eval-cm (cdr entry))))
- (cond ((list? action)
- (append (loop action (cons key keys))
- (loop (cdr keymap) keys)))
- (else
- (cons (cons (cdr entry)
- (string-join (reverse (cons key keys)) " "))
- (loop (cdr keymap) keys))))))))
-
-;; Predicate to test if entry is keymap or action
-(define gschem:keymap? list?)
-
-;; Map over keymap tree, applying f to every node before descending
-(define (gschem:for-each-keymap f kmap)
- (if (gschem:keymap? kmap)
- (for-each
- (lambda (kmap-entry)
- (apply f (list kmap-entry))
- (gschem:for-each-keymap f (eval-cm (cdr kmap-entry))))
- kmap)))
-
-;; Sorting multiple key modifiers for unambiguos keymaps
-(define gschem:normalize-accel!
- (lambda (kmap-entry)
- (let* ((accel-list (reverse (string-split (car kmap-entry) #\space)))
- (modifiers (cdr accel-list))
- (key (car accel-list))
- (sorted (sort modifiers string<?))
- (appended (append sorted (list key)))
- (joined (string-join appended " ")))
- (set-car! kmap-entry joined))))
-
-;; Once at startup normalize the global keymap
-(gschem:for-each-keymap gschem:normalize-accel! global-keymap)
+
+ (define lst '())
+
+ (define (binding->entry prefix key binding)
+ (let ((keys (list->vector (reverse (cons key prefix)))))
+ (set! lst (cons (cons (symbol->string binding)
+ (keys->display-string keys))
+ lst))))
+
+ (define (build-dump! km prefix)
+ (keymap-for-each
+ (lambda (key binding)
+ (cond
+ ((symbol? binding)
+ (binding->entry prefix key binding))
+ ((keymap? binding)
+ (build-dump! binding (cons key prefix)))
+ (else (error "Invalid action ~S bound to ~S"
+ binding (list->vector (reverse (cons key prefix)))))))
+ km))
+
+ (build-dump! keymap '())
+ lst)
diff --git a/gschem/src/g_keys.c b/gschem/src/g_keys.c
index f3a4177..45bd971 100644
--- a/gschem/src/g_keys.c
+++ b/gschem/src/g_keys.c
@@ -41,142 +41,6 @@
#include <gdk/gdkkeysyms.h>
-/*! \todo Finish function documentation!!!
- * \brief
- * \par Function Description
- *
- */
-/* for now this only supports single chars, not shift/alt/ctrl etc... */
-int g_keys_execute(GSCHEM_TOPLEVEL *w_current, int state, int keyval)
-{
- char *guile_string = NULL;
- char *modifier = NULL;
- char *key_name = NULL;
- char *mod_end = NULL;
- SCM scm_retval;
-
- if (keyval == 0) {
- return 0;
- }
-
- key_name = gdk_keyval_name(keyval);
- if ( key_name == NULL ) {
- return 0;
- }
-
- /* don't pass the raw modifier key presses to the guile code */
- if (strstr(key_name, "Alt") ||
- strstr(key_name, "Shift") ||
- strstr(key_name, "Control") ) {
- return 0;
- }
-
- /* Allocate space for concatenation of all strings below */
- modifier = mod_end = g_strnfill(3*10, '\0');
-
- /* The accels below must be in alphabetic order! */
- if (state & GDK_MOD1_MASK) {
- mod_end = g_stpcpy(mod_end, "Alt ");
- }
- if (state & GDK_CONTROL_MASK) {
- mod_end = g_stpcpy(mod_end, "Control ");
- }
- if (state & GDK_SHIFT_MASK) {
- mod_end = g_stpcpy(mod_end, "Shift ");
- }
-
- if(strcmp(key_name, "Escape") == 0) {
- g_free(w_current->keyaccel_string);
- w_current->keyaccel_string = NULL;
- } else if(w_current->keyaccel_string &&
- strlen(w_current->keyaccel_string) + strlen(key_name) > 10) {
- g_free(w_current->keyaccel_string);
- w_current->keyaccel_string = g_strconcat(modifier, key_name, NULL);
- } else {
- gchar *p, *r;
-
- p = w_current->keyaccel_string;
- w_current->keyaccel_string = g_strconcat(modifier, key_name, NULL);
- if(p) {
- r = g_strconcat(p, w_current->keyaccel_string, NULL);
- g_free(p);
- g_free(w_current->keyaccel_string);
- w_current->keyaccel_string = r;
- }
- }
-
- i_show_state(w_current, NULL);
-
- guile_string = g_strdup_printf("(press-key \"%s%s\")",
- modifier, key_name);
-
-#if DEBUG
- printf("_%s_\n", guile_string);
-#endif
-
- scm_dynwind_begin (0);
- scm_dynwind_unwind_handler (g_free, guile_string, SCM_F_WIND_EXPLICITLY);
- scm_dynwind_unwind_handler (g_free, modifier, SCM_F_WIND_EXPLICITLY);
- g_dynwind_window (w_current);
- scm_retval = g_scm_c_eval_string_protected (guile_string);
- scm_dynwind_end ();
-
- return (SCM_FALSEP (scm_retval)) ? 0 : 1;
-}
-
-/*! \brief Exports the keymap in scheme to a GLib GArray.
- * \par Function Description
- * This function converts the list of key sequence/action pairs
- * returned by the scheme function \c dump-current-keymap into an
- * array of C structures.
- *
- * The returned value must be freed by caller.
- *
- * \return A GArray with keymap data.
- */
-GArray*
-g_keys_dump_keymap (void)
-{
- SCM dump_proc = scm_c_lookup ("dump-current-keymap");
- SCM scm_ret;
- GArray *ret = NULL;
- struct keyseq_action_t {
- gchar *keyseq, *action;
- };
-
- dump_proc = scm_variable_ref (dump_proc);
- g_return_val_if_fail (SCM_NFALSEP (scm_procedure_p (dump_proc)), NULL);
-
- scm_ret = scm_call_0 (dump_proc);
- g_return_val_if_fail (SCM_CONSP (scm_ret), NULL);
-
- ret = g_array_sized_new (FALSE,
- FALSE,
- sizeof (struct keyseq_action_t),
- (guint)scm_ilength (scm_ret));
- for (; scm_ret != SCM_EOL; scm_ret = SCM_CDR (scm_ret)) {
- SCM scm_keymap_entry = SCM_CAR (scm_ret);
- struct keyseq_action_t keymap_entry;
- char *str;
-
- g_return_val_if_fail (SCM_CONSP (scm_keymap_entry) &&
- scm_is_symbol (SCM_CAR (scm_keymap_entry)) &&
- scm_is_string (SCM_CDR (scm_keymap_entry)), ret);
-
- str = scm_to_utf8_string (scm_symbol_to_string (SCM_CAR (scm_keymap_entry)));
- keymap_entry.action = g_strdup (str);
- free(str);
-
- str = scm_to_utf8_string (SCM_CDR (scm_keymap_entry));
- keymap_entry.keyseq = g_strdup (str);
- free(str);
-
- ret = g_array_append_val (ret, keymap_entry);
- }
-
- return ret;
-}
-
/*! \brief Clear the current key accelerator string
*
* \par Function Description
@@ -619,6 +483,174 @@ g_key_free (SCM key) {
return 0;
}
+SCM_SYMBOL (press_key_sym, "press-key");
+
+/*! \brief Evaluate a user keystroke.
+ * \par Function Description
+ * Evaluates the key combination specified by \a event using the
+ * current keymap. Updates the gschem status bar with the current key
+ * sequence.
+ *
+ * \param w_current The active #GSCHEM_TOPLEVEL context.
+ * \param event A GdkEventKey structure.
+ *
+ * \return 1 if a binding was found for the keystroke, 0 otherwise.
+ */
+int
+g_keys_execute(GSCHEM_TOPLEVEL *w_current, GdkEventKey *event)
+{
+ SCM s_retval, s_key, s_expr;
+ guint key, mods, upper, lower, caps;
+ GdkDisplay *display;
+ GdkKeymap *keymap;
+ GdkModifierType consumed_modifiers;
+
+ g_return_val_if_fail (w_current != NULL, 0);
+ g_return_val_if_fail (event != NULL, 0);
+
+ display = gtk_widget_get_display (w_current->main_window);
+ keymap = gdk_keymap_get_for_display (display);
+
+ /* Figure out what modifiers went into determining the key symbol */
+ gdk_keymap_translate_keyboard_state (keymap,
+ event->hardware_keycode,
+ event->state, event->group,
+ NULL, NULL, NULL, &consumed_modifiers);
+
+ key = event->keyval;
+ gdk_keyval_convert_case (event->keyval, &lower, &upper);
+ mods = (event->state & gtk_accelerator_get_default_mod_mask ()
+ & ~consumed_modifiers);
+
+ /* Handle Caps Lock. The idea is to obtain the same keybindings
+ * whether Caps Lock is enabled or not. */
+ if (upper != lower) {
+ caps = gdk_keymap_get_caps_lock_state (keymap);
+ if ((caps && (key == lower)) || (!caps && (key == upper))) {
+ mods |= GDK_SHIFT_MASK;
+ }
+ }
+
+ /* Always process key as lower case */
+ key = lower;
+
+ /* Validate the key -- there are some keystrokes we mask out. */
+ if (!g_key_is_valid (key, mods)) {
+ return 0;
+ }
+
+ /* Create Scheme key value */
+ /* FIXME Escape as cancel key shouldn't be hardcoded in. */
+ if (key == GDK_Escape) {
+ s_key = SCM_BOOL_F;
+ } else {
+ s_key = g_make_key (key, mods);
+ }
+
+ /* Update key hint string for status bar. */
+ if (s_key == SCM_BOOL_F) {
+ /* Cancelled key sequence, so clear hint string */
+ g_free (w_current->keyaccel_string);
+ w_current->keyaccel_string = NULL;
+
+ } else {
+ gchar *keystr = gtk_accelerator_get_label (key, mods);
+
+ /* If no current hint string, use key string directly */
+ if (w_current->keyaccel_string == NULL) {
+ w_current->keyaccel_string = keystr;
+
+ } else {
+ /* If concatenating key string onto current hint string would be
+ * longer than 14 characters, truncate and prefix with
+ * ellipsis. Otherwise, add key string to current hint
+ * string. */
+ /* FIXME this limit probably shouldn't be hardcoded */
+ if (strlen (w_current->keyaccel_string) + strlen (keystr) > 14) {
+ g_free (w_current->keyaccel_string);
+ w_current->keyaccel_string = g_strconcat ("\342\200\246 ",
+ keystr, NULL);
+
+ } else {
+ gchar *p = w_current->keyaccel_string;
+ w_current->keyaccel_string = g_strconcat (p, " ", keystr, NULL);
+ g_free (p);
+ }
+ g_free (keystr);
+ }
+ }
+
+ /* Update status bar */
+ i_show_state(w_current, NULL);
+
+ /* Build and evaluate Scheme expression. */
+ scm_dynwind_begin (0);
+ g_dynwind_window (w_current);
+ s_expr = scm_list_2 (press_key_sym, s_key);
+ s_retval = g_scm_eval_protected (s_expr, scm_interaction_environment ());
+ scm_dynwind_end ();
+
+ return !scm_is_false (s_retval);
+}
+
+/*! \brief Exports the keymap in Scheme to a GtkListStore
+ * \par Function Description
+ * This function converts the list of key sequence/action pairs
+ * returned by the Scheme function \c dump-global-keymap into a
+ * GtkListStore with two columns. The first column contains the name
+ * of the action executed by the keybinding as a string, and the
+ * second contains the keybinding itself as a string suitable for
+ * display.
+ *
+ * The returned value must be freed by caller.
+ *
+ * \return A GtkListStore containing keymap data.
+ */
+GtkListStore *
+g_keys_to_list_store (void)
+{
+ SCM s_expr;
+ SCM s_lst;
+ SCM s_iter;
+ GtkListStore *list_store;
+
+ /* Call Scheme procedure to dump global keymap into list */
+ s_expr = scm_list_1 (scm_from_utf8_symbol ("dump-global-keymap"));
+ s_lst = g_scm_eval_protected (s_expr, scm_interaction_environment ());
+
+ g_return_val_if_fail (scm_is_true (scm_list_p (s_lst)), NULL);
+
+ /* Convert to */
+ scm_dynwind_begin (0);
+ list_store = gtk_list_store_new (2, G_TYPE_STRING, G_TYPE_STRING);
+ scm_dynwind_unwind_handler (g_object_unref, list_store, 0);
+
+ for (s_iter = s_lst; !scm_is_null (s_iter); s_iter = scm_cdr (s_iter)) {
+ SCM s_binding = scm_caar (s_iter);
+ SCM s_keys = scm_cdar (s_iter);
+ char *binding, *keys;
+ GtkTreeIter iter;
+
+ scm_dynwind_begin (0);
+
+ binding = scm_to_utf8_string (s_binding);
+ scm_dynwind_free (binding);
+
+ keys = scm_to_utf8_string (s_keys);
+ scm_dynwind_free (keys);
+
+ gtk_list_store_insert_with_values (list_store, &iter, -1,
+ 0, binding,
+ 1, keys,
+ -1);
+
+ scm_dynwind_end ();
+ }
+
+ scm_dynwind_end ();
+ return list_store;
+}
+
/*! \brief Create the (gschem core keymap) Scheme module
* \par Function Description
* Defines procedures in the (gschem core keymap) module. The module
@@ -653,3 +685,4 @@ g_init_keys ()
init_module_gschem_core_keymap,
NULL);
}
+
diff --git a/gschem/src/x_dialog.c b/gschem/src/x_dialog.c
index 3c673c7..c596174 100644
--- a/gschem/src/x_dialog.c
+++ b/gschem/src/x_dialog.c
@@ -2607,11 +2607,6 @@ void x_dialog_hotkeys (GSCHEM_TOPLEVEL *w_current)
GtkWidget *treeview;
GtkCellRenderer *renderer;
GtkTreeViewColumn *column;
- GArray *keymap;
- gint i;
- struct keyseq_action_t {
- gchar *keyseq, *action;
- };
if (!w_current->hkwindow) {
w_current->hkwindow = gschem_dialog_new_with_buttons(_("Hotkeys"),
@@ -2646,31 +2641,7 @@ void x_dialog_hotkeys (GSCHEM_TOPLEVEL *w_current)
GTK_POLICY_AUTOMATIC);
/* the model */
- store = gtk_list_store_new (2,G_TYPE_STRING, G_TYPE_STRING);
-
- /* retrieve current keymap */
- keymap = g_keys_dump_keymap ();
- /* add each keymap entry to the list store of the dialog */
- for (i = 0; i < keymap->len; i++) {
- GtkTreeIter iter;
- struct keyseq_action_t *keymap_entry;
-
- keymap_entry = &g_array_index (keymap, struct keyseq_action_t, i);
- gtk_list_store_append (store, &iter);
- gtk_list_store_set (store, &iter,
- 0, keymap_entry->action,
- 1, keymap_entry->keyseq,
- -1);
- }
-
- /* finally free the array for keymap */
- for (i = 0; i < keymap->len; i++) {
- struct keyseq_action_t *keymap_entry;
- keymap_entry = &g_array_index (keymap, struct keyseq_action_t, i);
- g_free (keymap_entry->keyseq);
- g_free (keymap_entry->action);
- }
- g_array_free (keymap, TRUE);
+ store = g_keys_to_list_store ();
/* the tree view */
treeview = gtk_tree_view_new_with_model(GTK_TREE_MODEL(store));
diff --git a/gschem/src/x_event.c b/gschem/src/x_event.c
index 6f130e6..58dfe28 100644
--- a/gschem/src/x_event.c
+++ b/gschem/src/x_event.c
@@ -1269,8 +1269,7 @@ gboolean x_event_key (GtkWidget *widget, GdkEventKey *event,
}
if (pressed)
- retval = g_keys_execute (w_current, event->state, event->keyval)
- ? TRUE : FALSE;
+ retval = g_keys_execute (w_current, event) ? TRUE : FALSE;
scm_dynwind_end ();
diff --git a/gschem/src/x_menus.c b/gschem/src/x_menus.c
index 595b1a3..a02e94a 100644
--- a/gschem/src/x_menus.c
+++ b/gschem/src/x_menus.c
@@ -169,17 +169,20 @@ get_main_menu(GSCHEM_TOPLEVEL *w_current)
gtk_menu_append(GTK_MENU(menu), menu_item);
} else {
- if (scm_is_false (scm_item_hotkey_func))
+ if (scm_is_false (scm_item_hotkey_func)) {
menu_item_hotkey_func = NULL;
- else
+ } else {
menu_item_hotkey_func = scm_to_utf8_string (scm_symbol_to_string (scm_item_hotkey_func));
+ scm_dynwind_free (menu_item_hotkey_func);
+ }
if (menu_item_hotkey_func != NULL) {
+ SCM s_expr =
+ scm_list_2 (scm_from_utf8_symbol ("find-key"),
+ scm_list_2 (scm_from_utf8_symbol ("quote"),
+ scm_from_utf8_symbol (menu_item_hotkey_func)));
- buf = g_strdup_printf ("(find-key '%s)", menu_item_hotkey_func);
- scm_keys = g_scm_c_eval_string_protected (buf);
- g_free (buf);
- free(menu_item_hotkey_func);
+ scm_keys = g_scm_eval_protected (s_expr, scm_interaction_environment ());
if (scm_is_false (scm_keys)) {
menu_item_keys = "";
commit 70be3926b8f0604faadbe59651a1a7384fddb873
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Load `gschem.scm' earlier in boot process.
`gschem.scm' provides several core services to gschem, particularly
w.r.t. key- and stroke-bindings. Since rc files may wish to override
or make use of these functions, gschem.scm needs to be loaded *before*
the rc files are.
diff --git a/gschem/src/gschem.c b/gschem/src/gschem.c
index 93b3e64..f2776a0 100644
--- a/gschem/src/gschem.c
+++ b/gschem/src/gschem.c
@@ -239,10 +239,6 @@ void main_prog(void *closure, int argc, char *argv[])
/* Run pre-load Scheme expressions */
g_scm_eval_protected (s_pre_load_expr, scm_current_module ());
- /* Now read in RC files. */
- g_rc_parse_gtkrc();
- x_rc_parse_gschem (w_current, rc_filename);
-
/* By this point, libgeda should have setup the Guile load path, so
* we can take advantage of that. */
scm_tmp = scm_sys_search_load_path (scm_from_utf8_string ("gschem.scm"));
@@ -261,6 +257,10 @@ void main_prog(void *closure, int argc, char *argv[])
free (input_str); /* M'allocated by scm_to_utf8_string() */
scm_remember_upto_here_1 (scm_tmp);
+ /* Now read in RC files. */
+ g_rc_parse_gtkrc();
+ x_rc_parse_gschem (w_current, rc_filename);
+
/* Set default icon */
x_window_set_default_icon();
commit 54bb85c55e147a0222a41f415e3200194d3e70ac
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Recursive keymaps.
Adds the bind-keys! and lookup-keys functions, which are
used to work with key sequences and sub-keymaps.
diff --git a/docs/scheme-api/geda-scheme.texi b/docs/scheme-api/geda-scheme.texi
index 6f38597..5b2068b 100644
--- a/docs/scheme-api/geda-scheme.texi
+++ b/docs/scheme-api/geda-scheme.texi
@@ -1591,6 +1591,42 @@ Applies @var{proc} to each binding in @var{keymap}. @var{proc} should
take two arguments: the bound key, and its binding.
@end defun
+Actions are bound to key sequences by binding the first key
+combination to a keymap, then in the resulting keymap binding the
+second key combination, etc. This results in a directed graph of
+keymaps.
+
+For example, to bind the key sequence @kbd{F N}, a keymap is created
+containing a binding for @key{N} to the desired action, and then in the
+main keymap the prefix key @key{F} is bound to the new keymap.
+
+Three helper functions are provided for working with key sequence
+bindings.
+
+@defun bind-keys! keymap keys [bindable]
+Bind @var{keys} to @var{bindable}. Keys may be a key sequence vector, a
+single key combination, or a string representing a key sequence or key
+combination. If @var{bindable} is @samp{#f} or not specified, removes
+the binding for @var{keys}. @var{bindable} should be a thunk or a
+keymap.
+
+If @var{keys} contains invalid prefix keys (e.g. because one of the
+prefix keys is already bound to something other than a keymap), raises
+an error. Missing prefix keymaps are created as required.
+@end defun
+
+@defun lookup-keys keymap keys
+Looks up the binding for @var{keys} in @var{keymap}. @var{keys} is
+interpreted the same as for @code{bind-keys!}. If @var{keys} is not
+bound, returns @samp{#f}.
+@end defun
+
+@defun lookup-binding keymap bindable
+Recursively searches @var{keymap} for the key sequence bound to
+@var{bindable}, which should be a thunk or a keymap. If
+@var{bindable} is not bound, returns @samp{#f}.
+@end defun
+
@node Selections
@section Selections
diff --git a/gschem/scheme/gschem/keymap.scm b/gschem/scheme/gschem/keymap.scm
index dada972..db17842 100644
--- a/gschem/scheme/gschem/keymap.scm
+++ b/gschem/scheme/gschem/keymap.scm
@@ -95,3 +95,100 @@
(for-each
(lambda (x) (proc (car x) (cdr x)))
(keymap-key-table keymap)))
+
+;; -------------------- Recursive keymaps --------------------
+
+;; This helper function takes a string, key or key sequence, and
+;; returns a key sequence.
+(define (resolve-keys keys)
+ (cond
+ ((keys? keys) keys)
+ ((key? keys) (vector keys))
+ ((string? keys) (resolve-keys (string->keys keys)))
+ (error "~S is not a valid key sequence" keys)))
+
+;; This helper function recursively looks up the prefix of a key
+;; sequence (i.e. all keystrokes apart from the last one) and returns
+;; the corresponding keymap, or #f if there is no prefix keymap for
+;; the given key sequence. If create is #t, it creates empty keymaps
+;; for missing prefix keys as it goes.
+(define* (keymap-for-prefix-keys! keymap keys #:optional (create #f))
+
+ ;; Returns a new key sequence containing only the prefix key
+ ;; combinations from KEYS. This is relatively expensive, so it's
+ ;; only used when constructing error messages.
+ (define (prefix-keys keys)
+ (let* ((N (1- (vector-length keys)))
+ (p (make-vector N)))
+ (vector-move-left! keys 0 N p 0)
+ p))
+
+ ;; Recursive function that does the heavy lifting.
+ (define (lookup keymap keys ofs)
+ (if (= (1+ ofs) (vector-length keys))
+ ;; We've seen all the prefix keys, so return the keymap.
+ keymap
+
+ ;; Otherwise, check that the current key is bound to a keymap.
+ ;; If so, recurse; otherwise, error.
+ (let* ((key (vector-ref keys ofs))
+ (binding (keymap-lookup-key keymap key)))
+ (cond
+ ;; If not bound and we're creating new keymaps, create a
+ ;; new one, bind it, and recurse.
+ ((and create (not binding))
+ (let ((km (make-keymap)))
+ (keymap-bind-key! keymap key km)
+ (lookup km keys (1+ ofs))))
+
+ ;; If not bound and we're not creating new keymaps, return
+ ;; #f.
+ ((not binding) #f)
+
+ ;; If bound to a keymap already, recurse.
+ ((keymap? binding) (lookup binding keys (1+ ofs)))
+
+ ;; Otherwise, generate an error.
+ (else (error "~S is not a prefix key sequence."
+ (keys->display-string (prefix-keys keys))))))))
+
+ (lookup keymap keys 0))
+
+(define-public (lookup-keys keymap keys)
+ (let* ((keyseq (resolve-keys keys))
+ (km (keymap-for-prefix-keys! keymap keyseq)))
+ (and km (keymap-lookup-key
+ km
+ (vector-ref keyseq (1- (vector-length keyseq)))))))
+
+(define*-public (bind-keys! keymap keys #:optional (bindable #f))
+ (let* ((keyseq (resolve-keys keys))
+ (km (keymap-for-prefix-keys! keymap keyseq #t)))
+ (keymap-bind-key! km
+ (vector-ref keyseq (1- (vector-length keyseq)))
+ bindable)))
+
+(define-public (lookup-binding keymap bindable)
+
+ ;; Recursive function that does the heavy lifting. This ends up
+ ;; being a depth-first search, unfortunately. Return is a
+ ;; continuation to pass the result to.
+ (define (lookup-binding-recursive km prefix return)
+ (keymap-for-each
+ (lambda (key bound)
+ (cond
+ ;; Success! Return the full key sequence.
+ ((eq? bound bindable)
+ (return (list->vector (reverse (cons key prefix)))))
+
+ ;; If a keymap, recurse.
+ ((keymap? bound)
+ (lookup-binding-recursive bound (cons key prefix) return))
+
+ (else #f)))
+ km))
+
+ (call/cc
+ (lambda (return)
+ (lookup-binding-recursive keymap '() return)
+ #f))) ;; Return #f if no binding found.
commit d29eb4d67b08065be7e7961725d9b40a234ef1f7
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Basic keymaps.
Adds a basic keymap type. A keymap maps key combinations to "bindable
objects", which at the moment are expected (but not required) to be
thunks or other keymaps.
diff --git a/docs/scheme-api/geda-scheme.texi b/docs/scheme-api/geda-scheme.texi
index 4edf37f..6f38597 100644
--- a/docs/scheme-api/geda-scheme.texi
+++ b/docs/scheme-api/geda-scheme.texi
@@ -1557,6 +1557,40 @@ Converts the key sequence @var{keys} to a string, using a format
suitable for display.
@end defun
+@subsection Keymaps
+
+A @dfn{keymap} maps key combinations to actions or other keymaps.
+
+@defun keymap? obj
+Returns @samp{#t} if and only if @var{obj} is a keymap.
+@end defun
+
+@defun make-keymap
+Creates and returns a new, empty keymap.
+@end defun
+
+@defun keymap-bind-key! keymap key [bindable]
+Binds @var{key} to @var{bindable} in @var{keymap}. If @var{bindable} is
+@samp{#f} or not specified, removes the binding for @var{key}.
+@var{bindable} should be a thunk or a keymap.
+@end defun
+
+@defun keymap-lookup-key keymap key
+Looks up the binding for @var{key} in @var{keymap}. If @var{key} is not
+bound, returns @samp{#f}.
+@end defun
+
+@defun keymap-lookup-binding keymap bindable
+Carries out a reverse lookup in @var{keymap} to find the key bound to
+@var{bindable}. If @var{bindable} is not bound in @var{keymap},
+returns @samp{#f}.
+@end defun
+
+@defun keymap-for-each proc keymap
+Applies @var{proc} to each binding in @var{keymap}. @var{proc} should
+take two arguments: the bound key, and its binding.
+@end defun
+
@node Selections
@section Selections
diff --git a/gschem/scheme/gschem/keymap.scm b/gschem/scheme/gschem/keymap.scm
index e2b87f0..dada972 100644
--- a/gschem/scheme/gschem/keymap.scm
+++ b/gschem/scheme/gschem/keymap.scm
@@ -18,7 +18,11 @@
;;
(define-module (gschem keymap)
- #:use-module (gschem core keymap))
+ #:use-module (gschem core keymap)
+ #:use-module (ice-9 optargs)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-69))
;; -------------------- Key combinations --------------------
@@ -54,3 +58,40 @@
(define-public (keys->display-string keys)
(string-join (map key->display-string (vector->list keys)) " "))
+
+;; -------------------- Keymaps --------------------
+
+;; We use a record type here in case we later want to add additional
+;; information into the keymap (e.g. default actions, canonical
+;; ordering, keymap names, etc).
+(define <keymap> (make-record-type "gschem-keymap" '(key-table)))
+(define %make-keymap (record-constructor <keymap> '(key-table)))
+(define keymap-key-table (record-accessor <keymap> 'key-table))
+(define set-keymap-key-table! (record-modifier <keymap> 'key-table))
+
+(define-public keymap? (record-predicate <keymap>))
+
+(define*-public (make-keymap)
+ (%make-keymap
+ ;; This is actually an association list.
+ '()))
+
+(define-public (keymap-lookup-key keymap key)
+ (assoc-ref (keymap-key-table keymap) key))
+
+(define*-public (keymap-bind-key! keymap key #:optional (bindable #f))
+ (let ((alist (keymap-key-table keymap)))
+ (set-keymap-key-table! keymap
+ (if bindable
+ (assoc-set! alist key bindable)
+ (assoc-remove! alist key)))))
+
+(define-public (keymap-lookup-binding keymap bindable)
+ (let ((entry (find (lambda (x) (eq? bindable (cdr x)))
+ (keymap-key-table keymap))))
+ (and entry (car entry))))
+
+(define-public (keymap-for-each proc keymap)
+ (for-each
+ (lambda (x) (proc (car x) (cdr x)))
+ (keymap-key-table keymap)))
commit 675c01fe262c1bbc912a43a74c3c96ca78dc88e2
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Key sequences.
Adds some Scheme API functions for working with key sequences. A key
sequence is a vector of key combinations.
diff --git a/docs/scheme-api/geda-scheme.texi b/docs/scheme-api/geda-scheme.texi
index 84dd13f..4edf37f 100644
--- a/docs/scheme-api/geda-scheme.texi
+++ b/docs/scheme-api/geda-scheme.texi
@@ -1521,6 +1521,42 @@ returned string is translated according to the user's current locale.
@end example
@end defun
+@subsection Key sequences
+
+Most gschem functionality is bound not to single key combinations but to
+sequences of them. For example, @strong{Fileâ??New} is bound to @kbd{F N}
+by default (i.e. press @key{F} followed by @key{N}). Key sequences are
+simply vectors of key bindings. For example:
+
+@example
+(string->keys ``F N'')
+=> #(#<gschem-key "F"> #<gschem-key "N">)
+@end example
+
+In this case, @key{F} is a @dfn{prefix key}, because pressing it does
+not cause an action to be carried out directly, but just changes the
+effect of pressing subsequent keys.
+
+@defun keys? obj
+Returns @samp{#t} if and only if @var{obj} is a valid key sequence.
+@end defun
+
+@defun string->keys str
+Parses @var{str} into a key sequence. The expected format is a sequence
+of key combination specifications (as could be passed to
+@code{string->key}) separated by spaces.
+@end defun
+
+@defun keys->string keys
+Converts the key sequence @var{keys} to a string, using a format
+suitable for passing to @code{string->keys}.
+@end defun
+
+@defun keys->display-string keys
+Converts the key sequence @var{keys} to a string, using a format
+suitable for display.
+@end defun
+
@node Selections
@section Selections
diff --git a/gschem/scheme/gschem/keymap.scm b/gschem/scheme/gschem/keymap.scm
index 6fddb0f..e2b87f0 100644
--- a/gschem/scheme/gschem/keymap.scm
+++ b/gschem/scheme/gschem/keymap.scm
@@ -32,3 +32,25 @@
(or (%string->key str)
(scm-error 'key-format #f
"~S is not a valid key combination." (list str) #f)))
+
+;; -------------------- Key sequences --------------------
+
+(define-public (keys? obj)
+ (and (vector? obj)
+ (> (vector-length obj) 0)
+ (call/cc
+ (lambda (return)
+ (array-for-each
+ (lambda (x) (or (key? x) (return #f)))
+ obj)))))
+
+(define-public (keys->string keys)
+ (string-join (map key->string (vector->list keys)) " "))
+
+(define-public (string->keys str)
+ (list->vector (map string->key
+ (filter! (lambda (x) (not (string-null? x)))
+ (string-split str #\space)))))
+
+(define-public (keys->display-string keys)
+ (string-join (map key->display-string (vector->list keys)) " "))
commit 5a3917a2fe89a1b3e43d0fe9f7ee6a466f65e57c
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
gschem: Key combinations as first-class objects.
Adds a new Scheme type to gschem that represents a key combination
(e.g. Ctrl+Shift+A). The interface for working with them simply wraps
the GTK+ accelerator handling API, which means it's easy to convert
the key combination smobs either into a precise representation for
storing or into a properly-translated "pretty" representation for
display.
diff --git a/docs/scheme-api/geda-scheme.texi b/docs/scheme-api/geda-scheme.texi
index ac02d47..84dd13f 100644
--- a/docs/scheme-api/geda-scheme.texi
+++ b/docs/scheme-api/geda-scheme.texi
@@ -1451,6 +1451,7 @@ focused on enabling and responding to user editing operations.
@menu
* Windows and views::
+* Key mapping::
* Selections::
* Hooks::
* Miscellanous gschem functions::
@@ -1476,6 +1477,50 @@ form @samp{(x . y)}. If the pointer is outside the display area,
returns @samp{#f}.
@end defun
+@node Key mapping
+@section Key mapping
+
+To use the functions described in this section, you will need to load
+the @code{(gschem keymap)} module.
+
+@subsection Key combinations
+
+gschem treats key combinations as first-class objects. A key
+combination consists of a non-modifier key press with some number of
+modifiers applied. For example, the key combination @kbd{Ctrl+Shift+A}
+(which calls @strong{Editâ??Deselect} by default) is typed by
+holding the @key{Ctrl} and @key{Shift} keys down, and then pressing
+@key{A}.
+
+@defun key? obj
+Returns @samp{#t} if and only if @var{obj} is a key combination.
+@end defun
+
+@defun string->key str
+Parses @var{str} to create a new key combination. The expected format
+looks like @samp{<Control>a} or @samp{<Shift><Alt>F1}. Key names are
+parsed using @code{gdk_keyval_from_name()}, and modifiers may appear in
+any order. If @var{str} has invalid syntax or does not represent a
+valid key combination, raises a @samp{key-format} error.
+@end defun
+
+@defun key->string key
+Converts @var{key} to a string, using a format suitable for passing to
+@code{string->key}.
+@end defun
+
+@defun key->display-string key
+Converts @var{key} to a string, using a format suitable for
+display. This should be used when the key combination needs to be
+displayed to the user e.g. in the gschem menus or status area. The
+returned string is translated according to the user's current locale.
+
+@example
+(key->display-string (string->key ``<Control>bracketright''))
+=> ``Ctrl+]''
+@end example
+@end defun
+
@node Selections
@section Selections
diff --git a/gschem/include/prototype.h b/gschem/include/prototype.h
index 463c709..089adf2 100644
--- a/gschem/include/prototype.h
+++ b/gschem/include/prototype.h
@@ -184,6 +184,7 @@ SCM g_keys_misc3(SCM rest);
SCM g_keys_help_about(SCM rest);
SCM g_keys_help_hotkeys(SCM rest);
SCM g_keys_cancel(SCM rest);
+void g_init_keys ();
/* g_rc.c */
void g_rc_parse_gtkrc();
SCM g_rc_gschem_version(SCM version);
diff --git a/gschem/scheme/Makefile.am b/gschem/scheme/Makefile.am
index 53902d1..6c60a63 100644
--- a/gschem/scheme/Makefile.am
+++ b/gschem/scheme/Makefile.am
@@ -14,7 +14,8 @@ nobase_dist_scmdata_DATA = \
gschem/selection.scm \
gschem/deprecated.scm \
gschem/hook.scm \
- gschem/attrib.scm
+ gschem/attrib.scm \
+ gschem/keymap.scm
MOSTLYCLEANFILES = *.log *~
CLEANFILES = *.log *~
diff --git a/gschem/scheme/gschem/keymap.scm b/gschem/scheme/gschem/keymap.scm
new file mode 100644
index 0000000..6fddb0f
--- /dev/null
+++ b/gschem/scheme/gschem/keymap.scm
@@ -0,0 +1,34 @@
+;; gEDA - GPL Electronic Design Automation
+;; gschem - gEDA Schematic Capture - Scheme API
+;; Copyright (C) 2011 Peter Brett <peter@xxxxxxxxxxxxx>
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
+;;
+
+(define-module (gschem keymap)
+ #:use-module (gschem core keymap))
+
+;; -------------------- Key combinations --------------------
+
+(define-public key? %key?)
+
+(define-public key->string %key->string)
+
+(define-public key->display-string %key->display-string)
+
+(define-public (string->key str)
+ (or (%string->key str)
+ (scm-error 'key-format #f
+ "~S is not a valid key combination." (list str) #f)))
diff --git a/gschem/src/Makefile.am b/gschem/src/Makefile.am
index 8437633..44e7cd1 100644
--- a/gschem/src/Makefile.am
+++ b/gschem/src/Makefile.am
@@ -3,6 +3,7 @@ bin_PROGRAMS = gschem
BUILT_SOURCES = \
g_attrib.x \
g_hook.x \
+ g_keys.x \
g_window.x \
g_select.x
diff --git a/gschem/src/g_keys.c b/gschem/src/g_keys.c
index 55344b3..f3a4177 100644
--- a/gschem/src/g_keys.c
+++ b/gschem/src/g_keys.c
@@ -39,6 +39,8 @@
#include <dmalloc.h>
#endif
+#include <gdk/gdkkeysyms.h>
+
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
@@ -395,3 +397,259 @@ DEFINE_G_KEYS(help_hotkeys)
being called with a null, I suppose we should call it with the right param.
hack */
DEFINE_G_KEYS(cancel)
+
+/*! Contains the smob tag for key smobs */
+static scm_t_bits g_key_smob_tag;
+#define G_SCM_IS_KEY(x) SCM_SMOB_PREDICATE (g_key_smob_tag, (x))
+
+/*! Type for keybindings. Used internally by gschem key smobs. */
+typedef struct {
+ guint keyval;
+ GdkModifierType modifiers;
+ gchar *str; /* UTF-8. Free with g_free(). */
+ gchar *disp_str; /* UTF-8. Free with g_free(). */
+} GschemKey;
+
+/*! \brief Test if a key is valid.
+ * \par Function Description
+ * Test if the key combination defined by \a keyval and \a modifiers
+ * is valid for key binding. This is a less restrictive version of
+ * gtk_accelerator_valid() from GTK 2.
+ *
+ * \param keyval The key that was pressed.
+ * \param modifiers The active modifiers when the key was pressed.
+ *
+ * \return TRUE if the key combination is valid for keybinding.
+ */
+static gboolean
+g_key_is_valid (guint keyval, GdkModifierType modifiers)
+{
+ static const guint invalid_keyvals[] = {
+ GDK_Shift_L, GDK_Shift_R, GDK_Shift_Lock, GDK_Caps_Lock, GDK_ISO_Lock,
+ GDK_Control_L, GDK_Control_R, GDK_Meta_L, GDK_Meta_R,
+ GDK_Alt_L, GDK_Alt_R, GDK_Super_L, GDK_Super_R, GDK_Hyper_L, GDK_Hyper_R,
+ GDK_ISO_Level3_Shift, GDK_ISO_Next_Group, GDK_ISO_Prev_Group,
+ GDK_ISO_First_Group, GDK_ISO_Last_Group,
+ GDK_Mode_switch, GDK_Num_Lock, GDK_Multi_key,
+ GDK_Scroll_Lock, GDK_Sys_Req,
+ GDK_Tab, GDK_ISO_Left_Tab, GDK_KP_Tab,
+ GDK_First_Virtual_Screen, GDK_Prev_Virtual_Screen,
+ GDK_Next_Virtual_Screen, GDK_Last_Virtual_Screen,
+ GDK_Terminate_Server, GDK_AudibleBell_Enable,
+ };
+ const guint *val;
+
+ /* Exclude a bunch of control chars */
+ if (keyval <= 0xFF) return keyval >= 0x20;
+
+ /* Exclude special & modifier keys */
+ val = invalid_keyvals;
+ while (*val) {
+ if (keyval == *val++) return FALSE;
+ }
+
+ return TRUE;
+}
+
+/*! \brief Create a new bindable key object.
+ * \par Function Description
+ * Create and return a new gschem key object from a \a keyval and a
+ * set of \a modifiers. If the key combination is invalid, return
+ * SCM_BOOL_F.
+ *
+ * \param keyval the pressed key.
+ * \param modifiers the active modifiers for the key.
+ *
+ * \return a new bindable key object, or SCM_BOOL_F.
+ */
+static SCM
+g_make_key (guint keyval, GdkModifierType modifiers)
+{
+ SCM result = SCM_BOOL_F;
+ if (g_key_is_valid (keyval, modifiers)) {
+ GschemKey *k = g_new0 (GschemKey, 1);
+ k->keyval = keyval;
+ k->modifiers = modifiers & GDK_MODIFIER_MASK;
+ SCM_NEWSMOB (result, g_key_smob_tag, k);
+ }
+ return result;
+}
+
+/*! \brief Test if a Scheme value is a bindable key object.
+ * \par Function Description
+ * Returns SCM_BOOL_T if \a key_s is a gschem key object. Otherwise,
+ * returns SCM_BOOL_F.
+ *
+ * \note Scheme API: Implements the %key? procedure in the
+ * (gschem core keymap) module.
+ *
+ * \param key_s value to test
+ * \return SCM_BOOL_T iff value is a key, otherwise SCM_BOOL_F.
+ */
+SCM_DEFINE (g_keyp, "%key?", 1, 0, 0, (SCM key_s),
+ "Test if value is a gschem key.")
+{
+ if (G_SCM_IS_KEY (key_s)) {
+ return SCM_BOOL_T;
+ } else {
+ return SCM_BOOL_F;
+ }
+}
+
+/*! \brief Create a bindable key object from a string.
+ * \par Function Description
+ * Parse the string key description \a str_s to create and return a
+ * new gschem key object. If \a str_s contains syntax errors, or does
+ * not represent a valid bindable key combination, returns SCM_BOOL_F.
+ *
+ * \note Scheme API: Implements the %string-key procedure in the
+ * (gschem core keymap) module.
+ *
+ * \param str_s string to parse.
+ * \return a new gschem key object, or SCM_BOOL_F.
+ */
+SCM_DEFINE (g_string_to_key, "%string->key", 1, 0, 0, (SCM str_s),
+ "Create a gschem key by parsing a string.")
+{
+ SCM_ASSERT (scm_is_string (str_s), str_s, SCM_ARG1, s_g_string_to_key);
+
+ guint keyval;
+ GdkModifierType modifiers;
+ char *str = scm_to_utf8_string (str_s);
+ gtk_accelerator_parse (str, &keyval, &modifiers);
+ if ((keyval == 0) && (modifiers == 0)) return SCM_BOOL_F;
+ return g_make_key (keyval, modifiers);
+}
+
+/*! \brief Convert a bindable key object to a string.
+ * \par Function Description
+ * Returns a string representation of the gschem key object \a key_s,
+ * in a format suitable for parsing with %string->key.
+ *
+ * \note Scheme API: Implements the %key->string procedure in the
+ * (gschem core keymap) module.
+ *
+ * \param key_s Bindable key object to convert to string.
+ * \return a string representation of the key combination.
+ */
+SCM_DEFINE (g_key_to_string, "%key->string", 1, 0, 0, (SCM key_s),
+ "Create a string from a gschem key.")
+{
+ SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1, s_g_key_to_string);
+
+ GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
+ if (key->str != NULL) return scm_from_utf8_string (key->str);
+
+ key->str = gtk_accelerator_name (key->keyval, key->modifiers);
+ return scm_from_utf8_string (key->str);
+}
+
+/*! \brief Convert a bindable key object to a displayable string.
+ * \par Function Description
+ * Returns a string representation of the gschem key object \a key_s,
+ * in a format suitable for display to the user (e.g. as accelerator
+ * text in a menu).
+ *
+ * \note Scheme API: Implements the %key->display-string procedure in
+ * the (gschem core keymap) module.
+ *
+ * \param key_s Bindable key object to convert to string.
+ * \return a string representation of the key combination.
+ */
+SCM_DEFINE (g_key_to_display_string, "%key->display-string", 1, 0, 0,
+ (SCM key_s), "Create a display string from a gschem key.")
+{
+ SCM_ASSERT (G_SCM_IS_KEY (key_s), key_s, SCM_ARG1,
+ s_g_key_to_display_string);
+
+ GschemKey *key = (GschemKey *) SCM_SMOB_DATA (key_s);
+ if (key->disp_str != NULL) return scm_from_utf8_string (key->disp_str);
+
+ key->disp_str = gtk_accelerator_get_label (key->keyval, key->modifiers);
+ return scm_from_utf8_string (key->disp_str);
+}
+
+/*! \brief Print a representation of a key smob
+ * \par Function Description
+ * Outputs a string representing the \a smob to a Scheme output \a
+ * port. The format used is "#<gschem-key \"Ctrl+A\">".
+ *
+ * Used internally to Guile.
+ */
+static int
+g_key_print (SCM smob, SCM port, scm_print_state *pstate)
+{
+ scm_puts ("#<gschem-key ", port);
+ scm_write (g_key_to_display_string (smob), port);
+ scm_puts (">", port);
+
+ /* Non-zero means success */
+ return 1;
+}
+
+/* \brief Test if two key combinations are equivalent.
+ * \par Function Description
+ * Tests if the two gschem key objects \a a and \a b represent the
+ * same key event.
+ *
+ * Used internally to Guile.
+ */
+static SCM
+g_key_equalp (SCM a, SCM b)
+{
+ GschemKey *akey = (GschemKey *) SCM_SMOB_DATA (a);
+ GschemKey *bkey = (GschemKey *) SCM_SMOB_DATA (b);
+ if (akey->keyval != bkey->keyval) return SCM_BOOL_F;
+ if (akey->modifiers != bkey->modifiers) return SCM_BOOL_F;
+ return SCM_BOOL_T;
+}
+
+/* \brief Destroy a bindable key object
+ * \par Function Description
+ * Destroys the contents of a gschem key object on garbage collection.
+ *
+ * Used internally to Guile.
+ */
+static size_t
+g_key_free (SCM key) {
+ GschemKey *k = (GschemKey *) SCM_SMOB_DATA (key);
+ g_free (k->str);
+ g_free (k->disp_str);
+ g_free (k);
+ return 0;
+}
+
+/*! \brief Create the (gschem core keymap) Scheme module
+ * \par Function Description
+ * Defines procedures in the (gschem core keymap) module. The module
+ * can be accessed using (use-modules (gschem core keymap)).
+ */
+static void
+init_module_gschem_core_keymap ()
+{
+ /* Register the functions */
+ #include "g_keys.x"
+
+ /* Add them to the module's public definitions */
+ scm_c_export (s_g_keyp, s_g_string_to_key, s_g_key_to_string,
+ s_g_key_to_display_string, NULL);
+}
+
+/*! \brief Initialise the key combination procedures
+ * \par Function Description
+ * Registers some Scheme procedures for working with key combinations.
+ * Should only be called by main_prog().
+ */
+void
+g_init_keys ()
+{
+ /* Register key smob type */
+ g_key_smob_tag = scm_make_smob_type ("gschem-key", 0);
+ scm_set_smob_print (g_key_smob_tag, g_key_print);
+ scm_set_smob_equalp (g_key_smob_tag, g_key_equalp);
+ scm_set_smob_free (g_key_smob_tag, g_key_free);
+
+ scm_c_define_module ("gschem core keymap",
+ init_module_gschem_core_keymap,
+ NULL);
+}
diff --git a/gschem/src/gschem.c b/gschem/src/gschem.c
index ec3452a..93b3e64 100644
--- a/gschem/src/gschem.c
+++ b/gschem/src/gschem.c
@@ -198,6 +198,7 @@ void main_prog(void *closure, int argc, char *argv[])
g_init_select ();
g_init_hook ();
g_init_attrib ();
+ g_init_keys ();
/* initialise color map (need to do this before reading rc files */
x_color_init ();
commit b34be3c923c680efac20e3fafc68f9f820eb7255
Author: Peter TB Brett <peter@xxxxxxxxxxxxx>
Commit: Peter TB Brett <peter@xxxxxxxxxxxxx>
scheme-api: Fix parse-attrib usage in deprecated set-attribute-value!
diff --git a/gschem/scheme/gschem/deprecated.scm b/gschem/scheme/gschem/deprecated.scm
index 8a90e7d..802513c 100644
--- a/gschem/scheme/gschem/deprecated.scm
+++ b/gschem/scheme/gschem/deprecated.scm
@@ -129,7 +129,7 @@
;; Set the value part of the text object attrib.
(define-public (set-attribute-value! attrib value)
(let ((params (text-info attrib))
- (name-value (attrib-parse attrib)))
+ (name-value (parse-attrib attrib)))
(list-set! params 3 (simple-format "~A=~A" (car name-value) value))
(apply set-text! attrib params)))
_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs