]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/general-scheme.cc
remove obsolete comment
[lilypond.git] / lily / general-scheme.cc
index 868d2d11fb1f2620aaad23fa5f0117b76d70b5e0..48ee4503b12f90d4478e60e65606f80ee390d21f 100644 (file)
@@ -27,12 +27,30 @@ using namespace std;
 #include "file-name.hh"
 #include "string-convert.hh"
 
+LY_DEFINE (ly_start_environment, "ly:start-environment",
+          0, 0, 0, (),
+          "Return the environment, a list of strings, that was in effect at program start")
+{
+  SCM l = SCM_EOL;
+  SCM *tail = &l;
+
+  for (vsize i = 0; i < start_environment_global.size (); i++)
+    {
+      *tail = scm_cons (ly_string2scm (start_environment_global[i]),
+                       SCM_EOL);
+      tail = SCM_CDRLOC(*tail);
+    }
+
+  return l;
+}
+
+
 LY_DEFINE (ly_find_file, "ly:find-file",
           1, 0, 0, (SCM name),
           "Return the absolute file name of @var{name}, "
           "or @code{#f} if not found.")
 {
-  SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, name, 1);
 
   string nm = ly_scm2string (name);
   string file_name = global_path.find (nm);
@@ -51,11 +69,11 @@ LY_DEFINE (ly_gulp_file, "ly:gulp-file",
           "Read the file @var{name}, and return its contents in a string.  "
           "The file is looked up using the search path. ")
 {
-  SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, name, 1);
   int sz = INT_MAX;
   if (size != SCM_UNDEFINED)
     {
-      SCM_ASSERT_TYPE (scm_is_number (size), size, SCM_ARG2, __FUNCTION__, "number");
+      LY_ASSERT_TYPE (scm_is_number, size, 2);
       sz = scm_to_int (size);
     }
   
@@ -68,7 +86,7 @@ LY_DEFINE (ly_error, "ly:error",
           "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");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
   str = scm_simple_format (SCM_BOOL_F, str, rest);
   error (ly_scm2string (str));
   return SCM_UNSPECIFIED;
@@ -79,7 +97,7 @@ LY_DEFINE (ly_message, "ly:message",
           "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");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
   str = scm_simple_format (SCM_BOOL_F, str, rest);
   message (ly_scm2string (str));
   return SCM_UNSPECIFIED;
@@ -90,7 +108,7 @@ LY_DEFINE (ly_progress, "ly:progress",
           "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");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
   str = scm_simple_format (SCM_BOOL_F, str, rest);
   progress_indication (ly_scm2string (str));
   return SCM_UNSPECIFIED;
@@ -101,7 +119,7 @@ LY_DEFINE (ly_programming_error, "ly:programming-error",
           "Scheme callable function to issue the warning @code{msg}. "
           "The message is formatted with @code{format} and @code{rest}.")
 {
-  SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
   str = scm_simple_format (SCM_BOOL_F, str, rest);
   programming_error (ly_scm2string (str));
   return SCM_UNSPECIFIED;
@@ -112,7 +130,7 @@ LY_DEFINE (ly_warning, "ly:warning",
           "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");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
   str = scm_simple_format (SCM_BOOL_F, str, rest);
   warning (ly_scm2string (str));
   return SCM_UNSPECIFIED;
@@ -138,6 +156,8 @@ LY_DEFINE (ly_assoc_get, "ly:assoc-get",
           "Return value if KEY in ALIST, else DEFAULT-VALUE "
           "(or #f if not specified).")
 {
+  LY_ASSERT_TYPE(ly_cheap_is_list, alist, 2);
+  
   SCM handle = scm_assoc (key, alist);
   if (scm_is_pair (handle))
     return scm_cdr (handle);
@@ -150,11 +170,11 @@ LY_DEFINE (ly_assoc_get, "ly:assoc-get",
 
 LY_DEFINE (ly_string_substitute, "ly:string-substitute",
           3, 0, 0, (SCM a, SCM b, SCM s),
-          "Replace @var{a} by @var{b} in @var{s}.")
+          "Replace string @var{a} by string @var{b} in string @var{s}.")
 {
-  SCM_ASSERT_TYPE (scm_is_string (a), s, SCM_ARG1, __FUNCTION__, "string");
-  SCM_ASSERT_TYPE (scm_is_string (b), s, SCM_ARG2, __FUNCTION__, "string");
-  SCM_ASSERT_TYPE (scm_is_string (s), s, SCM_ARG3, __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, s, 1);
+  LY_ASSERT_TYPE (scm_is_string, b, 2);
+  LY_ASSERT_TYPE (scm_is_string, s, 3);
 
   string ss = ly_scm2string (s);
   replace_all (ss, string (scm_i_string_chars (a)),
@@ -166,7 +186,7 @@ LY_DEFINE (ly_number_2_string, "ly:number->string",
           1, 0, 0, (SCM s),
           "Convert @var{num} to a string without generating many decimals.")
 {
-  SCM_ASSERT_TYPE (scm_is_number (s), s, SCM_ARG1, __FUNCTION__, "number");
+  LY_ASSERT_TYPE (scm_is_number, s, 1);
 
   char str[400];                       // ugh.
 
@@ -224,18 +244,10 @@ LY_DEFINE (ly_gettext, "ly:gettext",
           1, 0, 0, (SCM string),
           "Gettext wrapper.")
 {
-  SCM_ASSERT_TYPE (scm_is_string (string), string, SCM_ARG1,
-                  __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, string, 1);
   return ly_string2scm (_ (scm_i_string_chars (string)));
 }
 
-LY_DEFINE (ly_output_backend, "ly:output-backend",
-          0, 0, 0, (),
-          "Return name of output backend.")
-{
-  return ly_string2scm (output_backend_global);
-}
-
 LY_DEFINE (ly_output_formats, "ly:output-formats",
           0, 0, 0, (),
           "Formats passed to --format as a list of strings, "
@@ -257,7 +269,7 @@ LY_DEFINE (ly_wide_char_2_utf_8, "ly:wide-char->utf-8",
 {
   char buf[5];
 
-  SCM_ASSERT_TYPE (scm_is_integer (wc), wc, SCM_ARG1, __FUNCTION__, "integer");
+  LY_ASSERT_TYPE (scm_is_integer, wc, 1);
   unsigned wide_char = (unsigned) scm_to_int (wc);
   char *p = buf;
 
@@ -290,7 +302,7 @@ LY_DEFINE (ly_effective_prefix, "ly:effective-prefix",
           0, 0, 0, (),
           "Return effective prefix.")
 {
-  return ly_string2scm (prefix_directory);
+  return ly_string2scm (lilypond_datadir);
 }
 
 LY_DEFINE (ly_chain_assoc_get, "ly:chain-assoc-get",
@@ -315,8 +327,7 @@ 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_is_string (file_name), file_name, SCM_ARG1,
-                  __FUNCTION__, "file_name");
+  LY_ASSERT_TYPE (scm_is_string, file_name, 1);
 
   string m = "w";
   if (mode != SCM_UNDEFINED && scm_string_p (mode))
@@ -336,7 +347,7 @@ accumulate_symbol (void *closure, SCM key, SCM val, SCM result)
   return scm_cons (key, result);
 }
 
-LY_DEFINE(ly_hash_table_keys, "ly:hash-table-keys",
+LY_DEFINE (ly_hash_table_keys, "ly:hash-table-keys",
          1,0,0, (SCM tab),
          "return a list of keys in @var{tab}")
 {
@@ -348,8 +359,7 @@ LY_DEFINE (ly_camel_case_2_lisp_identifier, "ly:camel-case->lisp-identifier",
           1, 0, 0, (SCM name_sym),
           "Convert FooBar_Bla to foo-bar-bla style symbol.")
 {
-  SCM_ASSERT_TYPE(scm_is_symbol (name_sym), name_sym,
-                 SCM_ARG1, __FUNCTION__, "symbol");
+  LY_ASSERT_TYPE (ly_is_symbol, name_sym, 1);
   
   /*
     TODO: should use strings instead?
@@ -365,8 +375,7 @@ LY_DEFINE (ly_expand_environment, "ly:expand-environment",
           1, 0, 0, (SCM str),
           "Expand $VAR and $@{VAR@} in @var{str}.")
 {
-  SCM_ASSERT_TYPE(scm_is_string (str), str,
-                 SCM_ARG1, __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
 
   return ly_string2scm (expand_environment_variables (ly_scm2string (str)));
 }
@@ -376,8 +385,7 @@ LY_DEFINE (ly_truncate_list_x, "ly:truncate-list!",
           2, 0, 0, (SCM lst, SCM i),
           "Take at most the first @var{i} of list @var{lst}")
 {
-  SCM_ASSERT_TYPE(scm_is_integer (i), i,
-                 SCM_ARG1, __FUNCTION__, "integer");
+  LY_ASSERT_TYPE (scm_is_integer, i, 1);
 
   int k = scm_to_int (i);
   if (k == 0)
@@ -409,7 +417,7 @@ format_single_argument (SCM arg, int precision)
          warning (_ ("Found infinity or nan in output. Substituting 0.0"));
          return ("0.0");
          if (strict_infinity_checking)
-           abort();
+           abort ();
        }
       else
        return (String_convert::form_string ("%.*lf", precision, val));
@@ -432,13 +440,13 @@ LY_DEFINE (ly_format, "ly:format",
           1, 0, 1, (SCM str, SCM rest),
           "LilyPond specific format, supporting ~a ~[0-9]f.")
 {
-  SCM_ASSERT_TYPE (scm_is_string (str), str, SCM_ARG1, __FUNCTION__, "string");
+  LY_ASSERT_TYPE (scm_is_string, str, 1);
 
   string format = ly_scm2string (str);
   vector<string> results;
 
   vsize i = 0;
-  while (i < format.size())
+  while (i < format.size ())
     {
       vsize tilde = format.find ('~', i);
 
@@ -467,14 +475,14 @@ LY_DEFINE (ly_format, "ly:format",
          int precision = 8;
          
          if (spec == '$')
-           precision = '2';
+           precision = 2;
          else if (isdigit (spec))
            {
              precision = spec - '0';
              spec = format.at (tilde ++);
            }
                   
-         if (spec == 'a' || spec == 'f')
+         if (spec == 'a' || spec == 'A' || spec == 'f' || spec == '$')
            results.push_back (format_single_argument (arg, precision));
          else if (spec == 'l')
            {
@@ -500,15 +508,15 @@ LY_DEFINE (ly_format, "ly:format",
                       + ": too many  arguments");
 
   vsize len = 0;
-  for (vsize i = 0; i < results.size(); i++)
-    len += results[i].size();
+  for (vsize i = 0; i < results.size (); i++)
+    len += results[i].size ();
   
   char *result = (char*) scm_malloc (len + 1);
   char *ptr = result;
-  for (vsize i = 0; i < results.size(); i++)
+  for (vsize i = 0; i < results.size (); i++)
     {
-      strncpy (ptr, results[i].c_str (), results[i].size());
-      ptr += results[i].size();
+      strncpy (ptr, results[i].c_str (), results[i].size ());
+      ptr += results[i].size ();
     }
   *ptr = '\0';