lily/scm-option.cc

   1 /*
   2   scm-option.cc --  implement option setting from Scheme
   3
   4   source file of the GNU LilyPond music typesetter
   5
   6   (c) 2001--2003  Han-Wen Nienhuys <hanwen@cs.uu.nl>
   7
   8  */
   9 #include <stdio.h>
  10
  11 #include "parse-scm.hh"
  12 #include "string.hh"
  13 #include "lily-guile.hh"
  14 #include "scm-option.hh"
  15 #include "warn.hh"
  16
  17 /*
  18   This interface to option setting is meant for setting options are
  19   useful to a limited audience. The reason for this interface is that
  20   making command line options clutters up the command-line option name
  21   space.
  22
  23
  24   preferably, also dont use TESTING_LEVEL_GLOBAL, since it defeats
  25   another purpose of this very versatile interface, which is to
  26   support multiple debug/testing options concurrently.
  27
  28  */
  29
  30
  31 /* Write midi as formatted ascii stream? */
  32 bool midi_debug_global_b;
  33
  34 /* General purpose testing flag */
  35 int testing_level_global;
  36
  37 /*
  38   Backwards compatibility.
  39  */
  40 bool lily_1_8_relative = false;
  41 bool lily_1_8_compatibility_used = false;
  42
  43 /*
  44   crash if internally the wrong type is used for a grob property.
  45  */
  46 bool internal_type_checking_global_b;
  47
  48 LY_DEFINE (ly_option_usage, "ly:option-usage", 0, 0, 0, (SCM),
  49                   "Print ly-set-option usage")
  50 {
  51   printf ( _("lilypond -e EXPR means:").to_str0 ());
  52   puts ("");
  53   printf (_ ("  Evalute the Scheme EXPR before parsing any .ly files.").to_str0 ());
  54   puts ("");
  55   printf (_ ("  Multiple -e options may be given, they will be evaluated sequentially.").to_str0 ());
  56   puts ("");
  57   printf (_("  The function ly-set-option allows for access to some internal variables.").to_str0 ());
  58   puts ("\n");
  59   printf (_ ("Usage: lilypond -e \"(ly-set-option SYMBOL VAL)\"").to_str0 ());
  60   puts ("\n");
  61   printf (_ ("Where SYMBOL VAL pair is any of:").to_str0 ());
  62   puts ("");
  63   printf ( "  help ANY-SYMBOL\n"
  64            "  internal-type-checking BOOLEAN\n"
  65            "  midi-debug BOOLEAN\n"
  66            "  parse-protect BOOLEAN\n"
  67            "  testing-level INTEGER\n");
  68
  69   exit (0);
  70   return SCM_UNSPECIFIED;
  71 }
  72
  73 /* Add these as well:
  74
  75 @item -T,--no-timestamps
  76 don't timestamp the output
  77
  78 @item -t,--test
  79 Switch on any experimental features.  Not for general public use. */
  80 LY_DEFINE (ly_set_option, "ly:set-option", 1, 1, 0, (SCM var, SCM val),
  81             "Set a global option value.  Supported options include\n"
  82 "\n"
  83 "@table @code\n"
  84 "@item help\n"
  85 "List all options.\n"
  86 "@item midi-debug\n"
  87 "If set to true, generate human readable MIDI\n"
  88 "@item internal-type-checking\n"
  89 "Set paranoia for property assignments\n"
  90 "@item parse-protect\n"
  91 "If protection is switched on, errors in inline scheme are caught in the parser. \n"
  92 "If off, GUILE will halt on errors, and give a stack trace. Default is protected evaluation. \n"
  93 "@item old-relative\n"
  94 "Relative for simultaneous functions similar to chord syntax\n"
  95 "@item new-relative\n"
  96 "Relative for simultaneous functions similar to sequential music\n"
  97 "@end table\n"
  98 "\n"
  99 "This function is useful to call from the command line: @code{lilypond -e\n"
 100 "\"(ly-set-option 'midi-debug #t_)\"}.\n")
 101 {
 102   if (val == SCM_UNDEFINED)
 103     val = SCM_BOOL_T;
 104
 105   if (var == ly_symbol2scm ("help"))
 106     {
 107       /* lilypond -e "(ly-set-option 'help #t)" */
 108       ly_option_usage (SCM_EOL);
 109     }
 110   else if (var == ly_symbol2scm ("midi-debug"))
 111     {
 112       midi_debug_global_b = to_boolean (val);
 113     }
 114   else if (var == ly_symbol2scm ("testing-level"))
 115     {
 116      testing_level_global = gh_scm2int (val);
 117     }
 118   else if (var == ly_symbol2scm ("parse-protect" ))
 119     {
 120       parse_protect_global = to_boolean(val);
 121     }
 122   else if (var == ly_symbol2scm ("internal-type-checking"))
 123     {
 124      internal_type_checking_global_b = to_boolean (val);
 125     }
 126   else if (var == ly_symbol2scm ("old-relative"))
 127     {
 128       lily_1_8_relative = true;
 129       lily_1_8_compatibility_used = false;
 130     }
 131   else if (var == ly_symbol2scm ("new-relative"))
 132     {
 133       lily_1_8_relative = false;
 134     }
 135   else
 136     {
 137       warning (_("Unknown internal option!"));
 138     }
 139
 140   return SCM_UNSPECIFIED;
 141 }
 142
 143
 144 LY_DEFINE (ly_get_option, "ly:get-option", 1, 0, 0, (SCM var),
 145             "Get a global option setting.  Supported options include\n"
 146            "@table @code\n"
 147            "@item old-relative-used\n"
 148            "Report whether old-relative compatibility mode is necessary\n"
 149            "@item old-relative\n"
 150            "Report whether old-relative compatibility mode is used\n"
 151            "@end table\n"
 152            "\n")
 153 {
 154   if (var == ly_symbol2scm ("old-relative-used"))
 155     {
 156       return gh_bool2scm (lily_1_8_compatibility_used);
 157     }
 158   if (var == ly_symbol2scm ("old-relative"))
 159     {
 160       return gh_bool2scm (lily_1_8_relative);
 161     }
 162   else
 163     {
 164       warning (_("Unknown internal option!"));
 165     }
 166
 167   return SCM_UNSPECIFIED;
 168 }