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