@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
* Text marks::
* Text markup::
* Nested scores::
+* Page wrapping text::
* Overview of text markup commands::
+* Overview of text markup list commands::
* Font selection::
* New dynamic marks::
@end menu
}
@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
@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
* Markup construction in Scheme::
* How markups work internally::
* New markup command definition::
+* New markup list command definition::
@end menu
@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
--- /dev/null
+\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.
+ }
+}
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
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 */
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);
{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);
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);
}
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
{"lyricsto", LYRICSTO},
{"mark", MARK},
{"markup", MARKUP},
+ {"markuplines", MARKUPLINES},
{"midi", MIDI},
{"name", NAME},
{"new", NEWCONTEXT},
= 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))
{
*/
}
}
- 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);
%token LYRICSTO "\\lyricsto"
%token MARK "\\mark"
%token MARKUP "\\markup"
+%token MARKUPLINES "\\markuplines"
%token MIDI "\\midi"
%token NAME "\\name"
%token NOTEMODE "\\notemode"
%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
%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> 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
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_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);
}
}
;
+full_markup_list:
+ MARKUPLINES
+ { PARSER->lexer_->push_markup_state (); }
+ markup_list {
+ $$ = $3;
+ PARSER->lexer_->pop_state ();
+ }
+ ;
+
full_markup:
MARKUP_IDENTIFIER {
$$ = $1;
| markup_braced_list {
$$ = $1;
}
+ | markup_command_list {
+ $$ = scm_list_1 ($1);
+ }
;
markup_composed_list:
}
;
+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);
4, 1, 0, (SCM springs, SCM rods, SCM length, SCM ragged),
"Solve a spring and rod problem for @var{count} objects, that "
"are connected by @var{count-1} springs, and an arbitrary number of rods "
- "Springs have the format (ideal, hooke) and rods (idx1, idx2, distance) "
+ "Springs have the format (ideal, inverse_hooke) and rods (idx1, idx2, distance) "
"@var{length} is a number, @var{ragged} a boolean "
"Return: a list containing the force (positive for stretching, "
"negative for compressing and #f for non-satisfied constraints) "
for (SCM s = springs; scm_is_pair (s); s = scm_cdr (s))
{
Real ideal = scm_to_double (scm_caar (s));
- Real hooke = scm_to_double (scm_cadar (s));
+ Real inv_hooke = scm_to_double (scm_cadar (s));
- spacer.add_spring (ideal, 1 / hooke);
+ spacer.add_spring (ideal, inv_hooke);
}
for (SCM s = rods; scm_is_pair (s); s = scm_cdr (s))
Simple_spacer::solve (Real line_len, bool ragged)
{
Real conf = configuration_length (force_);
+ double inv_hooke = 0;
+ for (vsize i=0; i < springs_.size (); i++)
+ inv_hooke += springs_[i].inverse_hooke_;
ragged_ = ragged;
line_len_ = line_len;
- if (conf < line_len_)
+ if ((inv_hooke > 0) && (conf < line_len_))
force_ = expand_line ();
else if (conf > line_len_)
force_ = compress_line ();
/* properties */
"all-elements "
"columns "
+ "labels "
"pure-Y-extent "
"spaceable-staves "
"skyline-distance "
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}. "
,(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)))))))
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)
"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))
)
(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-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;
@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."
-
- (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*
@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)))
(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)))
(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))
(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)
(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-list-doc-node)
+ (make <texi-node>
+ #:name "Markup list functions"
+ #:desc "Definitions of the markup list functions."
+ #:text (markup-list-doc-string)))
(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"))
`next-line' can be #f, meaning that `line' is the last line."
(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))
- (title
- (ly:output-def-lookup layout 'after-title-space))
- (next-title
- (ly:output-def-lookup layout 'before-title-space))
- (else
- (ly:prob-property
- line 'next-space
- (ly:output-def-lookup layout 'between-system-space))))))
+ (ly:prob-property
+ line 'next-space
+ (ly:output-def-lookup layout
+ (cond ((and title next-title) 'between-title-space)
+ (title 'after-title-space)
+ (next-title 'before-title-space)
+ (else 'between-system-space))))))
(define (line-next-padding line next-line layout)
"Return padding to use between `line' and `next-line'.
"Ideal distance between `line' reference position and `next-line'
reference position. If next-line is #f, return #f."
(and next-line
- (+ (max 0 (- (+ (interval-end (paper-system-staff-extents next-line))
- (if ignore-padding 0 (line-next-padding line next-line layout)))
- (interval-start (paper-system-staff-extents line))))
- (line-next-space line next-line layout))))
+ (max (+ (max 0 (- (+ (interval-end (paper-system-staff-extents next-line))
+ (if ignore-padding 0 (line-next-padding line next-line layout)))
+ (interval-start (paper-system-staff-extents line))))
+ (line-next-space line next-line layout))
+ (line-minimum-distance line next-line layout ignore-padding))))
(define (first-line-position line layout)
"Position of the first line on page"
'())))
(springs (map (lambda (prev-line line)
(list (line-ideal-distance prev-line line paper ignore-padding)
- (/ 1.0 (line-next-space prev-line line paper))))
+ (line-next-space prev-line line paper)))
lines
cdr-lines))
(rods (map (let ((i -1))
(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.
;; 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 "
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
;;; 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."
(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)))
projects / lilypond.git / commitdiff