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