lily/warn-scheme.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 1998--2015 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 "lily-guile.hh"
  24 #include "program-option.hh"
  25 #include "version.hh"
  26 #include "international.hh"
  27 #include "warn.hh"
  28
  29 using std::string;
  30
  31 /*
  32   Error / warning / progress / debug message output functions
  33 */
  34
  35 LY_DEFINE (ly_error, "ly:error",
  36            1, 0, 1, (SCM str, SCM rest),
  37            "A Scheme callable function to issue the error @var{str}."
  38            "  The error is formatted with @code{format} and @var{rest}.")
  39 {
  40   LY_ASSERT_TYPE (scm_is_string, str, 1);
  41   str = scm_simple_format (SCM_BOOL_F, str, rest);
  42   error (ly_scm2string (str));
  43   return SCM_UNSPECIFIED;
  44 }
  45
  46 LY_DEFINE (ly_programming_error, "ly:programming-error",
  47            1, 0, 1, (SCM str, SCM rest),
  48            "A Scheme callable function to issue the internal warning"
  49            "  @var{str}.  The message is formatted with @code{format}"
  50            " and @var{rest}.")
  51 {
  52   LY_ASSERT_TYPE (scm_is_string, str, 1);
  53   str = scm_simple_format (SCM_BOOL_F, str, rest);
  54   programming_error (ly_scm2string (str));
  55   return SCM_UNSPECIFIED;
  56 }
  57
  58 LY_DEFINE (ly_warning, "ly:warning",
  59            1, 0, 1, (SCM str, SCM rest),
  60            "A Scheme callable function to issue the warning @var{str}."
  61            "  The message is formatted with @code{format} and @var{rest}.")
  62 {
  63   LY_ASSERT_TYPE (scm_is_string, str, 1);
  64   str = scm_simple_format (SCM_BOOL_F, str, rest);
  65   warning (ly_scm2string (str));
  66   return SCM_UNSPECIFIED;
  67 }
  68
  69 LY_DEFINE (ly_progress, "ly:progress",
  70            1, 0, 1, (SCM str, SCM rest),
  71            "A Scheme callable function to print progress @var{str}."
  72            "  The message is formatted with @code{format} and @var{rest}.")
  73 {
  74   LY_ASSERT_TYPE (scm_is_string, str, 1);
  75   str = scm_simple_format (SCM_BOOL_F, str, rest);
  76   // Calls to ly:progress should in general not start a new line
  77   progress_indication (ly_scm2string (str), false);
  78   return SCM_UNSPECIFIED;
  79 }
  80
  81 LY_DEFINE (ly_basic_progress, "ly:basic-progress",
  82            1, 0, 1, (SCM str, SCM rest),
  83            "A Scheme callable function to issue a basic progress message @var{str}."
  84            "  The message is formatted with @code{format} and @var{rest}.")
  85 {
  86   LY_ASSERT_TYPE (scm_is_string, str, 1);
  87   str = scm_simple_format (SCM_BOOL_F, str, rest);
  88   basic_progress (ly_scm2string (str));
  89   return SCM_UNSPECIFIED;
  90 }
  91
  92 LY_DEFINE (ly_message, "ly:message",
  93            1, 0, 1, (SCM str, SCM rest),
  94            "A Scheme callable function to issue the message @var{str}."
  95            "  The message is formatted with @code{format} and @var{rest}.")
  96 {
  97   LY_ASSERT_TYPE (scm_is_string, str, 1);
  98   str = scm_simple_format (SCM_BOOL_F, str, rest);
  99   message (ly_scm2string (str));
 100   return SCM_UNSPECIFIED;
 101 }
 102
 103 LY_DEFINE (ly_debug, "ly:debug",
 104            1, 0, 1, (SCM str, SCM rest),
 105            "A Scheme callable function to issue a debug message @var{str}."
 106            "  The message is formatted with @code{format} and @var{rest}.")
 107 {
 108   // TODO: Add the newline flag!
 109   LY_ASSERT_TYPE (scm_is_string, str, 1);
 110   str = scm_simple_format (SCM_BOOL_F, str, rest);
 111   debug_output (ly_scm2string (str));
 112   return SCM_UNSPECIFIED;
 113 }
 114
 115 LY_DEFINE (ly_warning_located, "ly:warning-located",
 116            2, 0, 1, (SCM location, SCM str, SCM rest),
 117            "A Scheme callable function to issue the warning @var{str} at"
 118            " the specified location in an input file."
 119            "  The message is formatted with @code{format} and @var{rest}.")
 120 {
 121   LY_ASSERT_TYPE (scm_is_string, location, 1);
 122   LY_ASSERT_TYPE (scm_is_string, str, 2);
 123   str = scm_simple_format (SCM_BOOL_F, str, rest);
 124   warning (ly_scm2string (str), ly_scm2string (location));
 125   return SCM_UNSPECIFIED;
 126 }
 127
 128 LY_DEFINE (ly_expect_warning, "ly:expect-warning",
 129            1, 0, 1, (SCM str, SCM rest),
 130            "A Scheme callable function to register a warning to be expected"
 131            " and subsequently suppressed.  If the warning is not encountered,"
 132            " a warning about the missing warning will be shown.  The message"
 133            " should be translated with @code{(_ ...)} and changing parameters"
 134            " given after the format string.")
 135 {
 136   LY_ASSERT_TYPE (scm_is_string, str, 1);
 137   str = scm_simple_format (SCM_BOOL_F, str, rest);
 138   expect_warning (ly_scm2string (str));
 139   return SCM_UNSPECIFIED;
 140 }
 141
 142 LY_DEFINE (ly_check_expected_warnings, "ly:check-expected-warnings",
 143            0, 0, 0, (),
 144            "Check whether all expected warnings have really been triggered.")
 145 {
 146   check_expected_warnings ();
 147   return SCM_UNSPECIFIED;
 148 }
 149
 150 LY_DEFINE (ly_translate_cpp_warning_scheme, "ly:translate-cpp-warning-scheme",
 151            1, 0, 0, (SCM str),
 152            "Translates a string in C++ printf format and modifies it to use"
 153            " it for scheme formatting.")
 154 {
 155   LY_ASSERT_TYPE (scm_is_string, str, 1);
 156   string s = _ (ly_scm2string (str).c_str ());
 157
 158   /* Now replace all printf placeholders by scheme placeholders (~a).
 159    * Guile's format syntax is pretty similar to C's printf, only with
 160    * a tilde as the placeholder instead of a percent sign.
 161    * There is no easy way to replace all ~ -> ~~, %% -> %, % -> ~,
 162    * so simply walk through each character.
 163    */
 164 //   size_t pos = 0;
 165   const char *pos = s.c_str ();
 166   string result = "";
 167   while (*pos != '\0')
 168     {
 169       // In some cases (%%, %s) we need to do a lookahead. As the C string is
 170       // always \0-terminated the next char is never beyond the end of the
 171       // memory!
 172       switch (*pos)
 173         {
 174         case '~':
 175           result += "~~";
 176           break;
 177         case '%':
 178           if (*(pos + 1) == '%')
 179             {
 180               result += "%";
 181               // Skip the second '%'
 182               pos++;
 183             }
 184           else if (*(pos + 1) == 's' || *(pos + 1) == 'd')
 185             {
 186               // %s in C++ corresponds to ~a; ~s would add quotes!
 187               // ~d is only supported by ice-9, use ~a instead
 188               result += "~a";
 189               // Skip the following 's'
 190               pos++;
 191             }
 192           else
 193             result += "~";
 194           break;
 195         default:
 196           result += *pos;
 197         }
 198       pos++;
 199     }
 200   return ly_string2scm (result);
 201 }