]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/general-scheme.cc
Fix some bugs in the dynamic engraver and PostScript backend
[lilypond.git] / lily / general-scheme.cc
index d21f8bf6aad02480eea440765f00693b6e6c4204..558d111f8617b7b61147504ec8dbf658446b76ed 100644 (file)
@@ -3,25 +3,20 @@
 
   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 "std-string.hh"
 #include "misc.hh"
 #include "warn.hh"
 #include "version.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}, "
@@ -44,12 +31,12 @@ LY_DEFINE (ly_find_file, "ly:find-file",
 {
   SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
 
-  String nm = ly_scm2string (name);
-  String file_name = global_path.find (nm);
-  if (file_name.is_empty ())
+  string nm = ly_scm2string (name);
+  string file_name = global_path.find (nm);
+  if (file_name.empty ())
     return SCM_BOOL_F;
 
-  return scm_makfrom0str (file_name.to_str0 ());
+  return scm_makfrom0str (file_name.c_str ());
 }
 
 /*
@@ -57,25 +44,52 @@ LY_DEFINE (ly_find_file, "ly:find-file",
   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);
-  return scm_from_locale_stringn (contents.get_str0 (), contents.length ());
+  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.c_str (), 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;
 }
 
@@ -85,13 +99,22 @@ LY_DEFINE (ly_programming_error, "ly:programming-error",
           "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 "
@@ -119,8 +142,7 @@ LY_DEFINE (ly_assoc_get, "ly:assoc-get",
 
   if (scm_is_pair (handle))
     return scm_cdr (handle);
-  else
-    return default_value;
+  return default_value;
 }
 
 LY_DEFINE (ly_number2string, "ly:number->string",
@@ -134,13 +156,11 @@ 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;
          }
 
@@ -189,14 +209,14 @@ LY_DEFINE (ly_gettext, "ly:gettext",
 {
   SCM_ASSERT_TYPE (scm_is_string (string), string, SCM_ARG1,
                   __FUNCTION__, "string");
-  return scm_makfrom0str (_ (scm_i_string_chars (string)).to_str0 ());
+  return scm_makfrom0str (_ (scm_i_string_chars (string)).c_str ());
 }
 
 LY_DEFINE (ly_output_backend, "ly:output-backend",
           0, 0, 0, (),
           "Return name of output backend.")
 {
-  return scm_makfrom0str (output_backend_global.to_str0 ());
+  return scm_makfrom0str (output_backend_global.c_str ());
 }
 
 LY_DEFINE (ly_output_formats, "ly:output-formats",
@@ -204,12 +224,12 @@ LY_DEFINE (ly_output_formats, "ly:output-formats",
           "Formats passed to --format as a list of strings, "
           "used for the output.")
 {
-  Array<String> output_formats = split_string (output_format_global, ',');
+  vector<string> output_formats = string_split (output_format_global, ',');
 
   SCM lst = SCM_EOL;
   int output_formats_count = output_formats.size ();
-  for (int i = 0; i < output_formats_count; i ++)
-    lst = scm_cons (scm_makfrom0str (output_formats[i].to_str0 ()), lst);
+  for (int i = 0; i < output_formats_count; i++)
+    lst = scm_cons (scm_makfrom0str (output_formats[i].c_str ()), lst);
 
   return lst;
 }
@@ -218,25 +238,72 @@ LY_DEFINE (ly_wchar_to_utf_8, "ly:wide-char->utf-8",
           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 ());
+  return scm_makfrom0str (prefix_directory.c_str ());
 }
 
+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;
+}