1 /* $Id: guile-compat.c,v 1.3 2002/03/28 06:35:21 sgt Exp $ */
2 /*
3 * Original Copyright (C) 1997-1999, Maciej Stachowiak and Greg J. Badros
4 * Additions copyright 2008 Stephen G. Tell.
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2, or (at your option)
9 * any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this software; see the file COPYING.GPL. If not, write to
18 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
19 * Boston, MA 02111-1307 USA
20 *
21 */
22
23 #ifdef HAVE_CONFIG_H
24 #include <config.h>
25 #endif
26 #include <string.h>
27 #include <guile/gh.h>
28
29 #include "guile-compat.h"
30
31 #ifdef __cplusplus
32 extern "C" {
33 #endif
34
35 #define DBG -1
36
37 void scwm_msg(int , const char *id, const char *msg,...);
38
39 #undef USE_STACKJMPBUF
40
41
make_output_strport(char * fname)42 SCM make_output_strport(char *fname)
43 {
44 return scm_mkstrport(SCM_INUM0, scm_make_string(SCM_INUM0,
45 SCM_UNDEFINED),
46 SCM_OPN | SCM_WRTNG,
47 fname);
48 }
49
50
51 /* variant of guile-1.8's scm_to_locale_string that never throws an error.
52 * Instead of throwing an exception, NULL is returned if the arg is not a
53 * scheme string.
54 *
55 * The result is always nul terminated, and the length is always available,
56 * although a the lenp pointer may be passed as NULL, if the caller wants to
57 * ignore the length and assume that the string contains no inner \0s.
58 */
safe_scm_to_stringn(SCM str,size_t * lenp)59 char *safe_scm_to_stringn (SCM str, size_t *lenp)
60 {
61 char *res;
62 size_t len;
63
64 if (!scm_is_string (str)) {
65 if(lenp)
66 *lenp = 0;
67 return NULL;
68 }
69 len = scm_i_string_length (str);
70 res = scm_malloc (len + 1);
71 memcpy (res, scm_i_string_chars (str), len);
72 res[len] = '\0'; //unconditionaly null terminate
73
74 if(lenp)
75 *lenp = len;
76
77 scm_remember_upto_here_1 (str);
78 return res;
79 }
80
81
82
83
84 #ifdef __cplusplus
85 }
86 #endif
87