From 28d8d9ac38857927790af5759c393adeff1ceb82 Mon Sep 17 00:00:00 2001 From: Bertrand Bordage Date: Fri, 29 Jul 2011 23:26:45 +0200 Subject: [PATCH] New alist to replace special characters. add-text-replacements! command for \paper blocks. \replace to add replacements directly inside markups. --- input/regression/markup-special-characters.ly | 30 ++++ lily/text-interface.cc | 39 +++-- ly/paper-defaults-init.ly | 3 + ly/text-replacements.ly | 133 ++++++++++++++++++ scm/define-grob-properties.scm | 3 + scm/define-markup-commands.scm | 57 ++++++-- scm/output-lib.scm | 14 ++ 7 files changed, 252 insertions(+), 27 deletions(-) create mode 100644 input/regression/markup-special-characters.ly create mode 100644 ly/text-replacements.ly diff --git a/input/regression/markup-special-characters.ly b/input/regression/markup-special-characters.ly new file mode 100644 index 0000000000..2da01f8d72 --- /dev/null +++ b/input/regression/markup-special-characters.ly @@ -0,0 +1,30 @@ +\version "2.15.0" +\header { + texidoc = " + A list of special characters ASCII aliases can be easily included. + This works for markups and lyrics. + " +} + +\paper { + #(include-special-characters) +} + +#(define-markup-list-command (show-special-characters layout props) () + (let ((defs (ly:output-def-lookup layout 'text-font-defaults))) + (interpret-markup-list layout props + (map (lambda (pair) + (markup #:override '(line-width . 18) #:fill-line ( + #:override '(replacement-alist . ()) (car pair) + #:override '(thickness . 0.1) #:box (cdr pair)))) + (list-tail (assoc-get 'replacement-alist defs) 3))))) + +\markup "List of the special characters:" +\markuplines \justified-lines \show-special-characters + +\markup { \vspace #2 "Markup example:" } +\markup { \vspace #1 "§numero;2 §ndash; §OE;dipe§hellip; Qui de ton complexe e§s;t épargné§nnbsp;? (B. Bordage §copyright; 2011)" } +\markup { \vspace #1 "Lyric example:" } +\new Lyrics \lyricmode { + Ce§s;16 -- §s;ez In -- fi -- dè -- les, un c§oe;ur in -- no -- cent ne §s;çau -- roit vous plai -- re~en -- cor§nnbsp;; +} diff --git a/lily/text-interface.cc b/lily/text-interface.cc index 7bb4ceadc0..53d5af4232 100644 --- a/lily/text-interface.cc +++ b/lily/text-interface.cc @@ -31,22 +31,36 @@ #include "warn.hh" static void -replace_whitespace (string *str) +replace_special_characters (string *str, SCM props) { vsize i = 0; - vsize n = str->size (); + SCM replacement_alist = ly_chain_assoc_get (ly_symbol2scm ("replacement-alist"), + props, + SCM_BOOL_F); - while (i < n) - { - char cur = (*str)[i]; - - // avoid the locale-dependent isspace - if (cur == '\n' || cur == '\t' || cur == '\v') - (*str)[i] = ' '; + if (!to_boolean (scm_list_p (replacement_alist)) + || to_boolean (scm_null_p (replacement_alist))) + return; - vsize char_len = utf8_char_len (cur); + int max_length = 0; + for (SCM s = replacement_alist; scm_is_pair (s); s = scm_cdr (s)) + { + max_length = max (max_length, scm_to_int + (scm_string_length (scm_caar (s)))); + } - i += char_len; + while (i <= str->size ()) + { + for (int j = max_length; j > 0; j--) + { + string dummy = str->substr (i, j); + string ligature = robust_scm2string + (ly_assoc_get (ly_string2scm (dummy), + replacement_alist, SCM_BOOL_F), ""); + if (ligature != "") + str->replace (i, j, ligature); + } + i += utf8_char_len ((*str)[i]); } } @@ -63,7 +77,7 @@ Text_interface::interpret_string (SCM layout_smob, Output_def *layout = unsmob_output_def (layout_smob); Font_metric *fm = select_encoded_font (layout, props); - replace_whitespace (&str); + replace_special_characters (&str, props); /* We want to filter strings with a music font that pass through @@ -158,6 +172,7 @@ ADD_INTERFACE (Text_interface, /* properties */ "baseline-skip " + "replacement-alist " "text " "word-space " "text-direction " diff --git a/ly/paper-defaults-init.ly b/ly/paper-defaults-init.ly index c68652d8a4..33c73f24db 100644 --- a/ly/paper-defaults-init.ly +++ b/ly/paper-defaults-init.ly @@ -149,6 +149,9 @@ #(define text-font-defaults `((font-encoding . latin1) (baseline-skip . 3) + (replacement-alist . ,default-string-replacement-alist) (word-space . 0.6))) + \include "text-replacements.ly" + } diff --git a/ly/text-replacements.ly b/ly/text-replacements.ly new file mode 100644 index 0000000000..158fde40cc --- /dev/null +++ b/ly/text-replacements.ly @@ -0,0 +1,133 @@ +%%%% This file is part of LilyPond, the GNU music typesetter. +%%%% +%%%% Copyright (C) 2011 Bertrand Bordage +%%%% +%%%% LilyPond is free software: you can redistribute it and/or modify +%%%% it under the terms of the GNU General Public License as published by +%%%% the Free Software Foundation, either version 3 of the License, or +%%%% (at your option) any later version. +%%%% +%%%% LilyPond is distributed in the hope that it will be useful, +%%%% but WITHOUT ANY WARRANTY; without even the implied warranty of +%%%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +%%%% GNU General Public License for more details. +%%%% +%%%% You should have received a copy of the GNU General Public License +%%%% along with LilyPond. If not, see . + +\version "2.15.7" + +#(define (add-text-replacements! alist) + (assoc-set! text-font-defaults 'replacement-alist + (cdaar + (internal-add-text-replacements (list text-font-defaults) alist)))) + +#(define (include-special-characters) + (add-text-replacements! + '(; Punctuation + ("§hellip;" . "…") + ("§ndash;" . "–") + ("§mdash;" . "—") + ("§iexcl;" . "¡") + ("§iquest;" . "¿") + ("§solidus;" . "∕") ; this is not a slash, + ; contrary to what is said in Unicode. + + ; French, German and English quotes open/close + ("§flq;" . "‹") + ("§frq;" . "›") + ("§flqq;" . "«") + ("§frqq;" . "»") + ("§glq;" . "‚") + ("§grq;" . "‘") + ("§glqq;" . "„") + ("§grqq;" . "“") + ("§elq;" . "‘") + ("§erq;" . "’") + ("§elqq;" . "“") + ("§erqq;" . "”") + + ; Word dividers + ("§ensp;" . " ") + ("§emsp;" . " ") + ("§thinsp;" . " ") + ("§nbsp;" . " ") + ("§nnbsp;" . " ") ; narrow non-breaking space + ("§zwj;" . "‍") + ("§zwnj;" . "‌") + ("§middot;" . "·") ; interpunct + + ; General typography + ("§bull;" . "•") + ("§copyright;" . "©") + ("§registered;" . "®") + ("§trademark;" . "™") + ("§dagger;" . "†") + ("§Dagger;" . "‡") + ("§numero;" . "№") + ("§ordf;" . "ª") + ("§ordm;" . "º") + ("§para;" . "¶") + ("§sect;" . "§") + ("§deg;" . "°") + ("§numero;" . "№") + ("§permil;" . "‰") + ("§brvbar;" . "¦") + + ; Diacritics + ("§acute;" . "´") + ("§acutedbl;" . "˝") + ("§grave;" . "`") + ("§breve;" . "˘") + ("§caron;" . "ˇ") + ("§cedilla;" . "¸") + ("§circumflex;" . "^") + ("§diaeresis;" . "¨") + ("§macron;" . "¯") + + ; Non-ASCII Letters (Excluding Accented Letters) + ("§aa;" . "å") + ("§AA;" . "Å") + ("§ae;" . "æ") + ("§AE;" . "Æ") + ("§dh;" . "ð") + ("§DH;" . "Ð") + ("§dj;" . "đ") + ("§DJ;" . "Đ") + ("§l;" . "ł") + ("§L;" . "Ł") + ("§ng;" . "ŋ") + ("§NG;" . "Ŋ") + ("§o;" . "ø") + ("§O;" . "Ø") + ("§oe;" . "œ") + ("§OE;" . "Œ") + ("§s;" . "ſ") + ("§ss;" . "ß") + ("§th;" . "þ") + ("§TH;" . "Þ") + + ; Mathematical symbols + ("§plus;" . "+") + ("§minus;" . "−") + ("§times;" . "×") + ("§div;" . "÷") + ("§sup1;" . "¹") + ("§sup2;" . "²") + ("§sup3;" . "³") + ("§sqrt;" . "√") + ("§increment;" . "∆") + ("§infty;" . "∞") + ("§sum;" . "∑") + ("§pm;" . "±") + ("§bulletop;" . "∙") + ("§partial;" . "∂") + ("§neg;" . "¬") + + ; Currency symbols + ("§currency;" . "¤") + ("§dollar;" . "$") + ("§euro;" . "€") + ("§pounds;" . "£") + ("§yen;" . "¥") + ("§cent;" . "¢")))) diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index a45f1053d1..334245d349 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -689,6 +689,9 @@ number, the quicker the slur attains its @code{height-limit}.") interesting items.") (remove-first ,boolean? "Remove the first staff of an orchestral score?") + (replacement-alist ,list? "Alist of strings or characters. +The key is a string of the pattern to be replaced. The value is a +string of what should be displayed. Useful for ligatures.") (restore-first ,boolean? "Print a natural before the accidental.") (rhythmic-location ,rhythmic-location? "Where (bar number, diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index cdfaf1f9f8..d60191decf 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -2100,16 +2100,18 @@ Adjusts @code{baseline-skip} and @code{word-space} accordingly. } @end lilypond" (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12)) - (text-props (list (ly:output-def-lookup layout 'text-font-defaults))) - (ref-word-space (chain-assoc-get 'word-space text-props 0.6)) - (ref-baseline (chain-assoc-get 'baseline-skip text-props 3)) - (magnification (/ size ref-size))) - (interpret-markup layout - (cons `((baseline-skip . ,(* magnification ref-baseline)) - (word-space . ,(* magnification ref-word-space)) - (font-size . ,(magnification->font-size magnification))) - props) - arg))) + (text-props (list (ly:output-def-lookup layout 'text-font-defaults))) + (ref-word-space (chain-assoc-get 'word-space text-props 0.6)) + (ref-baseline (chain-assoc-get 'baseline-skip text-props 3)) + (magnification (/ size ref-size))) + (interpret-markup + layout + (cons + `((baseline-skip . ,(* magnification ref-baseline)) + (word-space . ,(* magnification ref-word-space)) + (font-size . ,(magnification->font-size magnification))) + props) + arg))) (define-markup-command (fontsize layout props increment arg) (number? markup?) @@ -2128,11 +2130,14 @@ accordingly. smaller } @end lilypond" - (let ((entries (list - (cons 'baseline-skip (* baseline-skip (magstep increment))) - (cons 'word-space (* word-space (magstep increment))) - (cons 'font-size (+ font-size increment))))) - (interpret-markup layout (cons entries props) arg))) + (interpret-markup + layout + (cons + `((baseline-skip . ,(* baseline-skip (magstep increment))) + (word-space . ,(* word-space (magstep increment))) + (font-size . ,(+ font-size increment))) + props) + arg)) (define-markup-command (magnify layout props sz arg) (number? markup?) @@ -3637,6 +3642,28 @@ Patterns are aligned to the @var{dir} markup. #:pattern (1+ count) X space pattern right)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Replacements +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-markup-command (replace layout props replacements arg) + (list? markup?) + #:category font + " +Used to automatically replace a string by another in the markup @var{arg}. +Each pair of the alist @var{replacements} specifies what should be replaced. +The @code{key} is the string to be replaced by the @code{value} string. + +@lilypond[verbatim, quote] +\\markup \\replace #'((\"thx\" . \"Thanks!\")) thx +@end lilypond" + (interpret-markup + layout + (internal-add-text-replacements + props + replacements) + (markup arg))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Markup list commands ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 025590e5ba..0b453a3838 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -968,3 +968,17 @@ between the two text elements." (define-public (laissez-vibrer::print grob) (ly:tie::print grob)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; text replacements + +(define-public default-string-replacement-alist + '(; Whitespaces + ("\t" . " ") + ("\n" . " ") + ("\v" . " "))) + +(define-public (internal-add-text-replacements props alist) + (let* ((dummy-replacements (chain-assoc-get 'replacement-alist props '())) + (new-replacements + (append dummy-replacements alist))) + (prepend-alist-chain 'replacement-alist new-replacements props))) -- 2.39.2