Hi,
Here is a patch implementing a page reference markup feature.
A label is attached to a score or a top-level markup using a \label
command with a symbol argument. When the page breaking is done, a {
label -> page-number } table is filled, which can be referenced later to
retreive page numbers from a label. The patch introduces a new stencil
command, delay-stencil-evaluation, and a new markup command using it:
\page-ref.
nicolas
diff --git a/lily/include/page-marker.hh b/lily/include/page-marker.hh
index a925a6c..69962e6 100644
--- a/lily/include/page-marker.hh
+++ b/lily/include/page-marker.hh
@@ -17,12 +17,17 @@ class Page_marker
SCM symbol_; /* either 'page-turn-permission or 'page-break-permission */
SCM permission_; /* 'force, 'allow, or '() */
+ SCM label_; /* bookmarking label (a symbol) */
public:
- Page_marker (SCM symbol, SCM permission);
+ Page_marker ();
+ void set_permission (SCM symbol, SCM permission);
+ void set_label (SCM label);
+
SCM permission_symbol ();
SCM permission_value ();
+ SCM label ();
};
DECLARE_UNSMOB (Page_marker, page_marker)
diff --git a/lily/page-breaking.cc b/lily/page-breaking.cc
index 46a1eed..25cd4bb 100644
--- a/lily/page-breaking.cc
+++ b/lily/page-breaking.cc
@@ -235,6 +235,7 @@ Page_breaking::make_pages (vector<vsize>
SCM book = book_->self_scm ();
int first_page_number = robust_scm2int (book_->paper_->c_variable ("first-page-number"), 1);
SCM ret = SCM_EOL;
+ SCM label_page_table = SCM_EOL;
for (vsize i = 0; i < lines_per_page.size (); i++)
{
@@ -246,10 +247,29 @@ Page_breaking::make_pages (vector<vsize>
SCM page = scm_apply_0 (make_page,
scm_list_n (book, lines, page_num, rag, last, SCM_UNDEFINED));
+ /* collect labels */
+ for (SCM l = lines ; scm_is_pair (l) ; l = scm_cdr (l))
+ {
+ SCM labels = SCM_EOL;
+ if (Grob * line = unsmob_grob (scm_car (l)))
+ {
+ System *system = dynamic_cast<System*> (line);
+ labels = system->get_property ("labels");
+ }
+ else if (Prob * markup = unsmob_prob (scm_car (l)))
+ labels = markup->get_property ("labels");
+
+ for (SCM lbls = labels ; scm_is_pair (lbls) ; lbls = scm_cdr (lbls))
+ label_page_table = scm_cons (scm_cons (scm_car (lbls), page_num),
+ label_page_table);
+ }
+
scm_apply_1 (page_stencil, page, SCM_EOL);
ret = scm_cons (page, ret);
systems = scm_list_tail (systems, line_count);
}
+ book_->paper_->set_variable (ly_symbol2scm ("label-page-table"),
+ scm_reverse_x (label_page_table, SCM_EOL));
ret = scm_reverse (ret);
return ret;
}
diff --git a/lily/page-marker-scheme.cc b/lily/page-marker-scheme.cc
index 3278a7b..f2450be 100644
--- a/lily/page-marker-scheme.cc
+++ b/lily/page-marker-scheme.cc
@@ -8,12 +8,24 @@
#include "page-marker.hh"
-LY_DEFINE (ly_make_page_marker, "ly:make-page-marker",
+LY_DEFINE (ly_make_page_permission_marker, "ly:make-page-permission-marker",
2, 0, 0,
(SCM symbol, SCM permission),
"Return page marker with page breaking and turning permissions.")
{
LY_ASSERT_TYPE (ly_is_symbol, symbol, 1);
- Page_marker *page_marker = new Page_marker (symbol, permission);
+ Page_marker *page_marker = new Page_marker ();
+ page_marker->set_permission (symbol, permission);
+ return page_marker->unprotect ();
+}
+
+LY_DEFINE (ly_make_page_label_marker, "ly:make-page-label-marker",
+ 1, 0, 0,
+ (SCM label),
+ "Return page marker with label.")
+{
+ LY_ASSERT_TYPE (ly_is_symbol, label, 1);
+ Page_marker *page_marker = new Page_marker ();
+ page_marker->set_label (label);
return page_marker->unprotect ();
}
diff --git a/lily/page-marker.cc b/lily/page-marker.cc
index dd43c35..11b1999 100644
--- a/lily/page-marker.cc
+++ b/lily/page-marker.cc
@@ -9,10 +9,11 @@
#include "page-marker.hh"
#include "ly-smobs.icc"
-Page_marker::Page_marker (SCM symbol, SCM permission)
+Page_marker::Page_marker ()
{
- symbol_ = symbol;
- permission_ = permission;
+ symbol_ = SCM_EOL;
+ permission_ = SCM_EOL;
+ label_ = SCM_EOL;
smobify_self ();
}
@@ -30,6 +31,7 @@ Page_marker::mark_smob (SCM smob)
Page_marker *pm = (Page_marker *) SCM_CELL_WORD_1 (smob);
scm_gc_mark (pm->symbol_);
scm_gc_mark (pm->permission_);
+ scm_gc_mark (pm->label_);
return SCM_EOL;
}
@@ -53,3 +55,24 @@ Page_marker::permission_value ()
{
return permission_;
}
+
+SCM
+Page_marker::label ()
+{
+ return label_;
+}
+
+void
+Page_marker::set_permission (SCM symbol, SCM permission)
+{
+ symbol_ = symbol;
+ permission_ = permission;
+}
+
+void
+Page_marker::set_label (SCM label)
+{
+ label_ = label;
+}
+
+
diff --git a/lily/paper-book.cc b/lily/paper-book.cc
index 95be368..ec603e8 100644
--- a/lily/paper-book.cc
+++ b/lily/paper-book.cc
@@ -270,6 +270,19 @@ set_system_penalty (SCM sys, SCM header)
}
}
+void
+set_label (SCM sys, SCM label)
+{
+ if (Paper_score *ps = dynamic_cast<Paper_score*> (unsmob_music_output (sys)))
+ {
+ SCM labels = ps->layout ()->c_variable ("labels");
+ ps->layout ()->set_variable (ly_symbol2scm ("labels"),
+ scm_cons (label, labels));
+ }
+ else if (Prob *pb = unsmob_prob (sys))
+ pb->set_property ("labels", scm_cons (label, pb->get_property ("labels")));
+}
+
SCM
Paper_book::get_score_title (SCM header)
{
@@ -324,11 +337,22 @@ Paper_book::get_system_specs ()
}
else if (Page_marker *page_marker = unsmob_page_marker (scm_car (s)))
{
- /* a page marker: set previous element page break or turn permission */
- if (scm_is_pair (system_specs))
- set_page_permission (scm_car (system_specs),
- page_marker->permission_symbol (),
- page_marker->permission_value ());
+ /* page markers are used to set page breaking/tunrning permission,
+ or to place bookmarking labels */
+ if (scm_is_symbol (page_marker->permission_symbol ()))
+ {
+ /* set previous element page break or turn permission */
+ if (scm_is_pair (system_specs))
+ set_page_permission (scm_car (system_specs),
+ page_marker->permission_symbol (),
+ page_marker->permission_value ());
+ }
+ if (scm_is_symbol (page_marker->label ()))
+ {
+ /* set previous element label */
+ if (scm_is_pair (system_specs))
+ set_label (scm_car (system_specs), page_marker->label ());
+ }
}
else if (Music_output *mop = unsmob_music_output (scm_car (s)))
{
diff --git a/lily/stencil-interpret.cc b/lily/stencil-interpret.cc
index f6deee0..8afc330 100644
--- a/lily/stencil-interpret.cc
+++ b/lily/stencil-interpret.cc
@@ -21,6 +21,11 @@ interpret_stencil_expression (SCM expr,
SCM head = scm_car (expr);
+ if (head == ly_symbol2scm ("delay-stencil-evaluation"))
+ {
+ interpret_stencil_expression (scm_force (scm_cadr (expr)), func, func_arg, o);
+ return;
+ }
if (head == ly_symbol2scm ("translate-stencil"))
{
o += ly_scm2offset (scm_cadr (expr));
diff --git a/lily/system.cc b/lily/system.cc
index e700615..7ba66a8 100644
--- a/lily/system.cc
+++ b/lily/system.cc
@@ -225,6 +225,13 @@ System::break_into_pieces (vector<Column
Interval iv (pure_height (this, st, end));
system->set_property ("pure-Y-extent", ly_interval2scm (iv));
+ /* set the first system labels with the score ones */
+ if (i == 0)
+ {
+ SCM labels = pscore_->layout ()->c_variable ("labels");
+ system->set_property ("labels", labels);
+ }
+
system->set_bound (LEFT, c[0]);
system->set_bound (RIGHT, c.back ());
for (vsize j = 0; j < c.size (); j++)
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 8a0853e..d1f5dd0 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -1463,8 +1463,30 @@ that."
(m (interpret-markup layout props arg)))
(bracketify-stencil m Y th (* 2.5 th) th)))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; size indications arrow
+;; Delayed markup evaluation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-builtin-markup-command (page-ref layout props label gauge default)
+ (symbol? markup? markup?)
+ "Reference to a page number. @var{label} is the label set on the referenced
+page (using the @code{\\label} command), @var{gauge} a markup used to estimate
+the maximum width of the page number, and @var{default} the value to display
+when @var{label} is not found."
+ (let* ((gauge-stencil (interpret-markup layout props gauge))
+ (x-ext (ly:stencil-extent gauge-stencil X))
+ (y-ext (ly:stencil-extent gauge-stencil Y)))
+ (ly:make-stencil
+ `(delay-stencil-evaluation
+ ,(delay (ly:stencil-expr
+ (let* ((table (ly:output-def-lookup layout 'label-page-table))
+ (label-page (and (list? table) (assoc label table)))
+ (page-number (and label-page (cdr label-page)))
+ (page-markup (if page-number (format "~a" page-number) default))
+ (page-stencil (interpret-markup layout props page-markup))
+ (gap (- (interval-length x-ext)
+ (interval-length (ly:stencil-extent page-stencil X)))))
+ (interpret-markup layout props
+ (markup #:concat (#:hspace gap page-markup)))))))
+ x-ext
+ y-ext)))
diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm
index 9b0b942..6a027b6 100644
--- a/scm/define-stencil-commands.scm
+++ b/scm/define-stencil-commands.scm
@@ -37,6 +37,8 @@
no-origin
placebox
unknown
+
+ delay-stencil-evaluation
))
;; TODO:
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 7a1141d..5435533 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -70,17 +70,21 @@
value
#f)))
(cond ((music-property 'page-marker)
- ;; a page marker: set page break/turn permissions
- (for-each (lambda (symbol)
- (let ((permission (music-property symbol)))
- (if (symbol? permission)
- (score-handler
- (ly:make-page-marker symbol
- (if (eqv? 'forbid permission)
- '()
- permission))))))
- (list 'line-break-permission 'page-break-permission
- 'page-turn-permission)))
+ ;; a page marker: set page break/turn permissions or label
+ (begin
+ (let ((label (music-property 'label)))
+ (if (symbol? label)
+ (score-handler (ly:make-page-label-marker label))))
+ (for-each (lambda (symbol)
+ (let ((permission (music-property symbol)))
+ (if (symbol? permission)
+ (score-handler
+ (ly:make-page-permission-marker symbol
+ (if (eqv? 'forbid permission)
+ '()
+ permission))))))
+ (list 'line-break-permission 'page-break-permission
+ 'page-turn-permission))))
((not (music-property 'void))
;; a regular music expression: make a score with this music
;; void music is discarded
_______________________________________________
lilypond-devel mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/lilypond-devel
