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