Add feature to link to a particular page or a page containing a given label

The main part of this patch was done by Dan Eble and posted to the
lilypond-devel mailinglist on December 27, 2010.

Like \with-url, this works only with the PDF backend.

-) Add markup functions \with-link (links to the page containing the
   given label) and \page-link (links to the given page number)
-) Internally, they are handled like the \with-url markup function,
   creating a pdfmark in the .ps file that creates the link in the
   PDF file.
-) Add links to the pages for all TOC entries.

8 files changed, 124 insertions, 4 deletions

diff --git a/Documentation/changes.tely b/Documentation/changes.tely
index d91f8e4473..0c468b14be 100644
--- a/Documentation/changes.tely
+++ b/Documentation/changes.tely
@@ -229,6 +229,12 @@ Enhanced support for obliqua shapes within white mensural ligatures.
 @end lilypond
 
 @item
+New markup functions @code{\with-link} and @code{\page-link} that add
+hyperlinks to a given label or a given page number. This works in the PDF
+backend only. All entries to the table of contents now automatically add
+hyperlinks to the pages they are referring to.
+
+@item
 Compound time signatures are now supported by the @code{\compoundMeter} command,
 which can be used instead of @code{\time}:
 
diff --git a/input/regression/page-links.ly b/input/regression/page-links.ly
new file mode 100644
index 0000000000..a4ad675de3
--- /dev/null
+++ b/input/regression/page-links.ly
@@ -0,0 +1,31 @@
+\version "2.13.47"
+
+\header {
+
+  texidoc = "Links to labels and explicit page number (PDF backend only)."
+
+}
+
+#(set-default-paper-size "a6" 'landscape)
+
+\book {
+  \label #'front
+  \markup { \with-link #'second \concat { "Link to page " \page-ref #'second "0" "?" " with label #'second."  } }
+  \markup { \page-link #3 "Explicit link to page 3" }
+  \markup { \with-link #'markB "Link to mark B" }
+
+  \pageBreak
+  \label #'second
+
+  \score {
+    { c'2
+      \mark \markup \with-link #'front { front: \concat { \page-ref #'front "0" "?" ) }} 
+      c'
+
+      \pageBreak
+      \mark \markup \with-link #'front "B" 
+      \label #'markB
+      d' d'
+      }
+  }
+}
\ No newline at end of file
diff --git a/input/regression/toc.ly b/input/regression/toc.ly
index 94fe0f08e7..4e23788f2c 100644
--- a/input/regression/toc.ly
+++ b/input/regression/toc.ly
@@ -3,7 +3,8 @@
 \header {
   texidoc = "A table of contents is included using
 @code{\\markuplines \\table-of-contents}. The toc items are added with
-the @code{\\tocItem} command."
+the @code{\\tocItem} command. In the PDF backend, the toc items are linked
+to the corresponding pages."
 }
 
 #(set-default-paper-size "a6")
diff --git a/ly/toc-init.ly b/ly/toc-init.ly
index 488e22ba2a..32c1dd2b3a 100644
--- a/ly/toc-init.ly
+++ b/ly/toc-init.ly
@@ -48,9 +48,10 @@ Usage: @code{\\markuplines \\table-of-contents}" )
 				 (text (caddr toc-item)))
 			     (interpret-markup
 			       layout
-			       (cons (list (cons 'toc:page 
-					    (markup #:page-ref label "XXX" "?"))
-					   (cons 'toc:text text))
+			       (cons (list (cons 'toc:page
+					    (markup #:with-link label #:page-ref label "XXX" "?"))
+					   (cons 'toc:text (markup #:with-link label text))
+					   (cons 'toc:label label))
 				     props)
 			       (ly:output-def-lookup layout toc-markup))))
 			 (toc-items)))))
diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps
index ccaf6b3dcc..09ac055f46 100644
--- a/ps/music-drawing-routines.ps
+++ b/ps/music-drawing-routines.ps
@@ -35,6 +35,24 @@
 }
 bind def
 
+% llx lly urx ury page
+/mark_page_link
+{
+    /page exch def
+    /ury exch def
+    /urx exch def
+    /lly exch def
+    /llx exch def
+    [
+        /Rect [ llx lly urx ury ]
+        /Border [ 0 0 0 ]
+        /Page page
+        /Subtype /Link
+    /ANN
+    pdfmark
+}
+bind def
+
 % from adobe tech note 5002.
 /BeginEPSF { %def
     /b4_Inc_state save def % Save state for cleanup
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 5de7fdc6b5..125a34339f 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -264,6 +264,60 @@ the PDF backend.
 
     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
 
+(define-markup-command (page-link layout props page-number arg)
+  (number? markup?)
+  #:category other
+  "
+@cindex referencing page numbers in text
+
+Add a link to the page @var{page-number} around @var{arg}. This only works in
+the PDF backend.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\page-link #2  { \\italic { This links to page 2... } }
+}
+@end lilypond"
+  (let* ((stil (interpret-markup layout props arg))
+	 (xextent (ly:stencil-extent stil X))
+	 (yextent (ly:stencil-extent stil Y))
+	 (old-expr (ly:stencil-expr stil))
+	 (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent))))
+
+    (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil)))
+
+(define-markup-command (with-link layout props label arg)
+  (symbol? markup?)
+  #:category other
+  "
+@cindex referencing page labels in text
+
+Add a link to the page holding label @var{label} around @var{arg}. This
+only works in the PDF backend.
+
+@lilypond[verbatim,quote]
+\\markup {
+  \\with-link #\"label\" { \\italic { This links to the page containing the label... } }
+}
+@end lilypond"
+  (let* ((arg-stencil (interpret-markup layout props arg))
+         (x-ext (ly:stencil-extent arg-stencil X))
+         (y-ext (ly:stencil-extent arg-stencil Y)))
+    (ly:make-stencil
+     `(delay-stencil-evaluation
+       ,(delay (ly:stencil-expr
+                (let* ((table (ly:output-def-lookup layout 'label-page-table))
+                       (page-number (if (list? table)
+                                        (assoc-get label table)
+                                        #f))
+                       (link-expr (list 'page-link page-number
+                                        `(quote ,x-ext) `(quote ,y-ext))))
+                  (ly:stencil-add (ly:make-stencil link-expr x-ext y-ext)
+arg-stencil)))))
+     x-ext
+     y-ext)))
+
+
 (define-markup-command (beam layout props width slope thickness)
   (number? number? number?)
   #:category graphic
diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm
index 4191a85532..7b27d5201b 100644
--- a/scm/define-stencil-commands.scm
+++ b/scm/define-stencil-commands.scm
@@ -39,6 +39,7 @@ defined in the output modules (@file{output-*.scm})."
     named-glyph
     no-origin
     oval
+    page-link
     path
     partial-ellipse
     placebox
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index f20c42f1e1..d1c0c419ed 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -261,6 +261,14 @@
 	     (cdr y)
 	     url))
 
+(define (page-link page-no x y)
+  (ly:format "~a ~a currentpoint vector_add  ~a ~a currentpoint vector_add ~a mark_page_link"
+	     (car x)
+	     (car y)
+	     (cdr x)
+	     (cdr y)
+	     page-no))
+
 (define* (path thickness exps #:optional (cap 'round) (join 'round) (fill? #f))
   (define (convert-path-exps exps)
     (if (pair? exps)