source file of the GNU LilyPond music typesetter
- (c) 1998--2005 Jan Nieuwenhuizen <janneke@gnu.org>
- Han-Wen Nienhuys <hanwen@cs.uu.nl>
+ (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+ Han-Wen Nienhuys <hanwen@xs4all.nl>
*/
#include "config.hh"
-#include <libintl.h> /* gettext on MacOS X */
-#include <math.h> /* isinf */
-#include <stdio.h>
-#include <string.h> /* memset */
-#if HAVE_UTF8_WCHAR_H
-#include <utf8/wchar.h> /* wcrtomb */
-#else
-#include <wchar.h> /* wcrtomb */
-#endif
+#include <cstdio>
+#include <cstring> /* memset */
+using namespace std;
+#include "international.hh"
#include "libc-extension.hh"
#include "lily-guile.hh"
#include "string.hh"
#include "main.hh"
#include "file-path.hh"
-/* MacOS S fix:
- source-file.hh includes cmath which undefines isinf and isnan
-*/
-#ifdef __APPLE__
-inline int my_isinf (Real r) { return isinf (r); }
-inline int my_isnan (Real r) { return isnan (r); }
-#endif
-
LY_DEFINE (ly_find_file, "ly:find-file",
1, 0, 0, (SCM name),
"Return the absolute file name of @var{name}, "
buffering.)
*/
LY_DEFINE (ly_gulp_file, "ly:gulp-file",
- 1, 0, 0, (SCM name),
+ 1, 1, 0, (SCM name, SCM size),
"Read the file @var{name}, and return its contents in a string. "
- "The file is looked up using the search path.")
+ "The file is looked up using the search path. ")
{
SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
- String contents = gulp_file_to_string (ly_scm2string (name), true);
+ int sz = -1;
+ if (size != SCM_UNDEFINED)
+ {
+ SCM_ASSERT_TYPE (scm_is_number (size), size, SCM_ARG2, __FUNCTION__, "number");
+ sz = scm_to_int (size);
+ }
+
+ String contents = gulp_file_to_string (ly_scm2string (name), true, sz);
return scm_from_locale_stringn (contents.get_str0 (), contents.length ());
}
-LY_DEFINE (ly_warn, "ly:warn",
+LY_DEFINE (ly_error, "ly:error",
1, 0, 1, (SCM str, SCM rest),
- "Scheme callable function to issue the warning @code{msg}. "
+ "Scheme callable function to issue the error @code{msg}. "
+ "The error is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ error (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
+LY_DEFINE (ly_message, "ly:message",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to issue the message @code{msg}. "
"The message is formatted with @code{format} and @code{rest}.")
{
SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
- progress_indication ("\n");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ message (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+LY_DEFINE (ly_progress, "ly:progress",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to print progress @code{str}. "
+ "The message is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
str = scm_simple_format (SCM_BOOL_F, str, rest);
- warning (ly_scm2string (str));
+ progress_indication (ly_scm2string (str));
return SCM_UNSPECIFIED;
}
"The message is formatted with @code{format} and @code{rest}.")
{
SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
- progress_indication ("\n");
-
str = scm_simple_format (SCM_BOOL_F, str, rest);
programming_error (ly_scm2string (str));
return SCM_UNSPECIFIED;
}
+LY_DEFINE (ly_warning, "ly:warning",
+ 1, 0, 1, (SCM str, SCM rest),
+ "Scheme callable function to issue the warning @code{str}. "
+ "The message is formatted with @code{format} and @code{rest}.")
+{
+ SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+ str = scm_simple_format (SCM_BOOL_F, str, rest);
+ warning (ly_scm2string (str));
+ return SCM_UNSPECIFIED;
+}
+
LY_DEFINE (ly_dir_p, "ly:dir?",
1, 0, 0, (SCM s),
"type predicate. A direction is @code{-1}, @code{0} or "
if (scm_is_pair (handle))
return scm_cdr (handle);
- else
- return default_value;
+ return default_value;
}
LY_DEFINE (ly_number2string, "ly:number->string",
if (scm_exact_p (s) == SCM_BOOL_F)
{
Real r (scm_to_double (s));
-#ifdef __APPLE__
- if (my_isinf (r) || my_isnan (r))
-#else
if (isinf (r) || isnan (r))
-#endif
{
- programming_error ("Infinity or NaN encountered while converting Real number; setting to zero.");
+ programming_error (_ ("infinity or NaN encountered while converting Real number"));
+ programming_error (_ ("setting to zero"));
+
r = 0.0;
}
SCM lst = SCM_EOL;
int output_formats_count = output_formats.size ();
- for (int i = 0; i < output_formats_count; i ++)
+ for (int i = 0; i < output_formats_count; i++)
lst = scm_cons (scm_makfrom0str (output_formats[i].to_str0 ()), lst);
return lst;
1, 0, 0, (SCM wc),
"Encode the Unicode codepoint @var{wc} as UTF-8")
{
- char buf[100];
+ char buf[5];
SCM_ASSERT_TYPE (scm_is_integer (wc), wc, SCM_ARG1, __FUNCTION__, "integer");
- wchar_t wide_char = (wchar_t) scm_to_int (wc);
+ unsigned wide_char = (unsigned) scm_to_int (wc);
+ char *p = buf;
- mbstate_t state;
- memset (&state, '\0', sizeof (state));
- memset (buf, '\0', sizeof (buf));
+ if (wide_char < 0x0080)
+ *p++ = (char)wide_char;
+ else if (wide_char < 0x0800)
+ {
+ *p++ = (char) (((wide_char >> 6)) | 0xC0);
+ *p++ = (char) (((wide_char) & 0x3F) | 0x80);
+ }
+ else if (wide_char < 0x10000)
+ {
+ *p++ = (char) (((wide_char >> 12)) | 0xE0);
+ *p++ = (char) (((wide_char >> 6) & 0x3F) | 0x80);
+ *p++ = (char) (((wide_char) & 0x3F) | 0x80);
+ }
+ else
+ {
+ *p++ = (char) (((wide_char >> 18)) | 0xF0);
+ *p++ = (char) (((wide_char >> 12) & 0x3F) | 0x80);
+ *p++ = (char) (((wide_char >> 6) & 0x3F) | 0x80);
+ *p++ = (char) (((wide_char) & 0x3F) | 0x80);
+ }
+ *p = 0;
- wcrtomb (buf, wide_char, &state);
-
return scm_makfrom0str (buf);
}
-
+
LY_DEFINE (ly_effective_prefix, "ly:effective-prefix",
0, 0, 0, (),
"Return effective prefix.")
return scm_makfrom0str (prefix_directory.to_str0 ());
}
+LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
+ 2, 1, 0, (SCM key, SCM achain, SCM dfault),
+ "Return value for @var{key} from a list of alists @var{achain}. "
+ "If no if no entry is found, return DFAULT, "
+ "or #f if no DFAULT not specified.")
+{
+ if (scm_is_pair (achain))
+ {
+ SCM handle = scm_assoc (key, scm_car (achain));
+ if (scm_is_pair (handle))
+ return scm_cdr (handle);
+ else
+ return ly_chain_assoc_get (key, scm_cdr (achain), dfault);
+ }
+ return dfault == SCM_UNDEFINED ? SCM_BOOL_F : dfault;
+}
+LY_DEFINE (ly_stderr_redirect, "ly:stderr-redirect",
+ 1, 1, 0, (SCM file_name, SCM mode),
+ "Redirect stderr to FILE-NAME, opened with MODE.")
+{
+ SCM_ASSERT_TYPE (scm_string_p (file_name), file_name, SCM_ARG1,
+ __FUNCTION__, "file_name");
+ char const *m = "w";
+ if (mode != SCM_UNDEFINED && scm_string_p (mode))
+ m = ly_scm2newstr (mode, 0);
+ /* dup2 and (fileno (current-error-port)) do not work with mingw'c
+ gcc -mwindows. */
+ freopen (ly_scm2newstr (file_name, 0), m, stderr);
+ return SCM_UNSPECIFIED;
+}
projects / lilypond.git / blobdiff