*** empty log message ***
Showing
1 changed file
with
0 additions
and
88 deletions
guimb/run_scm.c
deleted
100644 → 0
1 | /* GNU mailutils - a suite of utilities for electronic mail | ||
2 | Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc. | ||
3 | |||
4 | This program is free software; you can redistribute it and/or modify | ||
5 | it under the terms of the GNU General Public License as published by | ||
6 | the Free Software Foundation; either version 2, or (at your option) | ||
7 | any later version. | ||
8 | |||
9 | This program is distributed in the hope that it will be useful, | ||
10 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
11 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
12 | GNU General Public License for more details. | ||
13 | |||
14 | You should have received a copy of the GNU General Public License | ||
15 | along with this program; if not, write to the Free Software | ||
16 | Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */ | ||
17 | |||
18 | #include "guimb.h" | ||
19 | #include <mu_scm.h> | ||
20 | |||
21 | static void _scheme_main (); | ||
22 | |||
23 | void | ||
24 | run_main (int argc, char *argv[]) | ||
25 | { | ||
26 | /* Finish creating input mailbox */ | ||
27 | collect_create_mailbox (); | ||
28 | scm_boot_guile (argc, argv, _scheme_main, NULL); | ||
29 | } | ||
30 | |||
31 | SCM _current_mailbox; | ||
32 | SCM _user_name; | ||
33 | |||
34 | static SCM | ||
35 | catch_body (void *data) | ||
36 | { | ||
37 | if (program_file) | ||
38 | scm_primitive_load (scm_makfrom0str (program_file)); | ||
39 | |||
40 | if (program_expr) | ||
41 | scm_eval_0str (program_expr); | ||
42 | |||
43 | return SCM_BOOL_F; | ||
44 | } | ||
45 | |||
46 | static SCM | ||
47 | catch_handler (void *data, SCM tag, SCM throw_args) | ||
48 | { | ||
49 | collect_drop_mailbox (); | ||
50 | return scm_handle_by_message ("guimb", tag, throw_args); | ||
51 | } | ||
52 | |||
53 | void | ||
54 | _scheme_main () | ||
55 | { | ||
56 | SCM *scm_loc; | ||
57 | int rc; | ||
58 | |||
59 | if (debug_guile) | ||
60 | { | ||
61 | SCM_DEVAL_P = 1; | ||
62 | SCM_BACKTRACE_P = 1; | ||
63 | SCM_RECORD_POSITIONS_P = 1; | ||
64 | SCM_RESET_DEBUG_MODE; | ||
65 | } | ||
66 | |||
67 | /* Initialize scheme library */ | ||
68 | mu_scm_init (); | ||
69 | |||
70 | /* Provide basic primitives */ | ||
71 | #include <run_scm.x> | ||
72 | |||
73 | _current_mailbox = mu_scm_mailbox_create (mbox); | ||
74 | scm_loc = SCM_CDRLOC (scm_sysintern ("current-mailbox", SCM_EOL)); | ||
75 | *scm_loc = _current_mailbox; | ||
76 | |||
77 | _user_name = user_name ? scm_makfrom0str (user_name) : SCM_BOOL_F; | ||
78 | scm_loc = SCM_CDRLOC (scm_sysintern ("user-name", SCM_EOL)); | ||
79 | *scm_loc = _user_name; | ||
80 | |||
81 | scm_internal_lazy_catch (SCM_BOOL_T, | ||
82 | catch_body, NULL, | ||
83 | catch_handler, NULL); | ||
84 | |||
85 | rc = collect_output (); | ||
86 | collect_drop_mailbox (); | ||
87 | exit (rc); | ||
88 | } |
-
Please register or sign in to post a comment