[patch] \label, page references

[Nicolas Sceaux]

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