From 3b2376c6828136cdbc078015c0b9bee26bffb448 Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Sun, 26 Dec 2004 13:33:39 +0000 Subject: [PATCH] Fix internalsrefs {Tunable context properties}, {All layout objects}, {Music definitions}. --- ChangeLog | 9 + Documentation/user/changing-defaults.itely | 6 +- buildscripts/builder.py | 10 +- flower/file-path.cc | 18 +- po/lilypond.pot | 367 ++++++++++++++++----- scm/bass-figure.scm | 43 +-- scm/beam.scm | 80 ++--- scm/chord-generic-names.scm | 51 ++- scm/chord-ignatzek-names.scm | 249 ++++++-------- scm/define-markup-commands.scm | 199 +++++------ scm/define-music-types.scm | 20 +- scm/document-backend.scm | 182 ++++------ scm/document-functions.scm | 17 +- scm/document-markup.scm | 70 ++-- scm/document-music.scm | 76 ++--- scm/document-translation.scm | 247 ++++++-------- scm/documentation-generate.scm | 40 +-- scm/documentation-lib.scm | 112 +++---- scm/font.scm | 62 ++-- scm/framework-gnome.scm | 108 +++--- scm/framework-ps.scm | 141 ++++---- scm/fret-diagrams.scm | 2 - scm/lily.scm | 241 +++++++------- scm/music-functions.scm | 131 +++----- scm/output-gnome.scm | 37 +-- scm/output-lib.scm | 166 +++++----- scm/output-pdftex.scm | 66 ++-- scm/output-ps.scm | 119 ++++--- scm/output-tex.scm | 74 ++--- scm/page-layout.scm | 242 ++++++-------- scm/titling.scm | 91 +++-- scm/to-xml.scm | 49 ++- scm/translation-functions.scm | 21 +- 33 files changed, 1576 insertions(+), 1770 deletions(-) diff --git a/ChangeLog b/ChangeLog index c0de0c6935..5d40f51264 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2004-12-26 Jan Nieuwenhuizen + + * scm: Cleanups. + + * Documentation/user/changing-defaults.itely: Fix internalsrefs + {Tunable context properties}, + {All layout objects}, + {Music definitions}. + 2004-12-25 Han-Wen Nienhuys * scm/framework-ps.scm: remove all encoding code. diff --git a/Documentation/user/changing-defaults.itely b/Documentation/user/changing-defaults.itely index 29ac67b232..e9f1e8ed5a 100644 --- a/Documentation/user/changing-defaults.itely +++ b/Documentation/user/changing-defaults.itely @@ -361,7 +361,7 @@ note. A full description of all available context properties is in the program reference, see @ifhtml -@internalsref{Tunable-context-properties}. +@internalsref{Tunable context properties}. @end ifhtml @ifnothtml Translation @arrow{} Tunable context properties. @@ -553,7 +553,7 @@ affects settings that were made in the same context. In other words, the Internals: @internalsref{OverrideProperty}, @internalsref{RevertProperty}, @internalsref{PropertySet}, @internalsref{All-backend-properties}, and -@internalsref{All-layout-objects}. +@internalsref{All layout objects}. @refbugs @@ -1014,7 +1014,7 @@ starts from the output, and ends at the input event. The program reference can also be browsed like a normal document. It contains a chapter on @ifhtml -@internalsref{Music-definitions}, +@internalsref{Music definitions}, @end ifhtml @ifnothtml @code{Music definitions} diff --git a/buildscripts/builder.py b/buildscripts/builder.py index 3a65c176e1..dd000e78b9 100644 --- a/buildscripts/builder.py +++ b/buildscripts/builder.py @@ -223,12 +223,10 @@ env.Append (BUILDERS = {'PFA': pfa}) # Specific builders -# experiment: switch off for speed. -if 0: - env['DIFF_PY'] = '$srcdir/stepmake/bin/package-diff.py' - a = '$PYTHON $DIFF_PY $__verbose --outdir=${TARGET.dir}' - patch = Builder (action = a, suffix = '.diff', src_suffix = '.tar.gz') - env.Append (BUILDERS = {'PATCH': patch}) +env['DIFF_PY'] = '$srcdir/stepmake/bin/package-diff.py' +a = '$PYTHON $DIFF_PY $__verbose --outdir=${TARGET.dir}' +patch = Builder (action = a, suffix = '.diff', src_suffix = '.tar.gz') +env.Append (BUILDERS = {'PATCH': patch}) atvars = [ 'BASH', diff --git a/flower/file-path.cc b/flower/file-path.cc index 25b3931dbc..7b38191d1b 100644 --- a/flower/file-path.cc +++ b/flower/file-path.cc @@ -43,8 +43,9 @@ File_path::parse_path (String p) /** Find a file. - Seach in the current dir (DUH! FIXME?), in the construction-arg - (what's that?, and in any other appended directory, in this order. + Check absolute file name, search in the current dir (DUH! FIXME!), + in the construction-arg (what's that?), and in any other appended + directory, in this order. @return The file name if found, or empty string if not found. */ @@ -55,13 +56,14 @@ File_path::find (String name) const if (!name.length () || (name == "-") ) return name; - /* - TODO: should check for absolute path - */ - if (FILE *f =fopen (name.to_str0 (), "r")) + /* Handle absolute file name. */ + if (name[0] == DIRSEP) { - fclose (f); - return name; + if (FILE *f = fopen (name.to_str0 (), "r")) + { + fclose (f); + return name; + } } for (int i = 0; i < size (); i++) diff --git a/po/lilypond.pot b/po/lilypond.pot index 35ce8c77f3..ab9c04fd85 100644 --- a/po/lilypond.pot +++ b/po/lilypond.pot @@ -8,7 +8,7 @@ msgid "" msgstr "" "Project-Id-Version: PACKAGE VERSION\n" "Report-Msgid-Bugs-To: \n" -"POT-Creation-Date: 2004-11-05 15:16+0100\n" +"POT-Creation-Date: 2004-12-23 10:44+0100\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" @@ -22,6 +22,7 @@ msgstr "" #: lilylib.py:65 lilypond-book.py:91 lilypond-latex.py:109 midi2ly.py:100 #: mup2ly.py:75 ps2png.py:40 main.cc:131 lily/main.cc:131 lily/main.cc:132 +#: lily/main.cc:130 msgid "print this help" msgstr "" @@ -148,7 +149,10 @@ msgstr "" #. for --output-format. #. Bug in option parser: --output=foe is taken as an abbreviation #. for --output-format. +#. Bug in option parser: --output =foe is taken as an abbreviation +#. for --output-format. #: lilypond-book.py:89 main.cc:130 lily/main.cc:130 lily/main.cc:131 +#: lily/main.cc:129 msgid "EXT" msgstr "" @@ -165,7 +169,7 @@ msgid "pipe snippets through FILTER [convert-ly -n -]" msgstr "" #: lilypond-book.py:92 lilypond-book.py:94 lilypond-latex.py:114 main.cc:133 -#: lily/main.cc:133 lily/main.cc:134 +#: lily/main.cc:133 lily/main.cc:134 lily/main.cc:132 msgid "DIR" msgstr "" @@ -286,7 +290,7 @@ msgstr "" #: lilypond-latex.py:112 lilypond-latex.py:123 midi2ly.py:102 main.cc:134 #: main.cc:136 lily/main.cc:134 lily/main.cc:136 lily/main.cc:135 -#: lily/main.cc:137 +#: lily/main.cc:137 lily/main.cc:133 msgid "FILE" msgstr "" @@ -310,11 +314,12 @@ msgstr "" #. junkme? #: lilypond-latex.py:121 main.cc:135 lily/main.cc:135 lily/main.cc:136 +#: lily/main.cc:134 msgid "produce MIDI output only" msgstr "" #: lilypond-latex.py:123 midi2ly.py:102 mup2ly.py:76 main.cc:136 -#: lily/main.cc:136 lily/main.cc:137 +#: lily/main.cc:136 lily/main.cc:137 lily/main.cc:135 msgid "write output to FILE" msgstr "" @@ -449,7 +454,8 @@ msgstr "" #: lilypond-latex.py:820 includable-lexer.cc:57 kpath.cc:134 lily-guile.cc:89 #: lily-parser.cc:275 lily/includable-lexer.cc:57 lily/kpath.cc:134 -#: lily/lily-guile.cc:89 lily/lily-parser.cc:275 +#: lily/lily-guile.cc:89 lily/lily-parser.cc:275 lily/kpath.cc:128 +#: lily/lily-guile.cc:100 lily/lily-parser.cc:282 #, c-format, python-format msgid "can't find file: `%s'" msgstr "" @@ -511,12 +517,12 @@ msgstr "" msgid "treat every text as a lyric" msgstr "" -#: midi2ly.py:149 mup2ly.py:143 input.cc:88 lily/input.cc:88 +#: midi2ly.py:149 mup2ly.py:143 input.cc:88 lily/input.cc:88 lily/input.cc:87 msgid "warning: " msgstr "" #: midi2ly.py:164 midi2ly.py:1017 midi2ly.py:1082 mup2ly.py:146 mup2ly.py:160 -#: input.cc:93 lily/input.cc:93 +#: input.cc:93 lily/input.cc:93 lily/input.cc:92 msgid "error: " msgstr "" @@ -614,30 +620,31 @@ msgid "Continuing; crossing fingers" msgstr "" #: accidental-engraver.cc:194 lily/accidental-engraver.cc:201 -#: lily/accidental-engraver.cc:243 +#: lily/accidental-engraver.cc:243 lily/accidental-engraver.cc:239 #, c-format msgid "Accidental typesetting list must begin with context-name: %s" msgstr "" #: accidental-engraver.cc:222 lily/accidental-engraver.cc:229 -#: lily/accidental-engraver.cc:271 +#: lily/accidental-engraver.cc:271 lily/accidental-engraver.cc:267 #, c-format msgid "ignoring unknown accidental: %s" msgstr "" #: accidental-engraver.cc:239 lily/accidental-engraver.cc:246 -#: lily/accidental-engraver.cc:288 +#: lily/accidental-engraver.cc:288 lily/accidental-engraver.cc:284 #, c-format msgid "Accidental rule must be pair or context-name; Found %s" msgstr "" #: accidental.cc:221 key-signature-interface.cc:137 lily/accidental.cc:221 #: lily/key-signature-interface.cc:137 lily/accidental.cc:222 +#: lily/key-signature-interface.cc:133 #, c-format msgid "accidental `%s' not found" msgstr "" -#: afm.cc:143 lily/afm.cc:143 +#: afm.cc:143 lily/afm.cc:143 lily/afm.cc:144 #, c-format msgid "Error parsing AFM file: `%s'" msgstr "" @@ -652,50 +659,61 @@ msgstr "" #. FIXME: broken sentence #. FIXME: broken sentence #. FIXME: broken sentence +#. FIXME: broken sentence #: all-font-metrics.cc:95 lily/all-font-metrics.cc:95 +#: lily/all-font-metrics.cc:100 #, c-format msgid "checksum mismatch for font file: `%s'" msgstr "" #: all-font-metrics.cc:97 lily/all-font-metrics.cc:97 +#: lily/all-font-metrics.cc:102 #, c-format msgid "does not match: `%s'" msgstr "" #: all-font-metrics.cc:103 lily/all-font-metrics.cc:103 +#: lily/all-font-metrics.cc:108 msgid "Rebuild all .afm files, and remove all .pk and .tfm files." msgstr "" #: all-font-metrics.cc:105 lily/all-font-metrics.cc:105 +#: lily/all-font-metrics.cc:110 msgid "Rerun with -V to show font paths." msgstr "" #: all-font-metrics.cc:107 lily/all-font-metrics.cc:107 +#: lily/all-font-metrics.cc:112 msgid "A script for removing font-files is delivered with the source-code:" msgstr "" #: all-font-metrics.cc:184 lily/all-font-metrics.cc:184 +#: lily/all-font-metrics.cc:221 #, c-format msgid "can't find font: `%s'" msgstr "" #: all-font-metrics.cc:185 lily/all-font-metrics.cc:185 +#: lily/all-font-metrics.cc:222 msgid "Loading default font" msgstr "" #: all-font-metrics.cc:200 lily/all-font-metrics.cc:200 +#: lily/all-font-metrics.cc:237 #, c-format msgid "can't find default font: `%s'" msgstr "" #: all-font-metrics.cc:201 includable-lexer.cc:59 lily-parser.cc:268 #: lily/all-font-metrics.cc:201 lily/includable-lexer.cc:59 -#: lily/lily-parser.cc:268 +#: lily/lily-parser.cc:268 lily/all-font-metrics.cc:238 +#: lily/lily-parser.cc:275 #, c-format msgid "(search path: `%s')" msgstr "" #: all-font-metrics.cc:202 lily/all-font-metrics.cc:202 +#: lily/all-font-metrics.cc:239 msgid "Giving up" msgstr "" @@ -705,10 +723,12 @@ msgstr "" #: auto-change-iterator.cc:67 change-iterator.cc:61 #: lily/auto-change-iterator.cc:67 lily/change-iterator.cc:61 +#: lily/auto-change-iterator.cc:66 msgid "Can't switch translators, I'm there already" msgstr "" #: axis-group-engraver.cc:117 lily/axis-group-engraver.cc:117 +#: lily/axis-group-engraver.cc:112 msgid "" "Axis_group_engraver: vertical group already has a parent.\n" "Do you have two Axis_group_engravers?\n" @@ -720,25 +740,29 @@ msgstr "" msgid "barcheck failed at: %s" msgstr "" -#: beam-engraver.cc:139 lily/beam-engraver.cc:139 +#: beam-engraver.cc:139 lily/beam-engraver.cc:139 lily/beam-engraver.cc:138 msgid "already have a beam" msgstr "" #: beam-engraver.cc:211 lily/beam-engraver.cc:211 lily/beam-engraver.cc:210 +#: lily/beam-engraver.cc:209 msgid "unterminated beam" msgstr "" #: beam-engraver.cc:244 chord-tremolo-engraver.cc:174 #: lily/beam-engraver.cc:244 lily/chord-tremolo-engraver.cc:174 #: lily/beam-engraver.cc:243 lily/chord-tremolo-engraver.cc:171 +#: lily/beam-engraver.cc:242 lily/chord-tremolo-engraver.cc:169 msgid "stem must have Rhythmic structure" msgstr "" #: beam-engraver.cc:258 lily/beam-engraver.cc:258 lily/beam-engraver.cc:257 +#: lily/beam-engraver.cc:256 msgid "stem doesn't fit in beam" msgstr "" #: beam-engraver.cc:259 lily/beam-engraver.cc:259 lily/beam-engraver.cc:258 +#: lily/beam-engraver.cc:257 msgid "beam was started here" msgstr "" @@ -756,6 +780,7 @@ msgid "no viable initial configuration found: may not find good beam slope" msgstr "" #: break-align-interface.cc:214 lily/break-align-interface.cc:214 +#: lily/break-align-interface.cc:213 #, c-format msgid "No spacing entry from %s to `%s'" msgstr "" @@ -825,6 +850,12 @@ msgstr "" #. #. last->translator_id_string () = get_change ()->change_to_id_string (); #. +#. +#. We could change the current translator's id, but that would make +#. errors hard to catch +#. +#. last->translator_id_string () = get_change ()->change_to_id_string (); +#. #: change-iterator.cc:93 lily/change-iterator.cc:93 msgid "I'm one myself" msgstr "" @@ -834,25 +865,27 @@ msgid "none of these in my family" msgstr "" #: chord-tremolo-engraver.cc:100 lily/chord-tremolo-engraver.cc:100 +#: lily/chord-tremolo-engraver.cc:98 #, c-format msgid "Chord tremolo with %d elements. Must have two elements." msgstr "" #: chord-tremolo-engraver.cc:140 lily/chord-tremolo-engraver.cc:140 -#: lily/chord-tremolo-engraver.cc:137 +#: lily/chord-tremolo-engraver.cc:137 lily/chord-tremolo-engraver.cc:135 msgid "unterminated chord tremolo" msgstr "" #: chord-tremolo-iterator.cc:64 lily/chord-tremolo-iterator.cc:64 +#: lily/chord-tremolo-iterator.cc:65 msgid "no one to print a tremolos" msgstr "" -#: clef.cc:64 lily/clef.cc:64 +#: clef.cc:64 lily/clef.cc:64 lily/clef.cc:57 #, c-format msgid "clef `%s' not found" msgstr "" -#: cluster.cc:123 lily/cluster.cc:123 +#: cluster.cc:123 lily/cluster.cc:123 lily/cluster.cc:122 #, c-format msgid "unknown cluster style `%s'" msgstr "" @@ -882,17 +915,17 @@ msgstr "" msgid "can't find: `%s'" msgstr "" -#: context.cc:164 lily/context.cc:164 lily/context.cc:163 +#: context.cc:164 lily/context.cc:164 lily/context.cc:163 lily/context.cc:217 #, c-format msgid "Cannot find or create `%s' called `%s'" msgstr "" -#: context.cc:201 lily/context.cc:201 lily/context.cc:200 +#: context.cc:201 lily/context.cc:201 lily/context.cc:200 lily/context.cc:315 #, c-format msgid "can't find or create: `%s'" msgstr "" -#: custos.cc:85 lily/custos.cc:85 +#: custos.cc:85 lily/custos.cc:85 lily/custos.cc:84 #, c-format msgid "custos `%s' not found" msgstr "" @@ -904,41 +937,47 @@ msgstr "" #: dynamic-engraver.cc:186 span-dynamic-performer.cc:86 #: lily/dynamic-engraver.cc:186 lily/span-dynamic-performer.cc:86 #: lily/dynamic-engraver.cc:185 lily/dynamic-engraver.cc:182 +#: lily/dynamic-engraver.cc:179 lily/span-dynamic-performer.cc:84 msgid "can't find start of (de)crescendo" msgstr "" #: dynamic-engraver.cc:196 lily/dynamic-engraver.cc:196 #: lily/dynamic-engraver.cc:195 lily/dynamic-engraver.cc:192 +#: lily/dynamic-engraver.cc:189 msgid "already have a decrescendo" msgstr "" #: dynamic-engraver.cc:198 lily/dynamic-engraver.cc:198 #: lily/dynamic-engraver.cc:197 lily/dynamic-engraver.cc:194 +#: lily/dynamic-engraver.cc:191 msgid "already have a crescendo" msgstr "" #: dynamic-engraver.cc:201 lily/dynamic-engraver.cc:201 #: lily/dynamic-engraver.cc:200 lily/dynamic-engraver.cc:197 +#: lily/dynamic-engraver.cc:194 msgid "Cresc started here" msgstr "" #: dynamic-engraver.cc:307 lily/dynamic-engraver.cc:317 #: lily/dynamic-engraver.cc:321 lily/dynamic-engraver.cc:318 +#: lily/dynamic-engraver.cc:315 msgid "unterminated (de)crescendo" msgstr "" #: event-chord-iterator.cc:56 output-property-music-iterator.cc:29 #: lily/event-chord-iterator.cc:56 lily/output-property-music-iterator.cc:29 +#: lily/event-chord-iterator.cc:57 #, c-format msgid "Junking event: `%s'" msgstr "" -#: event.cc:49 lily/event.cc:49 lily/music.cc:184 +#: event.cc:49 lily/event.cc:49 lily/music.cc:184 lily/music.cc:185 #, c-format msgid "Transposition by %s makes alteration larger than two" msgstr "" -#: event.cc:72 lily/event.cc:72 lily/event.cc:50 +#: event.cc:72 lily/event.cc:72 lily/event.cc:50 lily/event.cc:49 #, c-format msgid "octave check failed; expected %s, found: %s" msgstr "" @@ -950,24 +989,29 @@ msgid "unterminated extender" msgstr "" #: folded-repeat-iterator.cc:65 lily/folded-repeat-iterator.cc:65 +#: lily/folded-repeat-iterator.cc:66 msgid "no one to print a repeat brace" msgstr "" #: glissando-engraver.cc:100 lily/glissando-engraver.cc:100 +#: lily/glissando-engraver.cc:99 msgid "Unterminated glissando." msgstr "" #: global-context.cc:150 lily/global-context.cc:150 lily/global-context.cc:157 +#: lily/global-context.cc:163 #, c-format msgid "can't find `%s' context" msgstr "" #: gourlay-breaking.cc:199 lily/gourlay-breaking.cc:199 +#: lily/gourlay-breaking.cc:200 #, c-format msgid "Optimal demerits: %f" msgstr "" #: gourlay-breaking.cc:204 lily/gourlay-breaking.cc:204 +#: lily/gourlay-breaking.cc:205 msgid "No feasible line breaking found" msgstr "" @@ -1019,100 +1063,114 @@ msgstr "" msgid "include files are not allowed" msgstr "" -#: input.cc:99 lily/input.cc:99 +#: input.cc:99 lily/input.cc:99 lily/input.cc:98 msgid "non fatal error: " msgstr "" #: input.cc:107 source-file.cc:135 source-file.cc:228 lily/input.cc:107 -#: lily/source-file.cc:135 lily/source-file.cc:228 +#: lily/source-file.cc:135 lily/source-file.cc:228 lily/input.cc:106 +#: lily/source-file.cc:132 lily/source-file.cc:225 msgid "position unknown" msgstr "" -#: key-performer.cc:90 lily/key-performer.cc:90 +#: key-performer.cc:90 lily/key-performer.cc:90 lily/key-performer.cc:87 msgid "FIXME: key change merge" msgstr "" -#: kpath.cc:83 lily/kpath.cc:83 +#: kpath.cc:83 lily/kpath.cc:83 lily/kpath.cc:79 #, c-format msgid "kpathsea can not find TFM file: `%s'" msgstr "" -#: kpath.cc:129 lily/kpath.cc:129 +#: kpath.cc:129 lily/kpath.cc:129 lily/kpath.cc:123 #, c-format msgid "kpathsea can not find file: `%s'" msgstr "" #: ligature-engraver.cc:152 lily/ligature-engraver.cc:152 +#: lily/ligature-engraver.cc:153 msgid "can't find start of ligature" msgstr "" #: ligature-engraver.cc:158 lily/ligature-engraver.cc:158 +#: lily/ligature-engraver.cc:159 msgid "no right bound" msgstr "" #: ligature-engraver.cc:184 lily/ligature-engraver.cc:184 +#: lily/ligature-engraver.cc:185 msgid "already have a ligature" msgstr "" #: ligature-engraver.cc:200 lily/ligature-engraver.cc:200 +#: lily/ligature-engraver.cc:201 msgid "no left bound" msgstr "" #: ligature-engraver.cc:256 lily/ligature-engraver.cc:256 +#: lily/ligature-engraver.cc:257 msgid "unterminated ligature" msgstr "" #: ligature-engraver.cc:280 lily/ligature-engraver.cc:280 +#: lily/ligature-engraver.cc:281 msgid "ignoring rest: ligature may not contain rest" msgstr "" #: ligature-engraver.cc:281 lily/ligature-engraver.cc:281 +#: lily/ligature-engraver.cc:282 msgid "ligature was started here" msgstr "" -#: lily-guile.cc:91 lily/lily-guile.cc:91 +#: lily-guile.cc:91 lily/lily-guile.cc:91 lily/lily-guile.cc:102 #, c-format msgid "(load path: `%s')" msgstr "" #: lily-guile.cc:559 lily/lily-guile.cc:559 lily/lily-guile.cc:575 +#: lily/lily-guile.cc:596 #, c-format msgid "Can't find property type-check for `%s' (%s)." msgstr "" #: lily-guile.cc:562 lily/lily-guile.cc:562 lily/lily-guile.cc:578 +#: lily/lily-guile.cc:599 msgid "Perhaps you made a typing error?" msgstr "" #: lily-guile.cc:568 lily/lily-guile.cc:568 lily/lily-guile.cc:584 +#: lily/lily-guile.cc:605 msgid "Doing assignment anyway." msgstr "" #: lily-guile.cc:582 lily/lily-guile.cc:582 lily/lily-guile.cc:598 +#: lily/lily-guile.cc:619 #, c-format msgid "Type check for `%s' failed; value `%s' must be of type `%s'" msgstr "" #: lily-lexer.cc:220 lily/lily-lexer.cc:220 lily/lily-lexer.cc:224 +#: lily/lily-lexer.cc:221 #, c-format msgid "Identifier name is a keyword: `%s'" msgstr "" #: lily-lexer.cc:237 lily/lily-lexer.cc:237 lily/lily-lexer.cc:241 +#: lily/lily-lexer.cc:238 #, c-format msgid "error at EOF: %s" msgstr "" -#: lily-parser.cc:97 lily/lily-parser.cc:97 +#: lily-parser.cc:97 lily/lily-parser.cc:97 lily/lily-parser.cc:98 msgid "Parsing..." msgstr "" #: lily-parser.cc:110 lily-parser.cc:143 lily/lily-parser.cc:110 -#: lily/lily-parser.cc:143 +#: lily/lily-parser.cc:143 lily/lily-parser.cc:116 msgid "Braces don't match" msgstr "" -#: lily-parser.cc:267 lily/lily-parser.cc:267 +#: lily-parser.cc:267 lily/lily-parser.cc:267 lily/lily-parser.cc:274 #, c-format msgid "can't find init file: `%s'" msgstr "" @@ -1122,7 +1180,7 @@ msgstr "" msgid "Now processing `%s'" msgstr "" -#: main.cc:91 lily/main.cc:91 lily/main.cc:92 +#: main.cc:91 lily/main.cc:91 lily/main.cc:92 lily/main.cc:90 msgid "" "This program is free software. It is covered by the GNU General Public\n" "License and you are welcome to change it and/or distribute copies of it\n" @@ -1130,7 +1188,7 @@ msgid "" "information.\n" msgstr "" -#: main.cc:97 lily/main.cc:97 lily/main.cc:98 +#: main.cc:97 lily/main.cc:97 lily/main.cc:98 lily/main.cc:96 msgid "" " This program is free software; you can redistribute it and/or\n" "modify it under the terms of the GNU General Public License version 2\n" @@ -1147,7 +1205,7 @@ msgid "" "Boston, MA 02111-1307, USA.\n" msgstr "" -#: main.cc:126 lily/main.cc:126 lily/main.cc:127 +#: main.cc:126 lily/main.cc:126 lily/main.cc:127 lily/main.cc:125 msgid "EXPR" msgstr "" @@ -1155,27 +1213,27 @@ msgstr "" msgid "set options, use -e '(ly:option-usage)' for help" msgstr "" -#: main.cc:130 lily/main.cc:130 lily/main.cc:131 +#: main.cc:130 lily/main.cc:130 lily/main.cc:131 lily/main.cc:129 msgid "select back-end to use" msgstr "" -#: main.cc:132 lily/main.cc:132 lily/main.cc:133 +#: main.cc:132 lily/main.cc:132 lily/main.cc:133 lily/main.cc:131 msgid "FIELD" msgstr "" -#: main.cc:132 lily/main.cc:132 lily/main.cc:133 +#: main.cc:132 lily/main.cc:132 lily/main.cc:133 lily/main.cc:131 msgid "write header field to BASENAME.FIELD" msgstr "" -#: main.cc:133 lily/main.cc:133 lily/main.cc:134 +#: main.cc:133 lily/main.cc:133 lily/main.cc:134 lily/main.cc:132 msgid "add DIR to search path" msgstr "" -#: main.cc:134 lily/main.cc:134 lily/main.cc:135 +#: main.cc:134 lily/main.cc:134 lily/main.cc:135 lily/main.cc:133 msgid "use FILE as init file" msgstr "" -#: main.cc:137 lily/main.cc:137 lily/main.cc:138 +#: main.cc:137 lily/main.cc:137 lily/main.cc:138 lily/main.cc:136 msgid "generate a preview" msgstr "" @@ -1240,11 +1298,13 @@ msgid "For more information, see %s" msgstr "" #: main.cc:410 lily/main.cc:410 lily/main.cc:412 lily/main.cc:415 +#: lily/main.cc:420 #, c-format msgid "This option is for developers only." msgstr "" #: main.cc:411 lily/main.cc:411 lily/main.cc:413 lily/main.cc:416 +#: lily/main.cc:421 #, c-format msgid "Read the sources for more information." msgstr "" @@ -1252,48 +1312,56 @@ msgstr "" #: mensural-ligature-engraver.cc:248 mensural-ligature-engraver.cc:383 #: lily/mensural-ligature-engraver.cc:248 #: lily/mensural-ligature-engraver.cc:383 +#: lily/mensural-ligature-engraver.cc:247 +#: lily/mensural-ligature-engraver.cc:382 msgid "unexpected case fall-through" msgstr "" #: mensural-ligature-engraver.cc:259 lily/mensural-ligature-engraver.cc:259 +#: lily/mensural-ligature-engraver.cc:258 msgid "ligature with less than 2 heads -> skipping" msgstr "" #: mensural-ligature-engraver.cc:279 lily/mensural-ligature-engraver.cc:279 +#: lily/mensural-ligature-engraver.cc:278 msgid "can not determine pitch of ligature primitive -> skipping" msgstr "" #: mensural-ligature-engraver.cc:302 lily/mensural-ligature-engraver.cc:302 +#: lily/mensural-ligature-engraver.cc:301 msgid "prime interval within ligature -> skipping" msgstr "" #: mensural-ligature-engraver.cc:312 lily/mensural-ligature-engraver.cc:312 +#: lily/mensural-ligature-engraver.cc:311 msgid "mensural ligature: duration none of L, B, S -> skipping" msgstr "" #: mensural-ligature.cc:161 lily/mensural-ligature.cc:161 +#: lily/mensural-ligature.cc:162 msgid "Mensural_ligature:unexpected case fall-through" msgstr "" #: mensural-ligature.cc:171 lily/mensural-ligature.cc:171 +#: lily/mensural-ligature.cc:172 msgid "Mensural_ligature: (join_left == 0)" msgstr "" -#: midi-item.cc:153 lily/midi-item.cc:153 +#: midi-item.cc:153 lily/midi-item.cc:153 lily/midi-item.cc:151 #, c-format msgid "no such MIDI instrument: `%s'" msgstr "" -#: midi-item.cc:257 lily/midi-item.cc:257 +#: midi-item.cc:257 lily/midi-item.cc:257 lily/midi-item.cc:255 msgid "silly pitch" msgstr "" -#: midi-item.cc:273 lily/midi-item.cc:273 +#: midi-item.cc:273 lily/midi-item.cc:273 lily/midi-item.cc:271 #, c-format msgid "Experimental: temporarily fine tuning (of %d cents) a channel." msgstr "" -#: midi-stream.cc:40 lily/midi-stream.cc:40 +#: midi-stream.cc:40 lily/midi-stream.cc:40 lily/midi-stream.cc:39 #, c-format msgid "could not write file: `%s'" msgstr "" @@ -1328,16 +1396,22 @@ msgstr "" #. #. music for the softenon children? #. +#. +#. music for the softenon children? +#. #: new-fingering-engraver.cc:155 lily/new-fingering-engraver.cc:155 +#: lily/new-fingering-engraver.cc:153 msgid "music for the martians." msgstr "" #: new-fingering-engraver.cc:235 lily/new-fingering-engraver.cc:235 +#: lily/new-fingering-engraver.cc:233 msgid "Fingerings are also not down?! Putting them down anyway." msgstr "" #: new-lyric-combine-music-iterator.cc:245 #: lily/new-lyric-combine-music-iterator.cc:245 +#: lily/new-lyric-combine-music-iterator.cc:244 #, c-format msgid "cannot find Voice `%s'" msgstr "" @@ -1346,7 +1420,7 @@ msgstr "" msgid "Too many clashing notecolumns. Ignoring them." msgstr "" -#: note-head.cc:45 lily/note-head.cc:45 +#: note-head.cc:45 lily/note-head.cc:45 lily/note-head.cc:68 #, c-format msgid "note head `%s' not found" msgstr "" @@ -1356,30 +1430,32 @@ msgstr "" msgid "Paper output to `%s'..." msgstr "" -#: paper-score.cc:68 lily/paper-score.cc:68 +#: paper-score.cc:68 lily/paper-score.cc:68 lily/paper-score.cc:67 #, c-format msgid "Element count %d (spanners %d) " msgstr "" -#: paper-score.cc:72 lily/paper-score.cc:72 +#: paper-score.cc:72 lily/paper-score.cc:72 lily/paper-score.cc:71 msgid "Preprocessing graphical objects..." msgstr "" #: parse-scm.cc:77 lily/parse-scm.cc:77 lily/parse-scm.cc:84 +#: lily/parse-scm.cc:82 msgid "GUILE signaled an error for the expression beginning here" msgstr "" #: percent-repeat-engraver.cc:110 lily/percent-repeat-engraver.cc:110 -#: lily/percent-repeat-engraver.cc:106 +#: lily/percent-repeat-engraver.cc:106 lily/percent-repeat-engraver.cc:101 msgid "Don't know how to handle a percent repeat of this length." msgstr "" #: percent-repeat-engraver.cc:170 lily/percent-repeat-engraver.cc:170 -#: lily/percent-repeat-engraver.cc:166 +#: lily/percent-repeat-engraver.cc:166 lily/percent-repeat-engraver.cc:161 msgid "unterminated percent repeat" msgstr "" #: percent-repeat-iterator.cc:53 lily/percent-repeat-iterator.cc:53 +#: lily/percent-repeat-iterator.cc:54 msgid "no one to print a percent" msgstr "" @@ -1387,41 +1463,47 @@ msgstr "" msgid "Track ... " msgstr "" -#: performance.cc:93 lily/performance.cc:93 +#: performance.cc:93 lily/performance.cc:93 lily/performance.cc:92 msgid "Creator: " msgstr "" -#: performance.cc:113 lily/performance.cc:113 +#: performance.cc:113 lily/performance.cc:113 lily/performance.cc:112 msgid "at " msgstr "" -#: performance.cc:167 lily/performance.cc:167 +#: performance.cc:167 lily/performance.cc:167 lily/performance.cc:166 #, c-format msgid "MIDI output to `%s'..." msgstr "" #: phrasing-slur-engraver.cc:99 slur-engraver.cc:114 #: lily/phrasing-slur-engraver.cc:99 lily/slur-engraver.cc:114 +#: lily/slur-engraver.cc:113 msgid "unterminated slur" msgstr "" #: piano-pedal-engraver.cc:237 lily/piano-pedal-engraver.cc:237 +#: lily/piano-pedal-engraver.cc:232 msgid "Need 3 strings for piano pedals. No pedal made. " msgstr "" #: piano-pedal-engraver.cc:252 piano-pedal-engraver.cc:267 #: piano-pedal-performer.cc:82 lily/piano-pedal-engraver.cc:252 #: lily/piano-pedal-engraver.cc:267 lily/piano-pedal-performer.cc:82 +#: lily/piano-pedal-engraver.cc:247 lily/piano-pedal-engraver.cc:262 +#: lily/piano-pedal-performer.cc:80 #, c-format msgid "can't find start of piano pedal: `%s'" msgstr "" #: piano-pedal-engraver.cc:318 lily/piano-pedal-engraver.cc:318 +#: lily/piano-pedal-engraver.cc:313 #, c-format msgid "can't find start of piano pedal bracket: `%s'" msgstr "" #: property-iterator.cc:94 lily/property-iterator.cc:94 +#: lily/property-iterator.cc:95 #, c-format msgid "Not a grob name, `%s'." msgstr "" @@ -1432,25 +1514,27 @@ msgid "No events found for \\quote" msgstr "" #: quote-iterator.cc:183 lily/quote-iterator.cc:199 lily/quote-iterator.cc:204 -#: lily/quote-iterator.cc:208 +#: lily/quote-iterator.cc:208 lily/quote-iterator.cc:251 #, c-format msgid "In quotation: junking event %s" msgstr "" #: relative-octave-check.cc:25 lily/relative-octave-check.cc:25 +#: lily/relative-octave-check.cc:26 msgid "Failed octave check, got: " msgstr "" -#: rest-collision.cc:132 lily/rest-collision.cc:132 +#: rest-collision.cc:132 lily/rest-collision.cc:132 lily/rest-collision.cc:133 msgid "rest direction not set. Cannot resolve collision." msgstr "" #: rest-collision.cc:144 rest-collision.cc:187 lily/rest-collision.cc:144 -#: lily/rest-collision.cc:187 +#: lily/rest-collision.cc:187 lily/rest-collision.cc:145 +#: lily/rest-collision.cc:188 msgid "too many colliding rests" msgstr "" -#: rest.cc:136 lily/rest.cc:136 +#: rest.cc:136 lily/rest.cc:136 lily/rest.cc:138 #, c-format msgid "rest `%s' not found" msgstr "" @@ -1509,24 +1593,24 @@ msgid "Install the ec-mftraced package from %s. Aborting" msgstr "" #: score.cc:100 score.cc:126 lily/score.cc:100 lily/score.cc:126 -#: lily/score.cc:102 lily/score.cc:128 +#: lily/score.cc:102 lily/score.cc:128 lily/score.cc:112 lily/score.cc:140 msgid "Need music in a score" msgstr "" -#: score.cc:116 lily/score.cc:116 lily/score.cc:118 +#: score.cc:116 lily/score.cc:116 lily/score.cc:118 lily/score.cc:130 msgid "Interpreting music... " msgstr "" -#: score.cc:137 lily/score.cc:137 lily/score.cc:139 +#: score.cc:137 lily/score.cc:137 lily/score.cc:139 lily/score.cc:151 #, c-format msgid "elapsed time: %.2f seconds" msgstr "" -#: score.cc:312 lily/score.cc:312 lily/score.cc:322 +#: score.cc:312 lily/score.cc:312 lily/score.cc:322 lily/score.cc:345 msgid "Already have music in score" msgstr "" -#: score.cc:313 lily/score.cc:313 lily/score.cc:323 +#: score.cc:313 lily/score.cc:313 lily/score.cc:323 lily/score.cc:346 msgid "This is the previous music" msgstr "" @@ -1540,11 +1624,14 @@ msgstr "" #. FIXME: #. FIXME: #. FIXME: +#. FIXME: #: script-engraver.cc:102 lily/script-engraver.cc:102 +#: lily/script-engraver.cc:101 msgid "Do not know how to interpret articulation: " msgstr "" #: script-engraver.cc:103 lily/script-engraver.cc:103 +#: lily/script-engraver.cc:102 msgid "Scheme encoding: " msgstr "" @@ -1558,32 +1645,35 @@ msgstr "" #. this shouldn't happen, but let's continue anyway. #. this shouldn't happen, but let's continue anyway. #. this shouldn't happen, but let's continue anyway. +#. this shouldn't happen, but let's continue anyway. #: separation-item.cc:53 separation-item.cc:97 lily/separation-item.cc:53 -#: lily/separation-item.cc:97 +#: lily/separation-item.cc:97 lily/separation-item.cc:54 +#: lily/separation-item.cc:98 msgid "Separation_item: I've been drinking too much" msgstr "" #: simple-spacer.cc:489 lily/simple-spacer.cc:489 lily/simple-spacer.cc:484 -#: lily/simple-spacer.cc:499 +#: lily/simple-spacer.cc:499 lily/simple-spacer.cc:506 #, c-format msgid "No spring between column %d and next one" msgstr "" -#: slur-engraver.cc:124 lily/slur-engraver.cc:124 +#: slur-engraver.cc:124 lily/slur-engraver.cc:124 lily/slur-engraver.cc:123 msgid "No slur to end" msgstr "" -#: source-file.cc:50 lily/source-file.cc:50 +#: source-file.cc:50 lily/source-file.cc:50 lily/source-file.cc:47 #, c-format msgid "can't open file: `%s'" msgstr "" -#: source-file.cc:63 lily/source-file.cc:63 +#: source-file.cc:63 lily/source-file.cc:63 lily/source-file.cc:60 #, c-format msgid "Huh? Got %d, expected %d characters" msgstr "" #: spacing-spanner.cc:388 lily/spacing-spanner.cc:388 +#: lily/spacing-spanner.cc:386 #, c-format msgid "Global shortest duration is %s" msgstr "" @@ -1602,6 +1692,7 @@ msgstr "" #. FIXME: #. FIXME: #. FIXME: +#. FIXME: #: stem-engraver.cc:125 lily/stem-engraver.cc:125 #, c-format msgid "Adding note head to incompatible stem (type = %d)" @@ -1611,7 +1702,7 @@ msgstr "" msgid "Don't you want polyphonic voices instead?" msgstr "" -#: stem.cc:126 lily/stem.cc:126 +#: stem.cc:126 lily/stem.cc:126 lily/stem.cc:125 msgid "Weird stem size; check for narrow beams" msgstr "" @@ -1625,29 +1716,32 @@ msgstr "" msgid "flag stroke `%s' not found" msgstr "" -#: system.cc:134 lily/system.cc:134 +#: system.cc:134 lily/system.cc:134 lily/system.cc:149 #, c-format msgid "Element count %d." msgstr "" -#: system.cc:272 lily/system.cc:272 +#: system.cc:272 lily/system.cc:272 lily/system.cc:302 #, c-format msgid "Grob count %d" msgstr "" -#: system.cc:286 lily/system.cc:286 +#: system.cc:286 lily/system.cc:286 lily/system.cc:320 msgid "Calculating line breaks..." msgstr "" #: text-spanner-engraver.cc:63 lily/text-spanner-engraver.cc:63 +#: lily/text-spanner-engraver.cc:62 msgid "can't find start of text spanner" msgstr "" #: text-spanner-engraver.cc:77 lily/text-spanner-engraver.cc:77 +#: lily/text-spanner-engraver.cc:76 msgid "already have a text spanner" msgstr "" #: text-spanner-engraver.cc:139 lily/text-spanner-engraver.cc:139 +#: lily/text-spanner-engraver.cc:138 msgid "unterminated text spanner" msgstr "" @@ -1671,6 +1765,8 @@ msgstr "" #. more of a programming error. #. Not using ngettext's plural feature here, as this message is #. more of a programming error. +#. Not using ngettext's plural feature here, as this message is +#. more of a programming error. #: tfm-reader.cc:108 lily/tfm-reader.cc:108 #, c-format msgid "TFM header of `%s' has only %u word (s)" @@ -1681,16 +1777,17 @@ msgstr "" msgid "%s: TFM file has %u parameters, which is more than the %u I can handle" msgstr "" -#: tfm.cc:73 lily/tfm.cc:73 +#: tfm.cc:73 lily/tfm.cc:73 lily/tfm.cc:71 #, c-format msgid "can't find ascii character: %d" msgstr "" -#: tie-engraver.cc:165 lily/tie-engraver.cc:173 +#: tie-engraver.cc:165 lily/tie-engraver.cc:173 lily/tie-engraver.cc:171 msgid "lonely tie" msgstr "" #: time-scaled-music-iterator.cc:24 lily/time-scaled-music-iterator.cc:24 +#: lily/time-scaled-music-iterator.cc:25 msgid "no one to print a tuplet start bracket" msgstr "" @@ -1744,7 +1841,13 @@ msgstr "" #. #. OTOH, Tristan Keuris writes 8/20 in his Intermezzi. #. +#. +#. Todo: should make typecheck? +#. +#. OTOH, Tristan Keuris writes 8/20 in his Intermezzi. +#. #: time-signature-engraver.cc:57 lily/time-signature-engraver.cc:57 +#: lily/time-signature-engraver.cc:55 #, c-format msgid "Found strange time signature %d/%d." msgstr "" @@ -1769,7 +1872,9 @@ msgstr "" #. (Here really with a warning!) #. If there is no such symbol, we default to the numbered style. #. (Here really with a warning!) -#: time-signature.cc:91 lily/time-signature.cc:91 +#. If there is no such symbol, we default to the numbered style. +#. (Here really with a warning!) +#: time-signature.cc:91 lily/time-signature.cc:91 lily/time-signature.cc:85 #, c-format msgid "time signature symbol `%s' not found; reverting to numbered style" msgstr "" @@ -1780,22 +1885,26 @@ msgid "unknown translator: `%s'" msgstr "" #: trill-spanner-engraver.cc:71 lily/trill-spanner-engraver.cc:71 +#: lily/trill-spanner-engraver.cc:70 msgid "can't find start of trill spanner" msgstr "" #: trill-spanner-engraver.cc:85 lily/trill-spanner-engraver.cc:85 +#: lily/trill-spanner-engraver.cc:84 msgid "already have a trill spanner" msgstr "" #: trill-spanner-engraver.cc:145 lily/trill-spanner-engraver.cc:145 +#: lily/trill-spanner-engraver.cc:144 msgid "unterminated trill spanner" msgstr "" -#: tuplet-bracket.cc:448 lily/tuplet-bracket.cc:447 +#: tuplet-bracket.cc:448 lily/tuplet-bracket.cc:447 lily/tuplet-bracket.cc:451 msgid "Killing tuplet bracket across linebreak." msgstr "" #: vaticana-ligature-engraver.cc:342 lily/vaticana-ligature-engraver.cc:342 +#: lily/vaticana-ligature-engraver.cc:341 #, c-format msgid "" "ignored prefix (es) `%s' of this head according to restrictions of the " @@ -1808,22 +1917,24 @@ msgid "Vaticana_ligature_engraver: setting `spacing-increment = %f': ptr=%ul" msgstr "" #: vaticana-ligature.cc:92 lily/vaticana-ligature.cc:92 +#: lily/vaticana-ligature.cc:93 msgid "ascending vaticana style flexa" msgstr "" #: vaticana-ligature.cc:181 lily/vaticana-ligature.cc:181 +#: lily/vaticana-ligature.cc:182 msgid "Vaticana_ligature: zero join (delta_pitch == 0)" msgstr "" -#: volta-engraver.cc:141 lily/volta-engraver.cc:141 +#: volta-engraver.cc:141 lily/volta-engraver.cc:141 lily/volta-engraver.cc:140 msgid "No volta spanner to end" msgstr "" -#: volta-engraver.cc:152 lily/volta-engraver.cc:152 +#: volta-engraver.cc:152 lily/volta-engraver.cc:152 lily/volta-engraver.cc:151 msgid "Already have a volta spanner. Stopping that one prematurely." msgstr "" -#: volta-engraver.cc:156 lily/volta-engraver.cc:156 +#: volta-engraver.cc:156 lily/volta-engraver.cc:156 lily/volta-engraver.cc:155 msgid "Also have a stopped spanner. Giving up." msgstr "" @@ -1973,34 +2084,124 @@ msgstr "" msgid "unterminated phrasing slur" msgstr "" -#: lily/score.cc:328 +#: lily/score.cc:328 lily/score.cc:351 msgid "Error found in this music expression. Ignoring it" msgstr "" -#: lily/lily-parser.cc:284 +#: lily/lily-parser.cc:284 lily/lily-parser.cc:291 #, c-format msgid "Processing `%s'" msgstr "" -#: lily/main.cc:128 +#: lily/main.cc:128 lily/main.cc:126 msgid "set option, use -e '(ly:option-usage)' for help" msgstr "" -#: lily/main.cc:139 +#: lily/main.cc:139 lily/main.cc:137 msgid "don't generate full pages" msgstr "" #. No version number or newline here. It confuses help2man. -#: lily/main.cc:194 +#. No version number or newline here. It confuses help2man. +#: lily/main.cc:194 lily/main.cc:192 #, c-format msgid "Usage: %s [OPTION]... FILE..." msgstr "" -#: lily/paper-outputter.cc:116 +#: lily/paper-outputter.cc:116 lily/paper-outputter.cc:113 #, c-format msgid "Layout output to `%s'..." msgstr "" -#: lily/performance.cc:50 +#: lily/performance.cc:50 lily/performance.cc:49 msgid "Track..." msgstr "" + +#: lily/coherent-ligature-engraver.cc:84 +#, c-format +msgid "gotcha: ptr =%ul" +msgstr "" + +#: lily/coherent-ligature-engraver.cc:96 +#, c-format +msgid "distance =%f" +msgstr "" + +#: lily/coherent-ligature-engraver.cc:139 +#, c-format +msgid "" +"Coherent_ligature_engraver: setting `spacing-increment = 0.01': ptr =%ul" +msgstr "" + +#: lily/kpath.cc:55 +#, c-format +msgid "kpathsea can not find AFM file `%s'" +msgstr "" + +#: lily/context.cc:151 +#, c-format +msgid "Cannot find or create new `%s'" +msgstr "" + +#: lily/score-engraver.cc:106 lily/score-engraver.cc:115 +#: lily/score-engraver.cc:117 +#, c-format +msgid "cannot find `%s'" +msgstr "" + +#: lily/score-engraver.cc:108 +msgid "Music font has not been installed properly.\n" +msgstr "" + +#: lily/score-engraver.cc:109 +#, c-format +msgid "Search path `%s'\n" +msgstr "" + +#: lily/score-engraver.cc:110 +msgid "Aborting" +msgstr "" + +#: lily/score-engraver.cc:119 +#, c-format +msgid "Install the ec-fonts-mftraced package from: %s." +msgstr "" + +#: lily/score-engraver.cc:122 +msgid "Aborting." +msgstr "" + +#: lily/vaticana-ligature-engraver.cc:571 +#, c-format +msgid "Vaticana_ligature_engraver: setting `spacing-increment = %f': ptr =%ul" +msgstr "" + +#: lily/modified-font-metric.cc:39 +#, c-format +msgid "conflicting metric coding (%s) and font_encoding (%s)" +msgstr "" + +#: lily/open-type-font.cc:32 +#, c-format +msgid "Cannot allocate %d bytes" +msgstr "" + +#: lily/open-type-font.cc:37 +#, c-format +msgid "Could not load %s font table" +msgstr "" + +#: lily/open-type-font.cc:91 +#, c-format +msgid "Unsupported font format: %s" +msgstr "" + +#: lily/open-type-font.cc:95 +#, c-format +msgid "Unknown error: %d reading font file: %s" +msgstr "" + +#: lily/open-type-font.cc:150 +#, c-format +msgid "FT_Get_Glyph_Name() returned error: %d" +msgstr "" diff --git a/scm/bass-figure.scm b/scm/bass-figure.scm index 104793b86f..a44f5216c0 100644 --- a/scm/bass-figure.scm +++ b/scm/bass-figure.scm @@ -1,34 +1,36 @@ -;;;; figured bass support ... +;;;; bass-figure.scm -- implement Scheme output routines for TeX +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys + (ly:add-interface -'bass-figure-interface + 'bass-figure-interface "A bass figure, including bracket" '()) - - (define-public (format-bass-figure figures context grob) ;; TODO: support slashed numerals here. (define (fig-to-markup fig-music) - (let* - ((align-accs (eq? #t (ly:context-property context 'alignBassFigureAccidentals))) - (fig (ly:music-property fig-music 'figure)) - (acc (ly:music-property fig-music 'alteration)) - (acc-markup #f) - (fig-markup - (if (markup? fig) - fig - (if align-accs (make-simple-markup " ") - (if (not (eq? acc '())) - (make-simple-markup "") - (make-strut-markup))) - ))) + (let* ((align-accs + (eq? #t (ly:context-property context 'alignBassFigureAccidentals))) + (fig (ly:music-property fig-music 'figure)) + (acc (ly:music-property fig-music 'alteration)) + (acc-markup #f) + (fig-markup + (if (markup? fig) + fig + (if align-accs (make-simple-markup " ") + (if (not (eq? acc '())) + (make-simple-markup "") + (make-strut-markup)))))) (if (number? acc) (make-line-markup (list fig-markup (alteration->text-accidental-markup acc))) - fig-markup) - )) + fig-markup))) (define (filter-brackets i figs acc) (cond @@ -49,5 +51,4 @@ (set! (ly:grob-property grob 'text) (make-bracketed-y-column-markup (sort (filter-brackets 0 figures '()) <) - (map fig-to-markup figures) - ))) + (map fig-to-markup figures)))) diff --git a/scm/beam.scm b/scm/beam.scm index 7ab4637d41..87739bbbcd 100644 --- a/scm/beam.scm +++ b/scm/beam.scm @@ -31,9 +31,7 @@ ;; -; -; DOCME: what goes into this func, what comes out. - +;; DOCME: what goes into this func, what comes out. (define (dir-compare up down) (sign (- up down))) @@ -46,9 +44,7 @@ (let ((maj (dir-compare (car count) (cdr count)))) (if (not (= maj 0)) maj - (beam-dir-median count total)) - )) - + (beam-dir-median count total)))) (define-public (beam-dir-mean count total) (dir-compare (car total) (cdr total))) @@ -58,45 +54,39 @@ (> (cdr count) 0)) (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count))) (dir-compare (car count) (cdr count)))) - (define ((check-beam-quant posl posr) beam) "Check whether BEAM has POSL and POSR quants. POSL are (POSITION . QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter) " - (let* - ((posns (ly:grob-property beam 'positions)) - (thick (ly:grob-property beam 'thickness)) - (layout (ly:grob-layout beam)) - (lthick (ly:output-def-lookup layout 'linethickness)) - (staff-thick lthick) ; fixme. - (quant->coord (lambda (p q) - (if (= 2 (abs q)) - (+ p (/ q 4.0)) - (+ p (- (* 0.5 q thick) (* 0.5 q lthick)))))) - (want-l (quant->coord (car posl) (cdr posl))) - (want-r (quant->coord (car posr) (cdr posr))) - (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3)))) + (let* ((posns (ly:grob-property beam 'positions)) + (thick (ly:grob-property beam 'thickness)) + (layout (ly:grob-layout beam)) + (lthick (ly:output-def-lookup layout 'linethickness)) + (staff-thick lthick) ; fixme. + (quant->coord (lambda (p q) + (if (= 2 (abs q)) + (+ p (/ q 4.0)) + (+ p (- (* 0.5 q thick) (* 0.5 q lthick)))))) + (want-l (quant->coord (car posl) (cdr posl))) + (want-r (quant->coord (car posr) (cdr posr))) + (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3)))) (if (or (not (almost-equal want-l (car posns))) (not (almost-equal want-r (cdr posns)))) (begin (ly:warn - "Error in beam quanting found. Want (~S,~S) found (~S)." - want-l want-r posns ) + "Error in beam quanting found. Want (~S,~S) found (~S)." + want-l want-r posns ) (set! (ly:grob-property beam 'quant-score) (format "(~S,~S)" want-l want-r))) - (set! (ly:grob-property beam 'quant-score) "") - - - ))) + (set! (ly:grob-property beam 'quant-score) "")))) (define ((check-beam-slope-sign comparison) beam) "Check whether the slope of BEAM is correct wrt. COMPARISON." - (let* - ((posns (ly:grob-property beam 'positions)) - (slope-sign (- (cdr posns) (car posns))) - (correct (comparison slope-sign 0))) + (let* ((posns (ly:grob-property beam 'positions)) + (slope-sign (- (cdr posns) (car posns))) + (correct (comparison slope-sign 0))) (if (not correct) @@ -105,28 +95,22 @@ (procedure-name comparison) slope-sign) (set! (ly:grob-property beam 'quant-score) (format "~S 0" (procedure-name comparison) ))) - (set! (ly:grob-property beam 'quant-score) "") + (set! (ly:grob-property beam 'quant-score) "")))) - - ))) - (define-public (check-quant-callbacks l r) (list Beam::least_squares - Beam::check_concave - Beam::slope_damping - Beam::shift_region_to_valid - Beam::quanting - (check-beam-quant l r) - )) + Beam::check_concave + Beam::slope_damping + Beam::shift_region_to_valid + Beam::quanting + (check-beam-quant l r))) + - (define-public (check-slope-callbacks comparison) (list Beam::least_squares - Beam::check_concave - Beam::slope_damping - Beam::shift_region_to_valid - Beam::quanting - (check-beam-slope-sign comparison) - )) + Beam::check_concave + Beam::slope_damping + Beam::shift_region_to_valid + Beam::quanting + (check-beam-slope-sign comparison))) - diff --git a/scm/chord-generic-names.scm b/scm/chord-generic-names.scm index c51b8c7438..7a1ff18932 100644 --- a/scm/chord-generic-names.scm +++ b/scm/chord-generic-names.scm @@ -1,7 +1,7 @@ ;;;; chord-generic-names.scm -- Compile chord names ;;;; ;;;; source file of the GNU LilyPond music typesetter -;;;; +;;;; ;;;; (c) 2003-2004 Jan Nieuwenhuizen @@ -24,15 +24,11 @@ (define-public (banter-chord-names pitches bass inversion context) (ugh-compat-double-plus-new-chord->markup - 'banter pitches bass inversion context '()) - ) - + 'banter pitches bass inversion context '())) (define-public (jazz-chord-names pitches bass inversion context) (ugh-compat-double-plus-new-chord->markup - 'jazz pitches bass inversion context '()) - ) - + 'jazz pitches bass inversion context '())) (define-public (ugh-compat-double-plus-new-chord->markup style pitches bass inversion context options) @@ -45,14 +41,13 @@ BASS and INVERSION are lily pitches. OPTIONS is an alist-alist (see input/test/dpncnt.ly). " - (define (step-nr pitch) (let* ((pitch-nr (+ (* 7 (ly:pitch-octave pitch)) (ly:pitch-notename pitch))) (root-nr (+ (* 7 (ly:pitch-octave (car pitches))) (ly:pitch-notename (car pitches))))) (+ 1 (- pitch-nr root-nr)))) - + (define (next-third pitch) (ly:pitch-transpose pitch (ly:make-pitch 0 2 (if (or (= (step-nr pitch) 3) @@ -64,7 +59,7 @@ input/test/dpncnt.ly). (normalized-pitch (ly:pitch-transpose pitch diff)) (alteration (ly:pitch-alteration normalized-pitch))) (if (= (step-nr pitch) 7) (+ alteration SEMI-TONE) alteration))) - + (define (pitch-unalter pitch) (let ((alteration (step-alteration pitch))) (if (= alteration 0) @@ -89,7 +84,7 @@ input/test/dpncnt.ly). ((NATURAL) "") ((SHARP) "+") ((DOUBLE-SHARP) "++")))))) - + (define (step->markup-accidental pitch) (make-line-markup (list (accidental->markup (step-alteration pitch)) @@ -102,16 +97,16 @@ input/test/dpncnt.ly). (list (ly:context-property context 'majorSevenSymbol)) (list (accidental->markup (step-alteration pitch)) (make-simple-markup (number->string (step-nr pitch))))))) - + ;; tja, kennok (define (make-sub->markup step->markup) (lambda (pitch) (make-line-markup (list (make-simple-markup "no") (step->markup pitch))))) - + (define (step-based-sub->markup step->markup pitch) (make-line-markup (list (make-simple-markup "no") (step->markup pitch)))) - + (define (get-full-list pitch) (if (<= (step-nr pitch) (step-nr (last pitches))) (cons pitch (get-full-list (next-third pitch))) @@ -144,7 +139,7 @@ input/test/dpncnt.ly). (partial-match (cdr exceptions)))) #f)) - (if #f (begin + (if #f (begin (write-me "pitches: " pitches))) (let* ((full-exceptions (ly:context-property context 'chordNameExceptionsFull)) @@ -167,7 +162,7 @@ input/test/dpncnt.ly). ;; (all pitches) (all (append (take full (length partial-pitches) ) (drop pitches (length partial-pitches) ))) - + (highest (last all)) (missing (list-minus full (map pitch-unalter all))) (consecutive (get-consecutive 1 all)) @@ -175,7 +170,7 @@ input/test/dpncnt.ly). (altered (filter step-even-or-altered? all)) (cons-alt (filter step-even-or-altered? consecutive)) (base (list-minus consecutive altered))) - + (if #f (begin (write-me "full:" full) @@ -195,7 +190,7 @@ input/test/dpncnt.ly). ;; root ;; + steps:altered + (highest all -- if not altered) ;; + subs:missing - + (let* ((root->markup (assoc-get 'root->markup options note-name->markup)) (step->markup (assoc-get @@ -206,11 +201,11 @@ input/test/dpncnt.ly). (step-based-sub->markup step->markup x)))) (sep (assoc-get 'separator options (make-simple-markup "/")))) - + (if (pair? full-markup) (make-line-markup (list (root->markup root) full-markup)) - + (make-line-markup (list (root->markup root) @@ -227,8 +222,8 @@ input/test/dpncnt.ly). (list partial-markup-suffix) (list (map sub->markup missing))) sep))))))) - - + + ((jazz) ;; root ;; + steps:(highest base) + cons-alt @@ -245,11 +240,11 @@ input/test/dpncnt.ly). 'separator options (make-simple-markup " "))) (add-prefix (assoc-get 'add-prefix options (make-simple-markup " add")))) - + (if (pair? full-markup) (make-line-markup (list (root->markup root) full-markup)) - + (make-line-markup (list (root->markup root) @@ -257,11 +252,11 @@ input/test/dpncnt.ly). (make-normal-size-super-markup (make-line-markup (list - + ;; kludge alert: omit <= 5 ;;(markup-join (map step->markup ;; (cons (last base) cons-alt)) sep) - + ;; This fixes: ;; c C5 -> C ;; c:2 C5 2 -> C2 @@ -273,11 +268,11 @@ input/test/dpncnt.ly). (if (> (step-nr tb) 5) (cons tb cons-alt) cons-alt))) sep) - + (if (pair? rest) add-prefix empty-markup) (markup-join (map step->markup rest) sep) partial-markup-suffix)))))))) - + (else empty-markup)))) diff --git a/scm/chord-ignatzek-names.scm b/scm/chord-ignatzek-names.scm index 1063f5c76a..a3c3aa1c8f 100644 --- a/scm/chord-ignatzek-names.scm +++ b/scm/chord-ignatzek-names.scm @@ -35,38 +35,25 @@ #f (if (= (- x 1) (ly:pitch-steps (car ps))) (car ps) - (get-step x (cdr ps))) - )) + (get-step x (cdr ps))))) (define (replace-step p ps) "Copy PS, but replace the step of P in PS." (if (null? ps) '() - (let* - ( - (t (replace-step p (cdr ps))) - ) - + (let* ((t (replace-step p (cdr ps)))) (if (= (ly:pitch-steps p) (ly:pitch-steps (car ps))) (cons p t) - (cons (car ps) t) - )) - )) + (cons (car ps) t))))) (define (remove-step x ps) "Copy PS, but leave out the Xth step." (if (null? ps) '() - (let* - ( - (t (remove-step x (cdr ps))) - ) - + (let* ((t (remove-step x (cdr ps)))) (if (= (- x 1) (ly:pitch-steps (car ps))) t - (cons (car ps) t) - )) - )) + (cons (car ps) t))))) (define-public (ignatzek-chord-names @@ -79,14 +66,13 @@ '() (if (< (ly:pitch-steps (car ps)) (- x 1)) (remove-uptil-step x (cdr ps)) - ps) - )) + ps))) (define name-root (ly:context-property context 'chordRootNamer)) (define name-note (let ((nn (ly:context-property context 'chordNoteNamer))) (if (eq? nn '()) - ; replacing the next line with name-root gives guile-error...? -rz + ; replacing the next line with name-root gives guile-error...? -rz ;; apparently sequence of defines is equivalent to let, not let* ? -hwn (ly:context-property context 'chordRootNamer) @@ -104,43 +90,38 @@ alteration-pitches addition-pitches suffix-modifiers - bass-pitch - ) + bass-pitch) "Format for the given (lists of) pitches. This is actually more work than classifying the pitches." (define (filter-main-name p) - "The main name: don't print anything for natural 5 or 3." - (if - (or (not (ly:pitch? p)) - (and (is-natural-alteration? p) - (or (= (pitch-step p) 5) - (= (pitch-step p) 3)))) - '() - (list (name-step p)) - )) + "The main name: don't print anything for natural 5 or 3." + (if + (or (not (ly:pitch? p)) + (and (is-natural-alteration? p) + (or (= (pitch-step p) 5) + (= (pitch-step p) 3)))) + '() + (list (name-step p)))) (define (glue-word-to-step word x) (make-line-markup (list (make-simple-markup word) - (name-step x))) - ) + (name-step x)))) (define (suffix-modifier->markup mod) (if (or (= 4 (pitch-step mod)) (= 2 (pitch-step mod))) (glue-word-to-step "sus" mod) - (glue-word-to-step "huh" mod) - )) + (glue-word-to-step "huh" mod))) (define (prefix-modifier->markup mod) (if (and (= 3 (pitch-step mod)) (= FLAT (ly:pitch-alteration mod))) (make-simple-markup "m") - (make-simple-markup "huh") - )) + (make-simple-markup "huh"))) (define (filter-alterations alters) "Filter out uninteresting (natural) pitches from ALTERS." @@ -151,37 +132,28 @@ work than classifying the pitches." (if (null? alters) '() - (let* - ( - (l (filter altered? alters)) - (lp (last-pair alters)) - ) + (let* ((lst (filter altered? alters)) + (lp (last-pair alters))) ;; we want the highest also if unaltered (if (and (not (altered? (car lp))) (> (pitch-step (car lp)) 5)) - (append l (last-pair alters)) - l) - ))) + (append lst (last-pair alters)) + lst)))) (define (name-step pitch) (define (step-alteration pitch) (- (ly:pitch-alteration pitch) - (natural-chord-alteration pitch) - )) + (natural-chord-alteration pitch))) - (let* - ( - (num-markup (make-simple-markup - (number->string (pitch-step pitch)))) - (args (list num-markup)) - (total (if (= (ly:pitch-alteration pitch) 0) - (if (= (pitch-step pitch) 7) - (list (ly:context-property context 'majorSevenSymbol)) - args) - (cons (accidental->markup (step-alteration pitch)) args) - )) - ) + (let* ((num-markup (make-simple-markup + (number->string (pitch-step pitch)))) + (args (list num-markup)) + (total (if (= (ly:pitch-alteration pitch) 0) + (if (= (pitch-step pitch) 7) + (list (ly:context-property context 'majorSevenSymbol)) + args) + (cons (accidental->markup (step-alteration pitch)) args)))) (make-line-markup total))) @@ -205,8 +177,7 @@ work than classifying the pitches." add-markups) sep)) (base-stuff (if (ly:pitch? bass-pitch) (list sep (name-note bass-pitch)) - '())) - ) + '()))) (set! base-stuff (append @@ -214,99 +185,91 @@ work than classifying the pitches." (markup-join prefixes sep) (make-super-markup to-be-raised-stuff)) base-stuff)) - (make-line-markup base-stuff) - - )) + (make-line-markup base-stuff))) (define (ignatzek-format-exception root exception-markup bass-pitch) - (make-line-markup - `( - ,(name-root root) - ,exception-markup - . - ,(if (ly:pitch? bass-pitch) + (make-line-markup + `( + ,(name-root root) + ,exception-markup + . + ,(if (ly:pitch? bass-pitch) (list (ly:context-property context 'chordNameSeparator) (name-note bass-pitch)) - '())))) + '())))) - (let* - ( - (root (car in-pitches)) - (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches))) - (exceptions (ly:context-property context 'chordNameExceptions)) - (exception (assoc-get pitches exceptions)) - (prefixes '()) - (suffixes '()) - (add-steps '()) - (main-name #f) - (bass-note - (if (ly:pitch? inversion) - inversion - bass)) - (alterations '()) - ) - + (let* ((root (car in-pitches)) + (pitches (map (lambda (x) (ly:pitch-diff x root)) (cdr in-pitches))) + (exceptions (ly:context-property context 'chordNameExceptions)) + (exception (assoc-get pitches exceptions)) + (prefixes '()) + (suffixes '()) + (add-steps '()) + (main-name #f) + (bass-note + (if (ly:pitch? inversion) + inversion + bass)) + (alterations '())) + (if exception - (ignatzek-format-exception root exception bass-note) - - (begin ; no exception. - - ; handle sus4 and sus2 suffix: if there is a 3 together with - ; sus2 or sus4, then we explicitly say add3. - (map - (lambda (j) - (if (get-step j pitches) - (begin - (if (get-step 3 pitches) - (begin - (set! add-steps (cons (get-step 3 pitches) add-steps)) - (set! pitches (remove-step 3 pitches)) - )) - (set! suffixes (cons (get-step j pitches) suffixes)) - ) - ) - ) '(2 4) ) + (ignatzek-format-exception root exception bass-note) + + (begin ; no exception. + + ; handle sus4 and sus2 suffix: if there is a 3 together with + ; sus2 or sus4, then we explicitly say add3. + (map + (lambda (j) + (if (get-step j pitches) + (begin + (if (get-step 3 pitches) + (begin + (set! add-steps (cons (get-step 3 pitches) add-steps)) + (set! pitches (remove-step 3 pitches)))) + (set! suffixes (cons (get-step j pitches) suffixes)))) + ) '(2 4) ) - ;; do minor-3rd modifier. - (if (and (get-step 3 pitches) - (= (ly:pitch-alteration (get-step 3 pitches)) FLAT)) - (set! prefixes (cons (get-step 3 pitches) prefixes))) - - ;; lazy bum. Should write loop. - (cond - ((get-step 7 pitches) (set! main-name (get-step 7 pitches))) - ((get-step 6 pitches) (set! main-name (get-step 6 pitches))) - ((get-step 5 pitches) (set! main-name (get-step 5 pitches))) - ((get-step 4 pitches) (set! main-name (get-step 4 pitches))) - ((get-step 3 pitches) (set! main-name (get-step 3 pitches)))) + ;; do minor-3rd modifier. + (if (and (get-step 3 pitches) + (= (ly:pitch-alteration (get-step 3 pitches)) FLAT)) + (set! prefixes (cons (get-step 3 pitches) prefixes))) + + ;; lazy bum. Should write loop. + (cond + ((get-step 7 pitches) (set! main-name (get-step 7 pitches))) + ((get-step 6 pitches) (set! main-name (get-step 6 pitches))) + ((get-step 5 pitches) (set! main-name (get-step 5 pitches))) + ((get-step 4 pitches) (set! main-name (get-step 4 pitches))) + ((get-step 3 pitches) (set! main-name (get-step 3 pitches)))) - (let* ((3-diff? (lambda (x y) - (= (- (pitch-step y) (pitch-step x)) 2))) - (split (split-at-predicate - 3-diff? (remove-uptil-step 5 pitches)))) - (set! alterations (append alterations (car split))) - (set! add-steps (append add-steps (cdr split))) - (set! alterations (delq main-name alterations)) - (set! add-steps (delq main-name add-steps)) + (let* ((3-diff? (lambda (x y) + (= (- (pitch-step y) (pitch-step x)) 2))) + (split (split-at-predicate + 3-diff? (remove-uptil-step 5 pitches)))) + (set! alterations (append alterations (car split))) + (set! add-steps (append add-steps (cdr split))) + (set! alterations (delq main-name alterations)) + (set! add-steps (delq main-name add-steps)) - ;; chords with natural (5 7 9 11 13) or leading subsequence. - ;; etc. are named by the top pitch, without any further - ;; alterations. - (if (and - (ly:pitch? main-name) - (= 7 (pitch-step main-name)) - (is-natural-alteration? main-name) - (pair? (remove-uptil-step 7 alterations)) - (reduce (lambda (x y) (and x y)) #t - (map is-natural-alteration? alterations))) - (begin - (set! main-name (last alterations)) - (set! alterations '()))) + ;; chords with natural (5 7 9 11 13) or leading subsequence. + ;; etc. are named by the top pitch, without any further + ;; alterations. + (if (and + (ly:pitch? main-name) + (= 7 (pitch-step main-name)) + (is-natural-alteration? main-name) + (pair? (remove-uptil-step 7 alterations)) + (reduce (lambda (x y) (and x y)) #t + (map is-natural-alteration? alterations))) + (begin + (set! main-name (last alterations)) + (set! alterations '()))) - (ignatzek-format-chord-name - root prefixes main-name alterations add-steps suffixes bass-note)))))) + (ignatzek-format-chord-name + root prefixes main-name alterations add-steps suffixes bass-note)))))) diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 506cbe8fa8..e59c01574e 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -17,19 +17,16 @@ "Stencil as markup" stil) - (def-markup-command (score layout props score) (ly:score?) "Inline an image of music." - (let* - ((systems (ly:score-embedded-format score layout))) + (let* ((systems (ly:score-embedded-format score layout))) (if (= 0 (vector-length systems)) (begin (ly:warn "No systems found in \\score markup. Did you forget \\layout?") empty-markup) (begin - (let* - ((stencil (ly:paper-system-stencil (vector-ref systems 0)))) + (let* ((stencil (ly:paper-system-stencil (vector-ref systems 0)))) (ly:stencil-align-to! stencil Y CENTER) stencil))))) @@ -37,13 +34,13 @@ (def-markup-command (simple layout props str) (string?) "A simple text string; @code{\\markup @{ foo @}} is equivalent with @code{\\markup @{ \\simple #\"foo\" @}}." - (interpret-markup layout props str)) + (interpret-markup layout props str)) (def-markup-command (encoded-simple layout props sym str) (symbol? string?) "A text string, encoded with encoding @var{sym}. See @usermanref{Text encoding} for more information." (Text_interface::interpret_string layout - props sym str)) + props sym str)) ;; TODO: use font recoding. @@ -100,8 +97,8 @@ gsave /ecrm10 findfont " (let* ((orig-stencils - (map (lambda (x) (interpret-markup layout props x)) - markups)) + (map (lambda (x) (interpret-markup layout props x)) + markups)) (stencils (map (lambda (stc) (if (ly:stencil-empty? stc) @@ -147,8 +144,7 @@ determines the space between each markup in @var{args}." (def-markup-command (fromproperty layout props symbol) (symbol?) "Read the @var{symbol} from property settings, and produce a stencil from the markup contained within. If @var{symbol} is not defined, it returns an empty markup" - (let* - ((m (chain-assoc-get symbol props))) + (let* ((m (chain-assoc-get symbol props))) (if (markup? m) (interpret-markup layout props m) @@ -158,23 +154,20 @@ determines the space between each markup in @var{args}." (def-markup-command (on-the-fly layout props procedure arg) (symbol? markup?) "Apply the @var{procedure} markup command to @var{arg}. @var{procedure} should take a single argument." - (let* - ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg)))) + (let* ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg)))) (set-object-property! anonymous-with-signature - 'markup-signature - (list markup?)) + 'markup-signature + (list markup?)) - (interpret-markup layout props (list anonymous-with-signature arg)) - )) + (interpret-markup layout props (list anonymous-with-signature arg)))) (def-markup-command (combine layout props m1 m2) (markup? markup?) "Print two markups on top of each other." - (let* - ((s1 (interpret-markup layout props m1)) - (s2 (interpret-markup layout props m2))) - + (let* ((s1 (interpret-markup layout props m1)) + (s2 (interpret-markup layout props m2))) + (ly:stencil-add s1 s2))) (def-markup-command (finger layout props arg) (markup?) @@ -258,9 +251,9 @@ some punctuation. It doesn't have any letters. " "Set @code{font-shape} to @code{caps}." (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg)) -;(def-markup-command (latin-i layout props arg) (markup?) -; "TEST latin1 encoding." -; (interpret-markup layout (prepend-alist-chain 'font-shape 'latin1 props) arg)) + ;(def-markup-command (latin-i layout props arg) (markup?) + ; "TEST latin1 encoding." + ; (interpret-markup layout (prepend-alist-chain 'font-shape 'latin1 props) arg)) (def-markup-command (dynamic layout props arg) (markup?) "Use the dynamic font. This font only contains @b{s}, @b{f}, @b{m}, @@ -334,7 +327,7 @@ of the @code{#'direction} layout property." (stack-lines (if (number? dir) dir -1) 0.0 - (chain-assoc-get 'baseline-skip props) + (chain-assoc-get 'baseline-skip props) (map (lambda (x) (interpret-markup layout props x)) args)))) (def-markup-command (center-align layout props args) (markup-list?) @@ -366,8 +359,7 @@ of the @code{#'direction} layout property." (let* ((m (interpret-markup layout props arg))) (ly:stencil-align-to! m axis dir) - m - )) + m)) (def-markup-command (halign layout props dir arg) (number? markup?) "Set horizontal alignment. If @var{dir} is @code{-1}, then it is @@ -386,14 +378,14 @@ See @usermanref{The Feta font} for a complete listing of the possible glyphs. " (ly:font-get-glyph (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) - props)) + props)) glyph-name)) (def-markup-command (lookup layout props glyph-name) (string?) "Lookup a glyph by name." (ly:font-get-glyph (ly:paper-get-font layout props) - glyph-name)) + glyph-name)) (def-markup-command (char layout props num) (integer?) "Produce a single character, e.g. @code{\\char #65} produces the @@ -420,7 +412,7 @@ and/or @code{extra-offset} properties. " (ly:stencil-translate-axis (interpret-markup layout props arg) - amount Y)) + amount Y)) (def-markup-command (fraction layout props arg1 arg2) (markup? markup?) "Make a fraction of two markups." @@ -451,8 +443,8 @@ and/or @code{extra-offset} properties. " (size (chain-assoc-get 'font-size props 0)) (stem-length (* (magstep size) (max 3 (- log 1)))) (head-glyph (ly:font-get-glyph - font - (string-append "noteheads-s" (number->string (min log 2))))) + font + (string-append "noteheads-s" (number->string (min log 2))))) (stem-thickness 0.13) (stemy (* dir stem-length)) (attachx (if (> dir 0) @@ -460,11 +452,11 @@ and/or @code{extra-offset} properties. " 0)) (attachy (* dir 0.28)) (stem-glyph (and (> log 0) - (ly:round-filled-box - (cons attachx (+ attachx stem-thickness)) - (cons (min stemy attachy) - (max stemy attachy)) - (/ stem-thickness 3)))) + (ly:round-filled-box + (cons attachx (+ attachx stem-thickness)) + (cons (min stemy attachy) + (max stemy attachy)) + (/ stem-thickness 3)))) (dot (ly:font-get-glyph font "dots-dot")) (dotwid (interval-length (ly:stencil-extent dot X))) (dots (and (> dot-count 0) @@ -476,9 +468,9 @@ and/or @code{extra-offset} properties. " (flaggl (and (> log 2) (ly:stencil-translate (ly:font-get-glyph font - (string-append "flags-" - (if (> dir 0) "u" "d") - (number->string log))) + (string-append "flags-" + (if (> dir 0) "u" "d") + (number->string log))) (cons (+ attachx (/ stem-thickness 2)) stemy))))) (if flaggl (set! stem-glyph (ly:stencil-add flaggl stem-glyph))) @@ -489,13 +481,13 @@ and/or @code{extra-offset} properties. " (set! stem-glyph (ly:stencil-add (ly:stencil-translate-axis dots - (+ (if (and (> dir 0) (> log 2)) - (* 1.5 dotwid) - 0) - ;; huh ? why not necessary? - ;;(cdr (ly:stencil-extent head-glyph X)) - dotwid) - X) + (+ (if (and (> dir 0) (> log 2)) + (* 1.5 dotwid) + 0) + ;; huh ? why not necessary? + ;;(cdr (ly:stencil-extent head-glyph X)) + dotwid) + X) stem-glyph))) stem-glyph)) @@ -531,10 +523,10 @@ a shortened down stem." "Set @var{arg} in superscript with a normal font size." (ly:stencil-translate-axis (interpret-markup - layout - props arg) - (* 0.5 (chain-assoc-get 'baseline-skip props)) - Y)) + layout + props arg) + (* 0.5 (chain-assoc-get 'baseline-skip props)) + Y)) (def-markup-command (super layout props arg) (markup?) " @@ -576,7 +568,7 @@ that. " (ly:stencil-translate (interpret-markup layout props arg) - offset)) + offset)) (def-markup-command (sub layout props arg) (markup?) "Set @var{arg} in subscript." @@ -660,7 +652,7 @@ around the markup." (m (interpret-markup layout props arg))) (box-stencil m th pad))) -;FIXME: is this working? + ;FIXME: is this working? (def-markup-command (strut layout props) () "Create a box of the same height as the space in the current font." @@ -681,22 +673,19 @@ around the markup." (define (number->markletter-string n) "Double letters for big marks." - (let* - ((l (vector-length number->mark-letter-vector))) + (let* ((l (vector-length number->mark-letter-vector))) - (if (>= n l) - (string-append (number->markletter-string (1- (quotient n l))) - (number->markletter-string (remainder n l))) - (make-string 1 (vector-ref number->mark-letter-vector n))))) + (if (>= n l) + (string-append (number->markletter-string (1- (quotient n l))) + (number->markletter-string (remainder n l))) + (make-string 1 (vector-ref number->mark-letter-vector n))))) (def-markup-command (markletter layout props num) (integer?) - "Make a markup letter for @var{num}. The letters start with A to Z + "Make a markup letter for @var{num}. The letters start with A to Z (skipping I), and continues with double letters." - - (Text_interface::interpret_markup layout props (number->markletter-string num))) - - + + (Text_interface::interpret_markup layout props (number->markletter-string num))) (def-markup-command (bracketed-y-column layout props indices args) @@ -704,14 +693,14 @@ around the markup." "Make a column of the markups in @var{args}, putting brackets around the elements marked in @var{indices}, which is a list of numbers." - (define (sublist l start stop) + (define (sublist l start stop) (take (drop l start) (- (1+ stop) start)) ) (define (stencil-list-extent ss axis) (cons (apply min (map (lambda (x) (car (ly:stencil-extent x axis))) ss)) (apply max (map (lambda (x) (cdr (ly:stencil-extent x axis))) ss)))) - + (define (stack-stencils stencils bskip last-stencil) (cond ((null? stencils) '()) @@ -719,65 +708,49 @@ the elements marked in @var{indices}, which is a list of numbers." (cons (car stencils) (stack-stencils (cdr stencils) bskip (car stencils)))) (else - (let* - ((orig (car stencils)) - (dir (chain-assoc-get 'direction props DOWN)) - (new (ly:stencil-moved-to-edge last-stencil Y dir - orig - 0.1 bskip)) - ) + (let* ((orig (car stencils)) + (dir (chain-assoc-get 'direction props DOWN)) + (new (ly:stencil-moved-to-edge last-stencil Y dir + orig + 0.1 bskip))) - (cons new (stack-stencils (cdr stencils) bskip new)))) - )) + (cons new (stack-stencils (cdr stencils) bskip new)))))) (define (make-brackets stencils indices acc) (if (and stencils (pair? indices) (pair? (cdr indices))) - (let* - ((encl (sublist stencils (car indices) (cadr indices))) - (x-ext (stencil-list-extent encl X)) - (y-ext (stencil-list-extent encl Y)) - (thick 0.10) - (pad 0.35) - (protusion (* 2.5 thick)) - (lb - (ly:stencil-translate-axis - (ly:bracket Y y-ext thick protusion) - (- (car x-ext) pad) X)) - (rb (ly:stencil-translate-axis - (ly:bracket Y y-ext thick (- protusion)) - (+ (cdr x-ext) pad) X)) - ) + (let* ((encl (sublist stencils (car indices) (cadr indices))) + (x-ext (stencil-list-extent encl X)) + (y-ext (stencil-list-extent encl Y)) + (thick 0.10) + (pad 0.35) + (protusion (* 2.5 thick)) + (lb + (ly:stencil-translate-axis + (ly:bracket Y y-ext thick protusion) + (- (car x-ext) pad) X)) + (rb (ly:stencil-translate-axis + (ly:bracket Y y-ext thick (- protusion)) + (+ (cdr x-ext) pad) X))) (make-brackets stencils (cddr indices) (append (list lb rb) - acc))) + acc))) acc)) - (let* - ((stencils - (map (lambda (x) - (interpret-markup - layout - props - x)) args)) - (leading - (chain-assoc-get 'baseline-skip props)) - (stacked (stack-stencils stencils 1.25 #f)) - (brackets (make-brackets stacked indices '())) - ) + (let* ((stencils + (map (lambda (x) + (interpret-markup + layout + props + x)) args)) + (leading + (chain-assoc-get 'baseline-skip props)) + (stacked (stack-stencils stencils 1.25 #f)) + (brackets (make-brackets stacked indices '()))) (apply ly:stencil-add - (append stacked brackets) - ))) - - - - - - - - + (append stacked brackets)))) diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm index 9dfcc33de1..600989c549 100644 --- a/scm/define-music-types.scm +++ b/scm/define-music-types.scm @@ -5,14 +5,13 @@ ;;;; (c) 1998--2004 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen - ;; TODO: should link back into user manual. (define-public music-descriptions `( (AbsoluteDynamicEvent . ( - (description . "Creates a dynamic mark. + (description . "Creates a dynamic mark. Syntax: @var{note}@code{\\x}, where x is one of \\ppp, \\pp, \\p, \\mp, \\mf, \\f, \\ff, \\fff.") @@ -57,7 +56,7 @@ Syntax: ;; separate non articulation scripts (ArticulationEvent . ( - (description . "Adds an articulation marking to a note. + (description . "Adds an articulation marking to a note. Syntax: @var{note}@code{X}@code{Y}, where X is a direction (up @code{^}, down @@ -93,7 +92,7 @@ is an articulation (such as @code{-.}, @code{->}, @code{\\tenuto}, )) (BeamEvent . ( - (description . "Starts or stops a beam. + (description . "Starts or stops a beam. Syntax for manual control: c8-[ c c-] c8") @@ -102,7 +101,7 @@ c8-[ c c-] c8") )) (BreakEvent . ( - (description . "Create a line break, Syntax: \\break or page break, Syntax: \\pagebreak.") + (description . "Create a line break, Syntax: \\break or page break, Syntax: \\pagebreak.") (internal-class-name . "Event") (types . (general-music break-event event)) @@ -139,7 +138,7 @@ Syntax @code{\\translator Staff = @var{new-id}}.") (description . "A note that is part of a cluster.") (internal-class-name . "Event") - ; not a note-event, to ensure that Note_engraver doesn't eat it. + ; not a note-event, to ensure that Note_engraver doesn't eat it. (types . (general-music cluster-note-event melodic-event rhythmic-event event)) )) @@ -169,7 +168,7 @@ Syntax: @var{note}\\cr (internal-class-name . "Event") (types . (general-music dynamic-event decrescendo-event event)) )) - + (ExtenderEvent . ( (description . "Extend lyrics.") @@ -620,7 +619,7 @@ Syntax: @code{\\skip }@var{duration}.") (iterator-ctor . ,Simple_music_iterator::constructor) (types . (general-music event rhythmic-event skip-event)) )) - + (SkipEvent . ( (description . "Filler that takes up duration, but does not print anything. @@ -765,7 +764,6 @@ Syntax: @code{\\\\}") (define music-name-to-property-table (make-vector 59 '())) - ;; init hash table, ;; transport description to an object property. (set! @@ -774,8 +772,7 @@ Syntax: @code{\\\\}") (set-object-property! (car x) 'music-description (cdr (assq 'description (cdr x)))) - (let - ((l (cdr x))) + (let ((l (cdr x))) (set! l (assoc-set! l 'name (car x))) (set! l (assq-remove! l 'description)) (hashq-set! music-name-to-property-table (car x) l) @@ -806,7 +803,6 @@ and values. E.g: (set-props music-properties) m))) - (define-public (make-repeated-music name) (let* ((handle (assoc name '(("volta" . VoltaRepeatedMusic) ("unfold" . UnfoldedRepeatedMusic) diff --git a/scm/document-backend.scm b/scm/document-backend.scm index 72aa188d34..8a828b4a8c 100644 --- a/scm/document-backend.scm +++ b/scm/document-backend.scm @@ -1,62 +1,51 @@ -;;; backend-documentation-lib.scm -- Functions for backend documentation -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Han-Wen Nienhuys -;;; Jan Nieuwenhuizen - +;;;; backend-documentation-lib.scm -- Functions for backend documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define (interface-doc-string interface grob-description) - (let* - ((name (car interface)) - (desc (cadr interface)) - (props (sort (caddr interface) symboltexi - 'backend pr grob-description))) - (iprops (filter (lambda (x) (object-property x 'backend-internal) ) props)) - (uprops (filter (lambda (x) (not (object-property x 'backend-internal)) ) props)) - (user-propdocs (map docfunc uprops)) - (internal-propdocs (map docfunc iprops))) - - (string-append - desc - - (if (pair? uprops) - (string-append - "\n\n@unnumberedsubsubsec User settable properties:\n" - (description-list->texi user-propdocs)) - "") - - (if (pair? iprops) - (string-append - "\n\n@unnumberedsubsubsec Internal properties: \n" - (description-list->texi internal-propdocs) - ) - "") - ) - )) - + (let* ((name (car interface)) + (desc (cadr interface)) + (props (sort (caddr interface) symboltexi + 'backend pr grob-description))) + (iprops (filter (lambda (x) (object-property x 'backend-internal) ) props)) + (uprops (filter (lambda (x) (not (object-property x 'backend-internal)) ) props)) + (user-propdocs (map docfunc uprops)) + (internal-propdocs (map docfunc iprops))) + + (string-append + desc + + (if (pair? uprops) + (string-append + "\n\n@unnumberedsubsubsec User settable properties:\n" + (description-list->texi user-propdocs)) + "") + + (if (pair? iprops) + (string-append + "\n\n@unnumberedsubsubsec Internal properties: \n" + (description-list->texi internal-propdocs)) + "")))) (define iface->grob-table (make-vector 61 '())) ;; extract ifaces, and put grob into the hash table. (map (lambda (x) - (let* - ( - (metah (assoc 'meta (cdr x))) - (meta (cdr metah)) - (ifaces (cdr (assoc 'interfaces meta))) - ) + (let* ((metah (assoc 'meta (cdr x))) + (meta (cdr metah)) + (ifaces (cdr (assoc 'interfaces meta)))) (map (lambda (iface) (hashq-set! iface->grob-table iface (cons (car x) - (hashq-ref iface->grob-table iface '()) - ))) - ifaces) - )) + (hashq-ref iface->grob-table iface '())))) + ifaces))) all-grob-descriptions) ;; First level Interface description @@ -74,42 +63,34 @@ (sort (map symbol->string (hashq-ref iface->grob-table (car interface) '() )) - stringtexi alist) - (let* - ((uprops (filter (lambda (x) (not (object-property x 'backend-internal))) - (map car alist)))) + (let* ((uprops (filter (lambda (x) (not (object-property x 'backend-internal))) + (map car alist)))) (description-list->texi (map (lambda (y) (property->texi 'backend y alist)) - uprops) - ))) - + uprops)))) (define (grob-doc description) "Given a property alist DESCRIPTION, make a documentation node." - (let* - ((metah (assoc 'meta description)) - (meta (cdr metah)) - (name (cdr (assoc 'name meta))) -; (bla (display name)) - (ifaces (map lookup-interface (cdr (assoc 'interfaces meta)))) - (ifacedoc (map (lambda (iface) - (if (pair? iface) - (ref-ify (symbol->string (car iface))) - (error (format "Error making doc of ~s" name)))) - (reverse ifaces))) - (engravers (filter - (lambda (x) (engraver-makes-grob? name x)) all-engravers-list)) - (namestr (symbol->string name)) - (engraver-names (map symbol->string (map ly:translator-name engravers)))) + (let* ((metah (assoc 'meta description)) + (meta (cdr metah)) + (name (cdr (assoc 'name meta))) + ;; (bla (display name)) + (ifaces (map lookup-interface (cdr (assoc 'interfaces meta)))) + (ifacedoc (map (lambda (iface) + (if (pair? iface) + (ref-ify (symbol->string (car iface))) + (error (format "Error making doc of ~s" name)))) + (reverse ifaces))) + (engravers (filter + (lambda (x) (engraver-makes-grob? name x)) all-engravers-list)) + (namestr (symbol->string name)) + (engraver-names (map symbol->string (map ly:translator-name engravers)))) (make #:name namestr @@ -121,9 +102,7 @@ node." "\n\nStandard settings: \n\n" (grob-alist->texi description) "\n\nThis object supports the following interfaces: \n" - (human-listify ifacedoc) - )) - )) + (human-listify ifacedoc))))) (define (all-grobs-doc) (make @@ -135,17 +114,14 @@ node." (define interface-description-alist (hash-fold (lambda (key val prior) - (cons (cons key val) prior) - ) + (cons (cons key val) prior)) '() (ly:all-grob-interfaces))) (set! interface-description-alist (sort interface-description-alist alist #:name "Graphical Object Interfaces" #:desc "Building blocks of graphical objects" #:children - (map interface-doc interface-description-alist) - )) + (map interface-doc interface-description-alist))) (define (backend-properties-doc-string lst) - (let* - ( - (ps (sort (map symbol->string lst) stringtexi 'backend (string->symbol prop) '())) - ps)) - (texi (description-list->texi descs)) - ) + (let* ((ps (sort (map symbol->string lst) stringtexi 'backend (string->symbol prop) '())) ps)) + (texi (description-list->texi descs))) texi)) - -;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 ) +;;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 ) (define (backend-doc-node) (make #:name "Backend" @@ -197,12 +162,11 @@ node." (list (all-grobs-doc) (all-interfaces-doc) - (make - #:name "User backend properties" - #:desc "All tunable properties in a big list" - #:text (backend-properties-doc-string all-user-grob-properties)) - (make - #:name "Internal backend properties" - #:desc "All internal layout properties in a big list" - #:text (backend-properties-doc-string all-internal-grob-properties)) - ))) + (make + #:name "User backend properties" + #:desc "All tunable properties in a big list" + #:text (backend-properties-doc-string all-user-grob-properties)) + (make + #:name "Internal backend properties" + #:desc "All internal layout properties in a big list" + #:text (backend-properties-doc-string all-internal-grob-properties))))) diff --git a/scm/document-functions.scm b/scm/document-functions.scm index 85e6219f78..aecde75f22 100644 --- a/scm/document-functions.scm +++ b/scm/document-functions.scm @@ -31,19 +31,14 @@ '() (ly:get-all-function-documentation))) (define (all-scheme-functions-doc) - (let* - ((fdocs (map (lambda (x) - (document-scheme-function (car x) (cadr x) (cddr x)) - ) - all-scheme-functions) - ) - (sfdocs (sort fdocs string #:name "Scheme functions" #:desc "Primitive functions exported by LilyPond" #:text - (apply string-append sfdocs)) - )) + (apply string-append sfdocs)))) - -; (dump-node (all-scheme-functions-doc) (current-output-port) 0 ) +;; (dump-node (all-scheme-functions-doc) (current-output-port) 0 ) diff --git a/scm/document-markup.scm b/scm/document-markup.scm index 7478a70dc5..65f0e5e0dc 100644 --- a/scm/document-markup.scm +++ b/scm/document-markup.scm @@ -6,51 +6,45 @@ ;;;; Jan Nieuwenhuizen (define (doc-markup-function func) - (let* - ((doc-str (procedure-documentation func) ) - (f-name (symbol->string (procedure-name func))) - (c-name (regexp-substitute/global #f "-markup$" f-name 'pre "" 'post)) - (sig (object-property func 'markup-signature)) - (arg-names - (map symbol->string - (cddr (cadr (procedure-source func))))) - - (sig-type-names (map type-name sig)) - (signature (zip arg-names sig-type-names)) - (signature-str - (string-join - (map (lambda (x) (string-append - "@var{" (car x) "} (" (cadr x) ")" )) - (zip arg-names sig-type-names)) - " " ))) - + (let* ((doc-str (procedure-documentation func) ) + (f-name (symbol->string (procedure-name func))) + (c-name (regexp-substitute/global #f "-markup$" f-name 'pre "" 'post)) + (sig (object-property func 'markup-signature)) + (arg-names + (map symbol->string + (cddr (cadr (procedure-source func))))) + + (sig-type-names (map type-name sig)) + (signature (zip arg-names sig-type-names)) + (signature-str + (string-join + (map (lambda (x) (string-append + "@var{" (car x) "} (" (cadr x) ")" )) + (zip arg-names sig-type-names)) + " " ))) - - (string-append - "\n\n@item @code{\\" c-name "} " signature-str - - "\n@findex " f-name "\n" - "\n@cindex @code{" c-name "}\n" - - (if (string? doc-str) - doc-str - "") - ))) + (string-append + "\n\n@item @code{\\" c-name "} " signature-str + + "\n@findex " f-name "\n" + "\n@cindex @code{" c-name "}\n" + + (if (string? doc-str) + doc-str + "")))) (define (markup-functionstring (procedure-name a)) (symbol->string (procedure-name b)))) (define (markup-doc-string) (string-append - - "@table @asis" - (apply string-append - - (map doc-markup-function - (sort markup-function-list markup-function diff --git a/scm/document-music.scm b/scm/document-music.scm index b1ab6613c4..31980d5fc0 100644 --- a/scm/document-music.scm +++ b/scm/document-music.scm @@ -10,37 +10,26 @@ #:name "Music properties" #:desc "All music properties, including descriptions" #:text - (let* ( - (ps (sort (map symbol->string all-music-properties) stringtexi 'music (string->symbol prop))) - ps)) - (texi (description-list->texi descs)) - ) - texi) - )) + (let* ((ps (sort (map symbol->string all-music-properties) stringtexi 'music (string->symbol prop))) + ps)) + (texi (description-list->texi descs))) + texi))) (define music-types->names (make-vector 61 '())) (map (lambda (entry) - (let* - ( - (types (cdr (assoc 'types (cdr entry) ))) - ) + (let* ((types (cdr (assoc 'types (cdr entry))))) (map (lambda (type) (hashq-set! music-types->names type (cons (car entry) - (hashq-ref music-types->names type '()))) - - ) types) - - )) - music-descriptions) - - + (hashq-ref music-types->names type '())))) + types))) + music-descriptions) (define (strip-description x) - (cons (symbol->string (car x)) - "")) + (cons (symbol->string (car x)) + "")) (define (music-type-doc entry) (make @@ -53,7 +42,7 @@ (human-listify (sort (map (lambda (x) (ref-ify (symbol->string x))) - (cdr entry)) string @@ -71,16 +59,12 @@ #:children (map music-type-doc (sort - (hash-table->alist music-types->names) alistalist music-types->names) aliststring (map ly:translator-name - (filter - (lambda (x) (engraver-accepts-music-types? types x)) all-engravers-list))))) + (filter + (lambda (x) (engraver-accepts-music-types? types x)) all-engravers-list))))) "\n\nProperties: \n" (description-list->texi (map (lambda (x) (property->texi 'music x props)) - (map car props))) - - ) - )) + (map car props)))))) (define (music-object-doc obj) (make #:name (symbol->string (car obj)) - #:text (music-doc-str obj) - )) + #:text (music-doc-str obj))) (define (music-expressions-doc) (make #:name "Music expressions" #:desc "Objects that represent music." #:children - (map music-object-doc music-descriptions) - )) - + (map music-object-doc music-descriptions))) + (define (music-doc-node) (make #:name "Music definitions" @@ -124,9 +103,4 @@ (list (music-expressions-doc) (music-types-doc) - (music-props-doc)) - )) - - - - + (music-props-doc)))) diff --git a/scm/document-translation.scm b/scm/document-translation.scm index 2eac4bfae1..9aa54b4f8e 100644 --- a/scm/document-translation.scm +++ b/scm/document-translation.scm @@ -5,34 +5,27 @@ ;;;; (c) 2000--2004 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen - (define (engraver-makes-grob? name-symbol grav) - (memq name-symbol (assoc 'grobs-created (ly:translator-description grav))) - ) + (memq name-symbol (assoc 'grobs-created (ly:translator-description grav)))) (define (engraver-accepts-music-type? name-symbol grav) - (memq name-symbol (assoc 'events-accepted (ly:translator-description grav))) - - ) + (memq name-symbol (assoc 'events-accepted (ly:translator-description grav)))) (define (engraver-accepts-music-types? types grav) (if (null? types) #f (or (engraver-accepts-music-type? (car types) grav) - (engraver-accepts-music-types? (cdr types) grav))) - ) + (engraver-accepts-music-types? (cdr types) grav)))) (define (engraver-doc-string engraver in-which-contexts) - (let* ( - (propsr (cdr (assoc 'properties-read (ly:translator-description engraver)))) + (let* ((propsr (cdr (assoc 'properties-read (ly:translator-description engraver)))) (propsw (cdr (assoc 'properties-written (ly:translator-description engraver)))) (accepted (cdr (assoc 'events-accepted (ly:translator-description engraver)))) (name-sym (ly:translator-name engraver)) (name-str (symbol->string name-sym)) (desc (cdr (assoc 'description (ly:translator-description engraver)))) - (grobs (engraver-grobs engraver)) - ) + (grobs (engraver-grobs engraver))) (string-append desc @@ -44,10 +37,9 @@ (map (lambda (x) (string-append "@ref{" - (symbol->string x) - "}")) accepted) - )) - "") + (symbol->string x) + "}")) accepted))) + "") "\n\n" (if (pair? propsr) (string-append @@ -59,7 +51,7 @@ (if (null? propsw) "" (string-append - "Properties (write)" + "Properties (write)" (description-list->texi (map (lambda (x) (property->texi 'translation x '())) propsw)))) (if (null? grobs) @@ -67,52 +59,40 @@ (string-append "This engraver creates the following layout objects: \n " (human-listify (map ref-ify (uniq-list (sort grobs stringstring contexts) stringstring contexts) string #:name (symbol->string (ly:translator-name grav)) - #:text (engraver-doc-string grav #t) - )) + #:text (engraver-doc-string grav #t))) ;; Second level, part of Context description (define name->engraver-table (make-vector 61 '())) @@ -127,77 +107,57 @@ (define (document-engraver-by-name name) "NAME is a symbol." - (let* - ( - (eg (find-engraver-by-name name )) - ) + (let* ((eg (find-engraver-by-name name ))) (cons (string-append "@code{" (ref-ify (symbol->string name)) "}") - (engraver-doc-string eg #f) - ) - )) + (engraver-doc-string eg #f)))) (define (document-property-operation op) - (let - ((tag (car op)) - (body (cdr op)) - (sym (cadr op)) - ) - - (cond - ((equal? tag 'push) - (string-append - "@item " - (if (null? (cddr body)) - "Revert " - "Set " - ) - "grob-property @code{" - (symbol->string (cadr body)) - "} in @ref{" (symbol->string sym) - "}" - (if (not (null? (cddr body))) - (string-append " to @code{" (scm->texi (cadr (cdr body))) "}" ) - ) - "\n" - ) - - ) - ((equal? (object-property sym 'is-grob?) #t) "") - ((equal? (car op) 'assign) - (string-append - "@item Set translator property @code{" - (symbol->string (car body)) - "} to @code{" - (scm->texi (cadr body)) - "}\n" - ) - ) - ) - )) - + (let ((tag (car op)) + (body (cdr op)) + (sym (cadr op))) + + (cond + ((equal? tag 'push) + (string-append + "@item " + (if (null? (cddr body)) + "Revert " + "Set ") + "grob-property @code{" + (symbol->string (cadr body)) + "} in @ref{" (symbol->string sym) + "}" + (if (not (null? (cddr body))) + (string-append " to @code{" (scm->texi (cadr (cdr body))) "}" )) + "\n")) + ((equal? (object-property sym 'is-grob?) #t) "") + ((equal? (car op) 'assign) + (string-append + "@item Set translator property @code{" + (symbol->string (car body)) + "} to @code{" + (scm->texi (cadr body)) + "}\n"))))) (define (context-doc context-desc) - (let* - ( - (name-sym (cdr (assoc 'context-name context-desc))) - (name (symbol->string name-sym)) - (aliases (map symbol->string (cdr (assoc 'aliases context-desc)))) - (desc-handle (assoc 'description context-desc)) - (desc (if (and (pair? desc-handle) (string? (cdr desc-handle))) - (cdr desc-handle) "(not documented)")) - - (accepts (cdr (assoc 'accepts context-desc))) - (group (assq-ref context-desc 'group-type)) + (let* ((name-sym (cdr (assoc 'context-name context-desc))) + (name (symbol->string name-sym)) + (aliases (map symbol->string (cdr (assoc 'aliases context-desc)))) + (desc-handle (assoc 'description context-desc)) + (desc (if (and (pair? desc-handle) (string? (cdr desc-handle))) + (cdr desc-handle) "(not documented)")) + + (accepts (cdr (assoc 'accepts context-desc))) + (group (assq-ref context-desc 'group-type)) - (consists (append - (if group (list group) - '()) - (cdr (assoc 'consists context-desc)) - )) - (props (cdr (assoc 'property-ops context-desc))) - (grobs (context-grobs context-desc)) - (grob-refs (map (lambda (x) (ref-ify x)) grobs)) ) + (consists (append + (if group (list group) + '()) + (cdr (assoc 'consists context-desc)))) + (props (cdr (assoc 'property-ops context-desc))) + (grobs (context-grobs context-desc)) + (grob-refs (map (lambda (x) (ref-ify x)) grobs)) ) (make #:name name @@ -216,10 +176,8 @@ "\n\nThis context sets the following properties:\n" "@itemize @bullet\n" (apply string-append (map document-property-operation props)) - "@end itemize\n" - ) - "" - ) + "@end itemize\n") + "") (if (null? accepts) "\n\nThis context is a `bottom' context; it can not contain other contexts." @@ -230,8 +188,7 @@ "\n\nThis context is built from the following engravers: " (description-list->texi - (map document-engraver-by-name consists)) - )))) + (map document-engraver-by-name consists)))))) (define (engraver-grobs grav) (let* ((eg (if (symbol? grav) @@ -239,43 +196,31 @@ grav))) (if (eq? eg #f) '() - (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg))))) - )) + (map symbol->string (cdr (assoc 'grobs-created (ly:translator-description eg))))))) (define (context-grobs context-desc) - (let* ( - (group (assq-ref context-desc 'group-type)) + (let* ((group (assq-ref context-desc 'group-type)) (consists (append (if group (list group) '()) - (cdr (assoc 'consists context-desc)) - )) + (cdr (assoc 'consists context-desc)))) (grobs (apply append - (map engraver-grobs consists)) - )) - grobs - )) - - + (map engraver-grobs consists)))) + grobs)) (define (all-contexts-doc) - (let* ( - (layout-alist + (let* ((layout-alist (sort (ly:output-description $defaultlayout) (lambda (x y) (symbolstring (map car layout-alist)) string #:name "Contexts" #:desc "Complete descriptions of all contexts" #:children - (map context-doc contexts) - ) - )) - + (map context-doc contexts)))) (define all-engravers-list (ly:get-all-translators)) (set! all-engravers-list @@ -292,17 +237,14 @@ (map engraver-doc all-engravers-list))) (define (translation-properties-doc-string lst) - (let* - ((ps (sort (map symbol->string lst) stringsymbol ps)) - (propdescs - (map - (lambda (x) (property->texi 'translation x '())) - sortedsyms)) - (texi (description-list->texi propdescs))) - texi - )) - + (let* ((ps (sort (map symbol->string lst) stringsymbol ps)) + (propdescs + (map + (lambda (x) (property->texi 'translation x '())) + sortedsyms)) + (texi (description-list->texi propdescs))) + texi)) (define (translation-doc-node) (make @@ -322,5 +264,4 @@ #:name "Internal context properties" #:desc "All internal context properties" #:text (translation-properties-doc-string - all-internal-translation-properties)) - ) ) ) + all-internal-translation-properties))))) diff --git a/scm/documentation-generate.scm b/scm/documentation-generate.scm index 1650bf1b96..82649a53ac 100644 --- a/scm/documentation-generate.scm +++ b/scm/documentation-generate.scm @@ -1,29 +1,27 @@ -;;; generate-documentation.scm -- Generate documentation -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Han-Wen Nienhuys -;;; Jan Nieuwenhuizen +;;;; generate-documentation.scm -- Generate documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen ;;; File entry point for generated documentation - ;;; Running LilyPond on this file generates the documentation -;(set-debug-cell-accesses! 5000) +;;(set-debug-cell-accesses! 5000) ;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;; TODO : make modules of these! ;;;;;;;;;;;;;;;; -; todo: naming: grob vs. layout property +;; todo: naming: grob vs. layout property (map ly:load '("documentation-lib.scm" "document-functions.scm" "document-translation.scm" "document-music.scm" "document-backend.scm" - "document-markup.scm" - )) + "document-markup.scm")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -43,21 +41,16 @@ (display (translation-properties-doc-string all-user-translation-properties) (open-output-file "context-properties.tely") ) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define file-name "lilypond-internals") (define outname (string-append file-name ".texi")) - (define out-port (open-output-file outname)) (writing-wip outname) - - - - (display (string-append (texi-file-head "LilyPond program-reference" file-name @@ -137,10 +130,8 @@ @end ignore -" - - - ) out-port) +") + out-port) (define top-node (make @@ -169,12 +160,7 @@ @printindex fn -\n@bye" - - - ) - ))) - +\n@bye")))) (dump-node top-node out-port 0) (newline (current-error-port)) diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm index 02d610462e..10c66c36a5 100644 --- a/scm/documentation-lib.scm +++ b/scm/documentation-lib.scm @@ -8,21 +8,18 @@ (use-modules (oop goops) (srfi srfi-13) - (srfi srfi-1) - ) + (srfi srfi-1)) (define-class () (children #:init-value '() #:accessor node-children #:init-keyword #:children) (text #:init-value "" #:accessor node-text #:init-keyword #:text) (name #:init-value "" #:accessor node-name #:init-keyword #:name) - (description #:init-value "" #:accessor node-desc #:init-keyword #:desc) - ) + (description #:init-value "" #:accessor node-desc #:init-keyword #:desc)) (define (menu-entry x) (cons (node-name x) - (node-desc x)) - ) + (node-desc x))) (define (dump-node node port level) (display @@ -37,13 +34,12 @@ "\n\n" (if (pair? (node-children node)) (texi-menu - (map (lambda (x) (menu-entry x) ) + (map (lambda (x) (menu-entry x)) (node-children node))) - "")) + "")) port) (map (lambda (x) (dump-node x port (+ 1 level))) - (node-children node)) - ) + (node-children node))) (define (processing name) (display (string-append "\nProcessing " name " ... ") (current-error-port))) @@ -55,8 +51,7 @@ x) (define (scm->texi x) - (string-append "@code{" (texify (scm->string x)) "}") - ) + (string-append "@code{" (texify (scm->string x)) "}")) ;; @@ -67,28 +62,25 @@ (symbol->string (procedure-name val)) (string-append (if (self-evaluating? val) "" "'") - (call-with-output-string (lambda (port) (display val port))) - ))) + (call-with-output-string (lambda (port) (display val port)))))) (define (texi-section-command level) (cdr (assoc level '( - ;; Hmm, texinfo doesn't have ``part'' - (0 . "@top") - (1 . "@unnumbered") - (2 . "@unnumberedsec") - (3 . "@unnumberedsubsec") - (4 . "@unnumberedsubsubsec") - (5 . "@unnumberedsubsubsec") - )))) + ;; Hmm, texinfo doesn't have ``part'' + (0 . "@top") + (1 . "@unnumbered") + (2 . "@unnumberedsec") + (3 . "@unnumberedsubsec") + (4 . "@unnumberedsubsubsec") + (5 . "@unnumberedsubsubsec"))))) (define (one-item->texi label-desc-pair) "Document one (LABEL . DESC); return empty string if LABEL is empty string. " (if (eq? (car label-desc-pair) "") "" - (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair)) - )) + (string-append "\n@item " (car label-desc-pair) "\n" (cdr label-desc-pair)))) (define (description-list->texi items-alist) @@ -102,37 +94,27 @@ (define (texi-menu items-alist) "Generate what is between @menu and @end menu." - (let - ( - (maxwid (apply max (map (lambda (x) (string-length (car x))) - items-alist))) - ) + (let ((maxwid + (apply max (map (lambda (x) (string-length (car x))) items-alist)))) - - - (string-append - "\n@menu" - (apply string-append - (map (lambda (x) - (string-append - (string-pad-right - (string-append "\n* " (car x) ":: ") - (+ maxwid 8) - ) - (cdr x)) - ) - items-alist)) - "\n@end menu\n" - ;; Menus don't appear in html, so we make a list ourselves - "\n@ignore\n" - "\n@ifhtml\n" - (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x))) - items-alist)) - "\n@end ifhtml\n" - "\n@end ignore\n"))) - - - + (string-append + "\n@menu" + (apply string-append + (map (lambda (x) + (string-append + (string-pad-right + (string-append "\n* " (car x) ":: ") + (+ maxwid 8)) + (cdr x))) + items-alist)) + "\n@end menu\n" + ;; Menus don't appear in html, so we make a list ourselves + "\n@ignore\n" + "\n@ifhtml\n" + (description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x))) + items-alist)) + "\n@end ifhtml\n" + "\n@end ignore\n"))) (define (texi-file-head name file-name top) (string-append @@ -145,10 +127,7 @@ "\n* GNU " name ": (" file-name "). " name "." "\n@end direntry\n" "@documentlanguage en\n" - "@documentencoding ISO-8859-1\n" - - )) - + "@documentencoding ISO-8859-1\n")) (define (context-name name) name) @@ -175,8 +154,7 @@ ((null? l) "none") ((null? (cdr l)) (car l)) ((null? (cddr l)) (string-append (car l) " and " (cadr l))) - (else (string-append (car l) ", " (human-listify (cdr l)))) - )) + (else (string-append (car l) ", " (human-listify (cdr l)))))) (define (writing-wip x) (display (string-append "\nWriting " x " ... ") (current-error-port))) @@ -198,12 +176,11 @@ with init values from ALIST (1st optional argument) (type (object-property sym type?-name)) (typename (type-name type)) (desc (object-property sym doc-name)) - (handle (assoc sym alist)) - ) + (handle (assoc sym alist))) (if (eq? desc #f) (error "No description for property ~S" sym)) - + (cons (string-append "@code{" name "} " "(" typename ")" @@ -212,11 +189,6 @@ with init values from ALIST (1st optional argument) ":\n\n" (scm->texi (cdr handle)) "\n\n") - "") - - - ) - desc) - - )) + "")) + desc))) diff --git a/scm/font.scm b/scm/font.scm index 8b639fc27d..955021c40d 100644 --- a/scm/font.scm +++ b/scm/font.scm @@ -80,8 +80,7 @@ (define (make-node fprops size-family) (if (null? fprops) (make-font-tree-leaf (car size-family) (cdr size-family)) - (let* - ((qual (next-qualifier default-qualifier-order fprops))) + (let* ((qual (next-qualifier default-qualifier-order fprops))) (make-font-tree-node qual (assoc-get qual fprops))))) @@ -96,14 +95,12 @@ (car order) (next-qualifier (cdr order) props))))) - - (let* - ((q (font-qualifier node)) - (d (font-default node)) - (v (assoc-get q fprops d)) - (new-fprops (assoc-delete q fprops)) - (child (hashq-ref (slot-ref node 'children) - v #f))) + (let* ((q (font-qualifier node)) + (d (font-default node)) + (v (assoc-get q fprops d)) + (new-fprops (assoc-delete q fprops)) + (child (hashq-ref (slot-ref node 'children) + v #f))) (if (not child) @@ -119,11 +116,10 @@ (define-method (g-lookup-font (node ) alist-chain) - (let* - ((qual (font-qualifier node)) - (def (font-default node)) - (val (chain-assoc-get qual alist-chain def)) - (desired-child (hashq-ref (font-children node) val))) + (let* ((qual (font-qualifier node)) + (def (font-default node)) + (val (chain-assoc-get qual alist-chain def)) + (desired-child (hashq-ref (font-children node) val))) (if desired-child (g-lookup-font desired-child alist-chain) @@ -152,25 +148,25 @@ `( (fetaNumber 20 #( - ,(delay (ly:font-load "feta-alphabet11")) - ,(delay (ly:font-load "feta-alphabet13")) - ,(delay (ly:font-load "feta-alphabet14")) - ,(delay (ly:font-load "feta-alphabet16")) - ,(delay (ly:font-load "feta-alphabet18")) - ,(delay (ly:font-load "feta-alphabet20")) - ,(delay (ly:font-load "feta-alphabet23")) - ,(delay (ly:font-load "feta-alphabet26")))) + ,(delay (ly:font-load "feta-alphabet11")) + ,(delay (ly:font-load "feta-alphabet13")) + ,(delay (ly:font-load "feta-alphabet14")) + ,(delay (ly:font-load "feta-alphabet16")) + ,(delay (ly:font-load "feta-alphabet18")) + ,(delay (ly:font-load "feta-alphabet20")) + ,(delay (ly:font-load "feta-alphabet23")) + ,(delay (ly:font-load "feta-alphabet26")))) (fetaDynamic 20.0 #( - ,(delay (ly:font-load "feta-alphabet11")) - ,(delay (ly:font-load "feta-alphabet13")) - ,(delay (ly:font-load "feta-alphabet14")) - ,(delay (ly:font-load "feta-alphabet16")) - ,(delay (ly:font-load "feta-alphabet18")) - ,(delay (ly:font-load "feta-alphabet20")) - ,(delay (ly:font-load "feta-alphabet23")) - ,(delay (ly:font-load "feta-alphabet26")))) - + ,(delay (ly:font-load "feta-alphabet11")) + ,(delay (ly:font-load "feta-alphabet13")) + ,(delay (ly:font-load "feta-alphabet14")) + ,(delay (ly:font-load "feta-alphabet16")) + ,(delay (ly:font-load "feta-alphabet18")) + ,(delay (ly:font-load "feta-alphabet20")) + ,(delay (ly:font-load "feta-alphabet23")) + ,(delay (ly:font-load "feta-alphabet26")))) + (fetaMusic 20.0 #( ,(delay (ly:font-load "bigcheese11")) @@ -183,7 +179,7 @@ ,(delay (ly:font-load "bigcheese26")))) (fetaBraces 100.0 #(,(delay - (ly:font-load "aybabtu"))))))) + (ly:font-load "aybabtu"))))))) (define-public (add-cmr-fonts node factor) (add-font node '((font-encoding . TeX-math)) diff --git a/scm/framework-gnome.scm b/scm/framework-gnome.scm index c7a47a5bee..e67eb90526 100644 --- a/scm/framework-gnome.scm +++ b/scm/framework-gnome.scm @@ -37,7 +37,7 @@ (define (debugf string . rest) (if #f (apply stderr (cons string rest)))) - + (define-class () (name #:init-value "untitled" #:init-keyword #:name #:accessor name) @@ -183,7 +183,7 @@ (if (not ifs) (set! ifs " ")) ifs) - + (define (spawn-editor location) (let* ((file-name (car location)) (line (cadr location)) @@ -206,7 +206,7 @@ (let ((command-list (string-split command #\ )));; (get-ifs)))) (apply execlp command-list) (primitive-exit))))) - + (define location-callback spawn-editor) (define (get-location grob) @@ -236,17 +236,16 @@ (offset-add origin offset)))))) (define-method (save-tweaks (go )) - (let* - ((dumper (ly:make-dumper)) - (tweaks (ly:all-tweaks)) - (serialized-tweaks (map - (lambda (tweak) - (append - (list - (ly:dumper-key-serial dumper (car tweak)) - (list 'unquote (procedure-name (cadr tweak)))) - (cddr tweak))) - tweaks))) + (let* ((dumper (ly:make-dumper)) + (tweaks (ly:all-tweaks)) + (serialized-tweaks (map + (lambda (tweak) + (append + (list + (ly:dumper-key-serial dumper (car tweak)) + (list 'unquote (procedure-name (cadr tweak)))) + (cddr tweak))) + tweaks))) (if (not (null? serialized-tweaks)) (let ((file (open-file (string-append (name go) ".twy") "w"))) @@ -300,51 +299,50 @@ (begin (stderr "CLICK WITH MODIFIERS: ~S\n" (gdk-event-button:modifiers event)) - + ;; some modifier, do jump to source (and-let* ((grob (hashq-ref (item-grobs go) item #f)) (location (get-location grob))) (location-callback location))))) ((= button 2) - (and-let* - ((grob (hashq-ref (item-grobs go) item #f))) - - (let ((properties (ly:grob-properties grob)) - (basic-properties (ly:grob-basic-properties grob)) - (x (inexact->exact (gdk-event-button:x-root event))) - (y (inexact->exact (gdk-event-button:y-root event)))) - - (debugf "GROB: ~S\n" grob) - (debugf "PROPERTIES: ~S\n" properties) - (debugf "BASIC PROPERTIES: ~S\n" basic-properties) - - ;; FIXME: dialog iso window? - ;; http://www.gtk.org/tutorial/sec-textentries.html - (let ((window (make )) - (vbox (make )) - (ok (make #:label "Ok"))) - - (add window vbox) - (connect ok 'clicked (lambda (b) (destroy window))) - - (for-each - (lambda (x) - (let ((label (make - ;;#:label (symbol->string (car x)))) - #:label (format #f "~S" (car x)))) - ;;(symbol->string (car x)))) - (entry (make - #:text (format #f "~S" (cdr x)))) - (hbox (make ))) - (add hbox label) - (add hbox entry) - (set-size-request label 150 BUTTON-HEIGHT) - (add vbox hbox))) - (append properties basic-properties)) - (add vbox ok) - - (show-all window) - (move window x y)))))))) + (and-let* ((grob (hashq-ref (item-grobs go) item #f))) + + (let ((properties (ly:grob-properties grob)) + (basic-properties (ly:grob-basic-properties grob)) + (x (inexact->exact (gdk-event-button:x-root event))) + (y (inexact->exact (gdk-event-button:y-root event)))) + + (debugf "GROB: ~S\n" grob) + (debugf "PROPERTIES: ~S\n" properties) + (debugf "BASIC PROPERTIES: ~S\n" basic-properties) + + ;; FIXME: dialog iso window? + ;; http://www.gtk.org/tutorial/sec-textentries.html + (let ((window (make )) + (vbox (make )) + (ok (make #:label "Ok"))) + + (add window vbox) + (connect ok 'clicked (lambda (b) (destroy window))) + + (for-each + (lambda (x) + (let ((label (make + ;;#:label (symbol->string (car x)))) + #:label (format #f "~S" (car x)))) + ;;(symbol->string (car x)))) + (entry (make + #:text (format #f "~S" (cdr x)))) + (hbox (make ))) + (add hbox label) + (add hbox entry) + (set-size-request label 150 BUTTON-HEIGHT) + (add vbox hbox))) + (append properties basic-properties)) + (add vbox ok) + + (show-all window) + (move window x y)))))))) ((2button-press) (gobject-set-property item 'fill-color "green")) ((key-press) @@ -374,7 +372,7 @@ (points (gobject-get-property x 'size-points))) ;;(gobject-set-property x 'scale pixels-per-unit) (gobject-set-property x 'size-points (* points factor)))) - (text-items go))) + (text-items go))) (define (key-press-event go item event) (let ((keyval (gdk-event-key:keyval event)) diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm index 4bab9cb734..4c53572606 100644 --- a/scm/framework-ps.scm +++ b/scm/framework-ps.scm @@ -30,8 +30,7 @@ (string-append "magfont" (string-encode-integer (hashq name 1000000)) - "m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))) - ))) + "m" (string-encode-integer (inexact->exact (round (* 1000 magnify))))))) (define (tex-font? fontname) (or @@ -39,15 +38,14 @@ (equal? (substring fontname 0 2) "ec"))) (define (ps-embed-cff body font-set-name version) - (let* - ((binary-data - (string-append - (format "/~a ~s StartData " font-set-name (string-length body)) - body))) + (let* ((binary-data + (string-append + (format "/~a ~s StartData " font-set-name (string-length body)) + body))) (string-append (format - "%!PS-Adobe-3.0 Resource-FontSet + "%!PS-Adobe-3.0 Resource-FontSet %%DocumentNeededResources: ProcSet (FontSetInit) %%EndComments %%IncludeResource: ProcSet (FontSetInit) @@ -57,27 +55,24 @@ /FontSetInit /ProcSet findresource begin %%BeginData: ~s Binary Bytes " - font-set-name font-set-name version (string-length binary-data) - ) - binary-data - "\n%%EndData + font-set-name font-set-name version (string-length binary-data)) + binary-data + "\n%%EndData %%EndResource %%EOF -" - - ))) +"))) (define (load-fonts paper) (let* ((fonts (ly:paper-fonts paper)) (all-font-names - (map - (lambda (font) - (if (string? (ly:font-file-name font)) - (list (ly:font-file-name font)) - (ly:font-sub-fonts font))) + (map + (lambda (font) + (if (string? (ly:font-file-name font)) + (list (ly:font-file-name font)) + (ly:font-sub-fonts font))) - fonts)) + fonts)) (font-names (uniq-list (sort (apply append all-font-names) stringstring (ly:output-def-lookup layout 'outputscale)) " lily-output-units mul def \n" (output-entry "page-height" 'vsize) - (output-entry "page-width" 'hsize) - )) + (output-entry "page-width" 'hsize))) (define (dump-page outputter page page-number page-count landscape?) (ly:outputter-dump-string outputter - (string-append - "%%Page: " - (number->string page-number) " " (number->string page-count) "\n" - - "%%BeginPageSetup\n" - (if landscape? - "page-width output-scale mul 0 translate 90 rotate\n" - "") - "%%EndPageSetup\n" - - "start-system { " - "set-ps-scale-to-lily-scale " - "\n")) + (string-append + "%%Page: " + (number->string page-number) " " (number->string page-count) "\n" + + "%%BeginPageSetup\n" + (if landscape? + "page-width output-scale mul 0 translate 90 rotate\n" + "") + "%%EndPageSetup\n" + + "start-system { " + "set-ps-scale-to-lily-scale " + "\n")) (ly:outputter-dump-stencil outputter page) (ly:outputter-dump-string outputter "} stop-system \nshowpage\n")) @@ -229,20 +223,20 @@ (page-number (1- (ly:output-def-lookup paper 'firstpagenumber))) (page-count (length pages))) - (for-each - (lambda (x) - (ly:outputter-dump-string outputter x)) - (cons - (page-header paper page-count) - (preamble paper))) - - (for-each - (lambda (page) - (set! page-number (1+ page-number)) - (dump-page outputter page page-number page-count landscape?)) - pages) - - (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n"))) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (cons + (page-header paper page-count) + (preamble paper))) + + (for-each + (lambda (page) + (set! page-number (1+ page-number)) + (dump-page outputter page page-number page-count landscape?)) + pages) + + (ly:outputter-dump-string outputter "%%Trailer\n%%EOF\n"))) (define-public (output-preview-framework outputter book scopes fields basename) (let* ((paper (ly:paper-book-paper book)) @@ -263,29 +257,28 @@ (if (or (nan? x) (inf? x)) 0.0 x)) (list (car xext) (car yext) - (cdr xext) (cdr yext))) - )) + (cdr xext) (cdr yext))) )) - (for-each - (lambda (x) - (ly:outputter-dump-string outputter x)) - (cons - (eps-header paper - (map - (lambda (x) - (inexact->exact - (round (* x scale mm-to-bigpoint)))) - bbox)) - (preamble paper))) - - - (ly:outputter-dump-string outputter - (string-append "start-system { " - "set-ps-scale-to-lily-scale " - "\n")) - - (ly:outputter-dump-stencil outputter dump-me) - (ly:outputter-dump-string outputter "} stop-system\n%%Trailer\n%%EOF\n"))) + (for-each + (lambda (x) + (ly:outputter-dump-string outputter x)) + (cons + (eps-header paper + (map + (lambda (x) + (inexact->exact + (round (* x scale mm-to-bigpoint)))) + bbox)) + (preamble paper))) + + + (ly:outputter-dump-string outputter + (string-append "start-system { " + "set-ps-scale-to-lily-scale " + "\n")) + + (ly:outputter-dump-stencil outputter dump-me) + (ly:outputter-dump-string outputter "} stop-system\n%%Trailer\n%%EOF\n"))) (define-public (convert-to-pdf book name) (let* ((defs (ly:paper-book-paper book)) @@ -295,7 +288,7 @@ (ly:warn "Can't convert to PDF") (postscript->pdf (if (string? papersizename) papersizename "a4") name)))) - + (define-public (convert-to-png book name) (let* ((defs (ly:paper-book-paper book)) (resolution (ly:output-def-lookup defs 'pngresolution))) diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm index 8a478f3cf3..211503981c 100644 --- a/scm/fret-diagrams.scm +++ b/scm/fret-diagrams.scm @@ -4,8 +4,6 @@ ;;;; ;;;; (c) 2004 Carl D. Sorensen - - (define (fret-parse-marking-list marking-list fret-count) (let* ((fret-range (list 1 fret-count)) (barre-list '()) diff --git a/scm/lily.scm b/scm/lily.scm index e7ee977ce8..491b58434c 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -9,7 +9,7 @@ (if (defined? 'set-debug-cell-accesses!) (set-debug-cell-accesses! #f)) -;(set-debug-cell-accesses! 5000) +;;(set-debug-cell-accesses! 5000) (use-modules (ice-9 regex) (ice-9 safe) @@ -18,13 +18,12 @@ (srfi srfi-13)) ; strings -; my display - +;; my display (define-public (myd k v) (display k) (display ": ") (display v) (display ", ")) (define-public (print . args) (apply format (cons (current-output-port) args))) - + ;;; General settings ;;; debugging evaluator is slower. This should @@ -54,7 +53,7 @@ (map (lambda (x) (if (symbol? x) (symbol->string x) (number->string x))) - (ly:version)) + (ly:version)) ".")) @@ -94,14 +93,13 @@ predicates. Print a message at LOCATION if any predicate failed." (if (null? signature) #t (and (helper (car signature) (car arguments) count) - (recursion-helper (cdr signature) (cdr arguments) (1+ count))) - )) + (recursion-helper (cdr signature) (cdr arguments) (1+ count))))) (recursion-helper signature arguments 1)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; output - + ;;(define-public (output-framework) (write "hello\n")) (define output-tex-module @@ -135,8 +133,7 @@ predicates. Print a message at LOCATION if any predicate failed." text white-dot white-text - zigzag-line - )) + zigzag-line)) ;; TODO: ;; - generate this list by registering the output-backend-commands @@ -149,93 +146,90 @@ predicates. Print a message at LOCATION if any predicate failed." grob-cause no-origin placebox - unknown - )) + unknown)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; other files. (for-each ly:load - ;; load-from-path - '("lily-library.scm" - "define-music-types.scm" - "output-lib.scm" - "c++.scm" - "chord-ignatzek-names.scm" - "chord-entry.scm" - "chord-generic-names.scm" - "stencil.scm" - "new-markup.scm" - "bass-figure.scm" - "music-functions.scm" - "part-combiner.scm" - "define-music-properties.scm" - "auto-beam.scm" - "chord-name.scm" - - "ly-from-scheme.scm" - - "define-context-properties.scm" - "translation-functions.scm" - "script.scm" - "midi.scm" - "beam.scm" - "clef.scm" - "slur.scm" - "font.scm" - "encoding.scm" - - "fret-diagrams.scm" - "define-markup-commands.scm" - "define-grob-properties.scm" - "define-grobs.scm" - "define-grob-interfaces.scm" - "page-layout.scm" - "titling.scm" - - "paper.scm" - - ; last: - "safe-lily.scm" - )) + ;; load-from-path + '("lily-library.scm" + "define-music-types.scm" + "output-lib.scm" + "c++.scm" + "chord-ignatzek-names.scm" + "chord-entry.scm" + "chord-generic-names.scm" + "stencil.scm" + "new-markup.scm" + "bass-figure.scm" + "music-functions.scm" + "part-combiner.scm" + "define-music-properties.scm" + "auto-beam.scm" + "chord-name.scm" + + "ly-from-scheme.scm" + + "define-context-properties.scm" + "translation-functions.scm" + "script.scm" + "midi.scm" + "beam.scm" + "clef.scm" + "slur.scm" + "font.scm" + "encoding.scm" + + "fret-diagrams.scm" + "define-markup-commands.scm" + "define-grob-properties.scm" + "define-grobs.scm" + "define-grob-interfaces.scm" + "page-layout.scm" + "titling.scm" + + "paper.scm" + + ; last: + "safe-lily.scm")) (set! type-p-name-alist - `( - (,boolean-or-symbol? . "boolean or symbol") - (,boolean? . "boolean") - (,char? . "char") - (,grob-list? . "list of grobs") - (,hash-table? . "hash table") - (,input-port? . "input port") - (,integer? . "integer") - (,list? . "list") - (,ly:context? . "context") - (,ly:dimension? . "dimension, in staff space") - (,ly:dir? . "direction") - (,ly:duration? . "duration") - (,ly:grob? . "layout object") - (,ly:input-location? . "input location") - (,ly:moment? . "moment") - (,ly:music? . "music") - (,ly:pitch? . "pitch") - (,ly:translator? . "translator") - (,ly:font-metric? . "font metric") - (,markup-list? . "list of markups") - (,markup? . "markup") - (,ly:music-list? . "list of music") - (,number-or-grob? . "number or grob") - (,number-or-string? . "number or string") - (,number-pair? . "pair of numbers") - (,number? . "number") - (,output-port? . "output port") - (,pair? . "pair") - (,procedure? . "procedure") - (,scheme? . "any type") - (,string? . "string") - (,symbol? . "symbol") - (,vector? . "vector") - )) + `( + (,boolean-or-symbol? . "boolean or symbol") + (,boolean? . "boolean") + (,char? . "char") + (,grob-list? . "list of grobs") + (,hash-table? . "hash table") + (,input-port? . "input port") + (,integer? . "integer") + (,list? . "list") + (,ly:context? . "context") + (,ly:dimension? . "dimension, in staff space") + (,ly:dir? . "direction") + (,ly:duration? . "duration") + (,ly:grob? . "layout object") + (,ly:input-location? . "input location") + (,ly:moment? . "moment") + (,ly:music? . "music") + (,ly:pitch? . "pitch") + (,ly:translator? . "translator") + (,ly:font-metric? . "font metric") + (,markup-list? . "list of markups") + (,markup? . "markup") + (,ly:music-list? . "list of music") + (,number-or-grob? . "number or grob") + (,number-or-string? . "number or string") + (,number-pair? . "pair of numbers") + (,number? . "number") + (,output-port? . "output port") + (,pair? . "pair") + (,procedure? . "procedure") + (,scheme? . "any type") + (,string? . "string") + (,symbol? . "symbol") + (,vector? . "vector"))) ;; debug mem leaks @@ -243,25 +237,23 @@ predicates. Print a message at LOCATION if any predicate failed." (define gc-protect-stat-count 0) (define-public (dump-gc-protects) (set! gc-protect-stat-count (1+ gc-protect-stat-count) ) - (let* - ((protects (sort - (hash-table->alist (ly:protects)) - (lambda (a b) - (< (object-address (car a)) - (object-address (car b)))))) - (out-file-name (string-append - "gcstat-" (number->string gc-protect-stat-count) - ".scm")) - (outfile (open-file out-file-name "w"))) + (let* ((protects (sort + (hash-table->alist (ly:protects)) + (lambda (a b) + (< (object-address (car a)) + (object-address (car b)))))) + (out-file-name (string-append + "gcstat-" (number->string gc-protect-stat-count) + ".scm")) + (outfile (open-file out-file-name "w"))) (display "Dumping gc protected objs to ...\n") (display (filter (lambda (x) (not (symbol? x))) (map (lambda (y) - (let - ((x (car y)) - (c (cdr y))) + (let ((x (car y)) + (c (cdr y))) (string-append (string-join @@ -275,13 +267,12 @@ predicates. Print a message at LOCATION if any predicate failed." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (ly:system command) - (let* - ((status 0) + (let* ((status 0) - (silenced - (string-append command (if (ly:get-option 'verbose) - "" - " > /dev/null 2>&1 ")))) + (silenced + (string-append command (if (ly:get-option 'verbose) + "" + " > /dev/null 2>&1 ")))) (if (ly:get-option 'verbose) (format (current-error-port) (_ "Invoking `~a'...\n") command)) @@ -297,7 +288,7 @@ predicates. Print a message at LOCATION if any predicate failed." (string-append "\"" (regexp-substitute/global #f "[^- 0-9,.a-zA-Z'\"\\]" str 'pre 'post) - "\"")) + "\"")) (define-public (postscript->pdf papersizename name) (let* ((cmd (string-append "ps2pdf " @@ -305,7 +296,7 @@ predicates. Print a message at LOCATION if any predicate failed." " -sPAPERSIZE=" (sanitize-command-option papersizename) " " - name))) + name))) (pdf-name (string-append (basename name ".ps") ".pdf" ))) (if (access? pdf-name W_OK) @@ -315,16 +306,15 @@ predicates. Print a message at LOCATION if any predicate failed." (ly:system cmd))) (define-public (postscript->png resolution name) - (let - ((cmd (string-append - "ps2png --resolution=" - (if (number? resolution) - (number->string resolution) - "90 ") - (if (ly:get-option 'verbose) - "--verbose " - " ") - name))) + (let ((cmd (string-append + "ps2png --resolution=" + (if (number? resolution) + (number->string resolution) + "90 ") + (if (ly:get-option 'verbose) + "--verbose " + " ") + name))) (ly:system cmd))) (define-public (lilypond-main files) @@ -334,10 +324,10 @@ predicates. Print a message at LOCATION if any predicate failed." (for-each (lambda (f) (catch 'ly-file-failed (lambda () (ly:parse-file f)) handler) -; (dump-gc-protects) - ) + (if #f + (dump-gc-protects))) files) - + (if (pair? failed) (begin (newline (current-error-port)) @@ -348,6 +338,5 @@ predicates. Print a message at LOCATION if any predicate failed." (exit 1)) (exit 0)))) - (define-public (tweak-grob-property grob sym val) - (set! (ly:grob-property grob sym) val)) + (set! (ly:grob-property grob sym) val)) diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 2eb261b110..3048acebea 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -60,7 +60,6 @@ music (make-music 'Music))) ;must return music. - (define-public (display-music music) "Display music, not done with music-map for clarity of presentation." (display music) @@ -79,7 +78,6 @@ (display " }\n") music) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (shift-one-duration-log music shift dot) @@ -101,7 +99,6 @@ (define-public (shift-duration-log music shift dot) (music-map (lambda (x) (shift-one-duration-log x shift dot)) music)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; clusters. @@ -132,13 +129,11 @@ This function replaces all repeats with unfold repeats. " (if (equal? (ly:music-property music 'iterator-ctor) Chord_tremolo_iterator::constructor) - (let* - ((seq-arg? (memq 'sequential-music - (ly:music-property e 'types))) - (count (ly:music-property music 'repeat-count)) - (dot-shift (if (= 0 (remainder count 3)) - -1 0)) - ) + (let* ((seq-arg? (memq 'sequential-music + (ly:music-property e 'types))) + (count (ly:music-property music 'repeat-count)) + (dot-shift (if (= 0 (remainder count 3)) + -1 0))) (if (= 0 -1) (set! count (* 2 (quotient count 3)))) @@ -147,8 +142,7 @@ This function replaces all repeats with unfold repeats. " (ly:intlog2 count)) dot-shift) (if seq-arg? - (ly:music-compress e (ly:make-moment (length (ly:music-property e 'elements)) 1))) - )) + (ly:music-compress e (ly:make-moment (length (ly:music-property e 'elements)) 1))))) (set! (ly:music-property music 'length) Repeated_music::unfolded_music_length) @@ -165,7 +159,6 @@ This function replaces all repeats with unfold repeats. " (unfold-repeats e))) music)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; property setting music objs. @@ -193,8 +186,7 @@ i.e. this is not an override" 'grob-property gprop)) (define direction-polyphonic-grobs - '(Stem Tie Rest Slur Script TextScript Dots DotColumn Fingering - )) + '(Stem Tie Rest Slur Script TextScript Dots DotColumn Fingering)) (define-public (make-voice-props-set n) (make-sequential-music @@ -204,10 +196,7 @@ i.e. this is not an override" direction-polyphonic-grobs) (list (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) - (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)) - - )))) - + (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) (define-public (make-voice-props-revert) (make-sequential-music @@ -227,7 +216,6 @@ i.e. this is not an override" (set! (ly:music-property cm 'context-id) id)) cm)) - (define-public (descend-to-context m context) "Like context-spec-music, but only descending. " (let ((cm (context-spec-music m context))) @@ -236,8 +224,7 @@ i.e. this is not an override" (define-public (make-non-relative-music mus) (make-music 'UnrelativableMusic - 'element mus - )) + 'element mus)) (define-public (make-apply-context func) (make-music 'ApplyContext @@ -399,21 +386,21 @@ of beat groupings " ;;; splitting chords into voices. (define (voicify-list lst number) - "Make a list of Musics. + "Make a list of Musics. voicify-list :: [ [Music ] ] -> number -> [Music] LST is a list music-lists. NUMBER is 0-base, i.e. Voice=1 (upstems) has number 0. " - (if (null? lst) - '() - (cons (context-spec-music - (make-sequential-music - (list (make-voice-props-set number) - (make-simultaneous-music (car lst)))) - 'Voice (number->string (1+ number))) - (voicify-list (cdr lst) (1+ number))))) + (if (null? lst) + '() + (cons (context-spec-music + (make-sequential-music + (list (make-voice-props-set number) + (make-simultaneous-music (car lst)))) + 'Voice (number->string (1+ number))) + (voicify-list (cdr lst) (1+ number))))) (define (voicify-chord ch) "Split the parts of a chord into different Voices using separator" @@ -442,7 +429,7 @@ of beat groupings " (ly:export (make-music 'Music))) ;;; -; Make a function that checks score element for being of a specific type. + ; Make a function that checks score element for being of a specific type. (define-public (make-type-checker symbol) (lambda (elt) ;;(display symbol) @@ -455,14 +442,14 @@ of beat groupings " (define-public ((set-output-property grob-name symbol val) grob grob-c context) - "Usage: + "Usage: \\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1)) " - (let ((meta (ly:grob-property grob 'meta))) - (if (equal? (cdr (assoc 'name meta)) grob-name) - (set! (ly:grob-property grob symbol) val)))) + (let ((meta (ly:grob-property grob 'meta))) + (if (equal? (cdr (assoc 'name meta)) grob-name) + (set! (ly:grob-property grob symbol) val)))) ;; @@ -494,7 +481,7 @@ of beat groupings " (if (ly:input-location? ip) (ly:input-message ip msg) (ly:warn msg)))) - + (define (check-start-chords music) "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), without context specification. Called from parser." @@ -521,9 +508,8 @@ without context specification. Called from parser." (define (vector-extend v x) "Make a new vector consisting of V, with X added to the end." - (let* - ((n (vector-length v)) - (nv (make-vector (+ n 1) '()))) + (let* ((n (vector-length v)) + (nv (make-vector (+ n 1) '()))) (vector-move-left! v 0 n nv 0) (vector-set! nv n x) nv)) @@ -580,13 +566,11 @@ Syntax: "Must happen after quote-substitute." (if (vector? (ly:music-property quote-music 'quoted-events)) - (let* - ((dir (ly:music-property quote-music 'quoted-voice-direction)) - (main-voice (if (eq? 1 dir) 1 0)) - (cue-voice (if (eq? 1 dir) 0 1)) - (main-music (ly:music-property quote-music 'element)) - (return-value quote-music) - ) + (let* ((dir (ly:music-property quote-music 'quoted-voice-direction)) + (main-voice (if (eq? 1 dir) 1 0)) + (cue-voice (if (eq? 1 dir) 0 1)) + (main-music (ly:music-property quote-music 'element)) + (return-value quote-music)) (if (or (eq? 1 dir) (eq? -1 dir)) @@ -601,28 +585,23 @@ Syntax: (list (context-spec-music (make-voice-props-set cue-voice) 'Voice "cue") quote-music - (context-spec-music (make-voice-props-revert) 'Voice "cue")) - )) + (context-spec-music (make-voice-props-revert) 'Voice "cue")))) (set! main-music (make-sequential-music (list (make-voice-props-set main-voice) main-music - (make-voice-props-revert) - ))) - (set! (ly:music-property quote-music 'element) main-music) - )) + (make-voice-props-revert)))) + (set! (ly:music-property quote-music 'element) main-music))) return-value) quote-music)) (define-public ((quote-substitute quote-tab) music) - (let* - ((quoted-name (ly:music-property music 'quoted-music-name)) - (quoted-vector (if (string? quoted-name) - (hash-ref quote-tab quoted-name #f) - #f - ))) + (let* ((quoted-name (ly:music-property music 'quoted-music-name)) + (quoted-vector (if (string? quoted-name) + (hash-ref quote-tab quoted-name #f) + #f))) (if (string? quoted-name) (if (vector? quoted-vector) @@ -630,7 +609,7 @@ Syntax: (ly:warn "Cannot find quoted music `~S'" quoted-name))) music)) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; switch it on here, so parsing and init isn't checked (too slow!) @@ -666,9 +645,7 @@ Syntax: (music-map (quote-substitute (ly:parser-lookup parser 'musicQuotes)) music)) ;; switch-on-debugging - (lambda (x parser) (music-map cue-substitute x)) - - )) + (lambda (x parser) (music-map cue-substitute x)))) ;;;;;;;;;;;;;;;;; ;; lyrics @@ -688,7 +665,7 @@ Syntax: ;; (define-public ((add-balloon-text object-name text off) grob orig-context cur-context) - "Usage: see input/regression/balloon.ly " + "Usage: see input/regression/balloon.ly " (let* ((meta (ly:grob-property grob 'meta)) (nm (if (pair? meta) (cdr (assoc 'name meta)) "nonexistant")) (cb (ly:grob-property grob 'print-function))) @@ -801,24 +778,18 @@ use GrandStaff as a context. " (define-public (skip-of-length mus) "Create a skip of exactly the same length as MUS." - (let* - ((skip - (make-music - 'SkipEvent - 'duration (ly:make-duration 0 0)))) - - (make-event-chord (list (ly:music-compress skip (ly:music-length mus)))) -)) + (let* ((skip + (make-music + 'SkipEvent + 'duration (ly:make-duration 0 0)))) + (make-event-chord (list (ly:music-compress skip (ly:music-length mus)))))) (define-public (mmrest-of-length mus) "Create a mmrest of exactly the same length as MUS." - (let* - ((skip - (make-multi-measure-rest - (ly:make-duration 0 0) '() ))) - (ly:music-compress skip (ly:music-length mus)) - skip -)) - + (let* ((skip + (make-multi-measure-rest + (ly:make-duration 0 0) '() ))) + (ly:music-compress skip (ly:music-length mus)) + skip)) diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm index 08f092b06d..2846daa9ba 100644 --- a/scm/output-gnome.scm +++ b/scm/output-gnome.scm @@ -120,13 +120,13 @@ lilypond -fgnome input/simple-song.ly (+ #x80 (modulo y #x40)))))) (else (begin (stderr "programming-error: utf-8 too big:~x\n" i) (list (integer->char 32)))))) - + (define (integer->utf8-string integer) (list->string (utf8 integer))) (define (char->utf8-string char) (list->string (utf8 (char->integer char)))) - + (define (string->utf8-string string) (apply string-append @@ -227,14 +227,13 @@ lilypond -fgnome input/simple-song.ly bezier)) (define (square-beam width slope thick blot) - (let* - ((def (make )) - (y (* (- width) slope)) - (props (make - #:parent (canvas-root) - #:fill-color "black" - #:outline-color "black" - #:width-units 0.0))) + (let* ((def (make )) + (y (* (- width) slope)) + (props (make + #:parent (canvas-root) + #:fill-color "black" + #:outline-color "black" + #:width-units 0.0))) (reset def) (moveto def 0 0) @@ -245,7 +244,7 @@ lilypond -fgnome input/simple-song.ly (closepath def) (set-path-def props def) props)) - + ;; two beziers (define (bezier-sandwich lst thick) (let* ((def (make )) @@ -262,16 +261,16 @@ lilypond -fgnome input/simple-song.ly ;; cl cr r l 0 1 2 3 ;; cr cl l r 4 5 6 7 - (moveto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3)))) - (curveto def (car (list-ref lst 0)) (- (cdr (list-ref lst 0))) + (moveto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3)))) + (curveto def (car (list-ref lst 0)) (- (cdr (list-ref lst 0))) (car (list-ref lst 1)) (- (cdr (list-ref lst 1))) (car (list-ref lst 2)) (- (cdr (list-ref lst 2)))) - (lineto def (car (list-ref lst 7)) (- (cdr (list-ref lst 7)))) - (curveto def (car (list-ref lst 4)) (- (cdr (list-ref lst 4))) + (lineto def (car (list-ref lst 7)) (- (cdr (list-ref lst 7)))) + (curveto def (car (list-ref lst 4)) (- (cdr (list-ref lst 4))) (car (list-ref lst 5)) (- (cdr (list-ref lst 5))) (car (list-ref lst 6)) (- (cdr (list-ref lst 6)))) - (lineto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3)))) + (lineto def (car (list-ref lst 3)) (- (cdr (list-ref lst 3)))) (closepath def) (set-path-def bezier def) @@ -332,7 +331,7 @@ lilypond -fgnome input/simple-song.ly #:fill-color "black" #:outline-color "black" #:join-style 'round) - #:width-units blot-diameter) + #:width-units blot-diameter) (points (ly:list->offsets '() coords)) (last-point (car (last-pair points)))) @@ -342,7 +341,7 @@ lilypond -fgnome input/simple-song.ly (closepath def) (set-path-def props def) props)) - + (define (round-filled-box breapth width depth height blot-diameter) (let ((r (/ blot-diameter 2))) (make @@ -371,7 +370,7 @@ lilypond -fgnome input/simple-song.ly ;;scaling:29.7046771653543 ;;magnification:0.569055118110236 ;;design:20.0 - + ;; ugh, experimental sizing ;; where does factor ops come from? ;; Hmm, design size: 26/20 diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 1128d68b6e..6234339c13 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -5,22 +5,20 @@ ;;;; (c) 1998--2004 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys -; Tablature functions, by Jiba (jiba@tuxfamily.org) +;;; Tablature functions, by Jiba (jiba@tuxfamily.org) -; The TabNoteHead stem attachment function. +;; The TabNoteHead stem attachment function. (define (tablature-stem-attachment-function style duration) (cons 0.0 0.5)) - -; The TabNoteHead tablatureFormat callback. -; Compute the text grob-property +;; The TabNoteHead tablatureFormat callback. +;; Compute the text grob-property (define-public (fret-number-tablature-format string tuning pitch) (number->string (- (ly:pitch-semitones pitch) (list-ref tuning - (- string 1) ; remove 1 because list index starts at 0 and guitar string at 1. - ) - ))) + ;; remove 1 because list index starts at 0 and guitar string at 1. + (- string 1))))) (define-public (hammer-print-function grob) (let* ((note-collums (ly:grob-property grob 'note-columns)) @@ -35,11 +33,9 @@ (letter (cond ((< fret1 fret2) "H") ((> fret1 fret2) "P") - (else ""))) - - ) - (let* ( - (slur ; (Slur::print grob) + (else "")))) + (let* ((slur + ;; (Slur::print grob) ;; ;; FIXME: a hammer is not a slur. @@ -50,24 +46,21 @@ layout (ly:grob-alist-chain grob (ly:output-def-lookup layout 'text-font-defaults)) letter))) - + (let ((x (/ (- (cdr (ly:stencil-extent slur 0)) - (/ (cdr (ly:stencil-extent text 0)) 2.0) - ) + (/ (cdr (ly:stencil-extent text 0)) 2.0)) -2.0))) - + (ly:stencil-set-extent! text 0 (cons x x)) - (ly:stencil-align-to! text 0 1) - ) + (ly:stencil-align-to! text 0 1))) ) ) -; (ly:stencil-combine-at-edge slur 1 1 text -0.6) - ) ) ) + ; (ly:stencil-combine-at-edge slur 1 1 text -0.6) (define-public guitar-tunings '(4 -1 -5 -10 -15 -20)) -; end of tablature functions + ; end of tablature functions (define-public (make-stencil-boxer line-thick x-padding y-padding callback) @@ -80,8 +73,7 @@ (y-ext (interval-widen (ly:stencil-extent mol 1) y-padding)) (x-rule (make-filled-box-stencil (interval-widen x-ext line-thick) (cons 0 line-thick))) - (y-rule (make-filled-box-stencil (cons 0 line-thick) y-ext)) - ) + (y-rule (make-filled-box-stencil (cons 0 line-thick) y-ext))) (set! mol (ly:stencil-combine-at-edge mol 0 1 y-rule x-padding)) (set! mol (ly:stencil-combine-at-edge mol 0 -1 y-rule x-padding)) @@ -138,40 +130,38 @@ (define (scm-scm action-name) 1) - ;; silly, use alist? (define-public (find-notehead-symbol duration style) (case style - ((xcircle) "2xcircle") - ((harmonic) "0harmonic") - ((baroque) - ;; Oops, I actually would not call this "baroque", but, for - ;; backwards compatibility to 1.4, this is supposed to take - ;; brevis, longa and maxima from the neo-mensural font and all - ;; other note heads from the default font. -- jr - (if (< duration 0) - (string-append (number->string duration) "neomensural") - (number->string duration))) - ((mensural) - (string-append (number->string duration) (symbol->string style))) - ((neomensural) - (string-append (number->string duration) (symbol->string style))) - ((default) - ;; The default font in mf/feta-bolletjes.mf defines a brevis, but - ;; neither a longa nor a maxima. Hence let us, for the moment, - ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes - ;; should define at least a longa for the default font. The longa - ;; should look exactly like the brevis of the default font, but - ;; with a stem exactly like that of the quarter note. -- jr - (if (< duration -1) - (string-append (number->string duration) "neomensural") - (number->string duration))) - (else - (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style)) - (symbol->string style) - (string-append (number->string (max 0 duration)) - (symbol->string style)))))) - + ((xcircle) "2xcircle") + ((harmonic) "0harmonic") + ((baroque) + ;; Oops, I actually would not call this "baroque", but, for + ;; backwards compatibility to 1.4, this is supposed to take + ;; brevis, longa and maxima from the neo-mensural font and all + ;; other note heads from the default font. -- jr + (if (< duration 0) + (string-append (number->string duration) "neomensural") + (number->string duration))) + ((mensural) + (string-append (number->string duration) (symbol->string style))) + ((neomensural) + (string-append (number->string duration) (symbol->string style))) + ((default) + ;; The default font in mf/feta-bolletjes.mf defines a brevis, but + ;; neither a longa nor a maxima. Hence let us, for the moment, + ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes + ;; should define at least a longa for the default font. The longa + ;; should look exactly like the brevis of the default font, but + ;; with a stem exactly like that of the quarter note. -- jr + (if (< duration -1) + (string-append (number->string duration) "neomensural") + (number->string duration))) + (else + (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style)) + (symbol->string style) + (string-append (number->string (max 0 duration)) + (symbol->string style)))))) ;; TODO junk completely? (define (note-head-style->attachment-coordinates grob axis) @@ -179,8 +169,7 @@ bounding box, where to attach the stem. e.g.: X==0 means horizontally centered, X==1 is at the right, X == -1 is at the left." - '(1.0 . 0.0)) - + '(1.0 . 0.0)) (define-public (string-encode-integer i) (cond @@ -190,14 +179,13 @@ centered, X==1 is at the right, X == -1 is at the left." (make-string 1 (integer->char (+ 65 (modulo i 26)))) (string-encode-integer (quotient i 26)))))) - (define-public ((every-nth-bar-number-visible n) barnum) (= 0 (modulo barnum n))) (define-public ((modulo-bar-number-visible n m) barnum) (and (> barnum 1) (= m (modulo barnum n)))) (define-public ((set-bar-number-visibility n) tr) (let* ((bn (ly:context-property tr 'currentBarNumber))) - (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n))))) + (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n))))) (define-public (default-bar-number-visibility barnum) (> barnum 1)) @@ -215,42 +203,36 @@ centered, X==1 is at the right, X == -1 is at the left." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Bar lines. -; -; How should a bar line behave at a break? -; +;; +;; How should a bar line behave at a break? +;; ;; Why prepend `default-' to every scm identifier? (define-public (default-break-barline glyph dir) - (let ((result (assoc glyph - '((":|:" . (":|" . "|:")) - ("||:" . ("||" . "|:")) - ("|" . ("|" . ())) - ("||:" . ("||" . "|:")) - ("|s" . (() . "|")) - ("|:" . ("|" . "|:")) - ("|." . ("|." . ())) - - ;; hmm... should we end with a bar line here? - (".|" . ("|" . ".|")) - (":|" . (":|" . ())) - ("||" . ("||" . ())) - (".|." . (".|." . ())) - ("" . ("" . "")) - (":" . (":" . "")) - ("empty" . (() . ())) - ("brace" . (() . "brace")) - ("bracket" . (() . "bracket")) - ) - ))) - - (if (equal? result #f) - (ly:warn "Unknown bar glyph: `~S'" glyph) - (index-cell (cdr result) dir)) - ) ) - - + (let ((result (assoc glyph + '((":|:" . (":|" . "|:")) + ("||:" . ("||" . "|:")) + ("|" . ("|" . ())) + ("||:" . ("||" . "|:")) + ("|s" . (() . "|")) + ("|:" . ("|" . "|:")) + ("|." . ("|." . ())) + + ;; hmm... should we end with a bar line here? + (".|" . ("|" . ".|")) + (":|" . (":|" . ())) + ("||" . ("||" . ())) + (".|." . (".|." . ())) + ("" . ("" . "")) + (":" . (":" . "")) + ("empty" . (() . ())) + ("brace" . (() . "brace")) + ("bracket" . (() . "bracket")) )))) + + (if (equal? result #f) + (ly:warn "Unknown bar glyph: `~S'" glyph) + (index-cell (cdr result) dir))) ) (define-public (shift-right-at-line-begin g) "Shift an item to the right, but only at the start of the line." (if (and (ly:item? g) (equal? (ly:item-break-dir g) RIGHT)) - (ly:grob-translate-axis! g 3.5 X) - )) + (ly:grob-translate-axis! g 3.5 X))) diff --git a/scm/output-pdftex.scm b/scm/output-pdftex.scm index f20f7a02aa..dbfe74fc2e 100644 --- a/scm/output-pdftex.scm +++ b/scm/output-pdftex.scm @@ -24,12 +24,8 @@ (define (unknown) "%\n\\unknown\n") - (define (select-font name-mag-pair) - (let* - ( - (c (assoc name-mag-pair font-name-alist)) - ) + (let* ((c (assoc name-mag-pair font-name-alist))) (if (eq? c #f) (begin @@ -38,14 +34,10 @@ (display (object-type (caaar font-name-alist))) (ly:warn "Programming error: No such font known ~S ~S" - (car name-mag-pair) - (ly:number->string (cdr name-mag-pair)) - ) + (car name-mag-pair) + (ly:number->string (cdr name-mag-pair))) "") ; issue no command - (string-append "\\" (cddr c))) - - - )) + (string-append "\\" (cddr c))))) (define (beam width slope thick blot) (embedded-pdf (list 'beam width slope thick blot))) @@ -76,48 +68,40 @@ (define (header-to-file fn key val) (set! key (symbol->string key)) (if (not (equal? "-" fn)) - (set! fn (string-append fn "." key)) - ) + (set! fn (string-append fn "." key))) (display (format "writing header field `~a' to `~a'..." key - (if (equal? "-" fn) "" fn) - ) + (if (equal? "-" fn) "" fn)) (current-error-port)) (if (equal? fn "-") (display val) - (display val (open-file fn "w")) - ) + (display val (open-file fn "w"))) (display "\n" (current-error-port)) - "" - ) + "") (define (embedded-pdf expr) - (let - ((os (open-output-string))) + (let ((os (open-output-string))) (pdf-output-expression expr os) (string-append "\\embeddedpdf{" (get-output-string os) "}"))) - - (define (experimental-on) "") (define (repeat-slash w a t) (embedded-pdf (list 'repeat-slash w a t))) - (define (tex-encoded-fontswitch name-mag) (let* ((iname-mag (car name-mag)) (ename-mag (cdr name-mag))) (cons iname-mag (cons ename-mag (string-append "magfont" - (string-encode-integer - (hashq (car ename-mag) 1000000)) - "m" - (string-encode-integer - (inexact->exact (* 1000 (cdr ename-mag))))))))) + (string-encode-integer + (hashq (car ename-mag) 1000000)) + "m" + (string-encode-integer + (inexact->exact (* 1000 (cdr ename-mag))))))))) (define (define-fonts internal-external-name-mag-pairs) (set! font-name-alist (map tex-encoded-fontswitch internal-external-name-mag-pairs)) @@ -126,7 +110,6 @@ (font-load-command (car x) (cdr x))) (map cdr font-name-alist)))) - (define (font-switch i) (string-append "\\" (font i) "\n")) @@ -141,8 +124,7 @@ (number->string (cond ((equal? (ly:unit) "mm") (/ 72.0 25.4)) ((equal? (ly:unit) "pt") (/ 72.0 72.27)) - (else (error "unknown unit" (ly:unit))) - )) + (else (error "unknown unit" (ly:unit))))) "}%\n" "\\ifx\\lilypondstart\\undefined\n" " \\input lilyponddefs\n" @@ -163,16 +145,16 @@ ;; FIXME: explain ploblem: need to do something to make this really safe. (define (output-tex-string s) (if (ly:get-option 'safe) - (regexp-substitute/global #f "\\\\" - (regexp-substitute/global #f "\\([{}]\\)" s 'pre "\\1" 'post) - 'pre "$\\backslash$" 'post) - + (regexp-substitute/global + #f "\\\\" + (regexp-substitute/global #f "\\([{}]\\)" s 'pre "\\1" 'post) + 'pre "$\\backslash$" 'post) s)) (define (lily-def key val) (let ((tex-key (regexp-substitute/global - #f "_" (output-tex-string key) 'pre "X" 'post)) + #f "_" (output-tex-string key) 'pre "X" 'post)) (tex-val (output-tex-string val))) (if (equal? (sans-surrounding-whitespace tex-val) "") (string-append "\\let\\" tex-key "\\undefined\n") @@ -228,14 +210,10 @@ (string-append "\\special{src:\\string:" (point-and-click line col file) "}" ) - "") - ) + "")) - ; no-origin not supported in PDFTeX +;; no-origin not supported in PDFTeX (define (no-origin) "") - - - (define-public (pdftex-output-expression expr port) (display (eval expr this-module) port) ) diff --git a/scm/output-ps.scm b/scm/output-ps.scm index d36cb6a1d4..40c24c19b1 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -20,31 +20,30 @@ ;; JUNK this -- see lily.scm: ly:all-output-backend-commands #:export (unknown - blank - dot - white-dot - beam - bracket - dashed-slur - char - named-glyph - dashed-line - zigzag-line - ez-ball - comment - repeat-slash - placebox - bezier-sandwich - horizontal-line - embedded-ps - filledbox - round-filled-box - text - white-text - polygon - draw-line - no-origin - )) + blank + dot + white-dot + beam + bracket + dashed-slur + char + named-glyph + dashed-line + zigzag-line + ez-ball + comment + repeat-slash + placebox + bezier-sandwich + horizontal-line + embedded-ps + filledbox + round-filled-box + text + white-text + polygon + draw-line + no-origin)) (use-modules (guile) @@ -113,12 +112,12 @@ (define (char font i) (string-append - (ps-font-command font) " setfont " + (ps-font-command font) " setfont " "(\\" (ly:inexact->string i 8) ") show" )) (define (named-glyph font glyph) (string-append - (ps-font-command font) " setfont " + (ps-font-command font) " setfont " "/" glyph " glyphshow ")) (define (dashed-line thick on off dx dy) @@ -144,7 +143,7 @@ (ly:number->string (* 10 thick)) " ] 0 draw_dashed_slur")) -; todo: merge with tex-font-command? + ; todo: merge with tex-font-command? (define (embedded-ps string) string) @@ -211,19 +210,16 @@ " draw_repeat_slash")) (define (round-filled-box x y width height blotdiam) - (string-append - (ly:numbers->string - (list x y width height blotdiam)) " draw_round_box")) + (string-append + (ly:numbers->string + (list x y width height blotdiam)) " draw_round_box")) (define (old-text font s) - (let* - - ;; ugh, we should find a better way to - ;; extract the hsbw for /space from the font. - - ((space-length (cdar (ly:text-dimension font " "))) - (commands '()) - (add-command (lambda (x) (set! commands (cons x commands)))) ) + ;; ugh, we should find a better way to + ;; extract the hsbw for /space from the font. + (let* ((space-length (cdar (ly:text-dimension font " "))) + (commands '()) + (add-command (lambda (x) (set! commands (cons x commands)))) ) (string-fold (lambda (chr word) @@ -244,18 +240,16 @@ (string-append (ps-font-command font) " setfont " - (string-join (reverse commands))) - )) + (string-join (reverse commands))))) (define (new-text font s) - (let* - ((space-length (cdar (ly:text-dimension font " "))) - (space-move (string-append (number->string space-length) " 0.0 rmoveto ")) - - (input-enc (assoc-get 'input-name - (ly:font-encoding-alist font) - 'latin1)) - (out-vec (decode-byte-string input-enc s))) + (let* ((space-length (cdar (ly:text-dimension font " "))) + (space-move (string-append (number->string space-length) " 0.0 rmoveto ")) + + (input-enc (assoc-get 'input-name + (ly:font-encoding-alist font) + 'latin1)) + (out-vec (decode-byte-string input-enc s))) (string-append @@ -268,30 +262,29 @@ (if (eq? sym 'space) space-move (string-append "/" (symbol->string sym) " glyphshow"))) - out-vec))) - ))) + out-vec)))))) -;(define text old-text) + ;(define text old-text) (define text new-text) (define (white-text scale s) - (let ((mystring (string-append "(" s ") " (number->string scale) " /Helvetica-Bold " - " draw_white_text"))) - mystring)) + (let ((mystring (string-append "(" s ") " (number->string scale) " /Helvetica-Bold " + " draw_white_text"))) + mystring)) (define (unknown) "\n unknown\n") (define (zigzag-line centre? zzw zzh thick dx dy) (string-append - (if centre? "true" "false") " " - (ly:number->string zzw) " " - (ly:number->string zzh) " " - (ly:number->string thick) " " - "0 0 " - (ly:number->string dx) " " - (ly:number->string dy) - " draw_zigzag_line")) + (if centre? "true" "false") " " + (ly:number->string zzw) " " + (ly:number->string zzh) " " + (ly:number->string thick) " " + "0 0 " + (ly:number->string dx) " " + (ly:number->string dy) + " draw_zigzag_line")) (define (grob-cause grob) diff --git a/scm/output-tex.scm b/scm/output-tex.scm index f2d8da9456..a0efaddded 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -23,30 +23,29 @@ ;; JUNK this -- see lily.scm: ly:all-output-backend-commands #:export (unknown - blank - dot - white-dot - beam - bracket - dashed-slur - named-glyph - dashed-line - zigzag-line - ez-ball - comment - repeat-slash - placebox - bezier-sandwich - horizontal-line - filledbox - round-filled-box - text - white-text - polygon - draw-line - no-origin - grob-cause - )) + blank + dot + white-dot + beam + bracket + dashed-slur + named-glyph + dashed-line + zigzag-line + ez-ball + comment + repeat-slash + placebox + bezier-sandwich + horizontal-line + filledbox + round-filled-box + text + white-text + polygon + draw-line + no-origin + grob-cause)) (use-modules (ice-9 regex) (ice-9 string-fun) @@ -109,8 +108,7 @@ (begin (ly:warn "Can't find ~a in ~a" name font) - "")) - )) + "")))) (define (dashed-line thick on off dx dy) (embedded-ps (list 'dashed-line thick on off dx dy))) @@ -161,16 +159,16 @@ (embedded-ps (list 'round-filled-box x y width height blotdiam))) (define (text font s) - (let* - ((mapping #f) ;; (assoc-get 'char-mapping (ly:font-encoding-alist font)))) + ;; (assoc-get 'char-mapping (ly:font-encoding-alist font)))) + (let* ((mapping #f) - - ;; TODO: we'd better do this for PS only - ;; LaTeX gets in the way, and we need to remap - ;; nonprintable chars. - - (input-enc-name #f) ;; (assoc-get 'input-name (ly:font-encoding-alist font) )) - ) + ;; TODO: we'd better do this for PS only + ;; LaTeX gets in the way, and we need to remap + ;; nonprintable chars. + + ;; (assoc-get 'input-name (ly:font-encoding-alist font))) + + (input-enc-name #f)) (string-append "\\hbox{\\" (tex-font-command font) (if (string? input-enc-name) @@ -183,8 +181,8 @@ "}"))) (define (white-text scale s) - (embedded-ps (list 'white-text scale s))) - + (embedded-ps (list 'white-text scale s))) + (define (polygon points blotdiameter) (embedded-ps (list 'polygon `(quote ,points) blotdiameter))) @@ -206,4 +204,4 @@ (string-append "\\special{src:" (apply point-and-click location) "}") "")) - "")) + "")) \ No newline at end of file diff --git a/scm/page-layout.scm b/scm/page-layout.scm index 1c23ce46c2..ccfc71329a 100644 --- a/scm/page-layout.scm +++ b/scm/page-layout.scm @@ -1,5 +1,5 @@ -;;; page-layout.scm -- page breaking and page layout -;;; +;;;; page-layout.scm -- page breaking and page layout +;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; ;;;; (c) 2004 Jan Nieuwenhuizen @@ -31,11 +31,10 @@ (define TAGLINE (string-append "Engraved by LilyPond (version " (lilypond-version) ")")) - + (define (page-headfoot layout scopes number sym sepsym dir last?) "Create a stencil including separating space." - (let* - ((header-proc (ly:output-def-lookup layout sym)) + (let* ((header-proc (ly:output-def-lookup layout sym)) (sep (ly:output-def-lookup layout sepsym)) (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0))) (head-stencil @@ -55,8 +54,7 @@ (define-public (default-page-music-height layout scopes number last?) "Printable area for music and titles; matches default-page-make-stencil." - (let* - ((h (- (ly:output-def-lookup layout 'vsize) + (let* ((h (- (ly:output-def-lookup layout 'vsize) (ly:output-def-lookup layout 'topmargin) (ly:output-def-lookup layout 'bottommargin))) (head (page-headfoot layout scopes number 'make-header 'headsep UP last?)) @@ -69,64 +67,61 @@ (interval-length (ly:stencil-extent foot Y)) 0)))) -; (display (list "\n available" available head foot)) + ; (display (list "\n available" available head foot)) available)) (define-public (default-page-make-stencil lines offsets layout scopes number last? ) "Construct a stencil representing the page from LINES. " - (let* - ((topmargin (ly:output-def-lookup layout 'topmargin)) - - ;; TODO: naming vsize/hsize not analogous to TeX. - - (vsize (ly:output-def-lookup layout 'vsize)) - (hsize (ly:output-def-lookup layout 'hsize)) - - (lmargin (ly:output-def-lookup layout 'leftmargin)) - (leftmargin (if lmargin - lmargin - (/ (- hsize - (ly:output-def-lookup layout 'linewidth)) 2))) - - (rightmargin (ly:output-def-lookup layout 'rightmargin)) - (bottom-edge (- vsize - (ly:output-def-lookup layout 'bottommargin))) - - (head (page-headfoot layout scopes number 'make-header 'headsep UP last?)) - (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?)) - - (head-height (if (ly:stencil? head) - (interval-length (ly:stencil-extent head Y)) - 0.0)) - - (line-stencils (map ly:paper-system-stencil lines)) - (height-proc (ly:output-def-lookup layout 'page-music-height)) - - (page-stencil (ly:make-stencil '() - (cons leftmargin hsize) - (cons (- topmargin) 0))) - (was-title #t) - (add-system (lambda (stencil-position) - (set! page-stencil - (ly:stencil-add - (ly:stencil-translate-axis - (car stencil-position) - (- 0 - head-height - (cadr stencil-position) - topmargin) - Y) - page-stencil)))) - ) + (let* ((topmargin (ly:output-def-lookup layout 'topmargin)) + + ;; TODO: naming vsize/hsize not analogous to TeX. + + (vsize (ly:output-def-lookup layout 'vsize)) + (hsize (ly:output-def-lookup layout 'hsize)) + + (lmargin (ly:output-def-lookup layout 'leftmargin)) + (leftmargin (if lmargin + lmargin + (/ (- hsize + (ly:output-def-lookup layout 'linewidth)) 2))) + + (rightmargin (ly:output-def-lookup layout 'rightmargin)) + (bottom-edge (- vsize + (ly:output-def-lookup layout 'bottommargin))) + + (head (page-headfoot layout scopes number 'make-header 'headsep UP last?)) + (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?)) + + (head-height (if (ly:stencil? head) + (interval-length (ly:stencil-extent head Y)) + 0.0)) + + (line-stencils (map ly:paper-system-stencil lines)) + (height-proc (ly:output-def-lookup layout 'page-music-height)) + + (page-stencil (ly:make-stencil '() + (cons leftmargin hsize) + (cons (- topmargin) 0))) + (was-title #t) + (add-system (lambda (stencil-position) + (set! page-stencil + (ly:stencil-add + (ly:stencil-translate-axis + (car stencil-position) + (- 0 + head-height + (cadr stencil-position) + topmargin) + Y) + page-stencil))))) (if #f (display (list - "leftmargin" leftmargin "rightmargin" rightmargin - ))) + "leftmargin" leftmargin "rightmargin" rightmargin))) (set! page-stencil (ly:stencil-combine-at-edge - page-stencil Y DOWN head 0. 0.)) + page-stencil Y DOWN head 0. 0.)) (map add-system (zip line-stencils offsets)) (if (ly:stencil? foot) @@ -137,12 +132,10 @@ foot (cons 0 (+ (- bottom-edge) - (- (car (ly:stencil-extent foot Y))))) - )))) + (- (car (ly:stencil-extent foot Y))))))))) + + (ly:stencil-translate page-stencil (cons leftmargin 0)))) - (ly:stencil-translate page-stencil (cons leftmargin 0)) - )) - @@ -151,11 +144,11 @@ ;;; This is not optimal page breaking, this is optimal distribution of ;;; lines over pages; line breaks are a given. -; TODO: -; -; - density scoring -; - separate function for word-wrap style breaking? -; - raggedbottom? raggedlastbottom? + ; TODO: + ; + ; - density scoring + ; - separate function for word-wrap style breaking? + ; - raggedbottom? raggedlastbottom? (define-public (ly:optimal-page-breaks lines paper-book) @@ -168,8 +161,7 @@ of lines. " (define scopes (ly:paper-book-scopes paper-book)) (define (page-height page-number last?) - (let - ((p (ly:output-def-lookup paper 'page-music-height))) + (let ((p (ly:output-def-lookup paper 'page-music-height))) (if (procedure? p) (p paper scopes page-number last?) @@ -184,8 +176,7 @@ is what have collected so far, and has ascending page numbers." done)) (define (combine-penalties force user best-paths) - (let* - ((prev-force (if (null? best-paths) + (let* ((prev-force (if (null? best-paths) 0.0 (node-force (car best-paths)))) (prev-penalty (if (null? best-paths) @@ -194,25 +185,22 @@ is what have collected so far, and has ascending page numbers." (inter-system-space (ly:output-def-lookup paper 'betweensystemspace)) (force-equalization-factor 0.3) (relative-force (/ force inter-system-space)) - (abs-relative-force (abs relative-force)) - ) - - - (+ (* abs-relative-force (+ abs-relative-force 1)) - prev-penalty - (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space)) - user))) + (abs-relative-force (abs relative-force))) + + + (+ (* abs-relative-force (+ abs-relative-force 1)) + prev-penalty + (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space)) + user))) (define (space-systems page-height lines ragged?) - (let* - ((inter-system-space + (let* ((inter-system-space (ly:output-def-lookup paper 'betweensystemspace)) (system-vector (list->vector - (append lines - (if (= (length lines) 1) - '(#f) - '())) - )) + (append lines + (if (= (length lines) 1) + '(#f) + '())))) (staff-extents (list->vector @@ -221,34 +209,28 @@ is what have collected so far, and has ascending page numbers." lines) (if (= (length lines) 1) '((0 . 0)) - '())) - )) + '())) )) (real-extents (list->vector (append (map (lambda (sys) (ly:paper-system-extent sys Y)) lines) - (if (= (length lines) 1) - '((0 . 0)) - '()) - ))) + (if (= (length lines) 1) + '((0 . 0)) + '()) ))) (no-systems (vector-length real-extents)) (topskip (interval-end (vector-ref real-extents 0))) (space-left (- page-height - (apply + (map interval-length (vector->list real-extents))) - - )) - + (apply + (map interval-length (vector->list real-extents))))) + (space (- page-height topskip - (- (interval-start (vector-ref real-extents (1- no-systems)))) - )) + (- (interval-start (vector-ref real-extents (1- no-systems)))))) (fixed-dist (ly:output-def-lookup paper 'betweensystempadding)) (calc-spring (lambda (idx) - (let* - ((this-system-ext (vector-ref staff-extents idx)) + (let* ((this-system-ext (vector-ref staff-extents idx)) (next-system-ext (vector-ref staff-extents (1+ idx))) (fixed (max 0 (- (+ (interval-end next-system-ext) fixed-dist) @@ -256,8 +238,8 @@ is what have collected so far, and has ascending page numbers." (title1? (and (vector-ref system-vector idx) (ly:paper-system-title? (vector-ref system-vector idx)))) (title2? (and - (vector-ref system-vector (1+ idx)) - (ly:paper-system-title? (vector-ref system-vector (1+ idx))))) + (vector-ref system-vector (1+ idx)) + (ly:paper-system-title? (vector-ref system-vector (1+ idx))))) (ideal (+ (cond ((and title2? title1?) @@ -268,19 +250,16 @@ is what have collected so far, and has ascending page numbers." (ly:output-def-lookup paper 'beforetitlespace)) (else inter-system-space)) fixed)) - (hooke (/ 1 (- ideal fixed))) - ) - (list ideal hooke)) - )) + (hooke (/ 1 (- ideal fixed)))) + (list ideal hooke)))) (springs (map calc-spring (iota (1- no-systems)))) (calc-rod (lambda (idx) - (let* - ((this-system-ext (vector-ref real-extents idx)) + (let* ((this-system-ext (vector-ref real-extents idx)) (next-system-ext (vector-ref real-extents (1+ idx))) (distance (max (- (+ (interval-end next-system-ext) - fixed-dist) + fixed-dist) (interval-start this-system-ext) ) 0)) (entry (list idx (1+ idx) distance))) @@ -296,26 +275,25 @@ is what have collected so far, and has ascending page numbers." (force (car result)) (positions (map (lambda (y) - (+ y topskip)) - (cdr result))) - ) + (+ y topskip)) + (cdr result)))) (if #f ;; debug. (begin - (display (list "\n# systems: " no-systems - "\nreal-ext" real-extents "\nstaff-ext" staff-extents - "\ninterscore" inter-system-space - "\nspace-letf" space-left - "\nspring,rod" springs rods - "\ntopskip " topskip - " space " space - "\npage-height" page-height - "\nragged" ragged? - "\nforce" force - "\nres" (cdr result) - "\npositions" positions "\n")))) - - (cons force positions))) + (display (list "\n# systems: " no-systems + "\nreal-ext" real-extents "\nstaff-ext" staff-extents + "\ninterscore" inter-system-space + "\nspace-letf" space-left + "\nspring,rod" springs rods + "\ntopskip " topskip + " space " space + "\npage-height" page-height + "\nragged" ragged? + "\nforce" force + "\nres" (cdr result) + "\npositions" positions "\n")))) + + (cons force positions))) (define (walk-paths done-lines best-paths current-lines last? current-best) "Return the best optimal-page-break-node that contains @@ -351,7 +329,7 @@ CURRENT-BEST is the best result sofar, or #f." (user-penalty (+ (max (ly:paper-system-break-before-penalty (car current-lines)) 0.0) - user-nobreak-penalties)) + user-nobreak-penalties)) (total-penalty (combine-penalties force user-penalty best-paths)) @@ -363,8 +341,8 @@ CURRENT-BEST is the best result sofar, or #f." (new-best (if better? (make #:prev (if (null? best-paths) - #f - (car best-paths)) + #f + (car best-paths)) #:lines current-lines #:pageno this-page-num #:force force @@ -410,7 +388,7 @@ DONE." (last? (null? (cdr todo))) (next (walk-paths done best-paths (list this-line) last? #f))) -; (display "\n***************") + ; (display "\n***************") (walk-lines (cons this-line done) (cons next best-paths) (cdr todo))))) @@ -425,12 +403,12 @@ DONE." (begin (display (list "\nbreaks: " (map line-number break-nodes)) - "\nsystems " (map node-lines break-nodes) - "\npenalties " (map node-penalty break-nodes) - "\nconfigs " (map node-configuration break-nodes)))) + "\nsystems " (map node-lines break-nodes) + "\npenalties " (map node-penalty break-nodes) + "\nconfigs " (map node-configuration break-nodes)))) - ; create stencils. + ; create stencils. (map (lambda (node) ((ly:output-def-lookup paper 'page-make-stencil) diff --git a/scm/titling.scm b/scm/titling.scm index 99ba004b2c..9fa0c4f74d 100644 --- a/scm/titling.scm +++ b/scm/titling.scm @@ -24,35 +24,33 @@ page:last?, page:page-number-string and page:page-number (define (interpret-in-page-env potential-markup) (if (markup? potential-markup) - (let* - ((alists (map ly:module->alist scopes)) - (prefixed-alists - (map (lambda (alist) - (map (lambda (entry) - (cons - (string->symbol - (string-append - "header:" - (symbol->string (car entry)))) - (cdr entry) - )) - alist)) - alists)) - (tagline (ly:modules-lookup scopes 'tagline)) + (let* ((alists (map ly:module->alist scopes)) + (prefixed-alists + (map (lambda (alist) + (map (lambda (entry) + (cons + (string->symbol + (string-append + "header:" + (symbol->string (car entry)))) + (cdr entry))) + alist)) + alists)) + (tagline (ly:modules-lookup scopes 'tagline)) - (pgnum-alist - (list - (cons 'header:tagline (if (markup? tagline) - tagline - TAGLINE)) - (cons 'page:last? last?) - (cons 'page:page-number-string - (number->string page-number)) - (cons 'page:page-number page-number))) - (props (append - (list pgnum-alist) - prefixed-alists - (page-properties layout)))) + (pgnum-alist + (list + (cons 'header:tagline (if (markup? tagline) + tagline + TAGLINE)) + (cons 'page:last? last?) + (cons 'page:page-number-string + (number->string page-number)) + (cons 'page:page-number page-number))) + (props (append + (list pgnum-alist) + prefixed-alists + (page-properties layout)))) (interpret-markup layout props potential-markup)) @@ -74,28 +72,23 @@ PROPS argument will include variables set in SCOPES (prefixed with (let ((x (ly:modules-lookup scopes sym))) (if (markup? x) x #f))) - (let* - ((alists (map ly:module->alist scopes)) - (prefixed-alist - (map (lambda (alist) - (map (lambda (entry) - (cons - (string->symbol - (string-append - "header:" - (symbol->string (car entry)))) - (cdr entry) - )) - alist)) - alists)) - (props (append prefixed-alist - (page-properties layout))) + (let* ((alists (map ly:module->alist scopes)) + (prefixed-alist + (map (lambda (alist) + (map (lambda (entry) + (cons + (string->symbol + (string-append + "header:" + (symbol->string (car entry)))) + (cdr entry))) + alist)) + alists)) + (props (append prefixed-alist + (page-properties layout))) - (markup (ly:output-def-lookup layout what)) - ) + (markup (ly:output-def-lookup layout what))) (if (markup? markup) (interpret-markup layout props markup) - (ly:make-stencil '() '(1 . -1) '(1 . -1))) - )) - + (ly:make-stencil '() '(1 . -1) '(1 . -1))))) diff --git a/scm/to-xml.scm b/scm/to-xml.scm index f991d5eed2..e3f3277c46 100644 --- a/scm/to-xml.scm +++ b/scm/to-xml.scm @@ -47,20 +47,19 @@ is then separated. (pitch . pitch) (duration . duration) (octave . octave) - (step . step) - )) + (step . step))) (define (musicxml-node->string node) (let ((xml-name (assoc-get (node-name node) node-names #f))) - (string-append - (if xml-name (open-tag xml-name '() '()) "") - (if (equal? (node-value node) "") - (string-append - (if xml-name "\n" "") - (apply string-append (map musicxml-node->string (node-children node)))) - (node-value node)) - (if xml-name (close-tag xml-name) "") - (if xml-name "\n" "")))) + (string-append + (if xml-name (open-tag xml-name '() '()) "") + (if (equal? (node-value node) "") + (string-append + (if xml-name "\n" "") + (apply string-append (map musicxml-node->string (node-children node)))) + (node-value node)) + (if xml-name (close-tag xml-name) "") + (if xml-name "\n" "")))) (define (xml-node->string node) (string-append @@ -106,7 +105,7 @@ is then separated. #:attributes `((octave . ,(ly:pitch-octave p)) (notename . ,(ly:pitch-notename p)) (alteration . ,(ly:pitch-alteration p))))) - + (define (music->xml-node music) (let* ((name (ly:music-property music 'name)) (e (ly:music-property music 'element)) @@ -136,8 +135,8 @@ is then separated. ]> ")) - - + + ;; as computed from input/trip.ly, by ;; http://www.pault.com/pault/dtdgenerator/ @@ -211,20 +210,16 @@ is then separated. (not (memq (car x) exceptions))) (define (dump-attr sym-val) - (let* - ( - (sym (car sym-val)) - (val (cdr sym-val)) - ) + (let* ((sym (car sym-val)) + (val (cdr sym-val))) - (string-append - "\n " - (symbol->string sym) - "=\"" - (let ((s (call-with-output-string (lambda (port) (display val port))))) - (re-sub-alist s xml-entities-alist)) - "\"" - ))) + (string-append + "\n " + (symbol->string sym) + "=\"" + (let ((s (call-with-output-string (lambda (port) (display val port))))) + (re-sub-alist s xml-entities-alist)) + "\""))) (string-append "<" (symbol->string tag) diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm index fe29e44515..a4228e8fd9 100644 --- a/scm/translation-functions.scm +++ b/scm/translation-functions.scm @@ -1,5 +1,9 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; tuplets. +;;;; translation-functions.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define-public (denominator-tuplet-formatter mus) (number->string (ly:music-property mus 'denominator))) @@ -8,14 +12,11 @@ (string-append (number->string (ly:music-property mus 'denominator)) ":" - (number->string (ly:music-property mus 'numerator)) - )) - + (number->string (ly:music-property mus 'numerator)))) ;; metronome marks (define-public (format-metronome-markup event context) - (let* - ((dur (ly:music-property event 'tempo-unit)) + (let* ((dur (ly:music-property event 'tempo-unit)) (count (ly:music-property event 'metronome-count)) (note-mark (make-smaller-markup (make-note-by-number-markup (ly:duration-log dur) @@ -25,11 +26,7 @@ (list (make-general-align-markup Y DOWN note-mark) (make-simple-markup "=") - (make-simple-markup (number->string count)) - - )))) - - + (make-simple-markup (number->string count)))))) (define-public (format-mark-letters mark context) (make-bold-markup (make-markletter-markup (1- mark)))) -- 2.39.5