From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Morgan Smith Newsgroups: gmane.lisp.guile.user Subject: [PATCH] Emacsy - formatting and consistency changes Date: Mon, 04 Dec 2023 17:55:12 -0500 Message-ID: Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="22888"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: janneke@gnu.org To: guile-user@gnu.org Original-X-From: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Mon Dec 04 23:56:06 2023 Return-path: Envelope-to: guile-user@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rAHrB-0005bN-1u for guile-user@m.gmane-mx.org; Mon, 04 Dec 2023 23:56:06 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rAHqh-0006kL-1O; Mon, 04 Dec 2023 17:55:35 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rAHqf-0006ja-5e for guile-user@gnu.org; Mon, 04 Dec 2023 17:55:33 -0500 Original-Received: from mail-bn7nam10olkn2021.outbound.protection.outlook.com ([40.92.40.21] helo=NAM10-BN7-obe.outbound.protection.outlook.com) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rAHqT-00005Y-IP; Mon, 04 Dec 2023 17:55:32 -0500 ARC-Seal: i=1; a=rsa-sha256; s=arcselector9901; d=microsoft.com; cv=none; b=T1Ugo40/Sd+oTZsM8dYhpO4wlnDR/bulxmBlFW9w/+hwVhf1GslxkcOS6aRWLujMZYjarmT66ETLVIjXfP0kXgtZf4nvVV8nJ7BbUwCaiQ+m/FSNNe/44iWhzr9xUaTQWDKkEzihCDiLvtuG4Iglpf94bqwJsCqK3yBJ2gBH8PuLKiFcgvJMx5qxNHiolmC2brYb3Fdz1rmTUAcvqzTbjMEbs+peFxh9j+PoAixRac7ikPP0t95mHcmfHje4NCCz412k/6KHZ+Yk54hdjjgSirRIWLczOF6NlOBnT8Qr6qqjmDnRjmY6bhv82h32tliVJ9Eyak2TnljUTOyA5un7kg== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=microsoft.com; s=arcselector9901; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-AntiSpam-MessageData-ChunkCount:X-MS-Exchange-AntiSpam-MessageData-0:X-MS-Exchange-AntiSpam-MessageData-1; bh=PnfQ0CUS5kMbIAfj2+/Zd3A8aTSx4dD7ZVf4BX2RZ/4=; b=ihXhVC1dR2WuFhbodHyMgJm/GiEWs5F5+y+25wv/r/2Kgh+43VPK5z7NCaDvIJ6/QNKOW3mP/h4LlO2BWe/TPt3lHWFTpcSj3vccJ135gxeBI776ZYUtCXqfqnm/EKHZt/f5KdhFddRxR/SalazM+7j8zCVfv9KcFfnmWlKhhlgZZ4cJCS90h+wZDL5hi0KeCpiKj/4DqR6ddzmLCGPhJ0UaY3ebkEvxTnslbZaWGuhfwdbu7whGPKt3qThX2a7k1aUUfrkiNyBlxYMBlt9YqBgUL9AOc+rwexsy749UChwLhH8HaiQTU4uSghvc/Xq+CVhHfhYYlsxYMsb8bvF8uA== ARC-Authentication-Results: i=1; mx.microsoft.com 1; spf=none; dmarc=none; dkim=none; arc=none DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=outlook.com; s=selector1; h=From:Date:Subject:Message-ID:Content-Type:MIME-Version:X-MS-Exchange-SenderADCheck; bh=PnfQ0CUS5kMbIAfj2+/Zd3A8aTSx4dD7ZVf4BX2RZ/4=; b=K4rzEtFWholGuzM7A0JiE3iVyKzT3Ryr5rYuGVSlgnSz1kjVkBaSe0TVmlu/c3G6d16slE8ReF1gfgDI9CeTY61iq4TqNKHbeL1j9LBEK5KN2pCS8thyiazL9ZOWs1kWrf+fXv78MIVp2UMmI4K1nX8KQFLiIAKtHTv63y3dCHRI2OlaEiW4Zld8ul2HBR/KmwZYB1pW18fsWj6O6BYKMTQHAqTZpkl9ngoCjUBUJPu5ahXjDYTc0BCGJWKHoY6CbXf1Tya1yIPenFaN19nbB99ywcBltEwQGcv/8ccVvKw6gHYEOivSWi3uTuM+PB9L0gY1w/kTpMOisUXT7SvUBw== Original-Received: from LV8PR84MB3436.NAMPRD84.PROD.OUTLOOK.COM (2603:10b6:408:1fb::12) by CYXPR84MB3515.NAMPRD84.PROD.OUTLOOK.COM (2603:10b6:930:db::18) with Microsoft SMTP Server (version=TLS1_2, cipher=TLS_ECDHE_RSA_WITH_AES_256_GCM_SHA384) id 15.20.7046.33; Mon, 4 Dec 2023 22:55:16 +0000 Original-Received: from LV8PR84MB3436.NAMPRD84.PROD.OUTLOOK.COM ([fe80::d37d:ad02:3bbe:4340]) by LV8PR84MB3436.NAMPRD84.PROD.OUTLOOK.COM ([fe80::d37d:ad02:3bbe:4340%4]) with mapi id 15.20.7046.033; Mon, 4 Dec 2023 22:55:15 +0000 X-Hashcash: 1:20:231204:guile-user@gnu.org::OKaC0VnkquzeLOxy:2BY6 X-Hashcash: 1:20:231204:janneke@gnu.org::xXetSE2JbN0mLP21:2QC3 X-TMN: [uF1Heg5kIwUCofR1dU/idNVMDZLvAlo3] X-ClientProxiedBy: YT4PR01CA0439.CANPRD01.PROD.OUTLOOK.COM (2603:10b6:b01:10d::12) To LV8PR84MB3436.NAMPRD84.PROD.OUTLOOK.COM (2603:10b6:408:1fb::12) X-Microsoft-Original-Message-ID: <87plzl60j3.fsf@outlook.com> X-MS-Exchange-MessageSentRepresentingType: 1 X-MS-PublicTrafficType: Email X-MS-TrafficTypeDiagnostic: LV8PR84MB3436:EE_|CYXPR84MB3515:EE_ X-MS-Office365-Filtering-Correlation-Id: fb53bad3-dc4a-4d03-47fa-08dbf51c1470 X-Microsoft-Antispam: BCL:0; X-Microsoft-Antispam-Message-Info: zWGAjb74CocR7qu8qhb825ShH3F1RIY8CCI2pyW1X2Vh1X6jYNIJq6YX4XEwwj4NDDjPumriXq9hHamR7YJqhgeCiGQoSRmt/YQL4Fa9KyUbFPTLpriMszB9EWT/SvG/P13gEuDkvwgW2cxILhWgAXjQrK6fID3GiPXZHpuvECaa02np9gb+DQqWDBE9K7Ng+b0/Y1tDS28mbwz6oBx1vW3UqocYvkGnAcv6wETRjL3J/qa1y7vfJZqyWq6fPqNUuyJl8cgIIlA6qQTjCtYbMIYzpkKkSA3BdKTE8Vm96PGVZrjHXEAX9PEi0jMbkmOpRf1rk8zGtmX1OkrAIXXINN3wvMudz3rm8j5T7US0wkxUWzX89KkiLL8QpMxl1z/cUX4eKb747dQj1FIeQNmGAotYaNt0YY2oZvGtDMM8m91VbDrWuGa6xbMYMzIMvPpy48Dbu9sgIkZXAFS7uyEnC7B5uz+CQuI+i8wzhlvbLjjL2otcVmNSuZuuP3Qiq3wmJ5cMeu3l7PvW3EHFwClm31tAhSc+Tzc2QBoT/mTA7qxZvY/DOtzkSUgYJ4MdSVle X-MS-Exchange-AntiSpam-MessageData-ChunkCount: 1 X-MS-Exchange-AntiSpam-MessageData-0: =?us-ascii?Q?oaRiSzIDAu9s6dknlu2QfUOUZGMy9RpNnQ+IJj58/3V6UKbZ/gBooi4VMVsq?= =?us-ascii?Q?vM2DPQn3CX/B9rjG8fnK9XRVMuPqbXsJu8TPEyEK3dzHDkcBVLD4oQEPjLPB?= =?us-ascii?Q?dhRzInfNFxlsnZBgeP5JK/1dqRc50CaafbAXiOLXV7M97CrjyVHwK74mq+99?= =?us-ascii?Q?qD63w9Zf9jG0ycNdBb99fRR798bGbofxO89RY2hXxFQDJWtYOs95EPgDgeUQ?= =?us-ascii?Q?O5yJPJTB7dZ3jg2nPaLJIBeb4CvHNylpRYKGviWoFixit1cZm3V71GsfmMlY?= =?us-ascii?Q?m0/njhQF+0oc5Bq+KzBgjFwVXiC6VozquUbeUyXAs0h6fXW4Y5wUHTYQ6SlQ?= =?us-ascii?Q?5LU7H8HU7O0xtTR8HTuOjEo3g2vKj4KpTtbO/Vw8DqtMIL7X3SaWVBYbwd2a?= =?us-ascii?Q?W+1j0yjfBl3NUN+ZL5GPvojVXeE/HfqmmHz4LmAHPXqVtwuxFJ5LWc9lyIEF?= =?us-ascii?Q?Y2gQWj7dT2o+KjHcxoHaTS9L/0VCiVpL3N0IADuD82UJkMLgk07kh8F07d3h?= =?us-ascii?Q?n2g5JJvVc5iZA/8iJYonAF9mjCWuo3p/uBC+kwtRx7tiDLHQVoc+BiPi+P44?= =?us-ascii?Q?F4KcjFA1EPbs9MhPODlGedldgQ9XuvoORHe1hjHhTeOXuFkcyGZbm35CpPX2?= =?us-ascii?Q?n5 X-OriginatorOrg: outlook.com X-MS-Exchange-CrossTenant-Network-Message-Id: fb53bad3-dc4a-4d03-47fa-08dbf51c1470 X-MS-Exchange-CrossTenant-AuthSource: LV8PR84MB3436.NAMPRD84.PROD.OUTLOOK.COM X-MS-Exchange-CrossTenant-AuthAs: Internal X-MS-Exchange-CrossTenant-OriginalArrivalTime: 04 Dec 2023 22:55:15.7175 (UTC) X-MS-Exchange-CrossTenant-FromEntityHeader: Hosted X-MS-Exchange-CrossTenant-Id: 84df9e7f-e9f6-40af-b435-aaaaaaaaaaaa X-MS-Exchange-CrossTenant-RMS-PersistedConsumerOrg: 00000000-0000-0000-0000-000000000000 X-MS-Exchange-Transport-CrossTenantHeadersStamped: CYXPR84MB3515 Received-SPF: pass client-ip=40.92.40.21; envelope-from=Morgan.J.Smith@outlook.com; helo=NAM10-BN7-obe.outbound.protection.outlook.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_NONE=-0.0001, RCVD_IN_MSPIKE_H2=-0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: guile-user@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: General Guile related discussions List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Original-Sender: guile-user-bounces+guile-user=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.lisp.guile.user:19347 Archived-At: --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-scripts-Add-lint-script.patch >From ac6f1d111e8a3bb3acaa99090ff25dde10e2de02 Mon Sep 17 00:00:00 2001 From: Morgan Smith 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 @@ -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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-Run-lint-script.patch >From 35c486ef565db4be11e88c7f22e7967700a1d928 Mon Sep 17 00:00:00 2001 From: Morgan Smith 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 ;;; ;;; 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. - ;;; - ;;; - ;;; = + (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. + ;;; + ;;; + ;;; = (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. - ;;; - ;;; - ;;; = + #;(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. + ;;; + ;;; + ;;; = (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 /* 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 ("%s ", status); - gtk_label_set_markup(GTK_LABEL(label), markup); - g_free(markup); - - markup = g_markup_printf_escaped ("%s ", modeline_string); - gtk_label_set_markup(GTK_LABEL(modeline), markup); - g_free(markup); + char *markup = + g_markup_printf_escaped + ("%s ", + status); + gtk_label_set_markup (GTK_LABEL (label), markup); + g_free (markup); + + markup = + g_markup_printf_escaped + ("%s ", + 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 /* 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), "Hi!", "buffer://?"); + webkit_web_view_load_html (WEBKIT_WEB_VIEW (content), "Hi!", + "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 ("%s ", status); - gtk_label_set_markup(GTK_LABEL(label), markup); - g_free(markup); + char *markup = + g_markup_printf_escaped + ("%s ", + 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 ("%s ", scm_to_locale_string(string)); - } else { - markup = g_markup_printf_escaped ("%s ", 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 + ("%s ", + scm_to_locale_string (string)); + } + else + { + markup = + g_markup_printf_escaped + ("%s ", + 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 /* 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 ("%s ", status); - gtk_label_set_markup(GTK_LABEL(label), markup); - g_free(markup); + char *markup = + g_markup_printf_escaped + ("%s ", + 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 @@ -;;; = -;;; @subsection Legal Stuff -;;; +;;; = +;;; @subsection Legal Stuff +;;; ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile -;;; +;;; ;;; Copyright (C) 2012, 2013 Shane Celis ;;; ;;; 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. -;;; -;;; -;;; = +;;; To test this functionality, we're going to make some counter +;;; procedures. +;;; +;;; +;;; = (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. -;;; -;;; = +;;; Let's make an identity advice procedure. It does nothing, but it does +;;; wrap around the function. +;;; +;;; = (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. -;;; -;;; -;;; = +;;; Let's test this with the simple functionality of having a piece of +;;; before advice. +;;; +;;; +;;; = (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. -;;; -;;; = +;;; Let's check the after advice. +;;; +;;; = (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. -;;; -;;; = +;;; Let's check the after advice. +;;; +;;; = (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. -;;; -;;; = -;;; @subsection Legal Stuff -;;; +;;; Layout for tests. +;;; +;;; = +;;; @subsection Legal Stuff +;;; ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile -;;; +;;; ;;; Copyright (C) 2012, 2013 Shane Celis ;;; ;;; 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. -;;; -;;; -;;; = +;;; +;;; 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. +;;; +;;; +;;; = (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. -;;; -;;; -;;; = +;;; [[i-block]] will immediately yield. If it is not called with +;;; [[call-blockable]] then it will throw an error. +;;; +;;; +;;; = (check-throw (i-block) => 'misc-error) -;;; Now we can call [[i-block]] and capture its continuation. -;;; -;;; -;;; = +;;; Now we can call [[i-block]] and capture its continuation. +;;; +;;; +;;; = (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]]. -;;; -;;; -;;; = +;;; Now we should be able to resume [[i-block]] by running [[block-tick]]. +;;; +;;; +;;; = (check done-blocking? => #f) (check (block-tick) => #t) (check done-blocking? => #t) (check (length blocking-continuations) => 0) -;;; Let's exercise this [[block-until]] procedure. -;;; -;;; = +;;; Let's exercise this [[block-until]] procedure. +;;; +;;; = (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. -;;; -;;; -;;; = +;;; \noindent Now, even if we call [[block-tick]] it shouldn't be resumed. +;;; +;;; +;;; = (block-tick) (check (length blocking-continuations) => 1) -;;; \noindent Let's change the condition for our blocking call. -;;; -;;; -;;; = +;;; \noindent Let's change the condition for our blocking call. +;;; +;;; +;;; = (set! continue-blocking? #f) (check (length blocking-continuations) => 1) (block-tick) (check (length blocking-continuations) => 0) -;;; \noindent Let's exercise [[block-kill]]. -;;; -;;; = +;;; \noindent Let's exercise [[block-kill]]. +;;; +;;; = (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 @@ ; ; 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0003-example-Fix-null-termination-warnings.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0004-test-Make-consistant-use-of-test-framework.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0005-Finish-renaming-variable-documentation-documentation.patch >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 --=-=-=--