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