lilypond-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[patch] breakable markups


From: Nicolas Sceaux
Subject: [patch] breakable markups
Date: Sun, 03 Jun 2007 15:01:57 +0200
User-agent: Gnus/5.11 (Gnus v5.11) Emacs/22.0.50 (darwin)

Nicolas Sceaux <address@hidden> writes:

> Hi,
>
> While thinking about an automatic way to build tables of contents (with
> a few \header variables, a \table-of-contents command, et voilà), I
> realized that an other problem needs to be solved first.  Indeed, if the
> table of contents is too long for a single page, then it should be split
> to fill several pages.  Hence the need of breakable markups.

Here is a patch implementing this feature.

 - \markuplist 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 markuplist, a list of a single prop being the result of a toplevel
   \markup), it sets their next-space and next-padding properties to
   (almost) zero so that the lines of a paragraph are not stretched on a
   page (but see below).


Some issues, related to page breaking and spacing:

 1. on the regression test included in the patch, the output looks like:
     ______   ______   ______ 
    |     1| |2     | |     3|
    |blabla| |blabla| |blabla|
    |blabla| |blabla| |      |
    |blabla| |blabla| |      |   (with ragged-bottom=##t)
    |      | |      | |      |
    |      | |      | |      |
    |      | |      | |taglin|
     ------   ------   ------ 
    That is, although the text could fit on two pages, three pages are
    created, with a lot of white space left at their bottom.

 2. setting the next-space or next-padding properties to zero results to
    wrong spacing. The stencils should just be stacked with no extra
    space between them.

 3. setting next-padding and next-space to almost zero make the lines
    stick one to the other only if there is an other object (like a
    score) on the page. Otherwise, the lines are spread over the
    page. This is not consistent.
     ______     ______ 
    |blabla|   |blabla|
    |blabla|   |      |
    |blabla|   |      |
    |      |   |blabla|   <--- next-space and next-spacing almost 0
    |      |   |      |        between all these blablas
    |      |   |      |
    |system|   |blabla|
     ------     ------

I'd like to fix this issues if they are in the range of things that I
can do, but I would be grateful if someone who knows might tell me where
to look at.

nicolas

diff --git a/input/regression/markup-list.ly b/input/regression/markup-list.ly
new file mode 100644
index 0000000..ef0124e
--- /dev/null
+++ b/input/regression/markup-list.ly
@@ -0,0 +1,41 @@
+\version "2.11.25"
+
+\header {
+  texidoc = "Text that can spread over pages is entered with the
address@hidden command."
+}
+
+#(set-default-paper-size "a6")
+
+\paper {
+  ragged-bottom = ##t
+}
+
+#(define-markup-list-command (paragraph layout props args) (markup-list?)
+  (interpret-markup-list layout props 
+   (make-justified-lines-markup-list (cons (make-hspace-markup 3) args))))
+
+\markuplist \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 265632a..2a10389 100644
--- a/lily/book.cc
+++ b/lily/book.cc
@@ -154,7 +154,7 @@ Book::process (Output_def *default_paper
              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
diff --git a/lily/include/text-interface.hh b/lily/include/text-interface.hh
index 3f8685b..4a0fdb7 100644
--- 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);
+  static bool is_markup_list (SCM);
 };
 
 #endif /* TEXT_ITEM */
diff --git a/lily/lexer.ll b/lily/lexer.ll
index ec17fb3..71fb56b 100644
--- 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);
+SCM lookup_markup_list_command (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);
-
+               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);
@@ -545,6 +546,22 @@ BOM_UTF8   \357\273\277
                                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);
        }
@@ -946,6 +963,13 @@ lookup_markup_command (string 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
 
diff --git a/lily/lily-lexer.cc b/lily/lily-lexer.cc
index 4eaa441..f0086d9 100644
--- 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},
+  {"markuplist", MARKUPLIST},
   {"midi", MIDI},
   {"name", NAME},
   {"new", NEWCONTEXT},
diff --git a/lily/paper-book.cc b/lily/paper-book.cc
index 84191b7..e17cd5b 100644
--- 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 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))
     {
@@ -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.01));
+                 ps->set_property ("next-space", scm_double2num (0.01));
+               }
+             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);
diff --git a/lily/parser.yy b/lily/parser.yy
index 18668de..5195048 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -182,6 +182,7 @@ void set_music_properties (Music *p, SCM
 %token LYRICSTO "\\lyricsto"
 %token MARK "\\mark"
 %token MARKUP "\\markup"
+%token MARKUPLIST "\\markuplist"
 %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_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
@@ -373,6 +378,7 @@ If we give names, Bison complains.
 %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
@@ -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_command_list
 %type <scm> markup_head_1_item
 %type <scm> markup_head_1_list
 %type <scm> markup_list
@@ -479,6 +486,10 @@ toplevel_expression:
        }
        | 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);
        }
        | output_def {
@@ -664,6 +675,10 @@ book_body:
        }
        | 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);
        }
        | book_body lilypond_header {
@@ -2186,6 +2201,15 @@ lyric_markup:
        }
        ;
 
+full_markup_list:
+       MARKUPLIST
+               { PARSER->lexer_->push_markup_state (); }
+       markup_list {
+               $$ = $3;
+               PARSER->lexer_->pop_state ();
+       }
+       ;
+
 full_markup:
        MARKUP_IDENTIFIER {
                $$ = $1;
@@ -2217,6 +2241,9 @@ markup_list:
        | markup_braced_list {
                $$ = $1;
        }
+       | markup_command_list {
+               $$ = scm_list_1 ($1);
+       }
        ;
 
 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);
diff --git a/lily/text-interface.cc b/lily/text-interface.cc
index 55e7bb7..0c514a3 100644
--- a/lily/text-interface.cc
+++ b/lily/text-interface.cc
@@ -96,6 +96,14 @@ Text_interface::is_markup (SCM x)
                                      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}. "
diff --git a/ly/markup-init.ly b/ly/markup-init.ly
index c40bd88..49c155c 100644
--- a/ly/markup-init.ly
+++ b/ly/markup-init.ly
@@ -85,3 +85,36 @@ or:
                         ,(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 d1f5dd0..035a469 100644
--- 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."
  
-  (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)
@@ -404,7 +402,7 @@ If there are no arguments, return an emp
   "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)) 
        )
@@ -438,7 +436,9 @@ equivalent to @code{\"fi\"}."
 
   (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)
@@ -520,32 +520,28 @@ equivalent to @code{\"fi\"}."
 
 (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))
-       (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;
 @address@hidden 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."
-
-  (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*
@@ -623,7 +619,7 @@ the line width, where @var{X} is the num
 @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)))
 
     
@@ -640,11 +636,11 @@ of the @code{#'direction} layout propert
      (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."
-  (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)))
@@ -1490,3 +1486,40 @@ when @var{label} is not found."
                                    (markup #:concat (#:hspace gap 
page-markup)))))))
      x-ext
      y-ext)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Markup list commands
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (space-lines baseline-skip lines)
+  (map (lambda (line)
+        (stack-lines DOWN 0.0 baseline-skip
+                     (list (ly:make-stencil "" (cons 0 0) (cons 0 0))
+                           line)))
+       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;
address@hidden@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.
address@hidden 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 27d1229..4d8feb1 100644
--- 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)))
-        (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)
@@ -43,6 +43,12 @@
          
          (map doc-markup-function
               (sort markup-function-list markup-function<?)))
+   "address@hidden table"
+   "address@hidden @asis"
+   (apply string-append
+         
+         (map doc-markup-function
+              (sort markup-list-function-list markup-function<?)))
    "address@hidden table"))
 
 (define (markup-doc-node)
diff --git a/scm/layout-page-layout.scm b/scm/layout-page-layout.scm
index 6c1f605..cd3167b 100644
--- a/scm/layout-page-layout.scm
+++ b/scm/layout-page-layout.scm
@@ -157,7 +157,9 @@
   (let* ((title (paper-system-title? line))
         (next-title (and next-line (paper-system-title? next-line))))
     (cond ((and title next-title)
-          (ly:output-def-lookup layout 'between-title-space))
+          (ly:prob-property
+           line 'next-space
+           (ly:output-def-lookup layout 'between-title-space)))
          (title
           (ly:output-def-lookup layout 'after-title-space))
          (next-title
diff --git a/scm/markup.scm b/scm/markup.scm
index f1d0863..70baeaa 100644
--- 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))))))
 
+(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.
@@ -261,6 +291,7 @@ Use `markup*' in a \\notemode context."
 
 ;; 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 "
@@ -282,14 +313,24 @@ Use `markup*' in a \\notemode context."
                                     sig)
                          "-"))))
 
-(define-public (lookup-markup-command code)
+(define (lookup-markup-command-aux symbol)
   (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))))
-    (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
@@ -313,13 +354,25 @@ eg: ((italic) (raise 4) (bold)), maps th
 ;;; 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)
+  "Return a true value if `x' is a list of markups or markup command lists."
   (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."
@@ -391,6 +444,18 @@ Uncovered - cheap-markup? is used."
 
 
 (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)))
 

reply via email to

[Prev in Thread] Current Thread [Next in Thread]