Breakable markups with \markuplines.

 - \markuplines is a new keyword for entering text that is not
   interpreted as a single markup of several lines, but as several
   one-line markups. The parser is modified to allow this, and
   define-(builtin-)markup-list-command macros are defined.

 - texts are collected into books as list of props. When
   Paper_book::get_system_specs finds a list of more than one props (ie
   a markup list, a list of a single prop being the result of a toplevel
   \markup), it sets their next-space and next-padding properties to
   zero, so that the lines of a paragraph are not stretched on a
   page

diff --git a/Documentation/topdocs/NEWS.tely b/Documentation/topdocs/NEWS.tely
index d6511260188948a1e1875ae1d78ea94c63872659..9a8a7a3591be6158fe065a4c70efe4171e5c4a79 100644 (file)
--- a/Documentation/topdocs/NEWS.tely
+++ b/Documentation/topdocs/NEWS.tely
@@ -65,6 +65,12 @@ which scares away people.
 
 @end ignore
 
 
 @end ignore
 

+@item
+Text spreading over several pages is entered using the
+@code{\markuplines} keyword. Builtin markup list commands, such as
+@code{\justified-lines} or @code{\wordwrap-lines} may be used, and new
+ones created using the @code{define-markup-list-command} Scheme macro.
+

 @item
 Particular points of a book may be marked with the @code{\label}
 command. Then, the page where these points are placed can be refered to
 @item
 Particular points of a book may be marked with the @code{\label}
 command. Then, the page where these points are placed can be refered to

diff --git a/Documentation/user/advanced-notation.itely b/Documentation/user/advanced-notation.itely
index 3a5e554c03e4483c5c58a59dbd9262b537ef42b6..068600c3c98f5900a2a1c9efdf3798dcf1803869 100644 (file)
--- a/Documentation/user/advanced-notation.itely
+++ b/Documentation/user/advanced-notation.itely
@@ -46,7 +46,9 @@ saved as UTF-8.  For more information, see @ref{Text encoding}.
 * Text marks::                  
 * Text markup::                 
 * Nested scores::               
 * Text marks::                  
 * Text markup::                 
 * Nested scores::               

+* Page wrapping text::          

 * Overview of text markup commands::  
 * Overview of text markup commands::  

+* Overview of text markup list commands::  

 * Font selection::              
 * New dynamic marks::           
 @end menu
 * Font selection::              
 * New dynamic marks::           
 @end menu


@@ -575,6 +577,40 @@ block.
 }
 @end lilypond
 
 }
 @end lilypond
 

+@node Page wrapping text
+@subsection Page wrapping text
+Whereas @code{\markup} is used to enter a not breakable block of text,
+@code{\markuplines} can be used at top-level to enter lines of text that
+can spread over pages:
+
+@verbatim
+\markuplines {
+  \justified-lines {
+    A very long text of justified lines.
+    ...
+  }
+  \justified-lines {
+    An other very long paragraph.
+    ...
+  }
+  ...
+}
+@end verbatim
+
+@code{\markuplines} accepts a list of markup, that is either the result
+of a markup list command, or a list of markups or of markup lists. The
+built-in markup list commands are described in
+@ref{Overview of text markup list commands}.
+
+@seealso
+
+This manual: @ref{Overview of text markup list commands}, 
+@ref{New markup list command definition}.
+
+@refcommands
+
+@funindex \markuplines
+@code{\markuplines}

 
 @node Overview of text markup commands
 @subsection Overview of text markup commands
 
 @node Overview of text markup commands
 @subsection Overview of text markup commands


@@ -583,6 +619,12 @@ The following commands can all be used inside @code{\markup @{ @}}.
 
 @include markup-commands.tely
 
 
 @include markup-commands.tely
 

+@node Overview of text markup list commands
+@subsection Overview of text markup list commands
+
+The following commands can all be used with @code{\markuplines}.
+
+@include markup-list-commands.tely

 
 @node Font selection
 @subsection Font selection
 
 @node Font selection
 @subsection Font selection

diff --git a/Documentation/user/programming-interface.itely b/Documentation/user/programming-interface.itely
index e55d26471bb677b0bbf0ceadd2b2346ccea27240..2d5e442e1511b02d8e3a908aaec72bc72e4a3feb 100644 (file)
--- a/Documentation/user/programming-interface.itely
+++ b/Documentation/user/programming-interface.itely
@@ -847,6 +847,7 @@ Stencil object given a number of arguments.
 * Markup construction in Scheme::  
 * How markups work internally::  
 * New markup command definition::  
 * Markup construction in Scheme::  
 * How markups work internally::  
 * New markup command definition::  

+* New markup list command definition::  

 @end menu
 
 
 @end menu
 
 


@@ -1114,6 +1115,56 @@ be used to set text in small caps.  See
 @ref{Overview of text markup commands}, for details.
 
 
 @ref{Overview of text markup commands}, for details.
 
 

+@node New markup list command definition
+@subsection New markup list command definition
+Markup list commands are defined with the
+@code{define-markup-list-command} Scheme macro, which is similar to the
+@code{define-markup-command} macro described in
+@ref{New markup command definition}, except that where the later returns
+a single stencil, the former returns a list stencils.
+
+In the following example, a @code{\paragraph} markup list command is
+defined, which returns a list of justified lines, the first one being
+indented.  The indent width is taken from the @code{props} argument.
+@example
+#(define-markup-list-command (paragraph layout props args) (markup-list?)
+   (let ((indent (chain-assoc-get 'par-indent props 2)))
+     (interpret-markup-list layout props 
+       (make-justified-lines-markup-list (cons (make-hspace-markup indent)
+                                               args)))))
+@end example
+
+Besides the usual @code{layout} and @code{props} arguments, the
+@code{paragraph} markup list command takes a markup list argument, named
+@code{args}.  The predicate for markup lists is @code{markup-list?}.
+
+First, the function gets the indent width, a property here named
+@code{par-indent}, from the property list @code{props} If the property
+is not found, the default value is @code{2}.  Then, a list of justified
+lines is made using the @code{make-justified-lines-markup-list}
+function, which is related to the @code{\justified-lines}
+built-in markup list command. An horizontal space is added at the
+begining using the @code{make-hspace-markup} function. Finally, the
+markup list is interpreted using the @code{interpret-markup-list}
+function.
+
+This new markup list command can be used as follows:
+@example
+\markuplines @{
+  \paragraph @{
+    The art of music typography is called \italic @{(plate) engraving.@}
+    The term derives from the traditional process of music printing.
+    Just a few decades ago, sheet music was made by cutting and stamping
+    the music into a zinc or pewter plate in mirror image.
+  @}
+  \override-lines #'(par-indent . 4) \paragraph @{
+    The plate would be inked, the depressions caused by the cutting
+    and stamping would hold ink. An image was formed by pressing paper
+    to the plate. The stamping and cutting was completely done by
+    hand.
+  @}
+@}
+@end example

 
 @node Contexts for programmers
 @section Contexts for programmers
 
 @node Contexts for programmers
 @section Contexts for programmers

diff --git a/input/regression/markup-lines.ly b/input/regression/markup-lines.ly
new file mode 100644 (file)
index 0000000..752dcf3
--- /dev/null
+++ b/input/regression/markup-lines.ly
@@ -0,0 +1,38 @@
+\version "2.11.25"
+
+\header {
+  texidoc = "Text that can spread over pages is entered with the
+@code{\\markuplines} command."
+}
+
+#(set-default-paper-size "a6")
+
+#(define-markup-list-command (paragraph layout props args) (markup-list?)
+  (interpret-markup-list layout props 
+   (make-justified-lines-markup-list (cons (make-hspace-markup 2) args))))
+
+%% Candide, Voltaire
+\markuplines \override-lines #'(baseline-skip . 2.5) {
+  \paragraph {
+    Il y avait en Westphalie, dans le château de M. le baron de
+    Thunder-ten-tronckh, un jeune garçon à qui la nature avait donné
+    les mœurs les plus douces.  Sa physionomie annonçait son âme.
+    Il avait le jugement assez droit, avec l'esprit le plus simple ;
+    c'est, je crois, pour cette raison qu'on le nommait Candide.  Les
+    anciens domestiques de la maison soupçonnaient qu'il était fils
+    de la sœur de monsieur le baron et d'un bon et honnête
+    gentilhomme du voisinage, que cette demoiselle ne voulut jamais
+    épouser parce qu'il n'avait pu prouver que soixante et onze
+    quartiers, et que le reste de son arbre généalogique avait été
+    perdu par l'injure du temps.
+  }
+  \paragraph {
+    Monsieur le baron était un des plus puissants seigneurs de la
+    Westphalie, car son château avait une porte et des fenêtres.  Sa
+    grande salle même était ornée d'une tapisserie.  Tous les chiens
+    de ses basses-cours composaient une meute dans le besoin ; ses
+    palefreniers étaient ses piqueurs; le vicaire du village était
+    son grand-aumônier.  Ils l'appelaient tous monseigneur, et ils
+    riaient quand il faisait des contes.
+  }
+}

diff --git a/lily/book.cc b/lily/book.cc
index 265632a3656d26145d53ad7e8beb0e86ab6131f5..2a1038941b8e630904c2f4abce75174991f966c4 100644 (file)
--- a/lily/book.cc
+++ b/lily/book.cc
@@ -154,7 +154,7 @@ Book::process (Output_def *default_paper,
              outputs = scm_cdr (outputs);
            }
        }
              outputs = scm_cdr (outputs);
            }
        }

-      else if (Text_interface::is_markup (scm_car (s))
+      else if (Text_interface::is_markup_list (scm_car (s))

               || unsmob_page_marker (scm_car (s)))
        paper_book->add_score (scm_car (s));
       else
               || unsmob_page_marker (scm_car (s)))
        paper_book->add_score (scm_car (s));
       else

diff --git a/lily/include/text-interface.hh b/lily/include/text-interface.hh
index 3f8685b15ec2a169098e93a76a62a63e497cfb5b..4a0fdb77109842f5fe4d75cc651cf441847be26d 100644 (file)
--- a/lily/include/text-interface.hh
+++ b/lily/include/text-interface.hh
@@ -22,6 +22,7 @@ public:
   DECLARE_SCHEME_CALLBACK (interpret_string, (SCM, SCM, SCM));
   DECLARE_GROB_INTERFACE();
   static bool is_markup (SCM);
   DECLARE_SCHEME_CALLBACK (interpret_string, (SCM, SCM, SCM));
   DECLARE_GROB_INTERFACE();
   static bool is_markup (SCM);

+  static bool is_markup_list (SCM);

 };
 
 #endif /* TEXT_ITEM */
 };
 
 #endif /* TEXT_ITEM */

diff --git a/lily/lexer.ll b/lily/lexer.ll
index ec17fb399e03963fb9dcdf1ec8753d345d82c8dc..71fb56b385c6d86205a735ed18c2ff0d75afb95c 100644 (file)
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -62,6 +62,7 @@ void strip_trailing_white (string&);
 void strip_leading_white (string&);
 string lyric_fudge (string s);
 SCM lookup_markup_command (string s);
 void strip_leading_white (string&);
 string lyric_fudge (string s);
 SCM lookup_markup_command (string s);

+SCM lookup_markup_list_command (string s);

 bool is_valid_version (string s);
 
 
 bool is_valid_version (string s);
 
 


@@ -516,7 +517,7 @@ BOM_UTF8    \357\273\277
        {MARKUPCOMMAND} {
                string str (YYText () + 1);
                SCM s = lookup_markup_command (str);
        {MARKUPCOMMAND} {
                string str (YYText () + 1);
                SCM s = lookup_markup_command (str);

-
+               SCM s2 = lookup_markup_list_command (str);

                if (scm_is_pair (s) && scm_is_symbol (scm_cdr (s)) ) {
                        yylval.scm = scm_car(s);
                        SCM tag = scm_cdr(s);
                if (scm_is_pair (s) && scm_is_symbol (scm_cdr (s)) ) {
                        yylval.scm = scm_car(s);
                        SCM tag = scm_cdr(s);


@@ -545,6 +546,22 @@ BOM_UTF8   \357\273\277
                                ly_display_scm (s);
                                assert(false);
                        }
                                ly_display_scm (s);
                                assert(false);
                        }

+               } else if (scm_is_pair (s2) && scm_is_symbol (scm_cdr (s2))) {
+                       yylval.scm = scm_car(s2);
+                       SCM tag = scm_cdr(s2);
+                       if (tag == ly_symbol2scm("empty"))
+                               return MARKUP_LIST_HEAD_EMPTY;
+                       else if (tag == ly_symbol2scm ("markup-list0"))
+                               return MARKUP_LIST_HEAD_LIST0;
+                       else if (tag == ly_symbol2scm ("scheme0-markup-list1"))
+                               return MARKUP_LIST_HEAD_SCM0_LIST1;
+                       else if (tag == ly_symbol2scm ("scheme0-scheme1-markup-list2"))
+                               return MARKUP_LIST_HEAD_SCM0_SCM1_LIST2;
+                       else {
+                               programming_error ("no parser tag defined for this markup signature"); 
+                               ly_display_scm (s);
+                               assert(false);
+                       }

                } else
                        return scan_escaped_word (str);
        }
                } else
                        return scan_escaped_word (str);
        }


@@ -946,6 +963,13 @@ lookup_markup_command (string s)
        return scm_call_1 (proc, ly_string2scm (s));
 }
 
        return scm_call_1 (proc, ly_string2scm (s));
 }
 

+SCM
+lookup_markup_list_command (string s)
+{
+       SCM proc = ly_lily_module_constant ("lookup-markup-list-command");
+       return scm_call_1 (proc, ly_string2scm (s));
+}
+

 /* Shut up lexer warnings.  */
 #if YY_STACK_USED
 
 /* Shut up lexer warnings.  */
 #if YY_STACK_USED
 

diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc
index 4eaa4415690e298d140047f6b5bae9dd65ae4e58..7b77d58922b6816c55607a1d30c9c0f622ae87d1 100644 (file)
--- a/lily/lily-lexer.cc
+++ b/lily/lily-lexer.cc
@@ -53,6 +53,7 @@ static Keyword_ent the_key_tab[]
   {"lyricsto", LYRICSTO},
   {"mark", MARK},
   {"markup", MARKUP},
   {"lyricsto", LYRICSTO},
   {"mark", MARK},
   {"markup", MARKUP},

+  {"markuplines", MARKUPLINES},

   {"midi", MIDI},
   {"name", NAME},
   {"new", NEWCONTEXT},
   {"midi", MIDI},
   {"name", NAME},
   {"new", NEWCONTEXT},

diff --git a/lily/paper-book.cc b/lily/paper-book.cc
index 84191b7da8b94bf17f4a67cd488591c4bdbc5e73..72648b682fe952df2d0a9a4292be258a229c3670 100644 (file)
--- a/lily/paper-book.cc
+++ b/lily/paper-book.cc
@@ -331,6 +331,7 @@ Paper_book::get_system_specs ()
     = scm_call_1 (ly_lily_module_constant ("layout-extract-page-properties"),
                  paper_->self_scm ());
 
     = scm_call_1 (ly_lily_module_constant ("layout-extract-page-properties"),
                  paper_->self_scm ());
 

+  SCM interpret_markup_list = ly_lily_module_constant ("interpret-markup-list");

   SCM header = SCM_EOL;
   for (SCM s = scm_reverse (scores_); scm_is_pair (s); s = scm_cdr (s))
     {
   SCM header = SCM_EOL;
   for (SCM s = scm_reverse (scores_); scm_is_pair (s); s = scm_cdr (s))
     {


@@ -384,24 +385,37 @@ Paper_book::get_system_specs ()
              */
            }
        }
              */
            }
        }

-      else if (Text_interface::is_markup (scm_car (s)))
+      else if (Text_interface::is_markup_list (scm_car (s)))

        {
        {

-         SCM t = Text_interface::interpret_markup (paper_->self_scm (),
-                                                   page_properties,
-                                                   scm_car (s));
-         
-         // TODO: init props
-         Prob *ps = make_paper_system (SCM_EOL);
-         ps->set_property ("page-break-permission", ly_symbol2scm ("allow"));
-         ps->set_property ("page-turn-permission", ly_symbol2scm ("allow"));
-         
-         paper_system_set_stencil (ps, *unsmob_stencil (t));
-         ps->set_property ("is-title", SCM_BOOL_T); 
-         system_specs = scm_cons (ps->self_scm (), system_specs);
-         ps->unprotect ();
-         
-         // FIXME: figure out penalty.
-         //set_system_penalty (ps, scores_[i].header_);
+         SCM texts = scm_call_3 (interpret_markup_list,
+                                 paper_->self_scm (),
+                                 page_properties,
+                                 scm_car (s));
+         for (SCM list = texts ; scm_is_pair (list) ; list = scm_cdr (list))
+           {
+             SCM t = scm_car (list);
+             // TODO: init props
+             Prob *ps = make_paper_system (SCM_EOL);
+             ps->set_property ("page-break-permission", ly_symbol2scm ("allow"));
+             ps->set_property ("page-turn-permission", ly_symbol2scm ("allow"));
+             
+             paper_system_set_stencil (ps, *unsmob_stencil (t));
+             ps->set_property ("is-title", SCM_BOOL_T); 
+             if (scm_is_pair (scm_cdr (list)))
+               {
+                 /* If an other markup is following, set this markup 
+                  * next padding and next space to 0, so that baseline-skip 
+                  * only should be taken into account for lines vertical
+                  * spacing. */
+                 ps->set_property ("next-padding", scm_double2num (0.0));
+                 ps->set_property ("next-space", scm_double2num (0.0));
+               }
+             system_specs = scm_cons (ps->self_scm (), system_specs);
+             ps->unprotect ();
+             
+             // FIXME: figure out penalty.
+             //set_system_penalty (ps, scores_[i].header_);
+           }

        }
       else
        assert (0);
        }
       else
        assert (0);

diff --git a/lily/parser.yy b/lily/parser.yy
index 18668dead09d914cee5e9f18031eab974ac86b3e..7ded9b737792b741947be52f450523df55ffd7b6 100644 (file)
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -182,6 +182,7 @@ void set_music_properties (Music *p, SCM a);
 %token LYRICSTO "\\lyricsto"
 %token MARK "\\mark"
 %token MARKUP "\\markup"
 %token LYRICSTO "\\lyricsto"
 %token MARK "\\mark"
 %token MARKUP "\\markup"

+%token MARKUPLINES "\\markuplines"

 %token MIDI "\\midi"
 %token NAME "\\name"
 %token NOTEMODE "\\notemode"
 %token MIDI "\\midi"
 %token NAME "\\name"
 %token NOTEMODE "\\notemode"


@@ -281,6 +282,10 @@ If we give names, Bison complains.
 %token <scm> MARKUP_HEAD_SCM0_SCM1_MARKUP2
 %token <scm> MARKUP_HEAD_SCM0_MARKUP1_MARKUP2
 %token <scm> MARKUP_HEAD_SCM0_SCM1_SCM2
 %token <scm> MARKUP_HEAD_SCM0_SCM1_MARKUP2
 %token <scm> MARKUP_HEAD_SCM0_MARKUP1_MARKUP2
 %token <scm> MARKUP_HEAD_SCM0_SCM1_SCM2

+%token <scm> MARKUP_LIST_HEAD_EMPTY
+%token <scm> MARKUP_LIST_HEAD_LIST0
+%token <scm> MARKUP_LIST_HEAD_SCM0_LIST1
+%token <scm> MARKUP_LIST_HEAD_SCM0_SCM1_LIST2

 %token <scm> MARKUP_IDENTIFIER
 %token <scm> MUSIC_FUNCTION
 %token <scm> MUSIC_IDENTIFIER
 %token <scm> MARKUP_IDENTIFIER
 %token <scm> MUSIC_FUNCTION
 %token <scm> MUSIC_IDENTIFIER


@@ -373,6 +378,7 @@ If we give names, Bison complains.
 %type <scm> figure_spec
 %type <scm> fraction
 %type <scm> full_markup
 %type <scm> figure_spec
 %type <scm> fraction
 %type <scm> full_markup

+%type <scm> full_markup_list

 %type <scm> function_scm_argument
 %type <scm> function_arglist
 %type <scm> function_arglist_music_last
 %type <scm> function_scm_argument
 %type <scm> function_arglist
 %type <scm> function_arglist_music_last


@@ -387,6 +393,7 @@ If we give names, Bison complains.
 %type <scm> markup_braced_list
 %type <scm> markup_braced_list_body 
 %type <scm> markup_composed_list
 %type <scm> markup_braced_list
 %type <scm> markup_braced_list_body 
 %type <scm> markup_composed_list

+%type <scm> markup_command_list

 %type <scm> markup_head_1_item
 %type <scm> markup_head_1_list
 %type <scm> markup_list
 %type <scm> markup_head_1_item
 %type <scm> markup_head_1_list
 %type <scm> markup_list


@@ -478,6 +485,10 @@ toplevel_expression:
                scm_call_2 (proc, PARSER->self_scm (), music->self_scm ());
        }
        | full_markup {
                scm_call_2 (proc, PARSER->self_scm (), music->self_scm ());
        }
        | full_markup {

+               SCM proc = PARSER->lexer_->lookup_identifier ("toplevel-text-handler");
+               scm_call_2 (proc, PARSER->self_scm (), scm_list_1 ($1));
+       }
+       | full_markup_list {

                SCM proc = PARSER->lexer_->lookup_identifier ("toplevel-text-handler");
                scm_call_2 (proc, PARSER->self_scm (), $1);
        }
                SCM proc = PARSER->lexer_->lookup_identifier ("toplevel-text-handler");
                scm_call_2 (proc, PARSER->self_scm (), $1);
        }


@@ -663,6 +674,10 @@ book_body:
                scm_call_3 (proc, PARSER->self_scm (), $$->self_scm (), music->self_scm ());
        }
        | book_body full_markup {
                scm_call_3 (proc, PARSER->self_scm (), $$->self_scm (), music->self_scm ());
        }
        | book_body full_markup {

+               SCM proc = PARSER->lexer_->lookup_identifier ("book-text-handler");
+               scm_call_2 (proc, $$->self_scm (), scm_list_1 ($2));
+       }
+       | book_body full_markup_list {

                SCM proc = PARSER->lexer_->lookup_identifier ("book-text-handler");
                scm_call_2 (proc, $$->self_scm (), $2);
        }
                SCM proc = PARSER->lexer_->lookup_identifier ("book-text-handler");
                scm_call_2 (proc, $$->self_scm (), $2);
        }


@@ -2186,6 +2201,15 @@ lyric_markup:
        }
        ;
 
        }
        ;
 

+full_markup_list:
+       MARKUPLINES
+               { PARSER->lexer_->push_markup_state (); }
+       markup_list {
+               $$ = $3;
+               PARSER->lexer_->pop_state ();
+       }
+       ;
+

 full_markup:
        MARKUP_IDENTIFIER {
                $$ = $1;
 full_markup:
        MARKUP_IDENTIFIER {
                $$ = $1;


@@ -2217,6 +2241,9 @@ markup_list:
        | markup_braced_list {
                $$ = $1;
        }
        | markup_braced_list {
                $$ = $1;
        }

+       | markup_command_list {
+               $$ = scm_list_1 ($1);
+       }

        ;
 
 markup_composed_list:
        ;
 
 markup_composed_list:


@@ -2242,6 +2269,21 @@ markup_braced_list_body:
        }
        ;
 
        }
        ;
 

+markup_command_list:
+       MARKUP_LIST_HEAD_EMPTY  {
+               $$ = scm_list_1 ($1);
+       }
+       | MARKUP_LIST_HEAD_LIST0 markup_list    {
+               $$ = scm_list_2 ($1, $2);
+       }
+       | MARKUP_LIST_HEAD_SCM0_LIST1 embedded_scm markup_list  {
+               $$ = scm_list_3 ($1, $2, $3);
+       }
+       | MARKUP_LIST_HEAD_SCM0_SCM1_LIST2 embedded_scm embedded_scm markup_list        {
+               $$ = scm_list_4 ($1, $2, $3, $4);
+       }
+       ;
+

 markup_head_1_item:
        MARKUP_HEAD_MARKUP0     {
                $$ = scm_list_1 ($1);
 markup_head_1_item:
        MARKUP_HEAD_MARKUP0     {
                $$ = scm_list_1 ($1);

diff --git a/lily/text-interface.cc b/lily/text-interface.cc
index 55e7bb7ec4c09a81ed73185271ef0c00a3ab3ef3..0c514a35d8aec694612fdb288a4a25c5c991c1ea 100644 (file)
--- a/lily/text-interface.cc
+++ b/lily/text-interface.cc
@@ -96,6 +96,14 @@ Text_interface::is_markup (SCM x)
                                      ly_symbol2scm ("markup-signature"))));
 }
 
                                      ly_symbol2scm ("markup-signature"))));
 }
 

+bool
+Text_interface::is_markup_list (SCM x)
+{
+  SCM music_list_p = ly_lily_module_constant ("markup-list?");
+  return scm_is_true (scm_call_1 (music_list_p, x));
+}
+
+

 ADD_INTERFACE (Text_interface,
               "A scheme markup text, see @usermanref{Text markup} and "
               "@usermanref{New markup command definition}. "
 ADD_INTERFACE (Text_interface,
               "A scheme markup text, see @usermanref{Text markup} and "
               "@usermanref{New markup command definition}. "

diff --git a/ly/markup-init.ly b/ly/markup-init.ly
index c40bd88ad4f5d7fd6a217a07cdd8c595aace4006..49c155c94e6a73ea215cde978d60c779c5cb4b97 100644 (file)
--- a/ly/markup-init.ly
+++ b/ly/markup-init.ly
@@ -85,3 +85,36 @@ or:
                         ,(symbol->string make-markup-name)
                         (list ,@signature)
                         args))))))
                         ,(symbol->string make-markup-name)
                         (list ,@signature)
                         args))))))

+
+#(defmacro-public define-markup-list-command (command-and-args signature . body)
+  "Same as `define-markup-command', but defines a command that, when interpreted,
+returns a list of stencils, instead of a single one."
+  (let* ((command (if (pair? command-and-args)
+                     (car command-and-args)
+                     command-and-args))
+        (command-name (string->symbol (format #f "~a-markup-list" command)))
+        (make-markup-name (string->symbol (format #f "make-~a-markup-list" command))))
+    `(begin
+       ;; define the COMMAND-markup-list procedure in toplevel module
+       ,(if (pair? command-and-args)
+           ;; 1/ (define (COMMAND-markup-list layout props arg1 arg2 ...)
+           ;;      ..command body))
+           `(define-public-toplevel (,command-name ,@(cdr command-and-args))
+              ,@body)
+           ;; 2/ (define (COMMAND-markup-list . args) (apply function args))
+           (let ((args (gensym "args"))
+                 (command (car body)))
+           `(define-public-toplevel (,command-name . ,args)
+              (apply ,command ,args))))
+       (let ((command-proc (toplevel-module-ref ',command-name)))
+        ;; register its command signature
+        (set! (markup-command-signature command-proc)
+              (list ,@signature))
+        ;; it's a markup-list command:
+        (set-object-property! command-proc 'markup-list-command #t)
+        ;; define the make-COMMAND-markup-list procedure in the toplevel module
+        (define-public-toplevel (,make-markup-name . args)
+          (list (make-markup command-proc
+                             ,(symbol->string make-markup-name)
+                             (list ,@signature)
+                             args)))))))

diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index d1f5dd04f81b2642d0ce862dc9948f24a75e8ceb..a6773286c6aa7673ca4241dcc0a6b9a3719df222 100644 (file)
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -346,9 +346,7 @@ grestore
 The markups are spaced or flushed to fill the entire line.
 If there are no arguments, return an empty stencil."
  
 The markups are spaced or flushed to fill the entire line.
 If there are no arguments, return an empty stencil."
  

-  (let* ((orig-stencils
-         (map (lambda (x) (interpret-markup layout props x))
-              markups))
+  (let* ((orig-stencils (interpret-markup-list layout props markups))

         (stencils
          (map (lambda (stc)
                 (if (ly:stencil-empty? stc)
         (stencils
          (map (lambda (stc)
                 (if (ly:stencil-empty? stc)


@@ -404,7 +402,7 @@ If there are no arguments, return an empty stencil."
   "Put @var{args} in a horizontal line.  The property @code{word-space}
 determines the space between each markup in @var{args}."
   (let*
   "Put @var{args} in a horizontal line.  The property @code{word-space}
 determines the space between each markup in @var{args}."
   (let*

-      ((stencils (map (lambda (m) (interpret-markup layout props m)) args))
+      ((stencils (interpret-markup-list layout props args))

        (space    (chain-assoc-get 'word-space props))
        (text-dir (chain-assoc-get 'text-direction props RIGHT)) 
        )
        (space    (chain-assoc-get 'word-space props))
        (text-dir (chain-assoc-get 'text-direction props RIGHT)) 
        )


@@ -438,7 +436,9 @@ equivalent to @code{\"fi\"}."
 
   (interpret-markup layout
                     (prepend-alist-chain 'word-space 0 props)
 
   (interpret-markup layout
                     (prepend-alist-chain 'word-space 0 props)

-                    (make-line-markup (concat-string-args args))))
+                    (make-line-markup (if (markup-command-list? args)
+                                         args
+                                         (concat-string-args args)))))

 
 (define (wordwrap-stencils stencils
                           justify base-space line-width text-dir)
 
 (define (wordwrap-stencils stencils
                           justify base-space line-width text-dir)


@@ -520,32 +520,28 @@ equivalent to @code{\"fi\"}."
 
 (define (wordwrap-markups layout props args justify)
   (let*
 
 (define (wordwrap-markups layout props args justify)
   (let*

-      ((baseline-skip (chain-assoc-get 'baseline-skip props))
-       (prop-line-width (chain-assoc-get 'line-width props #f))
+      ((prop-line-width (chain-assoc-get 'line-width props #f))

        (line-width (if prop-line-width prop-line-width
                       (ly:output-def-lookup layout 'line-width)))
        (word-space (chain-assoc-get 'word-space props))
        (line-width (if prop-line-width prop-line-width
                       (ly:output-def-lookup layout 'line-width)))
        (word-space (chain-assoc-get 'word-space props))

-       (text-dir (chain-assoc-get 'text-direction props RIGHT)) 
-       (lines (wordwrap-stencils
-              (remove ly:stencil-empty?
-                      (map (lambda (m) (interpret-markup layout props m)) args))
-              justify word-space line-width
-              text-dir)
-              ))
-
-    (stack-lines DOWN 0.0 baseline-skip lines)))
+       (text-dir (chain-assoc-get 'text-direction props RIGHT)))
+    (wordwrap-stencils (remove ly:stencil-empty?
+                               (interpret-markup-list layout props args))
+                       justify word-space line-width
+                       text-dir)))

 
 (define-builtin-markup-command (justify layout props args) (markup-list?)
   "Like wordwrap, but with lines stretched to justify the margins.
 Use @code{\\override #'(line-width . @var{X})} to set the line width;
 @var{X}@tie{}is the number of staff spaces."
 
 (define-builtin-markup-command (justify layout props args) (markup-list?)
   "Like wordwrap, but with lines stretched to justify the margins.
 Use @code{\\override #'(line-width . @var{X})} to set the line width;
 @var{X}@tie{}is the number of staff spaces."

-  (wordwrap-markups layout props args #t))
+  (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
+              (wordwrap-markups layout props args #t)))

 
 (define-builtin-markup-command (wordwrap layout props args) (markup-list?)
   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
 the line width, where @var{X} is the number of staff spaces."
 
 (define-builtin-markup-command (wordwrap layout props args) (markup-list?)
   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
 the line width, where @var{X} is the number of staff spaces."

-
-  (wordwrap-markups layout props args #f))
+  (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
+              (wordwrap-markups layout props args #f)))

 
 (define (wordwrap-string layout props justify arg) 
   (let*
 
 (define (wordwrap-string layout props justify arg) 
   (let*


@@ -623,7 +619,7 @@ the line width, where @var{X} is the number of staff spaces."
 @code{baseline-skip} determines the space between each markup in @var{args}."
 
   (let*
 @code{baseline-skip} determines the space between each markup in @var{args}."
 
   (let*

-      ((arg-stencils (map (lambda (m) (interpret-markup layout props m)) args))
+      ((arg-stencils (interpret-markup-list layout props args))

        (skip (chain-assoc-get 'baseline-skip props)))
 
     
        (skip (chain-assoc-get 'baseline-skip props)))
 
     


@@ -640,11 +636,11 @@ of the @code{#'direction} layout property."
      (if (number? dir) dir -1)
      0.0
      (chain-assoc-get 'baseline-skip props)
      (if (number? dir) dir -1)
      0.0
      (chain-assoc-get 'baseline-skip props)

-     (map (lambda (x) (interpret-markup layout props x)) args))))
+     (interpret-markup-list layout props args))))

 
 (define-builtin-markup-command (center-align layout props args) (markup-list?)
   "Put @code{args} in a centered column."
 
 (define-builtin-markup-command (center-align layout props args) (markup-list?)
   "Put @code{args} in a centered column."

-  (let* ((mols (map (lambda (x) (interpret-markup layout props x)) args))
+  (let* ((mols (interpret-markup-list layout props args))

          (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
     
     (stack-lines -1 0.0 (chain-assoc-get 'baseline-skip props) cmols)))
          (cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
     
     (stack-lines -1 0.0 (chain-assoc-get 'baseline-skip props) cmols)))


@@ -1490,3 +1486,41 @@ when @var{label} is not found."
                                    (markup #:concat (#:hspace gap page-markup)))))))
      x-ext
      y-ext)))
                                    (markup #:concat (#:hspace gap page-markup)))))))
      x-ext
      y-ext)))

+
+\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Markup list commands
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (space-lines baseline-skip lines)
+  (map (lambda (line)
+        (stack-lines DOWN 0.0 (/ baseline-skip 2.0)
+                     (list (ly:make-stencil "" (cons 0 0) (cons 0 0))
+                           line
+                           (ly:make-stencil "" (cons 0 0) (cons 0 0)))))
+       lines))
+
+(define-builtin-markup-list-command (justified-lines layout props args) (markup-list?)
+  "Like @code{\\justify}, but return a list of lines instead of a single markup.
+Use @code{\\override #'(line-width . @var{X})} to set the line width;
+@var{X}@tie{}is the number of staff spaces."
+  (space-lines (chain-assoc-get 'baseline-skip props)
+              (wordwrap-markups layout props args #t)))
+
+(define-builtin-markup-list-command (wordwrap-lines layout props args) (markup-list?)
+  "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
+Use @code{\\override #'(line-width . @var{X})} to set the line width,
+where @var{X} is the number of staff spaces."
+  (space-lines (chain-assoc-get 'baseline-skip props)
+              (wordwrap-markups layout props args #f)))
+
+(define-builtin-markup-list-command (column-lines layout props args) (markup-list?)
+  "Like @code{\\column}, but return a list of lines instead of a single markup.
+@code{baseline-skip} determines the space between each markup in @var{args}."
+  (space-lines (chain-assoc-get 'baseline-skip props)
+              (interpret-markup-list layout props args)))
+
+(define-builtin-markup-list-command (override-lines layout props new-prop args)
+  (pair? markup-list?)
+  "Like @code{\\override}, for markup lists."
+  (interpret-markup-list layout (cons (list new-prop) props) args))

diff --git a/scm/document-markup.scm b/scm/document-markup.scm
index 27d1229ddebc4414958224e75a92a7eba57adced..4396ea4d38b8575f030833e41253991cce92ac98 100644 (file)
--- a/scm/document-markup.scm
+++ b/scm/document-markup.scm
@@ -8,7 +8,7 @@
 (define (doc-markup-function func)
   (let* ((doc-str  (procedure-documentation func))
         (f-name (symbol->string (procedure-name  func)))
 (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))
+        (c-name (regexp-substitute/global #f "-markup(-list)?$" f-name  'pre "" 'post))

         (sig (object-property func 'markup-signature))
         (arg-names (let ((arg-list (cadr (procedure-source func))))
                       (if (list? arg-list)
         (sig (object-property func 'markup-signature))
         (arg-names (let ((arg-list (cadr (procedure-source func))))
                       (if (list? arg-list)


@@ -45,8 +45,22 @@
               (sort markup-function-list markup-function<?)))
    "\n@end table"))
 
               (sort markup-function-list markup-function<?)))
    "\n@end table"))
 

+(define (markup-list-doc-string)
+  (string-append
+   "@table @asis"
+   (apply string-append
+         (map doc-markup-function
+              (sort markup-list-function-list markup-function<?)))
+   "\n@end table"))
+

 (define (markup-doc-node)
   (make <texi-node>
     #:name "Markup functions"
     #:desc "Definitions of the markup functions."
     #:text (markup-doc-string)))
 (define (markup-doc-node)
   (make <texi-node>
     #:name "Markup functions"
     #:desc "Definitions of the markup functions."
     #:text (markup-doc-string)))

+
+(define (markup-list-doc-node)
+  (make <texi-node>
+    #:name "Markup list functions"
+    #:desc "Definitions of the markup list functions."
+    #:text (markup-list-doc-string)))

diff --git a/scm/documentation-generate.scm b/scm/documentation-generate.scm
index 9c9e7acf03098bfdfdd1356261fa10761a4a103b..fe37a366ba961c00ab62473af84ede9c550980a7 100644 (file)
--- a/scm/documentation-generate.scm
+++ b/scm/documentation-generate.scm
@@ -34,6 +34,10 @@
  (markup-doc-string)
  (open-output-file "markup-commands.tely"))
 
  (markup-doc-string)
  (open-output-file "markup-commands.tely"))
 

+(display 
+ (markup-list-doc-string)
+ (open-output-file "markup-list-commands.tely"))
+

 (display 
  (identifiers-doc-string)
  (open-output-file "identifiers.tely"))
 (display 
  (identifiers-doc-string)
  (open-output-file "identifiers.tely"))

diff --git a/scm/markup.scm b/scm/markup.scm
index f1d0863ff77381eb3ad681cf3caaa6e080146277..70baeaa54dd5d2070792a159f01cfc80b15a7e70 100644 (file)
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -80,6 +80,36 @@ Syntax:
          (let ((sig (list ,@signature)))
            (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
 
          (let ((sig (list ,@signature)))
            (make-markup ,command-name ,(symbol->string make-markup-name) sig args))))))
 

+(define-macro (define-builtin-markup-list-command command-and-args signature . body)
+  "Same as `define-builtin-markup-command, but defines a command that, when
+interpreted, returns a list of stencils instead os a single one"
+  (let* ((command (if (pair? command-and-args) (car command-and-args) command-and-args))
+        (args (if (pair? command-and-args) (cdr command-and-args) '()))
+        (command-name (string->symbol (format #f "~a-markup-list" command)))
+        (make-markup-name (string->symbol (format #f "make-~a-markup-list" command))))
+    `(begin
+       ;; define the COMMAND-markup-list function
+       ,(if (pair? args)
+           `(define-public (,command-name ,@args)
+              ,@body)
+           (let ((args (gensym "args"))
+                 (markup-command (car body)))
+           `(define-public (,command-name . ,args)
+              ,(format #f "Copy of the ~a command." markup-command)
+              (apply ,markup-command ,args))))
+       (set! (markup-command-signature ,command-name) (list ,@signature))
+       ;; add the command to markup-list-function-list, for markup documentation
+       (if (not (member ,command-name markup-list-function-list))
+          (set! markup-list-function-list (cons ,command-name
+                                                markup-list-function-list)))
+       ;; it's a markup-list command:
+       (set-object-property! ,command-name 'markup-list-command #t)
+       ;; define the make-COMMAND-markup-list function
+       (define-public (,make-markup-name . args)
+        (let ((sig (list ,@signature)))
+          (list (make-markup ,command-name
+                             ,(symbol->string make-markup-name) sig args)))))))
+

 (define-public (make-markup markup-function make-name signature args)
   " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
 against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
 (define-public (make-markup markup-function make-name signature args)
   " Construct a markup object from MARKUP-FUNCTION and ARGS. Typecheck
 against SIGNATURE, reporting MAKE-NAME as the user-invoked function.


@@ -261,6 +291,7 @@ Use `markup*' in a \\notemode context."
 
 ;; For documentation purposes
 (define-public markup-function-list (list))
 
 ;; For documentation purposes
 (define-public markup-function-list (list))

+(define-public markup-list-function-list (list))

 
 (define-public (markup-signature-to-keyword sig)
   " (A B C) -> a0-b1-c2 "
 
 (define-public (markup-signature-to-keyword sig)
   " (A B C) -> a0-b1-c2 "


@@ -282,14 +313,24 @@ Use `markup*' in a \\notemode context."
                                     sig)
                          "-"))))
 
                                     sig)
                          "-"))))
 

-(define-public (lookup-markup-command code)
+(define (lookup-markup-command-aux symbol)

   (let ((proc (catch 'misc-error
                 (lambda ()
   (let ((proc (catch 'misc-error
                 (lambda ()

-                  (module-ref (current-module)
-                              (string->symbol (format #f "~a-markup" code))))
+                  (module-ref (current-module) symbol))

                 (lambda (key . args) #f))))
                 (lambda (key . args) #f))))

-    (and (procedure? proc)
-         (cons proc (markup-command-keyword proc)))))
+    (and (procedure? proc) proc)))
+
+(define-public (lookup-markup-command code)
+  (let ((proc (lookup-markup-command-aux
+              (string->symbol (format #f "~a-markup" code)))))
+    (and proc (markup-function? proc)
+        (cons proc (markup-command-keyword proc)))))
+
+(define-public (lookup-markup-list-command code)
+  (let ((proc (lookup-markup-command-aux
+              (string->symbol (format #f "~a-markup-list" code)))))
+     (and proc (markup-list-function? proc)
+         (cons proc (markup-command-keyword proc)))))

 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;; used in parser.yy to map a list of markup commands on markup arguments
 
 ;;;;;;;;;;;;;;;;;;;;;;
 ;;; used in parser.yy to map a list of markup commands on markup arguments


@@ -313,13 +354,25 @@ eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
 ;;; markup type predicates
 
 (define (markup-function? x)
 ;;; markup type predicates
 
 (define (markup-function? x)

-  (not (not (markup-command-signature x))))
+  (and (markup-command-signature x)
+       (not (object-property x 'markup-list-command))))
+
+(define (markup-list-function? x)
+  (and (markup-command-signature x)
+       (object-property x 'markup-list-command)))
+
+(define-public (markup-command-list? x)
+  "Determine if `x' is a markup command list, ie. a list composed of
+a markup list function and its arguments."
+  (and (pair? x) (markup-list-function? (car x))))

 
 (define-public (markup-list? arg)
 
 (define-public (markup-list? arg)

+  "Return a true value if `x' is a list of markups or markup command lists."

   (define (markup-list-inner? lst)
     (or (null? lst)
   (define (markup-list-inner? lst)
     (or (null? lst)

-        (and (markup? (car lst)) (markup-list-inner? (cdr lst)))))
-  (and (list? arg) (markup-list-inner? arg)))
+       (and (or (markup? (car lst)) (markup-command-list? (car lst)))
+             (markup-list-inner? (cdr lst)))))
+  (not (not (and (list? arg) (markup-list-inner? arg)))))

 
 (define (markup-argument-list? signature arguments)
   "Typecheck argument list."
 
 (define (markup-argument-list? signature arguments)
   "Typecheck argument list."


@@ -391,6 +444,18 @@ Uncovered - cheap-markup? is used."
 
 
 (define-public interpret-markup ly:text-interface::interpret-markup)
 
 
 (define-public interpret-markup ly:text-interface::interpret-markup)

+
+(define-public (interpret-markup-list layout props markup-list)
+  (let ((stencils (list)))
+    (for-each (lambda (m)
+               (set! stencils
+                     (if (markup-command-list? m)
+                         (append! (reverse! (apply (car m) layout props (cdr m)))
+                                  stencils)
+                         (cons (interpret-markup layout props m) stencils))))
+             markup-list)
+    (reverse! stencils)))
+

 (define-public (prepend-alist-chain key val chain)
   (cons (acons key val (car chain)) (cdr chain)))
 
 (define-public (prepend-alist-chain key val chain)
   (cons (acons key val (car chain)) (cdr chain)))