* [PATCH] Emacsy - formatting and consistency changes
@ 2023-12-04 22:55 Morgan Smith
2023-12-05 6:08 ` Janneke Nieuwenhuizen
0 siblings, 1 reply; 3+ messages in thread
From: Morgan Smith @ 2023-12-04 22:55 UTC (permalink / raw)
To: guile-user; +Cc: janneke
[-- Attachment #1: Type: text/plain, Size: 852 bytes --]
Hello!
I have some more patches for emacsy.
I apologize for the linting change. I know it is a massive patch that
will muddle the history and will make applying any pre-existing patches
more difficult. I normally try to avoid making such a change to a
project if I can avoid it.
However, the ".dir-locals.el" file made my Emacs delete trailing
whitespace which was resulting in ugly patches. Also running GNU indent
was apparently on the TODO list anyways. So I decided to go ahead and
run a simply lint script.
I then went through all the tests to make everything consistent.
I also started fixing some of the simple warnings I was getting (null
termination error, unknown variable error).
With these patches applied, the source should be easier to work with. I
am planning to start providing more exciting patches soon.
Thanks,
Morgan
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-scripts-Add-lint-script.patch --]
[-- Type: text/x-patch, Size: 1988 bytes --]
From ac6f1d111e8a3bb3acaa99090ff25dde10e2de02 Mon Sep 17 00:00:00 2001
From: Morgan Smith <Morgan.J.Smith@outlook.com>
Date: Mon, 4 Dec 2023 09:09:40 -0500
Subject: [PATCH 1/5] scripts: Add lint script
---
TODO | 2 +-
emacsy/emacsy.h | 4 ++++
scripts/lint.sh | 17 +++++++++++++++++
3 files changed, 22 insertions(+), 1 deletion(-)
create mode 100755 scripts/lint.sh
diff --git a/TODO b/TODO
index 5a449f7..5238097 100644
--- a/TODO
+++ b/TODO
@@ -9,7 +9,7 @@ source code and separate texinfo documentation. This setup is now
functional and needs lots of work and cleaning up.
* Cleanup examples
-Run GNU indent, use struct_ref etc (see Guimax) instead of `wud*2'.
+use struct_ref etc (see Guimax) instead of `wud*2'.
Also see guimax branch @ https://gitlab.com/janneke/emacsy-webkit-gtk
* Self-doc/help system
diff --git a/emacsy/emacsy.h b/emacsy/emacsy.h
index f8b0a12..908616e 100644
--- a/emacsy/emacsy.h
+++ b/emacsy/emacsy.h
@@ -23,9 +23,11 @@
#ifndef __EMACSY_H
#define __EMACSY_H 1
+/* *INDENT-OFF* */
#ifdef __cplusplus
extern "C" {
#endif
+/* *INDENT-ON* */
#include <libguile.h>
@@ -112,8 +114,10 @@ SCM scm_c_string_to_symbol (char const* str);
/* Ref @var{name} from emacsy module. */
SCM scm_c_emacsy_ref (char const* name);
+/* *INDENT-OFF* */
#ifdef __cplusplus
}
#endif
+/* *INDENT-ON* */
#endif // __EMACSY_H
diff --git a/scripts/lint.sh b/scripts/lint.sh
new file mode 100755
index 0000000..4176c23
--- /dev/null
+++ b/scripts/lint.sh
@@ -0,0 +1,17 @@
+#!/bin/sh
+# Time-stamp: <2023-12-04 Mon 09:15>
+# Copyright (C) 2023 by Morgan Smith
+
+top_srcdir=$(dirname "$0")/..
+
+c_source=$(find "$top_srcdir" -name "*.[ch]")
+scm_source=$(find "$top_srcdir" -name "*.scm")
+
+# eliminate trailing whitespace
+sed --in-place 's/[[:space:]]\+$//' $c_source $scm_source
+
+# replace tabs with 2 spaces
+sed --in-place 's/\t/ /' $c_source $scm_source
+
+# run indent
+indent --no-tabs --indent-level2 $c_source
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Run-lint-script.patch --]
[-- Type: text/x-patch, Size: 170763 bytes --]
From 35c486ef565db4be11e88c7f22e7967700a1d928 Mon Sep 17 00:00:00 2001
From: Morgan Smith <Morgan.J.Smith@outlook.com>
Date: Mon, 4 Dec 2023 09:18:47 -0500
Subject: [PATCH 2/5] Run lint script
---
emacsy/emacsy.c | 74 +--
emacsy/emacsy.h | 21 +-
emacsy/line-pragma.scm | 30 +-
example/emacsy-webkit-gtk-w-buffers.c | 449 ++++++++++--------
example/emacsy-webkit-gtk-w-buffers.scm | 8 +-
example/emacsy-webkit-gtk-w-windows.c | 607 +++++++++++++-----------
example/emacsy-webkit-gtk.c | 347 +++++++-------
example/emacsy-webkit-gtk.scm | 18 +-
example/hello-emacsy.c | 37 +-
scripts/doc-snarf.scm | 162 +++----
test/advice.scm | 56 +--
test/block.scm | 210 ++++----
test/check.scm | 80 ++--
test/command.scm | 26 +-
test/core.scm | 46 +-
test/emacsy.scm | 58 +--
test/event.scm | 50 +-
test/help.scm | 10 +-
test/kbd-macro.scm | 30 +-
test/keymap.scm | 78 +--
test/klecl.scm | 60 +--
test/window.scm | 60 +--
22 files changed, 1302 insertions(+), 1215 deletions(-)
diff --git a/emacsy/emacsy.c b/emacsy/emacsy.c
index ed1d884..32b04b3 100644
--- a/emacsy/emacsy.c
+++ b/emacsy/emacsy.c
@@ -56,7 +56,8 @@ emacsy_initialize (int init_flags)
return err;
(void) scm_call_1 (scm_c_emacsy_ref ("emacsy-initialize"),
- (init_flags & EMACSY_INTERACTIVE) ? SCM_BOOL_T : SCM_BOOL_F);
+ (init_flags & EMACSY_INTERACTIVE) ? SCM_BOOL_T :
+ SCM_BOOL_F);
return err;
}
@@ -73,8 +74,7 @@ emacsy_key_event (int char_code, int modifier_key_flags)
//fprintf (stderr, "c = %d\n", scm_to_int (scm_char_to_integer (c)));
(void) scm_call_2 (scm_c_emacsy_ref ("emacsy-key-event"),
- c,
- modifier_key_flags_to_list (modifier_key_flags));
+ c, modifier_key_flags_to_list (modifier_key_flags));
}
/* void emacsy_mouse_event (int x, int y, int state, int button, int modifier_key_flags)
@@ -82,29 +82,34 @@ emacsy_key_event (int char_code, int modifier_key_flags)
*/
void
emacsy_mouse_event (int x, int y,
- int state,
- int button,
- int modifier_key_flags)
+ int state, int button, int modifier_key_flags)
{
- SCM down_sym = scm_c_string_to_symbol ("down");
- SCM up_sym = scm_c_string_to_symbol ("up");
+ SCM down_sym = scm_c_string_to_symbol ("down");
+ SCM up_sym = scm_c_string_to_symbol ("up");
SCM motion_sym = scm_c_string_to_symbol ("motion");
SCM state_sym;
- switch (state) {
- case EMACSY_MOUSE_BUTTON_UP: state_sym = up_sym; break;
- case EMACSY_MOUSE_BUTTON_DOWN: state_sym = down_sym; break;
- case EMACSY_MOUSE_MOTION: state_sym = motion_sym; break;
- default:
- fprintf (stderr, "warning: mouse event state received invalid input %d.\n",
- state);
- return;
- }
+ switch (state)
+ {
+ case EMACSY_MOUSE_BUTTON_UP:
+ state_sym = up_sym;
+ break;
+ case EMACSY_MOUSE_BUTTON_DOWN:
+ state_sym = down_sym;
+ break;
+ case EMACSY_MOUSE_MOTION:
+ state_sym = motion_sym;
+ break;
+ default:
+ fprintf (stderr,
+ "warning: mouse event state received invalid input %d.\n",
+ state);
+ return;
+ }
(void) scm_call_3 (scm_c_emacsy_ref ("emacsy-mouse-event"),
scm_vector (scm_list_2 (scm_from_int (x),
scm_from_int (y))),
- scm_from_int (button),
- state_sym);
+ scm_from_int (button), state_sym);
}
/* int emacsy_tick ()
@@ -125,8 +130,8 @@ emacsy_tick ()
/* char *emacsy_message_or_echo_area ()
*/
-char
-*emacsy_message_or_echo_area ()
+char *
+emacsy_message_or_echo_area ()
{
return scm_to_locale_string
(scm_call_0 (scm_c_emacsy_ref ("emacsy-message-or-echo-area")));
@@ -172,7 +177,8 @@ emacsy_run_hook_0 (char const *hook_name)
int
emacsy_minibuffer_point ()
{
- return scm_to_int (scm_call_0 (scm_c_emacsy_ref ("emacsy-minibuffer-point")));
+ return
+ scm_to_int (scm_call_0 (scm_c_emacsy_ref ("emacsy-minibuffer-point")));
}
/* int emacsy_terminate ()
@@ -219,14 +225,15 @@ emacsy_load_module (char const *module)
SCM result = scm_internal_catch (SCM_BOOL_T,
load_module_try, (void *) module,
load_module_error, (void *) module);
- if (scm_is_false (scm_car (result))) {
- fprintf (stderr, "error: Unable to load module (%s); got error to key %s with args %s. Try setting the "
- "GUILE_LOAD_PATH environment variable.\n", module,
- scm_to_locale_string (scm_car (scm_cdr (result))),
- scm_to_locale_string (scm_car (scm_cdr (scm_cdr (result))))
- );
- return 1; //EMACSY_ERR_NO_MODULE;
- }
+ if (scm_is_false (scm_car (result)))
+ {
+ fprintf (stderr,
+ "error: Unable to load module (%s); got error to key %s with args %s. Try setting the "
+ "GUILE_LOAD_PATH environment variable.\n", module,
+ scm_to_locale_string (scm_car (scm_cdr (result))),
+ scm_to_locale_string (scm_car (scm_cdr (scm_cdr (result)))));
+ return 1; //EMACSY_ERR_NO_MODULE;
+ }
return 0;
}
@@ -235,7 +242,8 @@ emacsy_load_module (char const *module)
SCM
modifier_key_flags_to_list (int modifier_key_flags)
{
- const char* modifiers[] = { "alt", "control", "hyper", "meta", "super", "shift" };
+ const char *modifiers[] =
+ { "alt", "control", "hyper", "meta", "super", "shift" };
SCM list = SCM_EOL;
for (int i = 0; i < EMACSY_MODKEY_COUNT; i++)
if (modifier_key_flags & (1 << i))
@@ -247,7 +255,7 @@ modifier_key_flags_to_list (int modifier_key_flags)
/* SCM scm_c_string_to_symbol (char const* str)
*/
SCM
-scm_c_string_to_symbol (char const* str)
+scm_c_string_to_symbol (char const *str)
{
return scm_string_to_symbol (scm_from_locale_string (str));
}
@@ -272,7 +280,7 @@ SCM_DEFINE (scm_modifier_key_flags_to_list, "modifier-key-flags->list",
* Ref @var{name} from emacsy module.
*/
SCM
-scm_c_emacsy_ref (char const* name)
+scm_c_emacsy_ref (char const *name)
{
return scm_c_public_ref ("emacsy emacsy", name);
}
diff --git a/emacsy/emacsy.h b/emacsy/emacsy.h
index 908616e..01bb225 100644
--- a/emacsy/emacsy.h
+++ b/emacsy/emacsy.h
@@ -66,17 +66,14 @@
*/
/* Initialize Emacsy. */
-int emacsy_initialize (int init_flags);
+int emacsy_initialize (int init_flags);
/* Enqueue a keyboard event. */
-void emacsy_key_event (int char_code,
- int modifier_key_flags);
+void emacsy_key_event (int char_code, int modifier_key_flags);
/* Enqueue a mouse event. */
void emacsy_mouse_event (int x, int y,
- int state,
- int button,
- int modifier_key_flags);
+ int state, int button, int modifier_key_flags);
/* Run an iteration of Emacsy's event loop, does not block. */
int emacsy_tick ();
@@ -91,13 +88,13 @@ char *emacsy_mode_line ();
char *emacsy_current_buffer ();
/* Run a hook. */
-int emacsy_run_hook_0 (char const *hook_name);
+int emacsy_run_hook_0 (char const *hook_name);
/* Return the minibuffer point. */
-int emacsy_minibuffer_point ();
+int emacsy_minibuffer_point ();
/* Terminate Emacsy; run termination hook. */
-int emacsy_terminate ();
+int emacsy_terminate ();
/* Attempt to load a module. */
int emacsy_load_module (char const *module_name);
@@ -106,13 +103,13 @@ int emacsy_load_module (char const *module_name);
//int emacsy_load(const char *file_name);
/* Convert the modifier_key_flags into a Scheme list of symbols. */
-SCM modifier_key_flags_to_list(int modifier_key_flags);
+SCM modifier_key_flags_to_list (int modifier_key_flags);
/* SCM scm_c_string_to_symbol (char const* str) */
-SCM scm_c_string_to_symbol (char const* str);
+SCM scm_c_string_to_symbol (char const *str);
/* Ref @var{name} from emacsy module. */
-SCM scm_c_emacsy_ref (char const* name);
+SCM scm_c_emacsy_ref (char const *name);
/* *INDENT-OFF* */
#ifdef __cplusplus
diff --git a/emacsy/line-pragma.scm b/emacsy/line-pragma.scm
index 4e40fe4..f00c0ac 100644
--- a/emacsy/line-pragma.scm
+++ b/emacsy/line-pragma.scm
@@ -1,9 +1,9 @@
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -20,13 +20,13 @@
#:use-module (ice-9 rdelim))
(eval-when (compile load eval)
- (define line-pragma-handler ;;; BUG: The line pragma ends up littering the source with zero length
- ;;; strings, which often doesn't matter, but it can't be used everywhere
- ;;; especially within a particular form. I'm not entirely sure how to fix
- ;;; that.
- ;;;
- ;;;
- ;;; <Line Pragma Handler>=
+ (define line-pragma-handler ;;; BUG: The line pragma ends up littering the source with zero length
+ ;;; strings, which often doesn't matter, but it can't be used everywhere
+ ;;; especially within a particular form. I'm not entirely sure how to fix
+ ;;; that.
+ ;;;
+ ;;;
+ ;;; <Line Pragma Handler>=
(lambda (char port)
(let ((ine (read port))
(lineno (read port))
@@ -41,12 +41,12 @@
)))
(read-hash-extend #\l #f)
(read-hash-extend #\l line-pragma-handler)
- #;(read-hash-extend #\" ;;; The above code will see a string "\#line 352 " followed by a bare
- ;;; symbol emacsy.w, which will not do. To get around this, I implemented
- ;;; another reader extension that will strip out any \#l lines within it.
- ;;;
- ;;;
- ;;; <Liberal String Quote Reader>=
+ #;(read-hash-extend #\" ;;; The above code will see a string "\#line 352 " followed by a bare
+ ;;; symbol emacsy.w, which will not do. To get around this, I implemented
+ ;;; another reader extension that will strip out any \#l lines within it.
+ ;;;
+ ;;;
+ ;;; <Liberal String Quote Reader>=
(lambda (char port)
(let ((accum '()))
(let loop ((entry (read-char port)))
diff --git a/example/emacsy-webkit-gtk-w-buffers.c b/example/emacsy-webkit-gtk-w-buffers.c
index ca0dd45..9b235a5 100644
--- a/example/emacsy-webkit-gtk-w-buffers.c
+++ b/example/emacsy-webkit-gtk-w-buffers.c
@@ -58,27 +58,28 @@
#include <libguile.h>
/* Event Handlers */
-static void destroy_window(GtkWidget* widget, GtkWidget* window);
-static gboolean close_window(WebKitWebView* webView, GtkWidget* window);
-static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_data);
-static gboolean process_and_update_emacsy(void *user_data);
+static void destroy_window (GtkWidget * widget, GtkWidget * window);
+static gboolean close_window (WebKitWebView * webView, GtkWidget * window);
+static gboolean key_press (GtkWidget * widget, GdkEventKey * event,
+ gpointer user_data);
+static gboolean process_and_update_emacsy (void *user_data);
/* Registers the Scheme primitive procedures */
-static void init_primitives(void);
+static void init_primitives (void);
/* Scheme Primitives */
-SCM scm_webkit_load_url(SCM url);
+SCM scm_webkit_load_url (SCM url);
-SCM scm_webkit_forward();
-SCM scm_webkit_backward();
-SCM scm_webkit_reload();
-SCM scm_webkit_find_next(SCM text);
-SCM scm_webkit_find_previous(SCM text);
-SCM scm_webkit_find_finish();
-SCM scm_webkit_zoom_in();
-SCM scm_webkit_zoom_out();
+SCM scm_webkit_forward ();
+SCM scm_webkit_backward ();
+SCM scm_webkit_reload ();
+SCM scm_webkit_find_next (SCM text);
+SCM scm_webkit_find_previous (SCM text);
+SCM scm_webkit_find_finish ();
+SCM scm_webkit_zoom_in ();
+SCM scm_webkit_zoom_out ();
//SCM scm_webkit_eval_javascript(SCM script, SCM when_finished_proc);
/* Global state */
@@ -88,7 +89,8 @@ WebKitWebView *web_view; /* The WebKit browser */
GtkWidget *scrolled_window;
char *
-try_load_startup (char const* prefix, char const* dir, char const* startup_script)
+try_load_startup (char const *prefix, char const *dir,
+ char const *startup_script)
{
static char file_name[PATH_MAX];
if (prefix)
@@ -120,24 +122,24 @@ try_load_startup (char const* prefix, char const* dir, char const* startup_scrip
Create a minimal web browser that has Emacsy integrated into it.
*/
int
-main (int argc, char* argv[])
+main (int argc, char *argv[])
{
int err;
// Initialize GNU Guile.
- scm_init_guile();
+ scm_init_guile ();
// Initialize Emacsy.
err = emacsy_initialize (EMACSY_INTERACTIVE);
if (err)
return err;
// Register the primitive procedures that control the browser.
- init_primitives();
+ init_primitives ();
// You can evaluate S-expressions here.
- scm_c_eval_string("(use-modules (system repl error-handling))"
- "(define (safe-load filename) "
- " (call-with-error-handling "
- " (lambda () (load filename)))) ");
+ scm_c_eval_string ("(use-modules (system repl error-handling))"
+ "(define (safe-load filename) "
+ " (call-with-error-handling "
+ " (lambda () (load filename)))) ");
// But to make the application easy to mold, it's best to load the
// Scheme code from a file.
@@ -149,33 +151,31 @@ main (int argc, char* argv[])
dirname (dirname (prefix));
if (!try_load_startup (0, 0, startup_script)
- &&!try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
- &&!try_load_startup (prefix, "/", startup_script)
- &&!try_load_startup (prefix, "/etc/emacsy/", startup_script))
+ && !try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
+ && !try_load_startup (prefix, "/", startup_script)
+ && !try_load_startup (prefix, "/etc/emacsy/", startup_script))
fprintf (stderr, "error: failed to find '%s'.\n", startup_script);
// Initialize GTK+.
- gtk_init(&argc, &argv);
+ gtk_init (&argc, &argv);
// Create an 800x600 window that will contain the browser instance.
- GtkWidget *main_window = gtk_window_new(GTK_WINDOW_TOPLEVEL);
- gtk_window_set_default_size(GTK_WINDOW(main_window), 800, 600);
+ GtkWidget *main_window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+ gtk_window_set_default_size (GTK_WINDOW (main_window), 800, 600);
//gtk_window_set_size(GTK_WINDOW(main_window), 800, 600);
GdkGeometry geom_struct;
geom_struct.max_width = 800;
geom_struct.max_height = 600;
- gtk_window_set_geometry_hints(GTK_WINDOW(main_window),
- NULL,
- &geom_struct,
- GDK_HINT_MAX_SIZE);
+ gtk_window_set_geometry_hints (GTK_WINDOW (main_window),
+ NULL, &geom_struct, GDK_HINT_MAX_SIZE);
#if 0
/* you might need to use GTK_STATE_ACTIVE or GTK_STATE_PRELIGHT */
- GdkColor black = {0, 0x0, 0x0, 0x0};
- GdkColor white = {0, 0xFFFF, 0xFFFF, 0xFFFF};
- gtk_widget_modify_bg(GTK_WINDOW(main_window), GTK_STATE_NORMAL, &black);
- gtk_widget_modify_fg(GTK_WINDOW(main_window), GTK_STATE_NORMAL, &white);
+ GdkColor black = { 0, 0x0, 0x0, 0x0 };
+ GdkColor white = { 0, 0xFFFF, 0xFFFF, 0xFFFF };
+ gtk_widget_modify_bg (GTK_WINDOW (main_window), GTK_STATE_NORMAL, &black);
+ gtk_widget_modify_fg (GTK_WINDOW (main_window), GTK_STATE_NORMAL, &white);
#endif
// Create a browser instance
@@ -184,61 +184,64 @@ main (int argc, char* argv[])
web_view = NULL;
// Create a scrollable area, and put the browser instance into it
- scrolled_window = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scrolled_window),
- GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+ scrolled_window = gtk_scrolled_window_new (NULL, NULL);
+ gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (scrolled_window),
+ GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
// Create one web view buffer
- scm_call_1(scm_c_public_ref("guile-user", "new-tab"),
- scm_from_utf8_string(
- "http://shanecelis.github.io/2013/06/15/the-garden/"));
+ scm_call_1 (scm_c_public_ref ("guile-user", "new-tab"),
+ scm_from_utf8_string
+ ("http://shanecelis.github.io/2013/06/15/the-garden/"));
// gtk_container_add(GTK_CONTAINER(scrolled_window), GTK_WIDGET(web_view));
// Set up callbacks so that if either the main window or the browser
// instance is closed, the program will exit.
- g_signal_connect(main_window, "destroy", G_CALLBACK(destroy_window), NULL);
+ g_signal_connect (main_window, "destroy", G_CALLBACK (destroy_window),
+ NULL);
//g_signal_connect(web_view, "close-web-view", G_CALLBACK(close_window), main_window);
// This label will be where we display Emacsy's echo-area.
- label = gtk_label_new("label");
- gtk_misc_set_alignment(GTK_MISC(label), 0.0f, 0.0f);
- gtk_label_set_use_underline(GTK_LABEL(label), FALSE);
- gtk_label_set_line_wrap(GTK_LABEL(label), TRUE);
- gtk_label_set_single_line_mode(GTK_LABEL(label), TRUE);
- gtk_label_set_max_width_chars(GTK_LABEL(label), 160);
+ label = gtk_label_new ("label");
+ gtk_misc_set_alignment (GTK_MISC (label), 0.0f, 0.0f);
+ gtk_label_set_use_underline (GTK_LABEL (label), FALSE);
+ gtk_label_set_line_wrap (GTK_LABEL (label), TRUE);
+ gtk_label_set_single_line_mode (GTK_LABEL (label), TRUE);
+ gtk_label_set_max_width_chars (GTK_LABEL (label), 160);
- modeline = gtk_label_new("modeline");
- gtk_misc_set_alignment(GTK_MISC(modeline), 0.0f, 0.0f);
- gtk_label_set_use_underline(GTK_LABEL(modeline), FALSE);
- gtk_label_set_line_wrap(GTK_LABEL(modeline), TRUE);
- gtk_label_set_single_line_mode(GTK_LABEL(modeline), TRUE);
- gtk_label_set_max_width_chars(GTK_LABEL(modeline), 160);
+ modeline = gtk_label_new ("modeline");
+ gtk_misc_set_alignment (GTK_MISC (modeline), 0.0f, 0.0f);
+ gtk_label_set_use_underline (GTK_LABEL (modeline), FALSE);
+ gtk_label_set_line_wrap (GTK_LABEL (modeline), TRUE);
+ gtk_label_set_single_line_mode (GTK_LABEL (modeline), TRUE);
+ gtk_label_set_max_width_chars (GTK_LABEL (modeline), 160);
// Handle Emacsy key press and release events.
- g_signal_connect(main_window, "key_press_event", G_CALLBACK(key_press), NULL);
- g_signal_connect(main_window, "key_release_event", G_CALLBACK(key_press), NULL);
+ g_signal_connect (main_window, "key_press_event", G_CALLBACK (key_press),
+ NULL);
+ g_signal_connect (main_window, "key_release_event", G_CALLBACK (key_press),
+ NULL);
GtkWidget *vbox;
- vbox = gtk_vbox_new(FALSE, 1);
- gtk_container_add(GTK_CONTAINER(vbox), scrolled_window);
- gtk_box_pack_start(GTK_BOX(vbox), modeline, FALSE, FALSE, 0);
- gtk_box_pack_start(GTK_BOX(vbox), label, FALSE, FALSE, 0);
+ vbox = gtk_vbox_new (FALSE, 1);
+ gtk_container_add (GTK_CONTAINER (vbox), scrolled_window);
+ gtk_box_pack_start (GTK_BOX (vbox), modeline, FALSE, FALSE, 0);
+ gtk_box_pack_start (GTK_BOX (vbox), label, FALSE, FALSE, 0);
// Put the scrollable area into the main window.
- gtk_container_add(GTK_CONTAINER(main_window), vbox);
+ gtk_container_add (GTK_CONTAINER (main_window), vbox);
// Make sure that when the browser area becomes visible, it will get mouse
// and keyboard events.
- gtk_widget_grab_focus(GTK_WIDGET(web_view));
+ gtk_widget_grab_focus (GTK_WIDGET (web_view));
// Make sure the main window and all its contents are visible.
- gtk_widget_show_all(main_window);
- gtk_window_set_resizable(GTK_WINDOW(main_window), FALSE);
+ gtk_widget_show_all (main_window);
+ gtk_window_set_resizable (GTK_WINDOW (main_window), FALSE);
// Run the main GTK+ event loop.
- gtk_main();
+ gtk_main ();
return 0;
}
@@ -248,30 +251,35 @@ main (int argc, char* argv[])
==============
*/
-static void destroy_window(GtkWidget* widget, GtkWidget* window)
+static void
+destroy_window (GtkWidget *widget, GtkWidget *window)
{
- gtk_main_quit();
+ gtk_main_quit ();
}
-static gboolean close_window(WebKitWebView* web_view, GtkWidget* window)
+static gboolean
+close_window (WebKitWebView *web_view, GtkWidget *window)
{
- gtk_widget_destroy(window);
+ gtk_widget_destroy (window);
return TRUE;
}
-static int scm_c_char_to_int(const char *char_name) {
+static int
+scm_c_char_to_int (const char *char_name)
+{
/* I should put a regex in here to validate it's a char */
- return scm_to_int(scm_char_to_integer(scm_c_eval_string(char_name)));
+ return scm_to_int (scm_char_to_integer (scm_c_eval_string (char_name)));
}
-static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_data)
+static gboolean
+key_press (GtkWidget *widget, GdkEventKey *event, gpointer user_data)
{
static guint32 last_unichar = 0;
guint32 unichar;
GdkModifierType modifiers;
int mod_flags = 0;
- modifiers = gtk_accelerator_get_default_mod_mask();
+ modifiers = gtk_accelerator_get_default_mod_mask ();
if (event->state & modifiers & GDK_CONTROL_MASK)
mod_flags |= EMACSY_MODKEY_CONTROL;
@@ -284,90 +292,105 @@ static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_d
if (event->state & modifiers & GDK_MOD1_MASK)
mod_flags |= EMACSY_MODKEY_META;
- unichar = gdk_keyval_to_unicode(event->keyval);
+ unichar = gdk_keyval_to_unicode (event->keyval);
// Fix up any key values that don't translate perfectly.
if (event->keyval == GDK_KEY_BackSpace)
- unichar = scm_c_char_to_int("#\\del");
+ unichar = scm_c_char_to_int ("#\\del");
// If unichar is 0 then it's not a regular key, e.g., Control, Meta, etc.
- if (event->type == GDK_KEY_PRESS) {
- printf("Key press %d %s (unicode %d last_unichar %d)\n",
- event->keyval, event->string, unichar, last_unichar);
- // Fix up some keys.
- if (unichar) {
- // Register the key event with Emacsy.
- emacsy_key_event(unichar, mod_flags);
- /*
- One can do the event handling and the actual processing
- separately in Emacsy. However, in this case, it's convenient
- to do some processing in the event handling here so we know
- whether or not to pass the event on to the browser.
-
- So we call process_and_update_emacsy to actually do the processing.
- */
- process_and_update_emacsy(NULL);
-
- int flags = emacsy_tick();
-
- printf("flags = %d\n", flags);
- if (flags & EMACSY_RAN_UNDEFINED_COMMAND_P) {
- printf("Passing to browser.\n");
- return FALSE; // Pass the event through to the web browser.
- } else {
- printf("Emacsy handled it.\n");
- last_unichar = unichar;
- return TRUE; // Emacsy handled it. Don't pass the event through.
- }
+ if (event->type == GDK_KEY_PRESS)
+ {
+ printf ("Key press %d %s (unicode %d last_unichar %d)\n",
+ event->keyval, event->string, unichar, last_unichar);
+ // Fix up some keys.
+ if (unichar)
+ {
+ // Register the key event with Emacsy.
+ emacsy_key_event (unichar, mod_flags);
+ /*
+ One can do the event handling and the actual processing
+ separately in Emacsy. However, in this case, it's convenient
+ to do some processing in the event handling here so we know
+ whether or not to pass the event on to the browser.
+
+ So we call process_and_update_emacsy to actually do the processing.
+ */
+ process_and_update_emacsy (NULL);
+
+ int flags = emacsy_tick ();
+
+ printf ("flags = %d\n", flags);
+ if (flags & EMACSY_RAN_UNDEFINED_COMMAND_P)
+ {
+ printf ("Passing to browser.\n");
+ return FALSE; // Pass the event through to the web browser.
+ }
+ else
+ {
+ printf ("Emacsy handled it.\n");
+ last_unichar = unichar;
+ return TRUE; // Emacsy handled it. Don't pass the event through.
+ }
+ }
}
- } else if (event->type == GDK_KEY_RELEASE) {
- /*
- We receive both key presses and key releases. If we decide not
- to pass a key event when pressed, then we remember it
- (last_unichar) such that we squelch the key release event too.
- */
- printf("Key release %d %s (unicode %d last_unichar %d)\n",
- event->keyval, event->string, unichar, last_unichar);
- if (last_unichar && last_unichar == unichar) {
- last_unichar = 0;
- return TRUE; // Don't pass event to the browser.
+ else if (event->type == GDK_KEY_RELEASE)
+ {
+ /*
+ We receive both key presses and key releases. If we decide not
+ to pass a key event when pressed, then we remember it
+ (last_unichar) such that we squelch the key release event too.
+ */
+ printf ("Key release %d %s (unicode %d last_unichar %d)\n",
+ event->keyval, event->string, unichar, last_unichar);
+ if (last_unichar && last_unichar == unichar)
+ {
+ last_unichar = 0;
+ return TRUE; // Don't pass event to the browser.
+ }
}
- }
- return FALSE; // Pass the event to the browser.
+ return FALSE; // Pass the event to the browser.
}
/*
Process events in Emacsy then update the echo area at the bottom of the
screen.
*/
-static gboolean process_and_update_emacsy(void *user_data)
+static gboolean
+process_and_update_emacsy (void *user_data)
{
// Process events and any background coroutines.
- int flags = emacsy_tick();
+ int flags = emacsy_tick ();
// If there's been a request to quit, quit.
if (flags & EMACSY_QUIT_APPLICATION_P)
- gtk_main_quit();
+ gtk_main_quit ();
// Update the status line.
- const char *modeline_string = emacsy_mode_line();
- const char *status = emacsy_message_or_echo_area();
+ const char *modeline_string = emacsy_mode_line ();
+ const char *status = emacsy_message_or_echo_area ();
// Use markup to style the status line.
- char *markup = g_markup_printf_escaped ("<span foreground=\"white\" background=\"black\" underline=\"single\"><tt>%s </tt></span>", status);
- gtk_label_set_markup(GTK_LABEL(label), markup);
- g_free(markup);
-
- markup = g_markup_printf_escaped ("<span foreground=\"white\" background=\"black\" underline=\"none\"><tt>%s </tt></span>", modeline_string);
- gtk_label_set_markup(GTK_LABEL(modeline), markup);
- g_free(markup);
+ char *markup =
+ g_markup_printf_escaped
+ ("<span foreground=\"white\" background=\"black\" underline=\"single\"><tt>%s </tt></span>",
+ status);
+ gtk_label_set_markup (GTK_LABEL (label), markup);
+ g_free (markup);
+
+ markup =
+ g_markup_printf_escaped
+ ("<span foreground=\"white\" background=\"black\" underline=\"none\"><tt>%s </tt></span>",
+ modeline_string);
+ gtk_label_set_markup (GTK_LABEL (modeline), markup);
+ g_free (markup);
// Show the cursor. Exercise for the reader: Make it blink.
char message[255];
- memset(message, ' ', 254);
+ memset (message, ' ', 254);
message[255] = NULL;
- message[emacsy_minibuffer_point() - 1] = '_';
- gtk_label_set_pattern(GTK_LABEL(label), message);
+ message[emacsy_minibuffer_point () - 1] = '_';
+ gtk_label_set_pattern (GTK_LABEL (label), message);
return TRUE;
}
@@ -379,133 +402,136 @@ static gboolean process_and_update_emacsy(void *user_data)
These C functions are exposed as callable procedures in Scheme.
*/
-SCM_DEFINE(scm_destroy_web_view_x, "destroy-web-view!", 1, 0, 0,
- (SCM web_view_pointer), "Destroys the web view pointer.") {
+SCM_DEFINE (scm_destroy_web_view_x, "destroy-web-view!", 1, 0, 0,
+ (SCM web_view_pointer), "Destroys the web view pointer.")
+{
- GtkWidget *view = GTK_WIDGET(scm_to_pointer(web_view_pointer));
+ GtkWidget *view = GTK_WIDGET (scm_to_pointer (web_view_pointer));
- if (view) {
- gtk_widget_destroy(view);
- }
+ if (view)
+ {
+ gtk_widget_destroy (view);
+ }
return SCM_UNDEFINED;
}
-SCM_DEFINE(scm_set_web_view_x, "set-web-view!", 1, 0, 0, (SCM web_view_pointer),
- "Set the current web view to the given pointer.") {
+SCM_DEFINE (scm_set_web_view_x, "set-web-view!", 1, 0, 0,
+ (SCM web_view_pointer),
+ "Set the current web view to the given pointer.")
+{
#if HAVE_SCM_POINTER_P
- if (scm_is_true(scm_pointer_p(web_view_pointer)))
+ if (scm_is_true (scm_pointer_p (web_view_pointer)))
#else
- if (SCM_POINTER_P(web_view_pointer))
+ if (SCM_POINTER_P (web_view_pointer))
#endif
- {
- GList *children = gtk_container_get_children(scrolled_window);
- GtkWidget *current = g_list_nth_data(children, 0);
-
- // Remove the current one from the window.
- if (current) {
- // Reference the web view so it is not destroyed once removed
- // from the container.
- g_object_ref(current);
- gtk_container_remove(GTK_CONTAINER(scrolled_window), current);
+ {
+ GList *children = gtk_container_get_children (scrolled_window);
+ GtkWidget *current = g_list_nth_data (children, 0);
+
+ // Remove the current one from the window.
+ if (current)
+ {
+ // Reference the web view so it is not destroyed once removed
+ // from the container.
+ g_object_ref (current);
+ gtk_container_remove (GTK_CONTAINER (scrolled_window), current);
+ }
+ // FIXME: mutating the current web_view is dangerous convert global
+ // variable web_view to current_web_view function. And update the
+ // webkit procedures.
+ web_view = WEBKIT_WEB_VIEW (scm_to_pointer (web_view_pointer));
+ gtk_container_add (GTK_CONTAINER (scrolled_window),
+ GTK_WIDGET (web_view));
+ gtk_widget_show_all (GTK_WIDGET (scrolled_window));
}
- // FIXME: mutating the current web_view is dangerous convert global
- // variable web_view to current_web_view function. And update the
- // webkit procedures.
- web_view = WEBKIT_WEB_VIEW(scm_to_pointer(web_view_pointer));
- gtk_container_add(GTK_CONTAINER(scrolled_window), GTK_WIDGET(web_view));
- gtk_widget_show_all(GTK_WIDGET(scrolled_window));
- } else
- fprintf(stderr, "error: not given a pointer in set-web-view!\n");
+ else
+ fprintf (stderr, "error: not given a pointer in set-web-view!\n");
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_make_web_view, "make-web-view", 0, 0, 0,
- (),
- "Creates and returns a pointer to a new webkit view.")
+SCM_DEFINE (scm_make_web_view, "make-web-view", 0, 0, 0,
+ (), "Creates and returns a pointer to a new webkit view.")
{
- WebKitWebView *a_web_view = WEBKIT_WEB_VIEW(webkit_web_view_new());
- a_web_view = g_object_ref(a_web_view);
- return scm_from_pointer(a_web_view, /*g_free*/ NULL);
+ WebKitWebView *a_web_view = WEBKIT_WEB_VIEW (webkit_web_view_new ());
+ a_web_view = g_object_ref (a_web_view);
+ return scm_from_pointer (a_web_view, /*g_free */ NULL);
}
-SCM_DEFINE(scm_webkit_load_url, "webkit-load-url", 1, 0, 0,
- (SCM scm_url),
- "Loads a given URL into the WebView.")
+SCM_DEFINE (scm_webkit_load_url, "webkit-load-url", 1, 0, 0,
+ (SCM scm_url), "Loads a given URL into the WebView.")
{
- const char *c_url = scm_to_locale_string(scm_url);
- webkit_web_view_load_uri(web_view, c_url);
- return SCM_UNSPECIFIED;
+ const char *c_url = scm_to_locale_string (scm_url);
+ webkit_web_view_load_uri (web_view, c_url);
+ return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_forward, "webkit-forward", 0, 0, 0,
- (),
- "Move browser forward.")
+SCM_DEFINE (scm_webkit_forward, "webkit-forward", 0, 0, 0,
+ (), "Move browser forward.")
{
- if (webkit_web_view_can_go_forward(web_view)) {
- webkit_web_view_go_forward(web_view);
- return SCM_BOOL_T;
- }
+ if (webkit_web_view_can_go_forward (web_view))
+ {
+ webkit_web_view_go_forward (web_view);
+ return SCM_BOOL_T;
+ }
return SCM_BOOL_F;
}
-SCM_DEFINE(scm_webkit_backward, "webkit-backward", 0, 0, 0,
- (),
- "Move browser backward.")
+SCM_DEFINE (scm_webkit_backward, "webkit-backward", 0, 0, 0,
+ (), "Move browser backward.")
{
- if (webkit_web_view_can_go_back(web_view)) {
- webkit_web_view_go_back(web_view);
- return SCM_BOOL_T;
- }
+ if (webkit_web_view_can_go_back (web_view))
+ {
+ webkit_web_view_go_back (web_view);
+ return SCM_BOOL_T;
+ }
return SCM_BOOL_F;
}
-SCM_DEFINE(scm_webkit_reload, "webkit-reload", 0, 0, 0,
- (),
- "Reload browser.")
+SCM_DEFINE (scm_webkit_reload, "webkit-reload", 0, 0, 0,
+ (), "Reload browser.")
{
- webkit_web_view_reload(web_view);
+ webkit_web_view_reload (web_view);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_next, "webkit-find-next", 1, 0, 0,
- (SCM text),
- "Find next.")
+SCM_DEFINE (scm_webkit_find_next, "webkit-find-next", 1, 0, 0,
+ (SCM text), "Find next.")
{
- const char *c_text = scm_to_locale_string(text);
- webkit_find_controller_search (webkit_web_view_get_find_controller (web_view), c_text, WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE, 0);
+ const char *c_text = scm_to_locale_string (text);
+ webkit_find_controller_search (webkit_web_view_get_find_controller
+ (web_view), c_text,
+ WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE, 0);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_previous, "webkit-find-previous", 1, 0, 0,
- (SCM text),
- "Find previous.")
+SCM_DEFINE (scm_webkit_find_previous, "webkit-find-previous", 1, 0, 0,
+ (SCM text), "Find previous.")
{
- const char *c_text = scm_to_locale_string(text);
- webkit_find_controller_search (webkit_web_view_get_find_controller (web_view), c_text, WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE|WEBKIT_FIND_OPTIONS_BACKWARDS, 0);
+ const char *c_text = scm_to_locale_string (text);
+ webkit_find_controller_search (webkit_web_view_get_find_controller
+ (web_view), c_text,
+ WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE |
+ WEBKIT_FIND_OPTIONS_BACKWARDS, 0);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_finish, "webkit-find-finish", 0, 0, 0,
- (),
- "Find finish.")
+SCM_DEFINE (scm_webkit_find_finish, "webkit-find-finish", 0, 0, 0,
+ (), "Find finish.")
{
- webkit_find_controller_search_finish (webkit_web_view_get_find_controller (web_view));
+ webkit_find_controller_search_finish (webkit_web_view_get_find_controller
+ (web_view));
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_zoom_in, "webkit-zoom-in", 0, 0, 0,
- (),
- "Zoom in.")
+SCM_DEFINE (scm_webkit_zoom_in, "webkit-zoom-in", 0, 0, 0, (), "Zoom in.")
{
gdouble zoom = webkit_web_view_get_zoom_level (web_view);
webkit_web_view_set_zoom_level (web_view, zoom * 1.1);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_zoom_out, "webkit-zoom-out", 0, 0, 0,
- (),
- "Zoom out.")
+SCM_DEFINE (scm_webkit_zoom_out, "webkit-zoom-out", 0, 0, 0, (), "Zoom out.")
{
gdouble zoom = webkit_web_view_get_zoom_level (web_view);
webkit_web_view_set_zoom_level (web_view, zoom / 1.1);
@@ -572,7 +598,8 @@ SCM_DEFINE(scm_webkit_eval_javascript, "webkit-eval-javascript", 2, 0, 0,
}
*/
-static void init_primitives(void)
+static void
+init_primitives (void)
{
/*
We use guile-snarf to generate main.c.x that helps us register the C
diff --git a/example/emacsy-webkit-gtk-w-buffers.scm b/example/emacsy-webkit-gtk-w-buffers.scm
index 332f7a4..5b9610f 100644
--- a/example/emacsy-webkit-gtk-w-buffers.scm
+++ b/example/emacsy-webkit-gtk-w-buffers.scm
@@ -64,8 +64,8 @@
(else
;; It's just one word. Let's try adding a .com and http:// if it
;; needs it.
- (load-url (format #f "http://~a~a" urlish
- (if (any (lambda (suffix)
+ (load-url (format #f "http://~a~a" urlish
+ (if (any (lambda (suffix)
(string-suffix? suffix urlish))
'(".com" ".org" ".net"))
""
@@ -87,13 +87,13 @@
;; These aren't as good as Emacs' isearch-forward, but they're not
;; a bad start.
-(define-interactive
+(define-interactive
(search-forward #:optional
(text (or find-text (read-from-minibuffer "Search: "))))
(set! find-text text)
(webkit-find-next text))
-(define-interactive
+(define-interactive
(search-backward #:optional
(text (or find-text (read-from-minibuffer "Search: "))))
(set! find-text text)
diff --git a/example/emacsy-webkit-gtk-w-windows.c b/example/emacsy-webkit-gtk-w-windows.c
index 1bf2c82..f26b7f5 100644
--- a/example/emacsy-webkit-gtk-w-windows.c
+++ b/example/emacsy-webkit-gtk-w-windows.c
@@ -57,28 +57,29 @@
#include <libguile.h>
/* Event Handlers */
-static void destroy_window(GtkWidget* widget, GtkWidget* window);
-static gboolean close_window(WebKitWebView* webView, GtkWidget* window);
-static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_data);
-static gboolean process_and_update_emacsy(void *user_data);
+static void destroy_window (GtkWidget * widget, GtkWidget * window);
+static gboolean close_window (WebKitWebView * webView, GtkWidget * window);
+static gboolean key_press (GtkWidget * widget, GdkEventKey * event,
+ gpointer user_data);
+static gboolean process_and_update_emacsy (void *user_data);
/* Registers the Scheme primitive procedures */
-static void init_primitives(void);
+static void init_primitives (void);
/* Scheme Primitives */
-SCM scm_webkit_load_url(SCM url);
-SCM scm_webkit_forward();
-SCM scm_webkit_backward();
-SCM scm_webkit_reload();
-SCM scm_webkit_find_next(SCM text);
-SCM scm_webkit_find_previous(SCM text);
-SCM scm_webkit_find_finish();
-SCM scm_webkit_zoom_in();
-SCM scm_webkit_zoom_out();
-SCM scm_current_web_view();
-WebKitWebView *scm_c_current_web_view();
-SCM scm_get_gtk_widget(SCM);
-GtkWidget* scm_c_get_gtk_widget(SCM);
+SCM scm_webkit_load_url (SCM url);
+SCM scm_webkit_forward ();
+SCM scm_webkit_backward ();
+SCM scm_webkit_reload ();
+SCM scm_webkit_find_next (SCM text);
+SCM scm_webkit_find_previous (SCM text);
+SCM scm_webkit_find_finish ();
+SCM scm_webkit_zoom_in ();
+SCM scm_webkit_zoom_out ();
+SCM scm_current_web_view ();
+WebKitWebView *scm_c_current_web_view ();
+SCM scm_get_gtk_widget (SCM);
+GtkWidget *scm_c_get_gtk_widget (SCM);
//SCM scm_webkit_eval_javascript(SCM script, SCM when_finished_proc);
/* Global state */
@@ -87,7 +88,8 @@ GtkWidget *content_vbox;
GtkWidget *content;
char *
-try_load_startup (char const* prefix, char const* dir, char const* startup_script)
+try_load_startup (char const *prefix, char const *dir,
+ char const *startup_script)
{
static char file_name[PATH_MAX];
if (prefix)
@@ -119,26 +121,26 @@ try_load_startup (char const* prefix, char const* dir, char const* startup_scrip
Create a minimal web browser that has Emacsy integrated into it.
*/
int
-main (int argc, char* argv[])
+main (int argc, char *argv[])
{
int err;
// Initialize GNU Guile.
- scm_init_guile();
+ scm_init_guile ();
// Initialize Emacsy.
err = emacsy_initialize (EMACSY_INTERACTIVE);
if (err)
return err;
// Register the primitive procedures that control the browser.
- init_primitives();
+ init_primitives ();
// You can evaluate S-expressions here.
- scm_c_eval_string("(use-modules (system repl error-handling))"
- "(define (safe-load filename) "
- " (call-with-error-handling "
- " (lambda () (load filename)))) ");
+ scm_c_eval_string ("(use-modules (system repl error-handling))"
+ "(define (safe-load filename) "
+ " (call-with-error-handling "
+ " (lambda () (load filename)))) ");
- scm_c_eval_string("(use-modules (emacsy window))");
+ scm_c_eval_string ("(use-modules (emacsy window))");
// But to make the application easy to mold, it's best to load the
// Scheme code from a file.
@@ -150,78 +152,80 @@ main (int argc, char* argv[])
dirname (dirname (prefix));
if (!try_load_startup (0, 0, startup_script)
- &&!try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
- &&!try_load_startup (prefix, "/", startup_script)
- &&!try_load_startup (prefix, "/etc/emacsy/", startup_script))
+ && !try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
+ && !try_load_startup (prefix, "/", startup_script)
+ && !try_load_startup (prefix, "/etc/emacsy/", startup_script))
fprintf (stderr, "error: failed to find '%s'.\n", startup_script);
// Initialize GTK+.
- gtk_init(&argc, &argv);
+ gtk_init (&argc, &argv);
// Create an 800x600 window that will contain the browser instance.
- GtkWidget *main_window = gtk_window_new(GTK_WINDOW_TOPLEVEL);
- gtk_window_set_default_size(GTK_WINDOW(main_window), 800, 600);
+ GtkWidget *main_window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+ gtk_window_set_default_size (GTK_WINDOW (main_window), 800, 600);
//gtk_window_set_size(GTK_WINDOW(main_window), 800, 600);
GdkGeometry geom_struct;
geom_struct.max_width = 800;
geom_struct.max_height = 600;
- gtk_window_set_geometry_hints(GTK_WINDOW(main_window),
- NULL,
- &geom_struct,
- GDK_HINT_MAX_SIZE);
+ gtk_window_set_geometry_hints (GTK_WINDOW (main_window),
+ NULL, &geom_struct, GDK_HINT_MAX_SIZE);
#if 0
/* you might need to use GTK_STATE_ACTIVE or GTK_STATE_PRELIGHT */
- GdkColor black = {0, 0x0, 0x0, 0x0};
- GdkColor white = {0, 0xFFFF, 0xFFFF, 0xFFFF};
- gtk_widget_modify_bg(GTK_WINDOW(main_window), GTK_STATE_NORMAL, &black);
- gtk_widget_modify_fg(GTK_WINDOW(main_window), GTK_STATE_NORMAL, &white);
+ GdkColor black = { 0, 0x0, 0x0, 0x0 };
+ GdkColor white = { 0, 0xFFFF, 0xFFFF, 0xFFFF };
+ gtk_widget_modify_bg (GTK_WINDOW (main_window), GTK_STATE_NORMAL, &black);
+ gtk_widget_modify_fg (GTK_WINDOW (main_window), GTK_STATE_NORMAL, &white);
#endif
// Set up callbacks so that if either the main window or the browser
// instance is closed, the program will exit.
- g_signal_connect(main_window, "destroy", G_CALLBACK(destroy_window), NULL);
+ g_signal_connect (main_window, "destroy", G_CALLBACK (destroy_window),
+ NULL);
// This label will be where we display Emacsy's echo-area.
- label = gtk_label_new("label");
- gtk_misc_set_alignment(GTK_MISC(label), 0.0f, 0.0f);
- gtk_label_set_use_underline(GTK_LABEL(label), FALSE);
- gtk_label_set_line_wrap(GTK_LABEL(label), TRUE);
- gtk_label_set_single_line_mode(GTK_LABEL(label), TRUE);
- gtk_label_set_max_width_chars(GTK_LABEL(label), 160);
+ label = gtk_label_new ("label");
+ gtk_misc_set_alignment (GTK_MISC (label), 0.0f, 0.0f);
+ gtk_label_set_use_underline (GTK_LABEL (label), FALSE);
+ gtk_label_set_line_wrap (GTK_LABEL (label), TRUE);
+ gtk_label_set_single_line_mode (GTK_LABEL (label), TRUE);
+ gtk_label_set_max_width_chars (GTK_LABEL (label), 160);
// While idle, process events in Emacsy and upate the echo-area.
- g_idle_add((GSourceFunc) process_and_update_emacsy, NULL);
+ g_idle_add ((GSourceFunc) process_and_update_emacsy, NULL);
// Handle key press and release events.
- g_signal_connect(main_window, "key_press_event", G_CALLBACK(key_press), NULL);
- g_signal_connect(main_window, "key_release_event", G_CALLBACK(key_press), NULL);
+ g_signal_connect (main_window, "key_press_event", G_CALLBACK (key_press),
+ NULL);
+ g_signal_connect (main_window, "key_release_event", G_CALLBACK (key_press),
+ NULL);
GtkWidget *vbox;
- vbox = gtk_vbox_new(FALSE, 1);
- content_vbox = gtk_vbox_new(FALSE, 1);
+ vbox = gtk_vbox_new (FALSE, 1);
+ content_vbox = gtk_vbox_new (FALSE, 1);
#if 0
- SCM record = scm_call_0(scm_c_public_ref("guile-user", "instantiate-root-window"));
- SCM widget_pointer = scm_call_1(scm_c_public_ref("guile-user", "wud-widget2"), record);
+ SCM record =
+ scm_call_0 (scm_c_public_ref ("guile-user", "instantiate-root-window"));
+ SCM widget_pointer =
+ scm_call_1 (scm_c_public_ref ("guile-user", "wud-widget2"), record);
#else
- SCM widget_pointer = scm_call_0(scm_c_public_ref("guile-user", "instantiate-root-window"));
+ SCM widget_pointer =
+ scm_call_0 (scm_c_public_ref ("guile-user", "instantiate-root-window"));
//SCM widget_pointer = scm_call_0 (scm_c_lookup ("instantiate-root-window"));
#endif
- content = scm_c_get_gtk_widget(widget_pointer);
- gtk_container_add(GTK_CONTAINER(content_vbox),
- GTK_WIDGET(content));
+ content = scm_c_get_gtk_widget (widget_pointer);
+ gtk_container_add (GTK_CONTAINER (content_vbox), GTK_WIDGET (content));
- gtk_container_add(GTK_CONTAINER(vbox),
- GTK_WIDGET(content_vbox));
+ gtk_container_add (GTK_CONTAINER (vbox), GTK_WIDGET (content_vbox));
// Add the echo area.
- gtk_box_pack_start(GTK_VBOX(vbox), label, FALSE, FALSE, 0);
+ gtk_box_pack_start (GTK_VBOX (vbox), label, FALSE, FALSE, 0);
// Put the scrollable area into the main window.
- gtk_container_add(GTK_WINDOW(main_window), vbox);
+ gtk_container_add (GTK_WINDOW (main_window), vbox);
#if 0
SCM widget_pointerscm_make_web_view ();
@@ -234,7 +238,8 @@ main (int argc, char* argv[])
// and keyboard events.
// gtk_widget_grab_focus (GTK_WIDGET(web_view));
#elif 0
- webkit_web_view_load_html (WEBKIT_WEB_VIEW (content), "<html>Hi!</html>", "buffer://?");
+ webkit_web_view_load_html (WEBKIT_WEB_VIEW (content), "<html>Hi!</html>",
+ "buffer://?");
#else
// TOO bad..
#endif
@@ -244,7 +249,7 @@ main (int argc, char* argv[])
gtk_window_set_resizable (GTK_WINDOW (main_window), FALSE);
// Run the main GTK+ event loop.
- gtk_main();
+ gtk_main ();
return 0;
}
@@ -254,30 +259,35 @@ main (int argc, char* argv[])
==============
*/
-static void destroy_window(GtkWidget* widget, GtkWidget* window)
+static void
+destroy_window (GtkWidget *widget, GtkWidget *window)
{
- gtk_main_quit();
+ gtk_main_quit ();
}
-static gboolean close_window(WebKitWebView* web_view, GtkWidget* window)
+static gboolean
+close_window (WebKitWebView *web_view, GtkWidget *window)
{
- gtk_widget_destroy(window);
+ gtk_widget_destroy (window);
return TRUE;
}
-static int scm_c_char_to_int(const char *char_name) {
+static int
+scm_c_char_to_int (const char *char_name)
+{
/* I should put a regex in here to validate it's a char */
- return scm_to_int(scm_char_to_integer(scm_c_eval_string(char_name)));
+ return scm_to_int (scm_char_to_integer (scm_c_eval_string (char_name)));
}
-static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_data)
+static gboolean
+key_press (GtkWidget *widget, GdkEventKey *event, gpointer user_data)
{
static guint32 last_unichar = 0;
guint32 unichar;
GdkModifierType modifiers;
int mod_flags = 0;
- modifiers = gtk_accelerator_get_default_mod_mask();
+ modifiers = gtk_accelerator_get_default_mod_mask ();
if (event->state & modifiers & GDK_CONTROL_MASK)
mod_flags |= EMACSY_MODKEY_CONTROL;
@@ -290,84 +300,96 @@ static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_d
if (event->state & modifiers & GDK_MOD1_MASK)
mod_flags |= EMACSY_MODKEY_META;
- unichar = gdk_keyval_to_unicode(event->keyval);
+ unichar = gdk_keyval_to_unicode (event->keyval);
// Fix up any key values that don't translate perfectly.
if (event->keyval == GDK_KEY_BackSpace)
- unichar = scm_c_char_to_int("#\\del");
+ unichar = scm_c_char_to_int ("#\\del");
// If unichar is 0 then it's not a regular key, e.g., Control, Meta, etc.
- if (event->type == GDK_KEY_PRESS) {
- printf("Key press %d %s (unicode %d last_unichar %d)\n",
- event->keyval, event->string, unichar, last_unichar);
- // Fix up some keys.
- if (unichar) {
- // Register the key event with Emacsy.
- emacsy_key_event(unichar, mod_flags);
+ if (event->type == GDK_KEY_PRESS)
+ {
+ printf ("Key press %d %s (unicode %d last_unichar %d)\n",
+ event->keyval, event->string, unichar, last_unichar);
+ // Fix up some keys.
+ if (unichar)
+ {
+ // Register the key event with Emacsy.
+ emacsy_key_event (unichar, mod_flags);
+ /*
+ One can do the event handling and the actual processing
+ separately in Emacsy. However, in this case, it's convenient
+ to do some processing in the event handling here so we know
+ whether or not to pass the event on to the browser.
+ */
+ int flags = emacsy_tick ();
+
+ printf ("flags = %d\n", flags);
+ if (flags & EMACSY_RAN_UNDEFINED_COMMAND_P)
+ {
+ printf ("Passing to browser.\n");
+ return FALSE; // Pass the event through to the web browser.
+ }
+ else
+ {
+ printf ("Emacsy handled it.\n");
+ last_unichar = unichar;
+ return TRUE; // Emacsy handled it. Don't pass the event through.
+ }
+ }
+ }
+ else if (event->type == GDK_KEY_RELEASE)
+ {
/*
- One can do the event handling and the actual processing
- separately in Emacsy. However, in this case, it's convenient
- to do some processing in the event handling here so we know
- whether or not to pass the event on to the browser.
+ We receive both key presses and key releases. If we decide not
+ to pass a key event when pressed, then we remember it
+ (last_unichar) such that we squelch the key release event too.
*/
- int flags = emacsy_tick();
-
- printf("flags = %d\n", flags);
- if (flags & EMACSY_RAN_UNDEFINED_COMMAND_P) {
- printf("Passing to browser.\n");
- return FALSE; // Pass the event through to the web browser.
- } else {
- printf("Emacsy handled it.\n");
- last_unichar = unichar;
- return TRUE; // Emacsy handled it. Don't pass the event through.
- }
- }
- } else if (event->type == GDK_KEY_RELEASE) {
- /*
- We receive both key presses and key releases. If we decide not
- to pass a key event when pressed, then we remember it
- (last_unichar) such that we squelch the key release event too.
- */
- printf("Key release %d %s (unicode %d last_unichar %d)\n",
- event->keyval, event->string, unichar, last_unichar);
- if (last_unichar && last_unichar == unichar) {
- last_unichar = 0;
- return TRUE; // Don't pass event to the browser.
+ printf ("Key release %d %s (unicode %d last_unichar %d)\n",
+ event->keyval, event->string, unichar, last_unichar);
+ if (last_unichar && last_unichar == unichar)
+ {
+ last_unichar = 0;
+ return TRUE; // Don't pass event to the browser.
+ }
}
- }
- return FALSE; // Pass the event to the browser.
+ return FALSE; // Pass the event to the browser.
}
/*
Process events in Emacsy then update the echo area at the bottom of the
screen.
*/
-static gboolean process_and_update_emacsy(void *user_data)
+static gboolean
+process_and_update_emacsy (void *user_data)
{
// Process events and any background coroutines.
- int flags = emacsy_tick();
+ int flags = emacsy_tick ();
// If there's been a request to quit, quit.
if (flags & EMACSY_QUIT_APPLICATION_P)
- gtk_main_quit();
+ gtk_main_quit ();
// Update the status line.
- const char *modeline_string = emacsy_mode_line();
- const char *status = emacsy_message_or_echo_area();
+ const char *modeline_string = emacsy_mode_line ();
+ const char *status = emacsy_message_or_echo_area ();
// Use markup to style the status line.
- char *markup = g_markup_printf_escaped ("<span foreground=\"white\" background=\"black\" underline=\"single\"><tt>%s </tt></span>", status);
- gtk_label_set_markup(GTK_LABEL(label), markup);
- g_free(markup);
+ char *markup =
+ g_markup_printf_escaped
+ ("<span foreground=\"white\" background=\"black\" underline=\"single\"><tt>%s </tt></span>",
+ status);
+ gtk_label_set_markup (GTK_LABEL (label), markup);
+ g_free (markup);
// Show the cursor. Exercise for the reader: Make it blink.
char message[255];
- memset(message, ' ', 254);
+ memset (message, ' ', 254);
message[255] = NULL;
- message[emacsy_minibuffer_point() - 1] = '_';
- gtk_label_set_pattern(GTK_LABEL(label), message);
+ message[emacsy_minibuffer_point () - 1] = '_';
+ gtk_label_set_pattern (GTK_LABEL (label), message);
- scm_call_0(scm_c_public_ref("guile-user", "redisplay-windows"));
+ scm_call_0 (scm_c_public_ref ("guile-user", "redisplay-windows"));
return TRUE;
}
@@ -379,33 +401,42 @@ static gboolean process_and_update_emacsy(void *user_data)
These C functions are exposed as callable procedures in Scheme.
*/
-SCM_DEFINE(scm_update_label_x, "update-label!", 3, 0, 0,
- (SCM scm_label, SCM string, SCM selected_p),
- "Update a GTK label to the given string.")
+SCM_DEFINE (scm_update_label_x, "update-label!", 3, 0, 0,
+ (SCM scm_label, SCM string, SCM selected_p),
+ "Update a GTK label to the given string.")
{
- const char *modeline_string = emacsy_mode_line();
- const char *status = emacsy_message_or_echo_area();
+ const char *modeline_string = emacsy_mode_line ();
+ const char *status = emacsy_message_or_echo_area ();
// Use markup to style the status line.
char *markup;
- if (scm_is_true(selected_p)) {
- markup = g_markup_printf_escaped ("<span foreground=\"white\" background=\"grey\" underline=\"none\"><tt>%s </tt></span>", scm_to_locale_string(string));
- } else {
- markup = g_markup_printf_escaped ("<span foreground=\"white\" background=\"black\" underline=\"none\"><tt>%s </tt></span>", scm_to_locale_string(string));
- }
- GtkWidget *label = (GtkWidget *) scm_to_pointer(scm_label);
- gtk_label_set_markup(GTK_LABEL(label), markup);
- g_free(markup);
+ if (scm_is_true (selected_p))
+ {
+ markup =
+ g_markup_printf_escaped
+ ("<span foreground=\"white\" background=\"grey\" underline=\"none\"><tt>%s </tt></span>",
+ scm_to_locale_string (string));
+ }
+ else
+ {
+ markup =
+ g_markup_printf_escaped
+ ("<span foreground=\"white\" background=\"black\" underline=\"none\"><tt>%s </tt></span>",
+ scm_to_locale_string (string));
+ }
+ GtkWidget *label = (GtkWidget *) scm_to_pointer (scm_label);
+ gtk_label_set_markup (GTK_LABEL (label), markup);
+ g_free (markup);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_set_content_vbox_x, "set-window-content!", 1, 0, 0,
- (SCM widget),
- "Delete contents and update a content vbox to the given widget.")
+SCM_DEFINE (scm_set_content_vbox_x, "set-window-content!", 1, 0, 0,
+ (SCM widget),
+ "Delete contents and update a content vbox to the given widget.")
{
- gtk_container_remove(GTK_CONTAINER(content_vbox), content);
- content = scm_c_get_gtk_widget(widget);
- gtk_container_add(GTK_CONTAINER(content_vbox), content);
- gtk_widget_show_all(content_vbox);
+ gtk_container_remove (GTK_CONTAINER (content_vbox), content);
+ content = scm_c_get_gtk_widget (widget);
+ gtk_container_add (GTK_CONTAINER (content_vbox), content);
+ gtk_widget_show_all (content_vbox);
return SCM_UNSPECIFIED;
}
@@ -430,65 +461,60 @@ SCM_DEFINE(scm_set_web_view_x, "set-web-view!", 1, 0, 0,
}
*/
-SCM_DEFINE(scm_make_web_view, "make-web-view", 0, 0, 0,
- (),
- "Creates and returns a pointer to a new webkit view.")
+SCM_DEFINE (scm_make_web_view, "make-web-view", 0, 0, 0,
+ (), "Creates and returns a pointer to a new webkit view.")
{
- WebKitWebView *a_web_view = WEBKIT_WEB_VIEW(webkit_web_view_new());
- a_web_view = g_object_ref(a_web_view);
- return scm_from_pointer(a_web_view, /*g_free*/ NULL);
+ WebKitWebView *a_web_view = WEBKIT_WEB_VIEW (webkit_web_view_new ());
+ a_web_view = g_object_ref (a_web_view);
+ return scm_from_pointer (a_web_view, /*g_free */ NULL);
}
-SCM_DEFINE(scm_webkit_load_url, "webkit-load-url", 1, 0, 0,
- (SCM scm_url),
- "Loads a given URL into the WebView.")
+SCM_DEFINE (scm_webkit_load_url, "webkit-load-url", 1, 0, 0,
+ (SCM scm_url), "Loads a given URL into the WebView.")
{
- const char *c_url = scm_to_locale_string(scm_url);
- webkit_web_view_load_uri(scm_c_current_web_view(), c_url);
- return SCM_UNSPECIFIED;
+ const char *c_url = scm_to_locale_string (scm_url);
+ webkit_web_view_load_uri (scm_c_current_web_view (), c_url);
+ return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_get_url, "webkit-get-url", 0, 0, 0,
- (),
- "Returns the current URL to the WebView.")
+SCM_DEFINE (scm_webkit_get_url, "webkit-get-url", 0, 0, 0,
+ (), "Returns the current URL to the WebView.")
{
- gchar *url = webkit_web_view_get_uri(scm_c_current_web_view());
- return scm_from_locale_string(url ? url : "");
+ gchar *url = webkit_web_view_get_uri (scm_c_current_web_view ());
+ return scm_from_locale_string (url ? url : "");
}
-SCM_DEFINE(scm_webkit_get_title, "webkit-get-title", 0, 0, 0,
- (),
- "Returns the current Title to the WebView.")
+SCM_DEFINE (scm_webkit_get_title, "webkit-get-title", 0, 0, 0,
+ (), "Returns the current Title to the WebView.")
{
- gchar *title = webkit_web_view_get_title(scm_c_current_web_view());
- return scm_from_locale_string(title ? title : "");
+ gchar *title = webkit_web_view_get_title (scm_c_current_web_view ());
+ return scm_from_locale_string (title ? title : "");
}
-SCM_DEFINE(scm_webkit_forward, "webkit-forward", 0, 0, 0,
- (),
- "Move browser forward.")
+SCM_DEFINE (scm_webkit_forward, "webkit-forward", 0, 0, 0,
+ (), "Move browser forward.")
{
- if (webkit_web_view_can_go_forward(scm_c_current_web_view())) {
- webkit_web_view_go_forward(scm_c_current_web_view());
- return SCM_BOOL_T;
- }
+ if (webkit_web_view_can_go_forward (scm_c_current_web_view ()))
+ {
+ webkit_web_view_go_forward (scm_c_current_web_view ());
+ return SCM_BOOL_T;
+ }
return SCM_BOOL_F;
}
-SCM_DEFINE(scm_webkit_backward, "webkit-backward", 0, 0, 0,
- (),
- "Move browser backward.")
+SCM_DEFINE (scm_webkit_backward, "webkit-backward", 0, 0, 0,
+ (), "Move browser backward.")
{
- if (webkit_web_view_can_go_back(scm_c_current_web_view())) {
- webkit_web_view_go_back(scm_c_current_web_view());
- return SCM_BOOL_T;
- }
+ if (webkit_web_view_can_go_back (scm_c_current_web_view ()))
+ {
+ webkit_web_view_go_back (scm_c_current_web_view ());
+ return SCM_BOOL_T;
+ }
return SCM_BOOL_F;
}
-SCM_DEFINE(scm_webkit_reload, "webkit-reload", 0, 0, 0,
- (),
- "Reload browser.")
+SCM_DEFINE (scm_webkit_reload, "webkit-reload", 0, 0, 0,
+ (), "Reload browser.")
{
WebKitWebView *v = scm_c_current_web_view ();
if (v)
@@ -496,44 +522,43 @@ SCM_DEFINE(scm_webkit_reload, "webkit-reload", 0, 0, 0,
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_next, "webkit-find-next", 1, 0, 0,
- (SCM text),
- "Find next.")
+SCM_DEFINE (scm_webkit_find_next, "webkit-find-next", 1, 0, 0,
+ (SCM text), "Find next.")
{
- const char *c_text = scm_to_locale_string(text);
- webkit_find_controller_search (webkit_web_view_get_find_controller (scm_c_current_web_view ()), c_text, WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE, 0);
+ const char *c_text = scm_to_locale_string (text);
+ webkit_find_controller_search (webkit_web_view_get_find_controller
+ (scm_c_current_web_view ()), c_text,
+ WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE, 0);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_previous, "webkit-find-previous", 1, 0, 0,
- (SCM text),
- "Find previous.")
+SCM_DEFINE (scm_webkit_find_previous, "webkit-find-previous", 1, 0, 0,
+ (SCM text), "Find previous.")
{
- const char *c_text = scm_to_locale_string(text);
- webkit_find_controller_search (webkit_web_view_get_find_controller (scm_c_current_web_view ()), c_text, WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE|WEBKIT_FIND_OPTIONS_BACKWARDS, 0);
+ const char *c_text = scm_to_locale_string (text);
+ webkit_find_controller_search (webkit_web_view_get_find_controller
+ (scm_c_current_web_view ()), c_text,
+ WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE |
+ WEBKIT_FIND_OPTIONS_BACKWARDS, 0);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_finish, "webkit-find-finish", 0, 0, 0,
- (),
- "Find finish.")
+SCM_DEFINE (scm_webkit_find_finish, "webkit-find-finish", 0, 0, 0,
+ (), "Find finish.")
{
- webkit_find_controller_search_finish (webkit_web_view_get_find_controller (scm_c_current_web_view ()));
+ webkit_find_controller_search_finish (webkit_web_view_get_find_controller
+ (scm_c_current_web_view ()));
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_zoom_in, "webkit-zoom-in", 0, 0, 0,
- (),
- "Zoom in.")
+SCM_DEFINE (scm_webkit_zoom_in, "webkit-zoom-in", 0, 0, 0, (), "Zoom in.")
{
gdouble zoom = webkit_web_view_get_zoom_level (scm_c_current_web_view ());
webkit_web_view_set_zoom_level (scm_c_current_web_view (), zoom * 1.1);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_zoom_out, "webkit-zoom-out", 0, 0, 0,
- (),
- "Zoom out.")
+SCM_DEFINE (scm_webkit_zoom_out, "webkit-zoom-out", 0, 0, 0, (), "Zoom out.")
{
gdouble zoom = webkit_web_view_get_zoom_level (scm_c_current_web_view ());
webkit_web_view_set_zoom_level (scm_c_current_web_view (), zoom / 1.1);
@@ -547,78 +572,80 @@ scm_current_web_view ()
return scm_c_eval_string ("(current-web-view)");
}
-WebKitWebView *scm_c_current_web_view()
+WebKitWebView *
+scm_c_current_web_view ()
{
SCM web_view = scm_current_web_view ();
if (!scm_is_false (web_view))
#if 1
- return (WebKitWebView *) scm_to_pointer (web_view);
+ return (WebKitWebView *) scm_to_pointer (web_view);
#else
return (WebKitWebView *) scm_c_get_gtk_widget (scm_to_pointer (web_view));
#endif
return NULL;
}
-SCM_DEFINE(scm_web_view_load_string, "web-view-load-string", 2, 0, 0,
- (SCM scm_web_view, SCM string),
- "Loads the plaintext string into the given web view.")
+SCM_DEFINE (scm_web_view_load_string, "web-view-load-string", 2, 0, 0,
+ (SCM scm_web_view, SCM string),
+ "Loads the plaintext string into the given web view.")
{
- WebKitWebView *web_view = (WebKitWebView *) scm_to_pointer(scm_web_view);
+ WebKitWebView *web_view = (WebKitWebView *) scm_to_pointer (scm_web_view);
- webkit_web_view_load_html (web_view,
- scm_to_locale_string (string),
- "buffer://?");
- return SCM_UNSPECIFIED;
+ webkit_web_view_load_html (web_view,
+ scm_to_locale_string (string), "buffer://?");
+ return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_create_web_view_window, "create-web-view-window", 3, 0, 0,
- (SCM window, SCM buffer, SCM plain_text_p),
- "Returns a pointer to a GtkWidget* that contains a webkit in a scrolled window with a modeline.")
+SCM_DEFINE (scm_create_web_view_window, "create-web-view-window", 3, 0, 0,
+ (SCM window, SCM buffer, SCM plain_text_p),
+ "Returns a pointer to a GtkWidget* that contains a webkit in a scrolled window with a modeline.")
{
- SCM scm_user_data = scm_call_2(scm_c_public_ref("oop goops", "slot-ref"),
- window,
- scm_string_to_symbol(scm_from_locale_string("user-data")));
+ SCM scm_user_data = scm_call_2 (scm_c_public_ref ("oop goops", "slot-ref"),
+ window,
+ scm_string_to_symbol (scm_from_locale_string
+ ("user-data")));
// Window has already been instantiated.
- if (scm_is_true(scm_user_data)) {
- return scm_user_data;
- }
+ if (scm_is_true (scm_user_data))
+ {
+ return scm_user_data;
+ }
GtkWidget *scrolled_window;
GtkWidget *modeline;
- SCM scm_web_view = scm_make_web_view();
- WebKitWebView *web_view = (WebKitWebView *) scm_to_pointer(scm_web_view);
- printf("Calling create_web_view_window\n");
-
- scrolled_window = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scrolled_window),
- GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
- gtk_container_add(GTK_CONTAINER(scrolled_window), GTK_WIDGET(web_view));
- gtk_widget_show_all(GTK_WIDGET(web_view));
- gtk_widget_show_all(GTK_WIDGET(scrolled_window));
-
- modeline = gtk_label_new("modeline");
- gtk_misc_set_alignment(GTK_MISC(modeline), 0.0f, 0.0f);
- gtk_label_set_use_underline(GTK_LABEL(modeline), FALSE);
- gtk_label_set_line_wrap(GTK_LABEL(modeline), TRUE);
- gtk_label_set_single_line_mode(GTK_LABEL(modeline), TRUE);
- gtk_label_set_max_width_chars(GTK_LABEL(modeline), 160);
+ SCM scm_web_view = scm_make_web_view ();
+ WebKitWebView *web_view = (WebKitWebView *) scm_to_pointer (scm_web_view);
+ printf ("Calling create_web_view_window\n");
+
+ scrolled_window = gtk_scrolled_window_new (NULL, NULL);
+ gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (scrolled_window),
+ GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+ gtk_container_add (GTK_CONTAINER (scrolled_window), GTK_WIDGET (web_view));
+ gtk_widget_show_all (GTK_WIDGET (web_view));
+ gtk_widget_show_all (GTK_WIDGET (scrolled_window));
+
+ modeline = gtk_label_new ("modeline");
+ gtk_misc_set_alignment (GTK_MISC (modeline), 0.0f, 0.0f);
+ gtk_label_set_use_underline (GTK_LABEL (modeline), FALSE);
+ gtk_label_set_line_wrap (GTK_LABEL (modeline), TRUE);
+ gtk_label_set_single_line_mode (GTK_LABEL (modeline), TRUE);
+ gtk_label_set_max_width_chars (GTK_LABEL (modeline), 160);
GtkWidget *vbox;
- vbox = gtk_vbox_new(FALSE, 1);
- gtk_container_add(GTK_CONTAINER(vbox), scrolled_window);
- gtk_box_pack_start(GTK_BOX(vbox), modeline, FALSE, FALSE, 0);
- SCM widget_pointer = scm_from_pointer(vbox, NULL);
- scm_user_data = scm_call_3(scm_c_public_ref("guile-user", "make-window-user-data2"),
- widget_pointer,
- scm_web_view,
- scm_from_pointer(modeline, NULL));
- gtk_widget_show_all(GTK_WIDGET(vbox));
- scm_call_3(scm_c_public_ref("oop goops", "slot-set!"),
- window,
- scm_string_to_symbol(scm_from_locale_string("user-data")),
- scm_user_data);
- printf("Finished create_web_view_window\n");
+ vbox = gtk_vbox_new (FALSE, 1);
+ gtk_container_add (GTK_CONTAINER (vbox), scrolled_window);
+ gtk_box_pack_start (GTK_BOX (vbox), modeline, FALSE, FALSE, 0);
+ SCM widget_pointer = scm_from_pointer (vbox, NULL);
+ scm_user_data =
+ scm_call_3 (scm_c_public_ref ("guile-user", "make-window-user-data2"),
+ widget_pointer, scm_web_view, scm_from_pointer (modeline,
+ NULL));
+ gtk_widget_show_all (GTK_WIDGET (vbox));
+ scm_call_3 (scm_c_public_ref ("oop goops", "slot-set!"),
+ window,
+ scm_string_to_symbol (scm_from_locale_string ("user-data")),
+ scm_user_data);
+ printf ("Finished create_web_view_window\n");
return scm_user_data;
}
@@ -626,9 +653,11 @@ SCM_DEFINE (scm_get_gtk_widget, "get-gtk-widget", 1, 0, 0,
(SCM pointer),
"Returns a pointer to a GtkWidget from a pointer or a window-user-data object.")
{
- if (scm_is_true(scm_call_1 (scm_c_public_ref ("guile-user", "window-user-data?2"),
- pointer)))
- return scm_call_1 (scm_c_public_ref ("guile-user", "wud-widget2"), pointer);
+ if (scm_is_true
+ (scm_call_1
+ (scm_c_public_ref ("guile-user", "window-user-data?2"), pointer)))
+ return scm_call_1 (scm_c_public_ref ("guile-user", "wud-widget2"),
+ pointer);
#if HAVE_SCM_POINTER_P
else if (scm_is_true (scm_pointer_p (pointer)))
#else
@@ -639,40 +668,51 @@ SCM_DEFINE (scm_get_gtk_widget, "get-gtk-widget", 1, 0, 0,
return SCM_BOOL_F;
}
-GtkWidget* scm_c_get_gtk_widget(SCM pointer)
+GtkWidget *
+scm_c_get_gtk_widget (SCM pointer)
{
- SCM widget = scm_get_gtk_widget(pointer);
- if (scm_is_true(widget)) {
- return GTK_WIDGET(scm_to_pointer(widget));
- } else {
- return NULL;
- }
+ SCM widget = scm_get_gtk_widget (pointer);
+ if (scm_is_true (widget))
+ {
+ return GTK_WIDGET (scm_to_pointer (widget));
+ }
+ else
+ {
+ return NULL;
+ }
}
-SCM_DEFINE(scm_create_gtk_window, "create-gtk-window", 2, 0, 0,
- (SCM list, SCM vertical_p),
- "Returns a pointer to a GtkWidget* that contains a vertical or "
-"horizontal window with the list of other widgets as its children.")
+SCM_DEFINE (scm_create_gtk_window, "create-gtk-window", 2, 0, 0,
+ (SCM list, SCM vertical_p),
+ "Returns a pointer to a GtkWidget* that contains a vertical or "
+ "horizontal window with the list of other widgets as its children.")
{
GtkWidget *vbox;
- if (scm_is_true(vertical_p)) {
- vbox = gtk_vbox_new(FALSE, 1);
- } else {
- vbox = gtk_hbox_new(FALSE, 1);
- }
+ if (scm_is_true (vertical_p))
+ {
+ vbox = gtk_vbox_new (FALSE, 1);
+ }
+ else
+ {
+ vbox = gtk_hbox_new (FALSE, 1);
+ }
- for (; ! scm_is_null(list); list = scm_cdr(list)) {
- SCM pointer = scm_car(list);
- GtkWidget *widget = GTK_WIDGET(scm_c_get_gtk_widget(pointer));
- if (gtk_widget_get_parent(widget)) {
- // If it has a parent, we have to reparent it rather than add it.
- gtk_widget_reparent(widget, GTK_WIDGET(vbox));
- } else {
- gtk_container_add(GTK_CONTAINER(vbox), widget);
+ for (; !scm_is_null (list); list = scm_cdr (list))
+ {
+ SCM pointer = scm_car (list);
+ GtkWidget *widget = GTK_WIDGET (scm_c_get_gtk_widget (pointer));
+ if (gtk_widget_get_parent (widget))
+ {
+ // If it has a parent, we have to reparent it rather than add it.
+ gtk_widget_reparent (widget, GTK_WIDGET (vbox));
+ }
+ else
+ {
+ gtk_container_add (GTK_CONTAINER (vbox), widget);
+ }
}
- }
- gtk_widget_show_all(GTK_WIDGET(vbox));
- return scm_from_pointer(vbox, NULL);
+ gtk_widget_show_all (GTK_WIDGET (vbox));
+ return scm_from_pointer (vbox, NULL);
}
/*
@@ -734,7 +774,8 @@ SCM_DEFINE(scm_webkit_eval_javascript, "webkit-eval-javascript", 2, 0, 0,
}
*/
-static void init_primitives(void)
+static void
+init_primitives (void)
{
/*
We use guile-snarf to generate main.c.x that helps us register the C
diff --git a/example/emacsy-webkit-gtk.c b/example/emacsy-webkit-gtk.c
index dc57f5d..0b6e0e7 100644
--- a/example/emacsy-webkit-gtk.c
+++ b/example/emacsy-webkit-gtk.c
@@ -58,27 +58,28 @@
#include <libguile.h>
/* Event Handlers */
-static void destroy_window(GtkWidget* widget, GtkWidget* window);
-static gboolean close_window(WebKitWebView* webView, GtkWidget* window);
-static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_data);
-static gboolean process_and_update_emacsy(void *user_data);
+static void destroy_window (GtkWidget * widget, GtkWidget * window);
+static gboolean close_window (WebKitWebView * webView, GtkWidget * window);
+static gboolean key_press (GtkWidget * widget, GdkEventKey * event,
+ gpointer user_data);
+static gboolean process_and_update_emacsy (void *user_data);
/* Registers the Scheme primitive procedures */
-static void init_primitives(void);
+static void init_primitives (void);
/* Scheme Primitives */
-SCM scm_webkit_load_url(SCM url);
+SCM scm_webkit_load_url (SCM url);
-SCM scm_webkit_forward();
-SCM scm_webkit_backward();
-SCM scm_webkit_reload();
-SCM scm_webkit_find_next(SCM text);
-SCM scm_webkit_find_previous(SCM text);
-SCM scm_webkit_find_finish();
-SCM scm_webkit_zoom_in();
-SCM scm_webkit_zoom_out();
+SCM scm_webkit_forward ();
+SCM scm_webkit_backward ();
+SCM scm_webkit_reload ();
+SCM scm_webkit_find_next (SCM text);
+SCM scm_webkit_find_previous (SCM text);
+SCM scm_webkit_find_finish ();
+SCM scm_webkit_zoom_in ();
+SCM scm_webkit_zoom_out ();
//SCM scm_webkit_eval_javascript(SCM script, SCM when_finished_proc);
/* Global state */
@@ -86,7 +87,8 @@ GtkWidget *label; /* Shows Emacsy's echo area or minibuffer */
WebKitWebView *web_view; /* The WebKit browser */
int
-try_load_startup (char const* prefix, char const* dir, char const* startup_script)
+try_load_startup (char const *prefix, char const *dir,
+ char const *startup_script)
{
static char file_name[PATH_MAX];
if (prefix)
@@ -118,24 +120,24 @@ try_load_startup (char const* prefix, char const* dir, char const* startup_scrip
Create a minimal web browser that has Emacsy integrated into it.
*/
int
-main (int argc, char* argv[])
+main (int argc, char *argv[])
{
int err;
// Initialize GNU Guile.
- scm_init_guile();
+ scm_init_guile ();
// Initialize Emacsy.
- err = emacsy_initialize(EMACSY_INTERACTIVE);
+ err = emacsy_initialize (EMACSY_INTERACTIVE);
if (err)
return err;
// Register the primitive procedures that control the browser.
- init_primitives();
+ init_primitives ();
// You can evaluate S-expressions here.
- scm_c_eval_string("(use-modules (system repl error-handling))"
- "(define (safe-load filename) "
- " (call-with-error-handling "
- " (lambda () (load filename)))) ");
+ scm_c_eval_string ("(use-modules (system repl error-handling))"
+ "(define (safe-load filename) "
+ " (call-with-error-handling "
+ " (lambda () (load filename)))) ");
// But to make the application easy to mold, it's best to load the
// Scheme code from a file.
@@ -147,86 +149,90 @@ main (int argc, char* argv[])
dirname (dirname (prefix));
if (!try_load_startup (0, 0, startup_script)
- &&!try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
- &&!try_load_startup (prefix, "/", startup_script)
- &&!try_load_startup (prefix, "/etc/emacsy/", startup_script))
+ && !try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
+ && !try_load_startup (prefix, "/", startup_script)
+ && !try_load_startup (prefix, "/etc/emacsy/", startup_script))
fprintf (stderr, "error: failed to find '%s'.\n", startup_script);
// Initialize GTK+.
- gtk_init(&argc, &argv);
+ gtk_init (&argc, &argv);
// Create an 800x600 window that will contain the browser instance.
- GtkWidget *main_window = gtk_window_new(GTK_WINDOW_TOPLEVEL);
- gtk_window_set_default_size(GTK_WINDOW(main_window), 800, 600);
+ GtkWidget *main_window = gtk_window_new (GTK_WINDOW_TOPLEVEL);
+ gtk_window_set_default_size (GTK_WINDOW (main_window), 800, 600);
//gtk_window_set_size(GTK_WINDOW(main_window), 800, 600);
GdkGeometry geom_struct;
geom_struct.max_width = 800;
geom_struct.max_height = 600;
- gtk_window_set_geometry_hints(GTK_WINDOW(main_window),
- NULL,
- &geom_struct,
- GDK_HINT_MAX_SIZE);
+ gtk_window_set_geometry_hints (GTK_WINDOW (main_window),
+ NULL, &geom_struct, GDK_HINT_MAX_SIZE);
/* you might need to use GTK_STATE_ACTIVE or GTK_STATE_PRELIGHT */
#if 0
- GdkColor black = {0, 0x0, 0x0, 0x0};
- GdkColor white = {0, 0xFFFF, 0xFFFF, 0xFFFF};
- gtk_widget_override_background_color (GTK_WINDOW (main_window), GTK_STATE_NORMAL, &black);
- gtk_widget_override_foreground_color (GTK_WINDOW (main_window), GTK_STATE_NORMAL, &white);
+ GdkColor black = { 0, 0x0, 0x0, 0x0 };
+ GdkColor white = { 0, 0xFFFF, 0xFFFF, 0xFFFF };
+ gtk_widget_override_background_color (GTK_WINDOW (main_window),
+ GTK_STATE_NORMAL, &black);
+ gtk_widget_override_foreground_color (GTK_WINDOW (main_window),
+ GTK_STATE_NORMAL, &white);
#endif
// Create a browser instance
- web_view = WEBKIT_WEB_VIEW(webkit_web_view_new());
+ web_view = WEBKIT_WEB_VIEW (webkit_web_view_new ());
//webkit_web_view_set_highlight_text_matches(web_view, TRUE);
// Create a scrollable area, and put the browser instance into it
- GtkWidget *scrolled_window = gtk_scrolled_window_new(NULL, NULL);
- gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(scrolled_window),
- GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
- gtk_container_add(GTK_CONTAINER(scrolled_window), GTK_WIDGET(web_view));
+ GtkWidget *scrolled_window = gtk_scrolled_window_new (NULL, NULL);
+ gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (scrolled_window),
+ GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
+ gtk_container_add (GTK_CONTAINER (scrolled_window), GTK_WIDGET (web_view));
// Set up callbacks so that if either the main window or the browser
// instance is closed, the program will exit.
- g_signal_connect(main_window, "destroy", G_CALLBACK(destroy_window), NULL);
- g_signal_connect(web_view, "close-web-view", G_CALLBACK(close_window), main_window);
+ g_signal_connect (main_window, "destroy", G_CALLBACK (destroy_window),
+ NULL);
+ g_signal_connect (web_view, "close-web-view", G_CALLBACK (close_window),
+ main_window);
// This label will be where we display Emacsy's echo-area.
- label = gtk_label_new("label");
- gtk_misc_set_alignment(GTK_MISC(label), 0.0f, 0.0f);
- gtk_label_set_use_underline(GTK_LABEL(label), FALSE);
- gtk_label_set_line_wrap(GTK_LABEL(label), TRUE);
- gtk_label_set_single_line_mode(GTK_LABEL(label), TRUE);
- gtk_label_set_max_width_chars(GTK_LABEL(label), 160);
+ label = gtk_label_new ("label");
+ gtk_misc_set_alignment (GTK_MISC (label), 0.0f, 0.0f);
+ gtk_label_set_use_underline (GTK_LABEL (label), FALSE);
+ gtk_label_set_line_wrap (GTK_LABEL (label), TRUE);
+ gtk_label_set_single_line_mode (GTK_LABEL (label), TRUE);
+ gtk_label_set_max_width_chars (GTK_LABEL (label), 160);
// While idle, process events in Emacsy and upate the echo-area.
- g_idle_add((GSourceFunc) process_and_update_emacsy, NULL);
+ g_idle_add ((GSourceFunc) process_and_update_emacsy, NULL);
// Handle key press and release events.
- g_signal_connect(main_window, "key_press_event", G_CALLBACK(key_press), NULL);
- g_signal_connect(main_window, "key_release_event", G_CALLBACK(key_press), NULL);
+ g_signal_connect (main_window, "key_press_event", G_CALLBACK (key_press),
+ NULL);
+ g_signal_connect (main_window, "key_release_event", G_CALLBACK (key_press),
+ NULL);
GtkWidget *vbox;
- vbox = gtk_vbox_new(FALSE, 1);
- gtk_container_add(GTK_CONTAINER(vbox), scrolled_window);
- gtk_box_pack_start(GTK_BOX(vbox), label, FALSE, FALSE, 0);
+ vbox = gtk_vbox_new (FALSE, 1);
+ gtk_container_add (GTK_CONTAINER (vbox), scrolled_window);
+ gtk_box_pack_start (GTK_BOX (vbox), label, FALSE, FALSE, 0);
// Put the scrollable area into the main window.
- gtk_container_add(GTK_CONTAINER(main_window), vbox);
+ gtk_container_add (GTK_CONTAINER (main_window), vbox);
// Load a web page into the browser instance.
- webkit_web_view_load_uri(web_view,
- "http://shanecelis.github.io/2013/06/15/the-garden/");
+ webkit_web_view_load_uri (web_view,
+ "http://shanecelis.github.io/2013/06/15/the-garden/");
// Make sure that when the browser area becomes visible, it will get mouse
// and keyboard events.
- gtk_widget_grab_focus(GTK_WIDGET(web_view));
+ gtk_widget_grab_focus (GTK_WIDGET (web_view));
// Make sure the main window and all its contents are visible.
- gtk_widget_show_all(main_window);
- gtk_window_set_resizable(GTK_WINDOW(main_window), FALSE);
+ gtk_widget_show_all (main_window);
+ gtk_window_set_resizable (GTK_WINDOW (main_window), FALSE);
// Run the main GTK+ event loop.
- gtk_main();
+ gtk_main ();
return 0;
}
@@ -236,30 +242,35 @@ main (int argc, char* argv[])
==============
*/
-static void destroy_window(GtkWidget* widget, GtkWidget* window)
+static void
+destroy_window (GtkWidget *widget, GtkWidget *window)
{
- gtk_main_quit();
+ gtk_main_quit ();
}
-static gboolean close_window(WebKitWebView* web_view, GtkWidget* window)
+static gboolean
+close_window (WebKitWebView *web_view, GtkWidget *window)
{
- gtk_widget_destroy(window);
+ gtk_widget_destroy (window);
return TRUE;
}
-static int scm_c_char_to_int(const char *char_name) {
+static int
+scm_c_char_to_int (const char *char_name)
+{
/* I should put a regex in here to validate it's a char */
- return scm_to_int(scm_char_to_integer(scm_c_eval_string(char_name)));
+ return scm_to_int (scm_char_to_integer (scm_c_eval_string (char_name)));
}
-static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_data)
+static gboolean
+key_press (GtkWidget *widget, GdkEventKey *event, gpointer user_data)
{
static guint32 last_unichar = 0;
guint32 unichar;
GdkModifierType modifiers;
int mod_flags = 0;
- modifiers = gtk_accelerator_get_default_mod_mask();
+ modifiers = gtk_accelerator_get_default_mod_mask ();
if (event->state & modifiers & GDK_CONTROL_MASK)
mod_flags |= EMACSY_MODKEY_CONTROL;
@@ -272,81 +283,93 @@ static gboolean key_press(GtkWidget* widget, GdkEventKey* event, gpointer user_d
if (event->state & modifiers & GDK_MOD1_MASK)
mod_flags |= EMACSY_MODKEY_META;
- unichar = gdk_keyval_to_unicode(event->keyval);
+ unichar = gdk_keyval_to_unicode (event->keyval);
// Fix up any key values that don't translate perfectly.
if (event->keyval == GDK_KEY_BackSpace)
- unichar = scm_c_char_to_int("#\\del");
+ unichar = scm_c_char_to_int ("#\\del");
// If unichar is 0 then it's not a regular key, e.g., Control, Meta, etc.
- if (event->type == GDK_KEY_PRESS) {
- printf("Key press %d %s (unicode %d last_unichar %d)\n",
- event->keyval, event->string, unichar, last_unichar);
- // Fix up some keys.
- if (unichar) {
- // Register the key event with Emacsy.
- emacsy_key_event(unichar, mod_flags);
+ if (event->type == GDK_KEY_PRESS)
+ {
+ printf ("Key press %d %s (unicode %d last_unichar %d)\n",
+ event->keyval, event->string, unichar, last_unichar);
+ // Fix up some keys.
+ if (unichar)
+ {
+ // Register the key event with Emacsy.
+ emacsy_key_event (unichar, mod_flags);
+ /*
+ One can do the event handling and the actual processing
+ separately in Emacsy. However, in this case, it's convenient
+ to do some processing in the event handling here so we know
+ whether or not to pass the event on to the browser.
+ */
+ int flags = emacsy_tick ();
+
+ printf ("flags = %d\n", flags);
+ if (flags & EMACSY_RAN_UNDEFINED_COMMAND_P)
+ {
+ printf ("Passing to browser.\n");
+ return FALSE; // Pass the event through to the web browser.
+ }
+ else
+ {
+ printf ("Emacsy handled it.\n");
+ last_unichar = unichar;
+ return TRUE; // Emacsy handled it. Don't pass the event through.
+ }
+ }
+ }
+ else if (event->type == GDK_KEY_RELEASE)
+ {
/*
- One can do the event handling and the actual processing
- separately in Emacsy. However, in this case, it's convenient
- to do some processing in the event handling here so we know
- whether or not to pass the event on to the browser.
+ We receive both key presses and key releases. If we decide not
+ to pass a key event when pressed, then we remember it
+ (last_unichar) such that we squelch the key release event too.
*/
- int flags = emacsy_tick();
-
- printf("flags = %d\n", flags);
- if (flags & EMACSY_RAN_UNDEFINED_COMMAND_P) {
- printf("Passing to browser.\n");
- return FALSE; // Pass the event through to the web browser.
- } else {
- printf("Emacsy handled it.\n");
- last_unichar = unichar;
- return TRUE; // Emacsy handled it. Don't pass the event through.
- }
- }
- } else if (event->type == GDK_KEY_RELEASE) {
- /*
- We receive both key presses and key releases. If we decide not
- to pass a key event when pressed, then we remember it
- (last_unichar) such that we squelch the key release event too.
- */
- printf("Key release %d %s (unicode %d last_unichar %d)\n",
- event->keyval, event->string, unichar, last_unichar);
- if (last_unichar && last_unichar == unichar) {
- last_unichar = 0;
- return TRUE; // Don't pass event to the browser.
+ printf ("Key release %d %s (unicode %d last_unichar %d)\n",
+ event->keyval, event->string, unichar, last_unichar);
+ if (last_unichar && last_unichar == unichar)
+ {
+ last_unichar = 0;
+ return TRUE; // Don't pass event to the browser.
+ }
}
- }
- return FALSE; // Pass the event to the browser.
+ return FALSE; // Pass the event to the browser.
}
/*
Process events in Emacsy then update the echo area at the bottom of the
screen.
*/
-static gboolean process_and_update_emacsy(void *user_data)
+static gboolean
+process_and_update_emacsy (void *user_data)
{
// Process events and any background coroutines.
- int flags = emacsy_tick();
+ int flags = emacsy_tick ();
// If there's been a request to quit, quit.
if (flags & EMACSY_QUIT_APPLICATION_P)
- gtk_main_quit();
+ gtk_main_quit ();
// Update the status line.
- const char *status = emacsy_message_or_echo_area();
+ const char *status = emacsy_message_or_echo_area ();
// Use markup to style the status line.
- char *markup = g_markup_printf_escaped ("<span foreground=\"white\" background=\"black\" underline=\"single\"><tt>%s </tt></span>", status);
- gtk_label_set_markup(GTK_LABEL(label), markup);
- g_free(markup);
+ char *markup =
+ g_markup_printf_escaped
+ ("<span foreground=\"white\" background=\"black\" underline=\"single\"><tt>%s </tt></span>",
+ status);
+ gtk_label_set_markup (GTK_LABEL (label), markup);
+ g_free (markup);
// Show the cursor. Exercise for the reader: Make it blink.
char message[255];
- memset(message, ' ', 254);
+ memset (message, ' ', 254);
message[255] = NULL;
- message[emacsy_minibuffer_point() - 1] = '_';
- gtk_label_set_pattern(GTK_LABEL(label), message);
+ message[emacsy_minibuffer_point () - 1] = '_';
+ gtk_label_set_pattern (GTK_LABEL (label), message);
return TRUE;
}
@@ -358,83 +381,80 @@ static gboolean process_and_update_emacsy(void *user_data)
These C functions are exposed as callable procedures in Scheme.
*/
-SCM_DEFINE(scm_webkit_load_url, "webkit-load-url", 1, 0, 0,
- (SCM scm_url),
- "Loads a given URL into the WebView.")
+SCM_DEFINE (scm_webkit_load_url, "webkit-load-url", 1, 0, 0,
+ (SCM scm_url), "Loads a given URL into the WebView.")
{
- const char *c_url = scm_to_locale_string(scm_url);
- webkit_web_view_load_uri(web_view, c_url);
- return SCM_UNSPECIFIED;
+ const char *c_url = scm_to_locale_string (scm_url);
+ webkit_web_view_load_uri (web_view, c_url);
+ return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_forward, "webkit-forward", 0, 0, 0,
- (),
- "Move browser forward.")
+SCM_DEFINE (scm_webkit_forward, "webkit-forward", 0, 0, 0,
+ (), "Move browser forward.")
{
- if (webkit_web_view_can_go_forward(web_view)) {
- webkit_web_view_go_forward(web_view);
- return SCM_BOOL_T;
- }
+ if (webkit_web_view_can_go_forward (web_view))
+ {
+ webkit_web_view_go_forward (web_view);
+ return SCM_BOOL_T;
+ }
return SCM_BOOL_F;
}
-SCM_DEFINE(scm_webkit_backward, "webkit-backward", 0, 0, 0,
- (),
- "Move browser backward.")
+SCM_DEFINE (scm_webkit_backward, "webkit-backward", 0, 0, 0,
+ (), "Move browser backward.")
{
- if (webkit_web_view_can_go_back(web_view)) {
- webkit_web_view_go_back(web_view);
- return SCM_BOOL_T;
- }
+ if (webkit_web_view_can_go_back (web_view))
+ {
+ webkit_web_view_go_back (web_view);
+ return SCM_BOOL_T;
+ }
return SCM_BOOL_F;
}
-SCM_DEFINE(scm_webkit_reload, "webkit-reload", 0, 0, 0,
- (),
- "Reload browser.")
+SCM_DEFINE (scm_webkit_reload, "webkit-reload", 0, 0, 0,
+ (), "Reload browser.")
{
webkit_web_view_reload (web_view);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_next, "webkit-find-next", 1, 0, 0,
- (SCM text),
- "Find next.")
+SCM_DEFINE (scm_webkit_find_next, "webkit-find-next", 1, 0, 0,
+ (SCM text), "Find next.")
{
- const char *c_text = scm_to_locale_string(text);
- webkit_find_controller_search (webkit_web_view_get_find_controller (web_view), c_text, WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE, 0);
+ const char *c_text = scm_to_locale_string (text);
+ webkit_find_controller_search (webkit_web_view_get_find_controller
+ (web_view), c_text,
+ WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE, 0);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_previous, "webkit-find-previous", 1, 0, 0,
- (SCM text),
- "Find previous.")
+SCM_DEFINE (scm_webkit_find_previous, "webkit-find-previous", 1, 0, 0,
+ (SCM text), "Find previous.")
{
- const char *c_text = scm_to_locale_string(text);
- webkit_find_controller_search (webkit_web_view_get_find_controller (web_view), c_text, WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE|WEBKIT_FIND_OPTIONS_BACKWARDS, 0);
+ const char *c_text = scm_to_locale_string (text);
+ webkit_find_controller_search (webkit_web_view_get_find_controller
+ (web_view), c_text,
+ WEBKIT_FIND_OPTIONS_CASE_INSENSITIVE |
+ WEBKIT_FIND_OPTIONS_BACKWARDS, 0);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_find_finish, "webkit-find-finish", 0, 0, 0,
- (),
- "Find finish.")
+SCM_DEFINE (scm_webkit_find_finish, "webkit-find-finish", 0, 0, 0,
+ (), "Find finish.")
{
- webkit_find_controller_search_finish (webkit_web_view_get_find_controller (web_view));
+ webkit_find_controller_search_finish (webkit_web_view_get_find_controller
+ (web_view));
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_zoom_in, "webkit-zoom-in", 0, 0, 0,
- (),
- "Zoom in.")
+SCM_DEFINE (scm_webkit_zoom_in, "webkit-zoom-in", 0, 0, 0, (), "Zoom in.")
{
gdouble zoom = webkit_web_view_get_zoom_level (web_view);
webkit_web_view_set_zoom_level (web_view, zoom * 1.1);
return SCM_UNSPECIFIED;
}
-SCM_DEFINE(scm_webkit_zoom_out, "webkit-zoom-out", 0, 0, 0,
- (),
- "Zoom out.")
+SCM_DEFINE (scm_webkit_zoom_out, "webkit-zoom-out", 0, 0, 0, (), "Zoom out.")
{
gdouble zoom = webkit_web_view_get_zoom_level (web_view);
webkit_web_view_set_zoom_level (web_view, zoom / 1.1);
@@ -500,7 +520,8 @@ SCM_DEFINE(scm_webkit_eval_javascript, "webkit-eval-javascript", 2, 0, 0,
}
*/
-static void init_primitives(void)
+static void
+init_primitives (void)
{
/*
We use guile-snarf to generate main.c.x that helps us register the C
diff --git a/example/emacsy-webkit-gtk.scm b/example/emacsy-webkit-gtk.scm
index 22435f1..9555f00 100644
--- a/example/emacsy-webkit-gtk.scm
+++ b/example/emacsy-webkit-gtk.scm
@@ -26,14 +26,14 @@
(use-modules (srfi srfi-1) ;; any
)
-(define-interactive
- (load-url #:optional
- (url (read-from-minibuffer "URL: ")))
+(define-interactive
+ (load-url #:optional
+ (url (read-from-minibuffer "URL: ")))
(webkit-load-url url))
;; Load-url is all right, but it requires an actual URL.
;; Let's fix that with a new command: GOTO.
-(define-interactive
+(define-interactive
(goto #:optional
(urlish (read-from-minibuffer "GOTO: ")))
(cond
@@ -48,12 +48,12 @@
(else
;; It's just one word. Let's try adding a .com and http:// if it
;; needs it.
- (load-url (format #f "http://~a~a" urlish
- (if (any (lambda (suffix)
+ (load-url (format #f "http://~a~a" urlish
+ (if (any (lambda (suffix)
(string-suffix? suffix urlish))
'(".com" ".org" ".net"))
""
-
+
".com"))))))
(define-interactive (go-forward)
@@ -72,13 +72,13 @@
;; These aren't as good as Emacs' isearch-forward, but they're not
;; a bad start.
-(define-interactive
+(define-interactive
(search-forward #:optional
(text (or find-text (read-from-minibuffer "Search: "))))
(set! find-text text)
(webkit-find-next text))
-(define-interactive
+(define-interactive
(search-backward #:optional
(text (or find-text (read-from-minibuffer "Search: "))))
(set! find-text text)
diff --git a/example/hello-emacsy.c b/example/hello-emacsy.c
index 6864b3a..6930798 100644
--- a/example/hello-emacsy.c
+++ b/example/hello-emacsy.c
@@ -46,8 +46,9 @@
void display_func ();
void keyboard_func (unsigned char glut_key, int x, int y);
-void draw_string (int, int, char*);
-char * try_load_startup (char const* prefix, char const* dir, char const* startup_script);
+void draw_string (int, int, char *);
+char *try_load_startup (char const *prefix, char const *dir,
+ char const *startup_script);
void primitives_init ();
/*
@@ -70,7 +71,7 @@ main (int argc, char *argv[])
* Initialize GLUT.
*/
glutInit (&argc, argv);
- glutInitDisplayMode (GLUT_RGB|GLUT_DOUBLE);
+ glutInitDisplayMode (GLUT_RGB | GLUT_DOUBLE);
glutInitWindowSize (500, 500);
glutCreateWindow ("Hello, Emacsy!");
glutDisplayFunc (display_func);
@@ -86,8 +87,7 @@ main (int argc, char *argv[])
if (argc == 2 && strcmp ("--batch", argv[1]) == 0)
interactive = 0;
err = emacsy_initialize (interactive
- ? EMACSY_INTERACTIVE
- : EMACSY_NON_INTERACTIVE);
+ ? EMACSY_INTERACTIVE : EMACSY_NON_INTERACTIVE);
if (err)
exit (err);
/* primitives_init ();
@@ -107,9 +107,9 @@ main (int argc, char *argv[])
dirname (dirname (prefix));
if (!try_load_startup (0, 0, startup_script)
- &&!try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
- &&!try_load_startup (prefix, "/", startup_script)
- &&!try_load_startup (prefix, "/etc/emacsy/", startup_script))
+ && !try_load_startup (getenv ("EMACSY_SYSCONFDIR"), "/", startup_script)
+ && !try_load_startup (prefix, "/", startup_script)
+ && !try_load_startup (prefix, "/etc/emacsy/", startup_script))
fprintf (stderr, "error: failed to find '%s'.\n", startup_script);
/* void glutMainLoop ();
* Enter GLUT main loop, not return.
@@ -156,9 +156,7 @@ keyboard_func (unsigned char glut_key, int x, int y)
* The keys @verb{|C-a|} and @verb{|C-b|} return @code{1} and @code{2}
* respectively. We want to map these to their actual character values.
*/
- key = mod_flags & EMACSY_MODKEY_CONTROL
- ? glut_key + ('a' - 1)
- : glut_key;
+ key = mod_flags & EMACSY_MODKEY_CONTROL ? glut_key + ('a' - 1) : glut_key;
emacsy_key_event (key, mod_flags);
glutPostRedisplay ();
}
@@ -181,9 +179,7 @@ display_func ()
glMatrixMode (GL_PROJECTION);
glLoadIdentity ();
glOrtho (0.0, 500.0, 0.0, 500.0, -2.0, 500.0);
- gluLookAt (0, 0, 2,
- 0.0, 0.0, 0.0,
- 0.0, 1.0, 0.0);
+ gluLookAt (0, 0, 2, 0.0, 0.0, 0.0, 0.0, 1.0, 0.0);
glMatrixMode (GL_MODELVIEW);
glColor3f (1, 1, 1);
@@ -227,8 +223,7 @@ draw_string (int x, int y, char *string)
glTranslatef (x, y, 0.);
glScalef (0.2, 0.2, 1.0);
while (*string)
- glutStrokeCharacter (GLUT_STROKE_ROMAN,
- *string++);
+ glutStrokeCharacter (GLUT_STROKE_ROMAN, *string++);
}
/*
@@ -259,8 +254,7 @@ SCM_DEFINE (scm_get_counter, "get-counter",
/* required arg count */ 0,
/* optional arg count */ 0,
/* variable length args? */ 0,
- (),
- "Returns value of counter.")
+ (), "Returns value of counter.")
{
return scm_from_int (counter);
}
@@ -275,9 +269,7 @@ SCM_DEFINE (scm_get_counter, "get-counter",
SCM_DEFINE (scm_set_counter_x, "set-counter!",
/* required, optional, var. length? */
- 1, 0, 0,
- (SCM value),
- "Sets value of counter.")
+ 1, 0, 0, (SCM value), "Sets value of counter.")
{
counter = scm_to_int (value);
glutPostRedisplay ();
@@ -300,7 +292,8 @@ primitives_init ()
* Locate the @file{hello-emacsy.scm} Guile initialization and load it.
*/
char *
-try_load_startup (char const* prefix, char const* dir, char const* startup_script)
+try_load_startup (char const *prefix, char const *dir,
+ char const *startup_script)
{
static char file_name[PATH_MAX];
if (prefix)
diff --git a/scripts/doc-snarf.scm b/scripts/doc-snarf.scm
index c51eef7..ffa9c45 100644
--- a/scripts/doc-snarf.scm
+++ b/scripts/doc-snarf.scm
@@ -124,17 +124,17 @@ This procedure foos, or bars, depending on the argument @var{braz}.
(define (doc-snarf . args)
(let ((options (getopt-long (cons "doc-snarf" args) command-synopsis)))
(let ((help-wanted (option-ref options 'help #f))
- (version-wanted (option-ref options 'version #f))
- (texinfo-wanted (option-ref options 'texinfo #f))
- (lang (string->symbol
+ (version-wanted (option-ref options 'version #f))
+ (texinfo-wanted (option-ref options 'texinfo #f))
+ (lang (string->symbol
(string-downcase (option-ref options 'lang "scheme")))))
(cond
(version-wanted (display-version))
(help-wanted (display-help))
(else
- (let ((input (option-ref options '() #f))
- (output (option-ref options 'output #f)))
- (if
+ (let ((input (option-ref options '() #f))
+ (output (option-ref options 'output #f)))
+ (if
;; Bonard B. Timmons III says `(pair? input)' alone is sufficient.
;; (and input (pair? input))
(pair? input)
@@ -249,75 +249,75 @@ return the standard internal docstring if found. Return #f if not."
options)))))
(let lp ((line (read-line i-p)) (state 'neutral) (doc-strings '())
- (options '()) (entries '()) (lno 0))
+ (options '()) (entries '()) (lno 0))
(cond
((eof-object? line)
- (close-input-port i-p)
- (reverse entries))
+ (close-input-port i-p)
+ (reverse entries))
;; State 'neutral: we're currently not within a docstring or
;; option section
((eq? state 'neutral)
- (let ((m (regexp-exec docstring-start line)))
- (if m
- (lp (read-line i-p) 'doc-string
- (list (match:substring m 1)) '() entries (+ lno 1))
- (lp (read-line i-p) state '() '() entries (+ lno 1)))))
+ (let ((m (regexp-exec docstring-start line)))
+ (if m
+ (lp (read-line i-p) 'doc-string
+ (list (match:substring m 1)) '() entries (+ lno 1))
+ (lp (read-line i-p) state '() '() entries (+ lno 1)))))
;; State 'doc-string: we have started reading a docstring and
;; are waiting for more, for options or for a define.
((eq? state 'doc-string)
- (let ((m0 (regexp-exec docstring-prefix line))
- (m1 (regexp-exec option-prefix line))
- (m2 (regexp-exec signature-start line))
- (m3 (regexp-exec docstring-end line)))
- (cond
- (m0
- (lp (read-line i-p) 'doc-string
- (cons (match:substring m0 1) doc-strings) '() entries
- (+ lno 1)))
- (m1
- (lp (read-line i-p) 'options
- doc-strings (cons (match:substring m1 1) options) entries
- (+ lno 1)))
- (m2
+ (let ((m0 (regexp-exec docstring-prefix line))
+ (m1 (regexp-exec option-prefix line))
+ (m2 (regexp-exec signature-start line))
+ (m3 (regexp-exec docstring-end line)))
+ (cond
+ (m0
+ (lp (read-line i-p) 'doc-string
+ (cons (match:substring m0 1) doc-strings) '() entries
+ (+ lno 1)))
+ (m1
+ (lp (read-line i-p) 'options
+ doc-strings (cons (match:substring m1 1) options) entries
+ (+ lno 1)))
+ (m2
(let ((options (augmented-options line i-p options))) ; ttn-mod
(lp (read-line i-p) 'neutral '() '()
(cons (parse-entry lang doc-strings options line input-file lno)
entries)
(+ lno 1))))
(m3
- (lp (read-line i-p) 'neutral '() '()
- (cons (parse-entry lang doc-strings options #f input-file lno)
- entries)
- (+ lno 1)))
- (else
- (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))
+ (lp (read-line i-p) 'neutral '() '()
+ (cons (parse-entry lang doc-strings options #f input-file lno)
+ entries)
+ (+ lno 1)))
+ (else
+ (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))
;; State 'options: We're waiting for more options or for a
;; define.
((eq? state 'options)
- (let ((m1 (regexp-exec option-prefix line))
- (m2 (regexp-exec signature-start line))
- (m3 (regexp-exec docstring-end line)))
- (cond
- (m1
- (lp (read-line i-p) 'options
- doc-strings (cons (match:substring m1 1) options) entries
- (+ lno 1)))
- (m2
+ (let ((m1 (regexp-exec option-prefix line))
+ (m2 (regexp-exec signature-start line))
+ (m3 (regexp-exec docstring-end line)))
+ (cond
+ (m1
+ (lp (read-line i-p) 'options
+ doc-strings (cons (match:substring m1 1) options) entries
+ (+ lno 1)))
+ (m2
(let ((options (augmented-options line i-p options))) ; ttn-mod
(lp (read-line i-p) 'neutral '() '()
(cons (parse-entry lang doc-strings options line input-file lno)
entries)
(+ lno 1))))
- (m3
- (lp (read-line i-p) 'neutral '() '()
- (cons (parse-entry lang doc-strings options #f input-file lno)
- entries)
- (+ lno 1)))
- (else
- (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))))))
+ (m3
+ (lp (read-line i-p) 'neutral '() '()
+ (cons (parse-entry lang doc-strings options #f input-file lno)
+ entries)
+ (+ lno 1)))
+ (else
+ (lp (read-line i-p) 'neutral '() '() entries (+ lno 1))))))))))
(define (make-entry type symbol signature docstrings options filename line)
(vector type symbol signature docstrings options filename line))
@@ -354,10 +354,10 @@ return the standard internal docstring if found. Return #f if not."
(else 'procedure))))
(make-entry type
(get-symbol def-line)
- (make-prototype def-line) (reverse docstrings)
- (reverse options)
+ (make-prototype def-line) (reverse docstrings)
+ (reverse options)
filename
- (+ (- line-no (length docstrings) (length options)) 1))))
+ (+ (- line-no (length docstrings) (length options)) 1))))
((> (length docstrings) 0)
(if (or (string-null? (car (reverse docstrings)))
(eq? lang 'scheme)) (make-entry 'text
@@ -369,13 +369,13 @@ return the standard internal docstring if found. Return #f if not."
(+ (- line-no (length docstrings) (length options)) 1))
(make-entry (if (eq? lang 'c) 'c-function 'procedure)
(string->symbol (car (reverse docstrings)))
- (car (reverse docstrings))
- (cdr (reverse docstrings))
- (reverse options) filename
- (+ (- line-no (length docstrings) (length options)) 1))))
+ (car (reverse docstrings))
+ (cdr (reverse docstrings))
+ (reverse options) filename
+ (+ (- line-no (length docstrings) (length options)) 1))))
(else
(make-entry 'procedure 'foo "" (reverse docstrings) (reverse options) filename
- (+ (- line-no (length docstrings) (length options)) 1)))))
+ (+ (- line-no (length docstrings) (length options)) 1)))))
;; Create a string which is a procedure prototype. The necessary
;; information for constructing the prototype is taken from the line
@@ -385,30 +385,30 @@ return the standard internal docstring if found. Return #f if not."
def-line
(lambda (s-p)
(let* ((paren (read-char s-p))
- (keyword (read s-p))
- (tmp (read s-p)))
+ (keyword (read s-p))
+ (tmp (read s-p)))
(cond
- ((pair? tmp)
- (join-symbols tmp))
- ((symbol? tmp)
- (symbol->string tmp))
- (else
- ""))))))
+ ((pair? tmp)
+ (join-symbols tmp))
+ ((symbol? tmp)
+ (symbol->string tmp))
+ (else
+ ""))))))
(define (get-symbol def-line)
(call-with-input-string
def-line
(lambda (s-p)
(let* ((paren (read-char s-p))
- (keyword (read s-p))
- (tmp (read s-p)))
+ (keyword (read s-p))
+ (tmp (read s-p)))
(cond
- ((pair? tmp)
- (car tmp))
- ((symbol? tmp)
- tmp)
- (else
- 'foo))))))
+ ((pair? tmp)
+ (car tmp))
+ ((symbol? tmp)
+ tmp)
+ (else
+ 'foo))))))
;; Append the symbols in the string list @var{s}, separated with a
;; space character.
@@ -424,17 +424,17 @@ return the standard internal docstring if found. Return #f if not."
((boolean? s)
(if s "#t" "#f"))))
(cond ((null? s)
- "")
- ((symbol? s)
- (string-append ". " (symbol->string s)))
+ "")
+ ((symbol? s)
+ (string-append ". " (symbol->string s)))
((and (pair? (car s)) (pair? (cdr s)))
(string-append "(" (join-symbols (car s)) ") " (join-symbols (cdr s))))
((pair? (car s))
(string-append "(" (join-symbols (car s)) ")"))
- ((null? (cdr s))
- (->string (car s)))
- (else
- (string-append (->string (car s)) " " (join-symbols (cdr s))))))
+ ((null? (cdr s))
+ (->string (car s)))
+ (else
+ (string-append (->string (car s)) " " (join-symbols (cdr s))))))
;; Write @var{entries} to @var{output-file} using @var{writer}.
;; @var{writer} is a proc that takes one entry.
diff --git a/test/advice.scm b/test/advice.scm
index 82995e4..d4282a0 100644
--- a/test/advice.scm
+++ b/test/advice.scm
@@ -1,12 +1,12 @@
-;;; <file:advice-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; <file:advice-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -29,15 +29,15 @@
;; Some trickery so we can test private procedures.
(module-use! (current-module) (resolve-module '(emacsy advice))))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; To test this functionality, we're going to make some counter
-;;; procedures.
-;;;
-;;;
-;;; <advice:test>=
+;;; To test this functionality, we're going to make some counter
+;;; procedures.
+;;;
+;;;
+;;; <advice:test>=
(define (my-orig-func x)
(+ x 1))
@@ -50,10 +50,10 @@
(car args))))))
(define a-before (make-counter))
-;;; Let's make an identity advice procedure. It does nothing, but it does
-;;; wrap around the function.
-;;;
-;;; <advice:test>=
+;;; Let's make an identity advice procedure. It does nothing, but it does
+;;; wrap around the function.
+;;;
+;;; <advice:test>=
(define advice (make-record-of-advice my-orig-func '() '() '()))
(define advised-func (make-advising-function advice))
@@ -61,11 +61,11 @@
(check (my-orig-func 1) => 2)
(check (advised-func 1) => 2)
(check (a-before 'count) => 0)
-;;; Let's test this with the simple functionality of having a piece of
-;;; before advice.
-;;;
-;;;
-;;; <advice:test>=
+;;; Let's test this with the simple functionality of having a piece of
+;;; before advice.
+;;;
+;;;
+;;; <advice:test>=
(define advice (make-record-of-advice my-orig-func (list (make-piece-of-advice a-before 'a-before 'before 0 'activate)) '() '()))
(define advised-func (make-advising-function advice))
@@ -73,11 +73,11 @@
(check (my-orig-func 1) => 2)
(check (advised-func 1) => 2)
(check (a-before 'count) => 1)
-;;; Let's check the after advice.
-;;;
-;;; <advice:test>=
+;;; Let's check the after advice.
+;;;
+;;; <advice:test>=
(define a-after (make-counter))
-(define advice (make-record-of-advice my-orig-func '() '()
+(define advice (make-record-of-advice my-orig-func '() '()
(list (make-piece-of-advice a-after 'a-after 'after 0 'activate))))
(define advised-func (make-advising-function advice))
@@ -85,9 +85,9 @@
(check (my-orig-func 1) => 2)
(check (advised-func 1) => 2)
(check (a-after 'count) => 1)
-;;; Let's check the after advice.
-;;;
-;;; <advice:test>=
+;;; Let's check the after advice.
+;;;
+;;; <advice:test>=
(define a-around (lambda args
(next-advice)
1))
@@ -96,7 +96,7 @@
(define advised-func (make-advising-function advice))
(check (my-orig-func 1) => 2)
(check (advised-func 1) => 1)
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/block.scm b/test/block.scm
index c64b410..b4ca8fb 100644
--- a/test/block.scm
+++ b/test/block.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:block-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:block-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -28,130 +28,130 @@
;; Some trickery so we can test private procedures.
(module-use! (current-module) (resolve-module '(emacsy block))))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; % -*- mode: Noweb; noweb-code-mode: scheme-mode -*-
-;;; @section Block Module
-;;;
+;;; % -*- mode: Noweb; noweb-code-mode: scheme-mode -*-
+;;; @section Block Module
+;;;
;;; \epigraph{Wearied I fell asleep: But now lead on; In me is no delay; with thee to go, Is to stay here}{Paradise Lost \\John Milton}
-;;;
-;;; The [[block]] module handles blocking in Emacsy. When I prototyped
-;;; Emacsy, I considered this the riskiest part of the project. If I
-;;; couldn't get this to work, it wouldn't be worth trying to develop the
-;;; idea further. To understand what I mean, one can try running the
-;;; following in Emacs \verb|M-: (read-key)|. This will evaluate
-;;; [[read-key]] and effectively block until there is another key press.
-;;;
-;;; Implementing ``blocking'' on a small set of bare functions can be done
-;;; without too much trickery. However, what if you have computations
-;;; that follow after these functions? For instance if you evaluate
-;;; \verb|M-: (message "Got %s" (read-key))|, [[read-key]] must block
-;;; until a key is pressed, then resume the computation that will call
-;;; [[message]]. An Operating System must perform a similar operation
-;;; whenever a system call is made, usually implemented using interrupts
-;;; or traps. Without recourse to interrupts and bare stack manipulation,
-;;; what can we do to achieve a similar feature?
-;;;
-;;; GNU Guile has a terrific feature called delimited continuations. Here
-;;; is an example of a delimited continuation from the Guile Manual. This
-;;; continuation [[cont]]
-;;;
-;;; @verbatim
-;;; (define cont
-;;; (call-with-prompt
-;;; ;; tag
-;;; 'foo
-;;; ;; thunk
-;;; (lambda ()
-;;; (+ 34 (abort-to-prompt 'foo)))
-;;; ;; handler
-;;; (lambda (k) k)))
-;;; @end verbatim
-;;;
-;;; \noindent could be rewritten as
-;;;
-;;; @verbatim
-;;; (define cont
-;;; (lambda (x)
-;;; (+ 34 x)))
-;;; @end verbatim.
-;;;
-;;; \noindent I had to read and re-read this example to let it sink in.
-;;; What does it buy us? It allows us to abort a computation at any time
-;;; and resume it later.\footnote{Lua's coroutines also seem like a good
-;;; candidate for pulling off a trick like this. Python's generators,
-;;; however, do not.} So if we were to implement [[read-key]], we abort
-;;; the computation if there has been no key press. Our main loop in
-;;; \verb|C| continues to run, redraw, wait for key presses. When a key
-;;; press comes, we can resume that computation---that continuation.
-;;; That's the idea. What's beautiful about this is that the user code
-;;; has access to the same rich input services as the system code without
-;;; any unnatural contortions. These ``system calls'' look like regular
-;;; procedure calls much like the Unix call to [[open]] looks like a
-;;; regular function call.
-;;;
-;;; One of the key features I figured one bought by embedding a
-;;; higher-level language like Scheme was garbage collection. High-level
-;;; blocking while still being low-level non-blocking is a huge boon.
-;;; What we'll implement is a simple blocking system using Guile's
-;;; delimited continuations, also called prompts.
-;;;
-;;; Let's start with the tests, so the usage is somewhat obvious.
-;;;
-;;;
-;;; <block:test>=
+;;;
+;;; The [[block]] module handles blocking in Emacsy. When I prototyped
+;;; Emacsy, I considered this the riskiest part of the project. If I
+;;; couldn't get this to work, it wouldn't be worth trying to develop the
+;;; idea further. To understand what I mean, one can try running the
+;;; following in Emacs \verb|M-: (read-key)|. This will evaluate
+;;; [[read-key]] and effectively block until there is another key press.
+;;;
+;;; Implementing ``blocking'' on a small set of bare functions can be done
+;;; without too much trickery. However, what if you have computations
+;;; that follow after these functions? For instance if you evaluate
+;;; \verb|M-: (message "Got %s" (read-key))|, [[read-key]] must block
+;;; until a key is pressed, then resume the computation that will call
+;;; [[message]]. An Operating System must perform a similar operation
+;;; whenever a system call is made, usually implemented using interrupts
+;;; or traps. Without recourse to interrupts and bare stack manipulation,
+;;; what can we do to achieve a similar feature?
+;;;
+;;; GNU Guile has a terrific feature called delimited continuations. Here
+;;; is an example of a delimited continuation from the Guile Manual. This
+;;; continuation [[cont]]
+;;;
+;;; @verbatim
+;;; (define cont
+;;; (call-with-prompt
+;;; ;; tag
+;;; 'foo
+;;; ;; thunk
+;;; (lambda ()
+;;; (+ 34 (abort-to-prompt 'foo)))
+;;; ;; handler
+;;; (lambda (k) k)))
+;;; @end verbatim
+;;;
+;;; \noindent could be rewritten as
+;;;
+;;; @verbatim
+;;; (define cont
+;;; (lambda (x)
+;;; (+ 34 x)))
+;;; @end verbatim.
+;;;
+;;; \noindent I had to read and re-read this example to let it sink in.
+;;; What does it buy us? It allows us to abort a computation at any time
+;;; and resume it later.\footnote{Lua's coroutines also seem like a good
+;;; candidate for pulling off a trick like this. Python's generators,
+;;; however, do not.} So if we were to implement [[read-key]], we abort
+;;; the computation if there has been no key press. Our main loop in
+;;; \verb|C| continues to run, redraw, wait for key presses. When a key
+;;; press comes, we can resume that computation---that continuation.
+;;; That's the idea. What's beautiful about this is that the user code
+;;; has access to the same rich input services as the system code without
+;;; any unnatural contortions. These ``system calls'' look like regular
+;;; procedure calls much like the Unix call to [[open]] looks like a
+;;; regular function call.
+;;;
+;;; One of the key features I figured one bought by embedding a
+;;; higher-level language like Scheme was garbage collection. High-level
+;;; blocking while still being low-level non-blocking is a huge boon.
+;;; What we'll implement is a simple blocking system using Guile's
+;;; delimited continuations, also called prompts.
+;;;
+;;; Let's start with the tests, so the usage is somewhat obvious.
+;;;
+;;;
+;;; <block:test>=
(define done-blocking? #f)
(define (i-block)
(block-yield)
(set! done-blocking? #t))
-;;; [[i-block]] will immediately yield. If it is not called with
-;;; [[call-blockable]] then it will throw an error.
-;;;
-;;;
-;;; <block:test>=
+;;; [[i-block]] will immediately yield. If it is not called with
+;;; [[call-blockable]] then it will throw an error.
+;;;
+;;;
+;;; <block:test>=
(check-throw (i-block) => 'misc-error)
-;;; Now we can call [[i-block]] and capture its continuation.
-;;;
-;;;
-;;; <block:test>=
+;;; Now we can call [[i-block]] and capture its continuation.
+;;;
+;;;
+;;; <block:test>=
(check-true (call-blockable (lambda () (i-block))))
(check (length blocking-continuations) => 1)
-;;; Now we should be able to resume [[i-block]] by running [[block-tick]].
-;;;
-;;;
-;;; <block:test>=
+;;; Now we should be able to resume [[i-block]] by running [[block-tick]].
+;;;
+;;;
+;;; <block:test>=
(check done-blocking? => #f)
(check (block-tick) => #t)
(check done-blocking? => #t)
(check (length blocking-continuations) => 0)
-;;; Let's exercise this [[block-until]] procedure.
-;;;
-;;; <block:test>=
+;;; Let's exercise this [[block-until]] procedure.
+;;;
+;;; <block:test>=
(define continue-blocking? #t)
(define (i-block-until)
(block-until (lambda () (not continue-blocking?))))
(check (length blocking-continuations) => 0)
(call-blockable (lambda () (i-block-until)))
(check (length blocking-continuations) => 1)
-;;; \noindent Now, even if we call [[block-tick]] it shouldn't be resumed.
-;;;
-;;;
-;;; <block:test>=
+;;; \noindent Now, even if we call [[block-tick]] it shouldn't be resumed.
+;;;
+;;;
+;;; <block:test>=
(block-tick)
(check (length blocking-continuations) => 1)
-;;; \noindent Let's change the condition for our blocking call.
-;;;
-;;;
-;;; <block:test>=
+;;; \noindent Let's change the condition for our blocking call.
+;;;
+;;;
+;;; <block:test>=
(set! continue-blocking? #f)
(check (length blocking-continuations) => 1)
(block-tick)
(check (length blocking-continuations) => 0)
-;;; \noindent Let's exercise [[block-kill]].
-;;;
-;;; <block:test>=
+;;; \noindent Let's exercise [[block-kill]].
+;;;
+;;; <block:test>=
(set! continue-blocking? #t)
(let ((bc (call-blockable (lambda () (i-block-until)))))
(check (length blocking-continuations) => 1)
@@ -163,7 +163,7 @@
(block-tick)
(check (length blocking-continuations) => 0))
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/check.scm b/test/check.scm
index a51c707..34d9fa1 100644
--- a/test/check.scm
+++ b/test/check.scm
@@ -1,6 +1,6 @@
; <PLAINTEXT>
; Copyright (c) 2005-2006 Sebastian Egner.
-;
+;
; Permission is hereby granted, free of charge, to any person obtaining
; a copy of this software and associated documentation files (the
; ``Software''), to deal in the Software without restriction, including
@@ -8,10 +8,10 @@
; distribute, sublicense, and/or sell copies of the Software, and to
; permit persons to whom the Software is furnished to do so, subject to
; the following conditions:
-;
+;
; The above copyright notice and this permission notice shall be
; included in all copies or substantial portions of the Software.
-;
+;
; THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND,
; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
@@ -19,9 +19,9 @@
; LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
; OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
; WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-;
+;
; -----------------------------------------------------------------------
-;
+;
; Lightweight testing (reference implementation)
; ==============================================
;
@@ -37,7 +37,7 @@
; -- portability --
; PLT: (require (lib "23.ss" "srfi") (lib "42.ss" "srfi"))
-; Scheme48: ,open srfi-23 srfi-42
+; Scheme48: ,open srfi-23 srfi-42
; -- utilities --
@@ -52,7 +52,7 @@
check-exit
)
#:export-syntax (check check-throw check-true check-false use-private-modules)
- )
+ )
(define check:write write)
@@ -139,7 +139,7 @@
(let* ((w (car (reverse check:failed)))
(expression (car w))
(actual-result (cadr w))
- (expected-result (caddr w)))
+ (expected-result (caddr w)))
(display " First failed example:")
(newline)
(check:report-expression expression)
@@ -149,7 +149,7 @@
(define (check-passed? expected-total-count)
(and (= (length check:failed) 0)
(= check:correct expected-total-count)))
-
+
; -- simple checks --
(define (check:proc expression thunk equal expected-result)
@@ -177,9 +177,9 @@
(begin (check:report-correct 1)
(check:add-correct!))
(begin (check:report-failed expected-result)
- (check:add-failed! expression
- actual-result
- expected-result)))))
+ (check:add-failed! expression
+ actual-result
+ expected-result)))))
(else (error "unrecognized check:mode" check:mode)))
(if #f #f))
@@ -222,7 +222,7 @@
(expression (cadr w))
(actual-result (caddr w))
(expected-result (cadddr w))
- (cases (car (cddddr w))))
+ (cases (car (cddddr w))))
(if correct?
(begin (if (>= check:mode 100)
(begin (check:report-expression expression)
@@ -233,39 +233,39 @@
(begin (check:report-expression expression)
(check:report-actual-result actual-result)
(check:report-failed expected-result)))
- (check:add-failed! expression
- actual-result
- expected-result)))))
+ (check:add-failed! expression
+ actual-result
+ expected-result)))))
(define-syntax check-ec:make
(syntax-rules (=>)
((check-ec:make qualifiers expr (=> equal) expected (arg ...))
(if (>= check:mode 1)
(check:proc-ec
- (let ((cases 0))
- (let ((w (first-ec
- #f
- qualifiers
- (:let equal-pred equal)
- (:let expected-result expected)
- (:let actual-result
+ (let ((cases 0))
+ (let ((w (first-ec
+ #f
+ qualifiers
+ (:let equal-pred equal)
+ (:let expected-result expected)
+ (:let actual-result
(let ((arg arg) ...) ; (*)
expr))
- (begin (set! cases (+ cases 1)))
- (if (not (equal-pred actual-result expected-result)))
- (list (list 'let (list (list 'arg arg) ...) 'expr)
- actual-result
- expected-result
- cases))))
- (if w
- (cons #f w)
- (list #t
- '(check-ec qualifiers
- expr (=> equal)
- expected (arg ...))
- (if #f #f)
- (if #f #f)
- cases)))))))))
+ (begin (set! cases (+ cases 1)))
+ (if (not (equal-pred actual-result expected-result)))
+ (list (list 'let (list (list 'arg arg) ...) 'expr)
+ actual-result
+ expected-result
+ cases))))
+ (if w
+ (cons #f w)
+ (list #t
+ '(check-ec qualifiers
+ expr (=> equal)
+ expected (arg ...))
+ (if #f #f)
+ (if #f #f)
+ cases)))))))))
; (*) is a compile-time check that (arg ...) is a list
; of pairwise disjoint bound variables at this point.
@@ -297,7 +297,7 @@
;; XXX I added this just so I could integrate it with unit tests.
(define (check-exit)
- (exit (if (and #;(= (length test-errors) 0)
+ (exit (if (and #;(= (length test-errors) 0)
(= 0 (length check:failed))) 0 1)))
;; Include everything a module uses including its non-exported
@@ -307,6 +307,6 @@
((use-private-modules . modules)
(eval-when (compile load eval)
;; Some trickery so we can test private procedures.
- (for-each (lambda (module)
+ (for-each (lambda (module)
(module-use! (current-module) (resolve-module module)))
'modules)))))
diff --git a/test/command.scm b/test/command.scm
index 2cdb4db..dcd4743 100644
--- a/test/command.scm
+++ b/test/command.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:command-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:command-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -29,11 +29,11 @@
;; Some trickery so we can test private procedures.
(module-use! (current-module) (resolve-module '(emacsy command))))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; <command:test>=
+;;; <command:test>=
(define test-cmd (lambda-cmd args 1))
(define (test-cmd-2) 2)
(define-cmd (test-cmd-3) 3)
@@ -47,8 +47,8 @@
(check (command-name test-cmd) => 'proc)
(check (command-name test-cmd-2) => 'test-cmd-2)
(check (command-name test-cmd-3) => 'test-cmd-3)
-;;; <command:test>=
-(define-cmd (test-who-am-i?)
+;;; <command:test>=
+(define-cmd (test-who-am-i?)
"test-who-am-i? documentation"
(let ((w (what-command-am-i?)))
1
@@ -56,7 +56,7 @@
(check (command-name test-who-am-i?) => 'test-who-am-i?)
(check (test-who-am-i?) => 'test-who-am-i?)
(check (procedure-documentation test-who-am-i?) => "test-who-am-i? documentation")
-;;; <command:test>=
+;;; <command:test>=
(define-cmd (foo)
(if (called-interactively?)
'interactive
@@ -69,7 +69,7 @@
(check-throw (command-execute 'foo) => 'misc-error)
(check (command-execute foo) => 'non-interactive)
(check (call-interactively foo) => 'interactive)
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/core.scm b/test/core.scm
index 1e522ae..6d78fd3 100644
--- a/test/core.scm
+++ b/test/core.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:core-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:core-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -31,29 +31,29 @@
(use-private-modules (emacsy core))
(set! emacsy-interactive? #t)
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; <core:test>=
+;;; <core:test>=
(set! emacsy-interactive? #f)
(check (eval-expression '(+ 1 2)) => 3)
(set! emacsy-interactive? #t)
-;;; One problem with this is I'd like to give completing-read a list of
-;;; objects that will be converted to strings, but I'd like to get the
-;;; object out rather than the string. I want something like this:
-;;;
-;;;
-;;; <core:test>=
+;;; One problem with this is I'd like to give completing-read a list of
+;;; objects that will be converted to strings, but I'd like to get the
+;;; object out rather than the string. I want something like this:
+;;;
+;;;
+;;; <core:test>=
(check (let* ((symbols '(aa ab c d)))
(let-values
(((to-string from-string) (object-tracker symbol->string)))
(map from-string (all-completions "a" (map to-string symbols))))) => '(aa ab))
-;;; We need to be able to deal with exceptions gracefully where ever they
-;;; may pop up.
-;;;
-;;;
-;;; <core:test>=
+;;; We need to be able to deal with exceptions gracefully where ever they
+;;; may pop up.
+;;;
+;;;
+;;; <core:test>=
(define (good-hook)
#t)
(define (bad-hook)
@@ -69,11 +69,11 @@
(check-throw (run-hook my-hook) => 'some-error)
(check-throw (emacsy-run-hook my-hook) => 'no-throw)
(check (emacsy-run-hook my-hook) => #f)
-;;; <core:test>=
+;;; <core:test>=
(emacsy-discard-input!)
;(emacsy-key-event #\a)
(define mouse-event #f)
-(agenda-schedule (colambda ()
+(agenda-schedule (colambda ()
(format #t "START~%")
(set! mouse-event (read-from-mouse))
(format #t "END~%")))
@@ -85,7 +85,7 @@
(update-agenda)
(check-true mouse-event)
;(block-tick)
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/emacsy.scm b/test/emacsy.scm
index 58ab1d3..399bdfa 100644
--- a/test/emacsy.scm
+++ b/test/emacsy.scm
@@ -1,12 +1,12 @@
-;;; <file:emacsy-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; <file:emacsy-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -19,35 +19,35 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-;;; Finally, let's provide this as our testing preamble.
-;;;
-;;;
-;;; <+ Test Preamble>=
+;;; Finally, let's provide this as our testing preamble.
+;;;
+;;;
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
-;;; <emacsy:test functions>=
+;;; <emacsy:test functions>=
(define unit-tests '())
(define (register-test name func)
(set! unit-tests (acons name func unit-tests)))
-;;; The function register-test does the work, but we don't want to require
-;;; the user to call it, so we'll define a macro that will automatically
-;;; call it.
-;;;
-;;;
-;;; <emacsy:test macro>=
+;;; The function register-test does the work, but we don't want to require
+;;; the user to call it, so we'll define a macro that will automatically
+;;; call it.
+;;;
+;;;
+;;; <emacsy:test macro>=
(define-syntax define-test
(syntax-rules ()
((define-test (name args ...) expr ...)
(begin (define* (name args ...)
expr ...)
(register-test 'name name)))))
-;;; Finally, now we just need a way to run all the unit tests.
-;;;
-;;;
-;;; <emacsy:run tests>=
+;;; Finally, now we just need a way to run all the unit tests.
+;;;
+;;;
+;;; <emacsy:run tests>=
(define test-errors '())
(define (run-tests)
(catch 'first-error
@@ -71,18 +71,18 @@
(reverse unit-tests)))
(lambda args
#f)))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
(eval-when (compile load eval)
- (module-use! (current-module) (resolve-module '(emacsy))))
+ (module-use! (current-module) (resolve-module '(emacsy))))
+
-
-;;; Let's run these tests at the end.
-;;;
-;;;
-;;; <+ Test Postscript>=
+;;; Let's run these tests at the end.
+;;;
+;;;
+;;; <+ Test Postscript>=
(run-tests)
(check-report)
@@ -91,10 +91,10 @@
(format #t "NO ERRORs in tests."))
(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
(format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
(format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
diff --git a/test/event.scm b/test/event.scm
index 83034b2..668a87d 100644
--- a/test/event.scm
+++ b/test/event.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:event-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:event-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -29,48 +29,48 @@
;; Some trickery so we can test private procedures.
(module-use! (current-module) (resolve-module '(emacsy event))))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; <event:test>=
+;;; <event:test>=
(check-true (make <key-event> #:command-char #\a))
-;;; <event:test>=
+;;; <event:test>=
(check (strip-off-modifier-keys "C-a") => '((control) "a"))
(check (strip-off-modifier-keys "a") => '(() "a"))
(check (strip-off-modifier-keys "asdf") => '(() "asdf"))
-;;; <event:test>=
+;;; <event:test>=
(check (modifier-char->symbol #\S) => 'shift)
(check (modifier-char->symbol #\X) => #f)
-;;; <event:test>=
+;;; <event:test>=
(check-true (memq 'kbd-entry->key-event (alist-keys kbd-converter-functions)))
-;;; One issue we have with the above is the following:
-;;;
-;;;
-;;; <event:test>=
+;;; One issue we have with the above is the following:
+;;;
+;;;
+;;; <event:test>=
(check (modifier-keys (kbd-entry->key-event "C-C-C-x")) => '(control control control))
;;; Let's test our canonization of a properly formed but non-canonical event.
-;;;
-;;;
-;;; <event:test>=
+;;;
+;;;
+;;; <event:test>=
(let ((key-event (kbd-entry->event "S-C-C-S-a")))
(check (modifier-keys key-event) => '(shift control control shift))
(check (command-char key-event) => #\a)
(canonize-event! key-event)
(check (modifier-keys key-event) => '(control))
(check (command-char key-event) => #\A))
-;;; <event:test>=
+;;; <event:test>=
(check (kbd "S-C-C-S-a") => '("C-A"))
(check (kbd "S-C-C-S-A") => '("C-A"))
-;;; <event:test>=
+;;; <event:test>=
(check (event->kbd (make <key-event> #:command-char #\a)) => "a")
-;;; <event:test>=
-(check (event->kbd (make <key-event> #:command-char #\a
+;;; <event:test>=
+(check (event->kbd (make <key-event> #:command-char #\a
#:modifier-keys '(control))) => "C-a")
-;;; <event:test>=
+;;; <event:test>=
(check (kbd "mouse-1") => '("mouse-1"))
(check (kbd "S-S-mouse-1") => '("S-mouse-1"))
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/help.scm b/test/help.scm
index 8f33261..b74a56f 100644
--- a/test/help.scm
+++ b/test/help.scm
@@ -1,12 +1,12 @@
-;;; <file:help-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; <file:help-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
diff --git a/test/kbd-macro.scm b/test/kbd-macro.scm
index d2121bf..49b787f 100644
--- a/test/kbd-macro.scm
+++ b/test/kbd-macro.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:kbd-macro-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:kbd-macro-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -23,7 +23,7 @@
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
(use-modules (emacsy kbd-macro)
(emacsy event)
- (emacsy command)
+ (emacsy command)
(emacsy klecl)
(oop goops)
(check))
@@ -32,14 +32,14 @@
(set! emacsy-interactive? #t)
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; Let's set up a command to test our functionality with.
-;;;
-;;;
-;;; <kbd-macro:test>=
+;;; Let's set up a command to test our functionality with.
+;;;
+;;;
+;;; <kbd-macro:test>=
(define test-command-called 0)
(define test-keymap (make-keymap))
(define-interactive (test-command)
@@ -59,12 +59,12 @@
(check (map command-char last-kbd-macro) => '(#\b #\a))
(execute-kbd-macro last-kbd-macro)
(check test-command-called => 2)
-;;; <kbd-macro:test>=
+;;; <kbd-macro:test>=
(check test-command-called => 2)
(execute-temporal-kbd-macro last-kbd-macro)
(primitive-command-loop (lambda args #f))
(check test-command-called => 3)
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/keymap.scm b/test/keymap.scm
index ce4be5f..83e9fb7 100644
--- a/test/keymap.scm
+++ b/test/keymap.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:keymap-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:keymap-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -29,22 +29,22 @@
;; Some trickery so we can test private procedures.
(module-use! (current-module) (resolve-module '(emacsy keymap))))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; <keymap:test>=
+;;; <keymap:test>=
(check-true (make <keymap>))
-;;; The core functionality of the keymap is being able to define and look
-;;; up key bindings.
-;;;
-;;; @subsection Lookup Key
-;;;
-;;; The procedure [[lookup-key]] return a keymap or symbol for a given
-;;; list of keys. Consider this test keymap
-;;;
-;;;
-;;; <keymap:test>=
+;;; The core functionality of the keymap is being able to define and look
+;;; up key bindings.
+;;;
+;;; @subsection Lookup Key
+;;;
+;;; The procedure [[lookup-key]] return a keymap or symbol for a given
+;;; list of keys. Consider this test keymap
+;;;
+;;;
+;;; <keymap:test>=
(define (self-insert-command) #f) ;; make a fake command
(define (mouse-drag-region) #f) ;; make a fake command
(define (find-file-at-point) #f) ;; make a fake command
@@ -52,13 +52,13 @@
(define-key k "a" 'self-insert-command)
(define-key k "mouse-1" 'mouse-drag-region)
(define-key k "C-x C-f" 'find-file-at-point)
-;;; \noindent [[lookup-key]] should behave in the following way.
-;;;
-;;;
-;;; <keymap:test>=
+;;; \noindent [[lookup-key]] should behave in the following way.
+;;;
+;;;
+;;; <keymap:test>=
(define (lookup-key* . args)
(let ((result (apply lookup-key args)))
- (if (procedure? result)
+ (if (procedure? result)
(procedure-name result)
result)))
(check (lookup-key* k '("a")) => 'self-insert-command-trampoline)
@@ -67,27 +67,27 @@
(check (lookup-key k "M-x b") => #f)
(check-true (keymap? (lookup-key k '("C-x"))))
(check (lookup-key k "C-x C-f a b" #f) => 2)
-;;; Because delivering the errors using booleans and numbers is a little
-;;; cumbersome (and perhaps should be replaced with exceptions?),
-;;; sometimes we just want to see if there is something in the keymap.
-;;;
-;;;
-;;; <keymap:test>=
+;;; Because delivering the errors using booleans and numbers is a little
+;;; cumbersome (and perhaps should be replaced with exceptions?),
+;;; sometimes we just want to see if there is something in the keymap.
+;;;
+;;;
+;;; <keymap:test>=
(check (lookup-key? k "C-x") => #f)
(check (lookup-key? k "C-x C-f") => #t)
(check (lookup-key? k "a") => #t)
-;;; @subsection Define Key
-;;;
-;;; The procedure [[define-key]] may return a number indicating an error,
-;;; or a keymap indicating it worked.
-;;;
-;;;
-;;; <keymap:test>=
+;;; @subsection Define Key
+;;;
+;;; The procedure [[define-key]] may return a number indicating an error,
+;;; or a keymap indicating it worked.
+;;;
+;;;
+;;; <keymap:test>=
;(check (define-key k (kbd "C-x C-f C-a C-b") 'nope) => 2)
-;;; <keymap:test>=
+;;; <keymap:test>=
(check-true (keymap? (make <keymap>)))
(check-false (keymap? 1))
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/klecl.scm b/test/klecl.scm
index ff20dc2..765fa5f 100644
--- a/test/klecl.scm
+++ b/test/klecl.scm
@@ -1,14 +1,14 @@
-;;; Layout for tests.
-;;;
-;;; <file:klecl-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; Layout for tests.
+;;;
+;;; <file:klecl-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -28,11 +28,11 @@
(use-private-modules (emacsy klecl))
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
-;;; <klecl:test>=
+;;; <klecl:test>=
(define last-event #f)
(codefine (test-read-event)
(set! last-event (read-event)))
@@ -51,11 +51,11 @@
;(check (blocking?) => #f)
(check (command-char last-event) => #\a)
;(clear-agenda)
-;;; Since we have no keymaps defined, [[read-key-sequence]] should quickly
-;;; return any single key inputs.
-;;;
-;;;
-;;; <klecl:test>=
+;;; Since we have no keymaps defined, [[read-key-sequence]] should quickly
+;;; return any single key inputs.
+;;;
+;;;
+;;; <klecl:test>=
(define last-key-seq #f)
(codefine (read-key-sequence*)
(set! last-key-seq #f)
@@ -68,11 +68,11 @@
(check last-key-seq => '(#\a))
(update-agenda)
(check last-key-seq => '(#\a))
-;;; \noindent However, if we add a keymap with only the sequence
-;;; \verb|a b c|, we will see that it'll behave differently.
-;;;
-;;;
-;;; <klecl:test>=
+;;; \noindent However, if we add a keymap with only the sequence
+;;; \verb|a b c|, we will see that it'll behave differently.
+;;;
+;;;
+;;; <klecl:test>=
(define (no-command) #f)
(define test-keymap (make-keymap))
(set! default-klecl-maps (lambda () (list test-keymap)))
@@ -83,14 +83,14 @@
;(block-tick)
(update-agenda)
(check last-key-seq => #f) ;; Not enough keys to return.
-;;; Let's test a sequence that is not in the keymap.
-;;;
-;;;
-;;; <klecl:test>=
+;;; Let's test a sequence that is not in the keymap.
+;;;
+;;;
+;;; <klecl:test>=
(emacsy-key-event #\z)
(update-agenda)
(check last-key-seq => '(#\a #\z)) ;; No way "a z" is an actual key-sequence.
-;;; <klecl:test>=
+;;; <klecl:test>=
;(with-blockable (read-key-sequence*))
(agenda-schedule read-key-sequence*)
(emacsy-key-event #\a)
@@ -101,10 +101,10 @@
(emacsy-key-event #\c)
(update-agenda)
(check last-key-seq => '(#\a #\b #\c)) ;; Got it!
-;;; Let's test keyboard quitting.
-;;;
-;;;
-;;; <klecl:test>=
+;;; Let's test keyboard quitting.
+;;;
+;;;
+;;; <klecl:test>=
(define-key test-keymap "q" 'keyboard-quit)
;(with-blockable (read-key-sequence*))
(agenda-schedule read-key-sequence*)
@@ -116,7 +116,7 @@
;(block-tick)
(update-agenda)
(check last-key-seq => '(#\a #\q)) ;; Got it!
-;;; <klecl:test>=
+;;; <klecl:test>=
(define my-command-count 0)
(define-interactive (my-command)
(incr! my-command-count))
@@ -127,7 +127,7 @@
(update-agenda)
;(with-blockable (primitive-command-tick))
(check my-command-count => 1)
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
diff --git a/test/window.scm b/test/window.scm
index 18535c4..ff65dac 100644
--- a/test/window.scm
+++ b/test/window.scm
@@ -1,12 +1,12 @@
-;;; <file:window-test.scm>=
-;;; @subsection Legal Stuff
-;;;
+;;; <file:window-test.scm>=
+;;; @subsection Legal Stuff
+;;;
;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
+;;;
;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
;;;
;;; This file is part of Emacsy.
-;;;
+;;;
;;; Emacsy 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 3 of the License, or
@@ -19,54 +19,54 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-;;; <+ Test Preamble>=
+;;; <+ Test Preamble>=
(use-modules (check))
(use-modules (ice-9 pretty-print))
(define test-errors '())
(use-modules (emacsy window))
(eval-when (compile load eval)
- (module-use! (current-module) (resolve-module '(emacsy window))))
-;;; <window:Windows Tests>=
+ (module-use! (current-module) (resolve-module '(emacsy window))))
+;;; <window:Windows Tests>=
(check (window? root-window) => #t)
-;;; <window:Windows Tests>=
+;;; <window:Windows Tests>=
(check (window-live? root-window) => #t)
-;;; <window:Windows Tests>=
+;;; <window:Windows Tests>=
(check (edges->bcoords '(0 1 1 0)) => '(0 0 1 1))
-;;; <window:Windows Tests>=
+;;; <window:Windows Tests>=
(check (bcoords->edges '(0 0 1 1)) => '(0 1 1 0))
-;;; Let's project a point in the current window to the point in its
-;;; ultimate parent window.
-;;;
-;;;
-;;; <window:Windows Tests>=
+;;; Let's project a point in the current window to the point in its
+;;; ultimate parent window.
+;;;
+;;;
+;;; <window:Windows Tests>=
(define i-window (make <internal-window>))
(define window (make <window>))
(check (window? i-window) => #t)
(check (window? window) => #t)
-;;; Let's test window splitting.
-;;;
-;;;
-;;; <window:Windows Tests>=
+;;; Let's test window splitting.
+;;;
+;;;
+;;; <window:Windows Tests>=
(check (procedure? split-window) => #t)
(define s-window (split-window window))
(check (is-a? s-window <internal-window>) => #t)
-;;; Let's test window splitting with a different size value.
-;;;
-;;; <window:Windows Tests>=
+;;; Let's test window splitting with a different size value.
+;;;
+;;; <window:Windows Tests>=
(define small-window (make <window>))
(define parent-window (split-window small-window 0.2))
(define big-window (cdr (window-children parent-window)))
(check (orientation parent-window) => 'vertical)
-;;; Let's test window splitting with a different orientation.
-;;;
-;;;
-;;; <window:Windows Tests>=
+;;; Let's test window splitting with a different orientation.
+;;;
+;;;
+;;; <window:Windows Tests>=
(define left-window (make <window>))
(define parent-window-2 (split-window left-window 0.2 'right))
(define right-window (cdr (window-children parent-window-2)))
(check (orientation parent-window-2) => 'horizontal)
-;;; <window:Windows Tests>=
+;;; <window:Windows Tests>=
(let* ((w (make <window>))
(sw (split-window w))
(c (cadr (window-children sw)))
@@ -78,10 +78,10 @@
(check (window-tree sw) => (list w (list c nc)))
(check (window-list sw) => (list w c nc))
;(check (window-list sw) => (list w c #f))
- )
+ )
-;;; <+ Test Postscript>=
+;;; <+ Test Postscript>=
;(run-tests)
(check-report)
'(if (> (length test-errors) 0)
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-example-Fix-null-termination-warnings.patch --]
[-- Type: text/x-patch, Size: 2017 bytes --]
From cb4b7cc76c2ecdbdd9299903859dad71b36d2be5 Mon Sep 17 00:00:00 2001
From: Morgan Smith <Morgan.J.Smith@outlook.com>
Date: Mon, 4 Dec 2023 09:25:42 -0500
Subject: [PATCH 3/5] example: Fix null termination warnings
---
example/emacsy-webkit-gtk-w-buffers.c | 2 +-
example/emacsy-webkit-gtk-w-windows.c | 2 +-
example/emacsy-webkit-gtk.c | 2 +-
3 files changed, 3 insertions(+), 3 deletions(-)
diff --git a/example/emacsy-webkit-gtk-w-buffers.c b/example/emacsy-webkit-gtk-w-buffers.c
index 9b235a5..20d09f2 100644
--- a/example/emacsy-webkit-gtk-w-buffers.c
+++ b/example/emacsy-webkit-gtk-w-buffers.c
@@ -388,7 +388,7 @@ process_and_update_emacsy (void *user_data)
// Show the cursor. Exercise for the reader: Make it blink.
char message[255];
memset (message, ' ', 254);
- message[255] = NULL;
+ message[254] = '\0';
message[emacsy_minibuffer_point () - 1] = '_';
gtk_label_set_pattern (GTK_LABEL (label), message);
diff --git a/example/emacsy-webkit-gtk-w-windows.c b/example/emacsy-webkit-gtk-w-windows.c
index f26b7f5..1d549dd 100644
--- a/example/emacsy-webkit-gtk-w-windows.c
+++ b/example/emacsy-webkit-gtk-w-windows.c
@@ -385,7 +385,7 @@ process_and_update_emacsy (void *user_data)
// Show the cursor. Exercise for the reader: Make it blink.
char message[255];
memset (message, ' ', 254);
- message[255] = NULL;
+ message[254] = '\0';
message[emacsy_minibuffer_point () - 1] = '_';
gtk_label_set_pattern (GTK_LABEL (label), message);
diff --git a/example/emacsy-webkit-gtk.c b/example/emacsy-webkit-gtk.c
index 0b6e0e7..ea77b0b 100644
--- a/example/emacsy-webkit-gtk.c
+++ b/example/emacsy-webkit-gtk.c
@@ -367,7 +367,7 @@ process_and_update_emacsy (void *user_data)
// Show the cursor. Exercise for the reader: Make it blink.
char message[255];
memset (message, ' ', 254);
- message[255] = NULL;
+ message[254] = '\0';
message[emacsy_minibuffer_point () - 1] = '_';
gtk_label_set_pattern (GTK_LABEL (label), message);
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #5: 0004-test-Make-consistant-use-of-test-framework.patch --]
[-- Type: text/x-patch, Size: 21999 bytes --]
From efe8c84a7cfcfa69a6a7dd696268c5c550a80324 Mon Sep 17 00:00:00 2001
From: Morgan Smith <Morgan.J.Smith@outlook.com>
Date: Mon, 4 Dec 2023 09:42:12 -0500
Subject: [PATCH 4/5] test: Make consistant use of test framework
---
Makefile.am | 1 -
test/advice.scm | 18 +++-----
test/block.scm | 17 ++------
test/buffer.scm | 10 +----
test/command.scm | 18 +++-----
test/core.scm | 11 +----
test/coroutine.scm | 8 +++-
test/emacsy.scm | 100 --------------------------------------------
test/event.scm | 21 +++-------
test/help.scm | 4 +-
test/job.scm | 7 ++--
test/kbd-macro.scm | 17 +++-----
test/keymap.scm | 18 +++-----
test/klecl.scm | 14 ++-----
test/minibuffer.scm | 17 +++-----
test/mru-stack.scm | 7 +++-
test/self-doc.scm | 2 +
test/text.scm | 12 +-----
test/window.scm | 17 +++-----
test/windows.scm | 16 ++-----
20 files changed, 71 insertions(+), 264 deletions(-)
delete mode 100644 test/emacsy.scm
diff --git a/Makefile.am b/Makefile.am
index 1d3345d..9ad42ba 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -89,7 +89,6 @@ TESTS = \
test/command.scm \
test/core.scm \
test/coroutine.scm \
- test/emacsy.scm \
test/event.scm \
test/help.scm \
test/job.scm \
diff --git a/test/advice.scm b/test/advice.scm
index d4282a0..6ca5afc 100644
--- a/test/advice.scm
+++ b/test/advice.scm
@@ -19,20 +19,15 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy advice)
+(use-modules (check)
+ (emacsy advice)
(emacsy event)
(emacsy klecl)
(oop goops)
(srfi srfi-11))
-(eval-when (compile load eval)
- ;; Some trickery so we can test private procedures.
- (module-use! (current-module) (resolve-module '(emacsy advice))))
+(use-private-modules (emacsy advice))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; To test this functionality, we're going to make some counter
;;; procedures.
;;;
@@ -96,10 +91,7 @@
(define advised-func (make-advising-function advice))
(check (my-orig-func 1) => 2)
(check (advised-func 1) => 1)
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/block.scm b/test/block.scm
index b4ca8fb..61f9c63 100644
--- a/test/block.scm
+++ b/test/block.scm
@@ -21,17 +21,12 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy block)
+(use-modules (check)
+ (emacsy block)
(oop goops))
-(eval-when (compile load eval)
- ;; Some trickery so we can test private procedures.
- (module-use! (current-module) (resolve-module '(emacsy block))))
+(use-private-modules (emacsy block))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; % -*- mode: Noweb; noweb-code-mode: scheme-mode -*-
;;; @section Block Module
;;;
@@ -164,9 +159,5 @@
(check (length blocking-continuations) => 0))
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/buffer.scm b/test/buffer.scm
index 54e7f40..a823e27 100644
--- a/test/buffer.scm
+++ b/test/buffer.scm
@@ -28,10 +28,6 @@
(use-private-modules (emacsy buffer))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <buffer:test>=
(define b (make <buffer> #:name "*test-buffer*"))
(check (buffer-name b) => "*test-buffer*")
@@ -54,9 +50,5 @@
(check (current-buffer) => a)
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/command.scm b/test/command.scm
index dcd4743..4f9fc51 100644
--- a/test/command.scm
+++ b/test/command.scm
@@ -21,18 +21,13 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy command)
+(use-modules (check)
+ (emacsy command)
(emacsy event)
(oop goops))
-(eval-when (compile load eval)
- ;; Some trickery so we can test private procedures.
- (module-use! (current-module) (resolve-module '(emacsy command))))
+(use-private-modules (emacsy command))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <command:test>=
(define test-cmd (lambda-cmd args 1))
(define (test-cmd-2) 2)
@@ -69,10 +64,7 @@
(check-throw (command-execute 'foo) => 'misc-error)
(check (command-execute foo) => 'non-interactive)
(check (call-interactively foo) => 'interactive)
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/core.scm b/test/core.scm
index 6d78fd3..fa94aa0 100644
--- a/test/core.scm
+++ b/test/core.scm
@@ -31,10 +31,6 @@
(use-private-modules (emacsy core))
(set! emacsy-interactive? #t)
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <core:test>=
(set! emacsy-interactive? #f)
(check (eval-expression '(+ 1 2)) => 3)
@@ -85,10 +81,7 @@
(update-agenda)
(check-true mouse-event)
;(block-tick)
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/coroutine.scm b/test/coroutine.scm
index 9cb80ee..4fd2e5d 100644
--- a/test/coroutine.scm
+++ b/test/coroutine.scm
@@ -17,8 +17,8 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy coroutine)
- (check))
+(use-modules (check)
+ (emacsy coroutine))
(define a (make-coroutine
(lambda ()
@@ -32,3 +32,7 @@
'a-user-data))
(check (a) => 'a-user-data)
+
+;;; <+ Test Postscript>=
+(check-report)
+(check-exit)
diff --git a/test/emacsy.scm b/test/emacsy.scm
deleted file mode 100644
index 399bdfa..0000000
--- a/test/emacsy.scm
+++ /dev/null
@@ -1,100 +0,0 @@
-;;; <file:emacsy-test.scm>=
-;;; @subsection Legal Stuff
-;;;
-;;; Emacsy --- An embeddable Emacs-like library using GNU Guile
-;;;
-;;; Copyright (C) 2012, 2013 Shane Celis <shane.celis@gmail.com>
-;;;
-;;; This file is part of Emacsy.
-;;;
-;;; Emacsy 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 3 of the License, or
-;;; (at your option) any later version.
-;;;
-;;; Emacsy 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 Emacsy. If not, see <http://www.gnu.org/licenses/>.
-;;; Finally, let's provide this as our testing preamble.
-;;;
-;;;
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-
-;;; <emacsy:test functions>=
-(define unit-tests '())
-
-(define (register-test name func)
- (set! unit-tests (acons name func unit-tests)))
-
-;;; The function register-test does the work, but we don't want to require
-;;; the user to call it, so we'll define a macro that will automatically
-;;; call it.
-;;;
-;;;
-;;; <emacsy:test macro>=
-(define-syntax define-test
- (syntax-rules ()
- ((define-test (name args ...) expr ...)
- (begin (define* (name args ...)
- expr ...)
- (register-test 'name name)))))
-;;; Finally, now we just need a way to run all the unit tests.
-;;;
-;;;
-;;; <emacsy:run tests>=
-(define test-errors '())
-(define (run-tests)
- (catch 'first-error
- (lambda () (for-each (lambda (elt)
- (display "TEST: ")
- (pretty-print elt)
- (catch #t
- (lambda ()
- (with-throw-handler #t
- (lambda ()
- (apply (cdr elt) '()))
- (lambda args
- (set! test-errors (cons (car elt) test-errors))
- (format #t "Error in test ~a: ~a" (car elt) args)
-
- (backtrace))))
- (lambda args
- ;(throw 'first-error)
- #f
- )))
- (reverse unit-tests)))
- (lambda args
- #f)))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
-(eval-when (compile load eval)
- (module-use! (current-module) (resolve-module '(emacsy))))
-
-
-;;; Let's run these tests at the end.
-;;;
-;;;
-;;; <+ Test Postscript>=
-
-(run-tests)
-(check-report)
-(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
-
-;;; <+ Test Postscript>=
-;(run-tests)
-(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
diff --git a/test/event.scm b/test/event.scm
index 668a87d..55139e5 100644
--- a/test/event.scm
+++ b/test/event.scm
@@ -21,18 +21,12 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy event)
- (oop goops)
- )
+(use-modules (check)
+ (emacsy event)
+ (oop goops))
-(eval-when (compile load eval)
- ;; Some trickery so we can test private procedures.
- (module-use! (current-module) (resolve-module '(emacsy event))))
+(use-private-modules (emacsy event))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <event:test>=
(check-true (make <key-event> #:command-char #\a))
;;; <event:test>=
@@ -70,10 +64,7 @@
;;; <event:test>=
(check (kbd "mouse-1") => '("mouse-1"))
(check (kbd "S-S-mouse-1") => '("S-mouse-1"))
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/help.scm b/test/help.scm
index b74a56f..3e67adb 100644
--- a/test/help.scm
+++ b/test/help.scm
@@ -23,6 +23,6 @@
(emacsy help))
(use-private-modules (emacsy help))
-
-
+;;; <+ Test Postscript>=
+(check-report)
(check-exit)
diff --git a/test/job.scm b/test/job.scm
index ab6d5f1..9f6d206 100644
--- a/test/job.scm
+++ b/test/job.scm
@@ -17,11 +17,11 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy coroutine)
+(use-modules (check)
+ (emacsy coroutine)
(emacsy agenda)
(emacsy job)
- (ice-9 receive)
- (check))
+ (ice-9 receive))
(use-private-modules (emacsy job))
@@ -116,5 +116,6 @@
(check (format #f "~a" (car *current-job-list*)) => "#<job id: 6 state: zombie exit-value: f>")
+;;; <+ Test Postscript>=
(check-report)
(check-exit)
diff --git a/test/kbd-macro.scm b/test/kbd-macro.scm
index 49b787f..066b6fb 100644
--- a/test/kbd-macro.scm
+++ b/test/kbd-macro.scm
@@ -21,21 +21,17 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy kbd-macro)
+(use-modules (check)
+ (emacsy kbd-macro)
(emacsy event)
(emacsy command)
(emacsy klecl)
- (oop goops)
- (check))
+ (oop goops))
(use-private-modules (emacsy kbd-macro))
(set! emacsy-interactive? #t)
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; Let's set up a command to test our functionality with.
;;;
;;;
@@ -64,10 +60,7 @@
(execute-temporal-kbd-macro last-kbd-macro)
(primitive-command-loop (lambda args #f))
(check test-command-called => 3)
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/keymap.scm b/test/keymap.scm
index 83e9fb7..88b396f 100644
--- a/test/keymap.scm
+++ b/test/keymap.scm
@@ -21,18 +21,13 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy keymap)
+(use-modules (check)
+ (emacsy keymap)
(emacsy event)
(oop goops))
-(eval-when (compile load eval)
- ;; Some trickery so we can test private procedures.
- (module-use! (current-module) (resolve-module '(emacsy keymap))))
+(use-private-modules (emacsy keymap))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <keymap:test>=
(check-true (make <keymap>))
;;; The core functionality of the keymap is being able to define and look
@@ -87,10 +82,7 @@
;;; <keymap:test>=
(check-true (keymap? (make <keymap>)))
(check-false (keymap? 1))
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/klecl.scm b/test/klecl.scm
index 765fa5f..01e6885 100644
--- a/test/klecl.scm
+++ b/test/klecl.scm
@@ -21,17 +21,14 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy klecl)
+(use-modules (check)
+ (emacsy klecl)
(emacsy event)
(check)
(oop goops))
(use-private-modules (emacsy klecl))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <klecl:test>=
(define last-event #f)
(codefine (test-read-event)
@@ -127,10 +124,7 @@
(update-agenda)
;(with-blockable (primitive-command-tick))
(check my-command-count => 1)
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/minibuffer.scm b/test/minibuffer.scm
index ed53c9f..5906388 100644
--- a/test/minibuffer.scm
+++ b/test/minibuffer.scm
@@ -21,21 +21,17 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy minibuffer)
+(use-modules (check)
+ (emacsy minibuffer)
(emacsy event)
(emacsy klecl)
- (oop goops)
- (check))
+ (oop goops))
(use-private-modules (emacsy minibuffer))
(set! emacsy-interactive? #t)
(set! aux-buffer minibuffer)
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
;;; <minibuffer:test>=
(check (buffer-string) => "")
(check (point) => 1)
@@ -225,10 +221,7 @@
(cursor-right! h)
(cursor-right! h)
(check (cursor-list->list h) => '("3" "2" "a")))
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-;;(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/mru-stack.scm b/test/mru-stack.scm
index fac9b04..d7a5f6e 100644
--- a/test/mru-stack.scm
+++ b/test/mru-stack.scm
@@ -19,8 +19,8 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (emacsy mru-stack)
- (check))
+(use-modules (check)
+ (emacsy mru-stack))
(use-private-modules (emacsy mru-stack))
;;; <mru-stack:test>=
@@ -63,4 +63,7 @@
(mru-remove! ms 'b)
(mru-remove! ms 'c)
(check (mru-list ms) => '()))
+
+;;; <+ Test Postscript>=
+(check-report)
(check-exit)
diff --git a/test/self-doc.scm b/test/self-doc.scm
index 04d7881..384b356 100644
--- a/test/self-doc.scm
+++ b/test/self-doc.scm
@@ -103,4 +103,6 @@
(check (source-properties 'x) => '())
(check (source-properties (module-variable (current-module) 'x)) => '())
+;;; <+ Test Postscript>=
+(check-report)
(check-exit)
diff --git a/test/text.scm b/test/text.scm
index 53be242..2d16eea 100644
--- a/test/text.scm
+++ b/test/text.scm
@@ -30,11 +30,6 @@
(use-private-modules (emacsy buffer))
(use-private-modules (emacsy text))
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
-
;;; Let's test this regex search in a gap buffer.
;;;
;;; <buffer:test>=
@@ -70,10 +65,7 @@
;; is ^ ^
;; goto ^
;; was ^
+
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/window.scm b/test/window.scm
index ff65dac..1b4a23d 100644
--- a/test/window.scm
+++ b/test/window.scm
@@ -19,14 +19,11 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
+(use-modules (check)
+ (emacsy window))
+
+(use-private-modules (emacsy window))
-(use-modules (emacsy window))
-(eval-when (compile load eval)
- (module-use! (current-module) (resolve-module '(emacsy window))))
;;; <window:Windows Tests>=
(check (window? root-window) => #t)
;;; <window:Windows Tests>=
@@ -82,9 +79,5 @@
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
diff --git a/test/windows.scm b/test/windows.scm
index b313547..09054bf 100644
--- a/test/windows.scm
+++ b/test/windows.scm
@@ -19,16 +19,10 @@
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Emacsy. If not, see <http://www.gnu.org/licenses/>.
-;;; <+ Test Preamble>=
-(use-modules (check))
-(use-modules (ice-9 pretty-print))
-(define test-errors '())
-
-(use-modules (emacsy windows))
+(use-modules (check)
+ (emacsy windows))
(use-private-modules (emacsy windows))
-;; (eval-when (compile load eval)
-;; (module-use! (current-module) (resolve-module '(emacsy windows))))
;;; <windows:Windows Tests>=
(check (window? root-window) => #t)
;;; <windows:Windows Tests>=
@@ -111,9 +105,5 @@
(check (window-unproject window #(1. 1. 1.)) => #(1. 1. 1.))
;;; <+ Test Postscript>=
-;(run-tests)
(check-report)
-'(if (> (length test-errors) 0)
- (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors))
- (format #t "NO ERRORs in tests."))
-(exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1))
+(check-exit)
--
2.41.0
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #6: 0005-Finish-renaming-variable-documentation-documentation.patch --]
[-- Type: text/x-patch, Size: 1899 bytes --]
From 8e9335b8a26414c8f59d330a0ab28303487b10da Mon Sep 17 00:00:00 2001
From: Morgan Smith <Morgan.J.Smith@outlook.com>
Date: Thu, 30 Nov 2023 12:19:09 -0500
Subject: [PATCH 5/5] Finish renaming variable-documentation -> documentation
---
emacsy/help.scm | 6 +++---
emacsy/self-doc.scm | 2 +-
2 files changed, 4 insertions(+), 4 deletions(-)
diff --git a/emacsy/help.scm b/emacsy/help.scm
index 9055a69..3acfff4 100644
--- a/emacsy/help.scm
+++ b/emacsy/help.scm
@@ -42,8 +42,8 @@
"Describe variable: "
(emacsy-collect-kind (current-module) 'variable 1)
#:to-string symbol->string)))
- ;;(message "Describing variable ~a: ~a" symbol (variable-documentation symbol))
- (message "~a" (variable-documentation symbol)))
+ ;;(message "Describing variable ~a: ~a" symbol (documentation symbol))
+ (message "~a" (documentation symbol)))
;;.
(define-interactive (describe-command #:optional symbol) #t)
@@ -55,7 +55,7 @@
"Describe command: "
(emacsy-collect-kind (current-module) 'command 1)
#:to-string symbol->string)))
- ;;(message "Describing variable ~a: ~a" symbol (variable-documentation symbol))
+ ;;(message "Describing variable ~a: ~a" symbol (documentation symbol))
(message "~a" (procedure-documentation (module-ref (current-module) symbol))))
;;; <help:keymap>=
diff --git a/emacsy/self-doc.scm b/emacsy/self-doc.scm
index 440d320..de430a6 100644
--- a/emacsy/self-doc.scm
+++ b/emacsy/self-doc.scm
@@ -79,7 +79,7 @@ OBJECT can be a procedure, macro or any object that has its
(else
(scm-error
'no-such-variable
- "variable-documentation"
+ "documentation"
"Expected a symbol in the current module or a variable; got ~a"
(list variable-or-symbol)
#f)))))
--
2.41.0
^ permalink raw reply related [flat|nested] 3+ messages in thread
* Re: [PATCH] Emacsy - formatting and consistency changes
2023-12-04 22:55 [PATCH] Emacsy - formatting and consistency changes Morgan Smith
@ 2023-12-05 6:08 ` Janneke Nieuwenhuizen
2023-12-05 6:31 ` Janneke Nieuwenhuizen
0 siblings, 1 reply; 3+ messages in thread
From: Janneke Nieuwenhuizen @ 2023-12-05 6:08 UTC (permalink / raw)
To: Morgan Smith; +Cc: guile-user
Morgan Smith writes:
Hi!
> I have some more patches for emacsy.
\o/
> I apologize for the linting change. I know it is a massive patch that
> will muddle the history and will make applying any pre-existing patches
> more difficult. I normally try to avoid making such a change to a
> project if I can avoid it.
> However, the ".dir-locals.el" file made my Emacs delete trailing
> whitespace which was resulting in ugly patches. Also running GNU indent
> was apparently on the TODO list anyways. So I decided to go ahead and
> run a simply lint script.
It's a good effort; it would (have) be(en) nice to run Emacs'
indent-region in the lint script, but I guess this simple lint
is much of an improvement already.
> I then went through all the tests to make everything consistent.
Nice.
> I also started fixing some of the simple warnings I was getting (null
> termination error, unknown variable error).
Ok.
> With these patches applied, the source should be easier to work with. I
> am planning to start providing more exciting patches soon.
Great, applied to master.
Thanks,
Janneke
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply [flat|nested] 3+ messages in thread
* Re: [PATCH] Emacsy - formatting and consistency changes
2023-12-05 6:08 ` Janneke Nieuwenhuizen
@ 2023-12-05 6:31 ` Janneke Nieuwenhuizen
0 siblings, 0 replies; 3+ messages in thread
From: Janneke Nieuwenhuizen @ 2023-12-05 6:31 UTC (permalink / raw)
To: Morgan Smith; +Cc: guile-user
Janneke Nieuwenhuizen writes:
Hi!
>> However, the ".dir-locals.el" file made my Emacs delete trailing
>> whitespace which was resulting in ugly patches. Also running GNU indent
>> was apparently on the TODO list anyways. So I decided to go ahead and
>> run a simply lint script.
>
> It's a good effort; it would (have) be(en) nice to run Emacs'
> indent-region in the lint script,
e.g., something like
<https://git.savannah.nongnu.org/cgit/dezyne.git/tree/build-aux/indent.scm>
Janneke
--
Janneke Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond https://LilyPond.org
Freelance IT https://www.JoyOfSource.com | Avatar® https://AvatarAcademy.com
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2023-12-05 6:31 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2023-12-04 22:55 [PATCH] Emacsy - formatting and consistency changes Morgan Smith
2023-12-05 6:08 ` Janneke Nieuwenhuizen
2023-12-05 6:31 ` Janneke Nieuwenhuizen
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).