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