lily/general-scheme.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 1998--2011 Jan Nieuwenhuizen <janneke@gnu.org>
   5   Han-Wen Nienhuys <hanwen@xs4all.nl>
   6
   7   LilyPond is free software: you can redistribute it and/or modify
   8   it under the terms of the GNU General Public License as published by
   9   the Free Software Foundation, either version 3 of the License, or
  10   (at your option) any later version.
  11
  12   LilyPond is distributed in the hope that it will be useful,
  13   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15   GNU General Public License for more details.
  16
  17   You should have received a copy of the GNU General Public License
  18   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  19 */
  20
  21 #include "config.hh"
  22
  23 #include <cstdio>
  24 #include <ctype.h>
  25 #include <cstring>  /* memset */
  26 #include <glib.h>
  27 using namespace std;
  28
  29 #include "dimensions.hh"
  30 #include "file-name.hh"
  31 #include "file-path.hh"
  32 #include "international.hh"
  33 #include "libc-extension.hh"
  34 #include "lily-guile.hh"
  35 #include "main.hh"
  36 #include "misc.hh"
  37 #include "program-option.hh"
  38 #include "relocate.hh"
  39 #include "string-convert.hh"
  40 #include "version.hh"
  41 #include "warn.hh"
  42
  43 LY_DEFINE (ly_start_environment, "ly:start-environment",
  44            0, 0, 0, (),
  45            "Return the environment (a list of strings) that was in"
  46            " effect at program start.")
  47 {
  48   SCM l = SCM_EOL;
  49   SCM *tail = &l;
  50
  51   for (vsize i = 0; i < start_environment_global.size (); i++)
  52     {
  53       *tail = scm_cons (ly_string2scm (start_environment_global[i]),
  54                         SCM_EOL);
  55       tail = SCM_CDRLOC (*tail);
  56     }
  57
  58   return l;
  59 }
  60
  61 LY_DEFINE (ly_find_file, "ly:find-file",
  62            1, 0, 0, (SCM name),
  63            "Return the absolute file name of @var{name},"
  64            " or @code{#f} if not found.")
  65 {
  66   LY_ASSERT_TYPE (scm_is_string, name, 1);
  67
  68   string nm = ly_scm2string (name);
  69   string file_name = global_path.find (nm);
  70   if (file_name.empty ())
  71     return SCM_BOOL_F;
  72
  73   return ly_string2scm (file_name);
  74 }
  75
  76 /*
  77   Ugh. Gulped file is copied twice. (maybe thrice if you count stdio
  78   buffering.)
  79 */
  80 LY_DEFINE (ly_gulp_file, "ly:gulp-file",
  81            1, 1, 0, (SCM name, SCM size),
  82            "Read @var{size} characters from the file @var{name},"
  83            " and return its contents in a string."
  84            "  If @var{size} is undefined, the entire file is read."
  85            "  The file is looked up using the search path.")
  86 {
  87   LY_ASSERT_TYPE (scm_is_string, name, 1);
  88   int sz = INT_MAX;
  89   if (size != SCM_UNDEFINED)
  90     {
  91       LY_ASSERT_TYPE (scm_is_number, size, 2);
  92       sz = scm_to_int (size);
  93     }
  94
  95   string contents = gulp_file_to_string (ly_scm2string (name), true, sz);
  96   return scm_from_locale_stringn (contents.c_str (), contents.length ());
  97 }
  98
  99 LY_DEFINE (ly_error, "ly:error",
 100            1, 0, 1, (SCM str, SCM rest),
 101            "A Scheme callable function to issue the error @var{str}."
 102            "  The error is formatted with @code{format} and @var{rest}.")
 103 {
 104   LY_ASSERT_TYPE (scm_is_string, str, 1);
 105   str = scm_simple_format (SCM_BOOL_F, str, rest);
 106   error (ly_scm2string (str));
 107   return SCM_UNSPECIFIED;
 108 }
 109
 110 LY_DEFINE (ly_message, "ly:message",
 111            1, 0, 1, (SCM str, SCM rest),
 112            "A Scheme callable function to issue the message @var{str}."
 113            "  The message is formatted with @code{format} and @var{rest}.")
 114 {
 115   LY_ASSERT_TYPE (scm_is_string, str, 1);
 116   str = scm_simple_format (SCM_BOOL_F, str, rest);
 117   message (ly_scm2string (str));
 118   return SCM_UNSPECIFIED;
 119 }
 120
 121 LY_DEFINE (ly_progress, "ly:progress",
 122            1, 0, 1, (SCM str, SCM rest),
 123            "A Scheme callable function to print progress @var{str}."
 124            "  The message is formatted with @code{format} and @var{rest}.")
 125 {
 126   LY_ASSERT_TYPE (scm_is_string, str, 1);
 127   str = scm_simple_format (SCM_BOOL_F, str, rest);
 128   progress_indication (ly_scm2string (str));
 129   return SCM_UNSPECIFIED;
 130 }
 131
 132 LY_DEFINE (ly_programming_error, "ly:programming-error",
 133            1, 0, 1, (SCM str, SCM rest),
 134            "A Scheme callable function to issue the internal warning"
 135            "  @var{str}.  The message is formatted with @code{format}"
 136            " and @var{rest}.")
 137 {
 138   LY_ASSERT_TYPE (scm_is_string, str, 1);
 139   str = scm_simple_format (SCM_BOOL_F, str, rest);
 140
 141   if (get_program_option ("warning-as-error"))
 142     error (ly_scm2string (str));
 143   else
 144     programming_error (ly_scm2string (str));
 145
 146   return SCM_UNSPECIFIED;
 147 }
 148
 149 LY_DEFINE (ly_success, "ly:success",
 150            1, 0, 1, (SCM str, SCM rest),
 151            "A Scheme callable function to issue a success message @var{str}."
 152            "  The message is formatted with @code{format} and @var{rest}.")
 153 {
 154   LY_ASSERT_TYPE (scm_is_string, str, 1);
 155   str = scm_simple_format (SCM_BOOL_F, str, rest);
 156   successful (ly_scm2string (str));
 157   return SCM_UNSPECIFIED;
 158
 159 }
 160 LY_DEFINE (ly_warning, "ly:warning",
 161            1, 0, 1, (SCM str, SCM rest),
 162            "A Scheme callable function to issue the warning @var{str}."
 163            "  The message is formatted with @code{format} and @var{rest}.")
 164 {
 165   LY_ASSERT_TYPE (scm_is_string, str, 1);
 166   str = scm_simple_format (SCM_BOOL_F, str, rest);
 167
 168   if (get_program_option ("warning-as-error"))
 169     error (ly_scm2string (str));
 170   else
 171     warning (ly_scm2string (str));
 172
 173   return SCM_UNSPECIFIED;
 174 }
 175
 176 LY_DEFINE (ly_dir_p, "ly:dir?",
 177            1, 0, 0, (SCM s),
 178            "Is @var{s} a direction?  Valid directions are @code{-1},"
 179            " @code{0}, or@tie{}@code{1}, where @code{-1} represents"
 180            " left or down, @code{1}@tie{}represents right or up, and @code{0}"
 181            " represents a neutral direction.")
 182 {
 183   if (scm_is_number (s))
 184     {
 185       int i = scm_to_int (s);
 186       return (i >= -1 && i <= 1) ? SCM_BOOL_T : SCM_BOOL_F;
 187     }
 188   return SCM_BOOL_F;
 189 }
 190
 191 LY_DEFINE (ly_assoc_get, "ly:assoc-get",
 192            2, 2, 0,
 193            (SCM key, SCM alist, SCM default_value, SCM strict_checking),
 194            "Return value if @var{key} in @var{alist}, else @var{default-value}"
 195            " (or @code{#f} if not specified).  If @var{strict-checking} is set"
 196            " to @code{#t} and @var{key} is not in @var{alist}, a programming_error"
 197            " is output.")
 198 {
 199   LY_ASSERT_TYPE (ly_cheap_is_list, alist, 2);
 200
 201   SCM handle = scm_assoc (key, alist);
 202   if (scm_is_pair (handle))
 203     return scm_cdr (handle);
 204
 205   if (default_value == SCM_UNDEFINED)
 206     default_value = SCM_BOOL_F;
 207
 208   if (strict_checking == SCM_BOOL_T)
 209     {
 210       string key_string = ly_scm2string
 211                           (scm_object_to_string (key, SCM_UNDEFINED));
 212       string default_value_string = ly_scm2string
 213                                     (scm_object_to_string (default_value,
 214                                                            SCM_UNDEFINED));
 215       programming_error ("Cannot find key `"
 216                          + key_string
 217                          + "' in alist, setting to `"
 218                          + default_value_string + "'.");
 219     }
 220
 221   return default_value;
 222 }
 223
 224 LY_DEFINE (ly_string_substitute, "ly:string-substitute",
 225            3, 0, 0, (SCM a, SCM b, SCM s),
 226            "Replace string@tie{}@var{a} by string@tie{}@var{b} in"
 227            " string@tie{}@var{s}.")
 228 {
 229   LY_ASSERT_TYPE (scm_is_string, s, 1);
 230   LY_ASSERT_TYPE (scm_is_string, b, 2);
 231   LY_ASSERT_TYPE (scm_is_string, s, 3);
 232
 233   string ss = ly_scm2string (s);
 234   replace_all (&ss, ly_scm2string (a),
 235                ly_scm2string (b));
 236
 237   return ly_string2scm (ss);
 238 }
 239
 240 bool
 241 is_not_escape_character (Byte c)
 242 {
 243   switch (c)
 244     {
 245     case '-':
 246     case '.':
 247     case '/':
 248     case '0'...'9':
 249     case ':':
 250     case 'A'...'Z':
 251     case '_':
 252     case 'a'...'z':
 253       return true;
 254     }
 255
 256   return false;
 257 }
 258
 259 LY_DEFINE (ly_string_percent_encode, "ly:string-percent-encode",
 260            1, 0, 0, (SCM str),
 261            "Encode all characters in string @var{str} with hexadecimal"
 262            " percent escape sequences, with the following exceptions:"
 263            " characters @code{-}, @code{.}, @code{/}, and @code{_}; and"
 264            " characters in ranges @code{0-9}, @code{A-Z}, and @code{a-z}.")
 265 {
 266   LY_ASSERT_TYPE (scm_is_string, str, 1);
 267
 268   string orig_str = ly_scm2string (str);
 269   string new_str = "";
 270
 271   vsize i = 0;
 272   vsize n = orig_str.size ();
 273
 274   while (i < n)
 275     {
 276       Byte cur = orig_str[i];
 277
 278       if (is_not_escape_character (cur))
 279         new_str += cur;
 280       else
 281         {
 282           new_str += '%';
 283           new_str += String_convert::bin2hex (cur);
 284         }
 285
 286       i++;
 287     }
 288
 289   return ly_string2scm (new_str);
 290 }
 291
 292 LY_DEFINE (ly_number_2_string, "ly:number->string",
 293            1, 0, 0, (SCM s),
 294            "Convert @var{s} to a string without generating many decimals.")
 295 {
 296   LY_ASSERT_TYPE (scm_is_number, s, 1);
 297
 298   char str[400];                        // ugh.
 299
 300   if (scm_exact_p (s) == SCM_BOOL_F)
 301     {
 302       Real r (scm_to_double (s));
 303       if (isinf (r) || isnan (r))
 304         {
 305           programming_error (_ ("infinity or NaN encountered while converting Real number"));
 306           programming_error (_ ("setting to zero"));
 307
 308           r = 0.0;
 309         }
 310
 311       snprintf (str, sizeof (str), "%.4f", r);
 312     }
 313   else
 314     snprintf (str, sizeof (str), "%d", int (scm_to_int (s)));
 315
 316   return scm_from_locale_string (str);
 317 }
 318
 319 LY_DEFINE (ly_version, "ly:version", 0, 0, 0, (),
 320            "Return the current lilypond version as a list, e.g.,"
 321            " @code{(1 3 127 uu1)}.")
 322 {
 323   char const *vs = "\'(" MAJOR_VERSION " " MINOR_VERSION " " PATCH_LEVEL " " MY_PATCH_LEVEL ")";
 324
 325   return scm_c_eval_string ((char *)vs);
 326 }
 327
 328 LY_DEFINE (ly_unit, "ly:unit", 0, 0, 0, (),
 329            "Return the unit used for lengths as a string.")
 330 {
 331   return scm_from_locale_string (INTERNAL_UNIT);
 332 }
 333
 334 LY_DEFINE (ly_dimension_p, "ly:dimension?", 1, 0, 0, (SCM d),
 335            "Return @var{d} as a number.  Used to distinguish length"
 336            " variables from normal numbers.")
 337 {
 338   return scm_number_p (d);
 339 }
 340
 341 /*
 342   Debugging mem leaks:
 343 */
 344 LY_DEFINE (ly_protects, "ly:protects",
 345            0, 0, 0, (),
 346            "Return hash of protected objects.")
 347 {
 348   return scm_protects;
 349 }
 350
 351 LY_DEFINE (ly_gettext, "ly:gettext",
 352            1, 0, 0, (SCM original),
 353            "A Scheme wrapper function for @code{gettext}.")
 354 {
 355   LY_ASSERT_TYPE (scm_is_string, original, 1);
 356   return ly_string2scm (_ (ly_scm2string (original).c_str ()));
 357 }
 358
 359 LY_DEFINE (ly_output_formats, "ly:output-formats",
 360            0, 0, 0, (),
 361            "Formats passed to @option{--format} as a list of strings,"
 362            " used for the output.")
 363 {
 364   vector<string> output_formats = string_split (output_format_global, ',');
 365
 366   SCM lst = SCM_EOL;
 367   int output_formats_count = output_formats.size ();
 368   for (int i = 0; i < output_formats_count; i++)
 369     lst = scm_cons (ly_string2scm (output_formats[i]), lst);
 370
 371   return lst;
 372 }
 373
 374 LY_DEFINE (ly_wide_char_2_utf_8, "ly:wide-char->utf-8",
 375            1, 0, 0, (SCM wc),
 376            "Encode the Unicode codepoint @var{wc}, an integer, as UTF-8.")
 377 {
 378   char buf[5];
 379
 380   LY_ASSERT_TYPE (scm_is_integer, wc, 1);
 381   unsigned wide_char = (unsigned) scm_to_int (wc);
 382   char *p = buf;
 383
 384   if (wide_char < 0x0080)
 385     *p++ = (char)wide_char;
 386   else if (wide_char < 0x0800)
 387     {
 388       *p++ = (char) (((wide_char >> 6)) | 0xC0);
 389       *p++ = (char) (((wide_char) & 0x3F) | 0x80);
 390     }
 391   else if (wide_char < 0x10000)
 392     {
 393       *p++ = (char) (((wide_char >> 12)) | 0xE0);
 394       *p++ = (char) (((wide_char >> 6) & 0x3F) | 0x80);
 395       *p++ = (char) (((wide_char) & 0x3F) | 0x80);
 396     }
 397   else
 398     {
 399       *p++ = (char) (((wide_char >> 18)) | 0xF0);
 400       *p++ = (char) (((wide_char >> 12) & 0x3F) | 0x80);
 401       *p++ = (char) (((wide_char >> 6) & 0x3F) | 0x80);
 402       *p++ = (char) (((wide_char) & 0x3F) | 0x80);
 403     }
 404   *p = 0;
 405
 406   return scm_from_locale_string (buf);
 407 }
 408
 409 LY_DEFINE (ly_effective_prefix, "ly:effective-prefix",
 410            0, 0, 0, (),
 411            "Return effective prefix.")
 412 {
 413   return ly_string2scm (lilypond_datadir);
 414 }
 415
 416 LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
 417            2, 2, 0, (SCM key, SCM achain, SCM default_value, SCM strict_checking),
 418            "Return value for @var{key} from a list of alists @var{achain}."
 419            "  If no entry is found, return @var{default-value} or @code{#f} if"
 420            " @var{default-value} is not specified.  With @var{strict-checking}"
 421            " set to @code{#t}, a programming_error is output in such cases.")
 422 {
 423   if (scm_is_pair (achain))
 424     {
 425       SCM handle = scm_assoc (key, scm_car (achain));
 426       if (scm_is_pair (handle))
 427         return scm_cdr (handle);
 428       else
 429         return ly_chain_assoc_get (key, scm_cdr (achain), default_value);
 430     }
 431
 432   if (strict_checking == SCM_BOOL_T)
 433     {
 434       string key_string = ly_scm2string
 435                           (scm_object_to_string (key, SCM_UNDEFINED));
 436       string default_value_string = ly_scm2string
 437                                     (scm_object_to_string (default_value,
 438                                                            SCM_UNDEFINED));
 439       programming_error ("Cannot find key `"
 440                          + key_string
 441                          + "' in achain, setting to `"
 442                          + default_value_string + "'.");
 443     }
 444
 445   return default_value == SCM_UNDEFINED ? SCM_BOOL_F : default_value;
 446 }
 447
 448 LY_DEFINE (ly_stderr_redirect, "ly:stderr-redirect",
 449            1, 1, 0, (SCM file_name, SCM mode),
 450            "Redirect stderr to @var{file-name}, opened with @var{mode}.")
 451 {
 452   LY_ASSERT_TYPE (scm_is_string, file_name, 1);
 453
 454   string m = "w";
 455   FILE *stderrfile;
 456   if (mode != SCM_UNDEFINED && scm_string_p (mode))
 457     m = ly_scm2string (mode);
 458   /* dup2 and (fileno (current-error-port)) do not work with mingw'c
 459      gcc -mwindows.  */
 460   fflush (stderr);
 461   stderrfile = freopen (ly_scm2string (file_name).c_str (), m.c_str (), stderr);
 462   return SCM_UNSPECIFIED;
 463 }
 464
 465 static SCM
 466 accumulate_symbol (void * /* closure */,
 467                    SCM key,
 468                    SCM /* val */,
 469                    SCM result)
 470 {
 471   return scm_cons (key, result);
 472 }
 473
 474 LY_DEFINE (ly_hash_table_keys, "ly:hash-table-keys",
 475            1, 0, 0, (SCM tab),
 476            "Return a list of keys in @var{tab}.")
 477 {
 478   return scm_internal_hash_fold ((scm_t_hash_fold_fn) &accumulate_symbol,
 479                                  NULL, SCM_EOL, tab);
 480 }
 481
 482 LY_DEFINE (ly_camel_case_2_lisp_identifier, "ly:camel-case->lisp-identifier",
 483            1, 0, 0, (SCM name_sym),
 484            "Convert @code{FooBar_Bla} to @code{foo-bar-bla} style symbol.")
 485 {
 486   LY_ASSERT_TYPE (ly_is_symbol, name_sym, 1);
 487
 488   /*
 489     TODO: should use strings instead?
 490   */
 491
 492   const string in = ly_symbol2string (name_sym);
 493   string result = camel_case_to_lisp_identifier (in);
 494
 495   return ly_symbol2scm (result.c_str ());
 496 }
 497
 498 LY_DEFINE (ly_expand_environment, "ly:expand-environment",
 499            1, 0, 0, (SCM str),
 500            "Expand @code{$VAR} and @code{$@{VAR@}} in @var{str}.")
 501 {
 502   LY_ASSERT_TYPE (scm_is_string, str, 1);
 503
 504   return ly_string2scm (expand_environment_variables (ly_scm2string (str)));
 505 }
 506
 507 LY_DEFINE (ly_truncate_list_x, "ly:truncate-list!",
 508            2, 0, 0, (SCM lst, SCM i),
 509            "Take at most the first @var{i} of list @var{lst}.")
 510 {
 511   LY_ASSERT_TYPE (scm_is_integer, i, 1);
 512
 513   int k = scm_to_int (i);
 514   if (k == 0)
 515     lst = SCM_EOL;
 516   else
 517     {
 518       SCM s = lst;
 519       k--;
 520       for (; scm_is_pair (s) && k--; s = scm_cdr (s))
 521         ;
 522
 523       if (scm_is_pair (s))
 524         scm_set_cdr_x (s, SCM_EOL);
 525     }
 526   return lst;
 527 }
 528
 529 string
 530 format_single_argument (SCM arg, int precision, bool escape = false)
 531 {
 532   if (scm_is_integer (arg) && scm_exact_p (arg) == SCM_BOOL_T)
 533     return (String_convert::int_string (scm_to_int (arg)));
 534   else if (scm_is_number (arg))
 535     {
 536       Real val = scm_to_double (arg);
 537
 538       if (isnan (val) || isinf (val))
 539         {
 540           warning (_ ("Found infinity or nan in output. Substituting 0.0"));
 541           return ("0.0");
 542           if (strict_infinity_checking)
 543             abort ();
 544         }
 545       else
 546         return (String_convert::form_string ("%.*lf", precision, val));
 547     }
 548   else if (scm_is_string (arg))
 549     {
 550       string s = ly_scm2string (arg);
 551       if (escape)
 552         {
 553           // Escape backslashes and double quotes, wrap it in double quotes
 554           replace_all (&s, "\\", "\\\\");
 555           replace_all (&s, "\"", "\\\"");
 556           // don't replace percents, since the png backend uses %d as escape sequence
 557           // replace_all (&s, "%", "\\%");
 558           replace_all (&s, "$", "\\$");
 559           s = "\"" + s + "\"";
 560         }
 561       return s;
 562     }
 563   else if (scm_is_symbol (arg))
 564     return (ly_symbol2string (arg));
 565   else
 566     {
 567       ly_progress (scm_from_locale_string ("\nUnsupported SCM value for format: ~a"),
 568                    scm_list_1 (arg));
 569     }
 570
 571   return "";
 572 }
 573
 574 LY_DEFINE (ly_format, "ly:format",
 575            1, 0, 1, (SCM str, SCM rest),
 576            "LilyPond specific format, supporting @code{~a} and @code{~[0-9]f}."
 577            "  Basic support for @code{~s} is also provided.")
 578 {
 579   LY_ASSERT_TYPE (scm_is_string, str, 1);
 580
 581   string format = ly_scm2string (str);
 582   vector<string> results;
 583
 584   vsize i = 0;
 585   while (i < format.size ())
 586     {
 587       vsize tilde = format.find ('~', i);
 588
 589       results.push_back (format.substr (i, (tilde - i)));
 590
 591       if (tilde == NPOS)
 592         break;
 593
 594       tilde++;
 595
 596       char spec = format.at (tilde++);
 597       if (spec == '~')
 598         results.push_back ("~");
 599       else
 600         {
 601           if (!scm_is_pair (rest))
 602             {
 603               programming_error (string (__FUNCTION__)
 604                                  + ": not enough arguments for format.");
 605               return ly_string2scm ("");
 606             }
 607
 608           SCM arg = scm_car (rest);
 609           rest = scm_cdr (rest);
 610
 611           int precision = 8;
 612
 613           if (spec == '$')
 614             precision = 2;
 615           else if (isdigit (spec))
 616             {
 617               precision = spec - '0';
 618               spec = format.at (tilde++);
 619             }
 620
 621           if (spec == 'a' || spec == 'A' || spec == 'f' || spec == '$')
 622             results.push_back (format_single_argument (arg, precision));
 623           else if (spec == 's' || spec == 'S')
 624             results.push_back (format_single_argument (arg, precision, true));
 625           else if (spec == 'l')
 626             {
 627               SCM s = arg;
 628               for (; scm_is_pair (s); s = scm_cdr (s))
 629                 {
 630                   results.push_back (format_single_argument (scm_car (s), precision));
 631                   if (scm_cdr (s) != SCM_EOL)
 632                     results.push_back (" ");
 633                 }
 634
 635               if (s != SCM_EOL)
 636                 results.push_back (format_single_argument (s, precision));
 637
 638             }
 639         }
 640
 641       i = tilde;
 642     }
 643
 644   if (scm_is_pair (rest))
 645     programming_error (string (__FUNCTION__)
 646                        + ": too many arguments");
 647
 648   vsize len = 0;
 649   for (vsize i = 0; i < results.size (); i++)
 650     len += results[i].size ();
 651
 652   char *result = (char *) scm_malloc (len + 1);
 653   char *ptr = result;
 654   for (vsize i = 0; i < results.size (); i++)
 655     {
 656       strncpy (ptr, results[i].c_str (), results[i].size ());
 657       ptr += results[i].size ();
 658     }
 659   *ptr = '\0';
 660
 661   return scm_take_locale_stringn (result, len);
 662 }
 663
 664 int
 665 ly_run_command (char *argv[], char **standard_output, char **standard_error)
 666 {
 667   GError *error = 0;
 668   int exit_status = 0;
 669   int flags = G_SPAWN_SEARCH_PATH;
 670   if (!standard_output)
 671     flags |= G_SPAWN_STDOUT_TO_DEV_NULL;
 672   if (!standard_error)
 673     flags |= G_SPAWN_STDERR_TO_DEV_NULL;
 674   if (!g_spawn_sync (0, argv, 0, GSpawnFlags (flags),
 675                      0, 0,
 676                      standard_output, standard_error,
 677                      &exit_status, &error))
 678     {
 679       fprintf (stderr, "failed (%d): %s: %s\n", exit_status, argv[0], error->message);
 680       g_error_free (error);
 681       if (!exit_status)
 682         exit_status = -1;
 683     }
 684
 685   return exit_status;
 686 }
 687
 688 static char *
 689 ly_scm2utf8 (SCM str)
 690 {
 691   char *p = ly_scm2str0 (str);
 692   char *g = g_locale_to_utf8 (p, -1, 0, 0, 0);
 693   free (p);
 694   return g;
 695 }
 696
 697 LY_DEFINE (ly_spawn, "ly:spawn",
 698            1, 0, 1, (SCM command, SCM rest),
 699            "Simple interface to g_spawn_sync"
 700            " @var{str}."
 701            "  The error is formatted with @code{format} and @var{rest}.")
 702
 703 {
 704   LY_ASSERT_TYPE (scm_is_string, command, 1);
 705
 706   int argc = scm_is_pair (rest) ? scm_ilength (rest) : 0;
 707   char **argv = new char*[argc + 2];
 708
 709   int n = 0;
 710   argv[n++] = ly_scm2utf8 (command);
 711   for (SCM s = rest; scm_is_pair (s); s = scm_cdr (s))
 712     argv[n++] = ly_scm2utf8 (scm_car (s));
 713   argv[n] = 0;
 714
 715   char *standard_output = 0;
 716   char *standard_error = 0;
 717   int exit_status = be_verbose_global
 718                     ? ly_run_command (argv, &standard_output, &standard_error)
 719                     : ly_run_command (argv, 0, 0);
 720
 721   if (be_verbose_global)
 722     {
 723       fprintf (stderr, "\n%s", standard_output);
 724       fprintf (stderr, "%s", standard_error);
 725     }
 726
 727   for (int i = 0; i < n; i++)
 728     free (argv[i]);
 729   delete[] argv;
 730
 731   return scm_from_int (exit_status);
 732 }