Update using bison-CVS.

[lilypond.git] / lily / output-def-scheme.cc

diff --git a/lily/output-def-scheme.cc b/lily/output-def-scheme.cc
index 88d6f28c49666e76d8788141171128078f45abcf..9e56fb79bb29c29bea919d89b143c153e1882b59 100644 (file)
--- a/lily/output-def-scheme.cc
+++ b/lily/output-def-scheme.cc
@@ -1,5 +1,5 @@
 /*
-  output-def-scheme.cc --  implement Output_def bindings
+  output-def-scheme.cc -- implement Output_def bindings
 
   source file of the GNU LilyPond music typesetter
 
@@ -8,6 +8,8 @@
 */
 
 #include "font-metric.hh"
+#include "pango-font.hh"
+#include "modified-font-metric.hh"
 #include "output-def.hh"
 #include "ly-module.hh"
 #include "context-def.hh"
@@ -121,3 +123,50 @@ LY_DEFINE (ly_paper_get_number, "ly:paper-get-number", 2, 0, 0,
                   __FUNCTION__, "layout definition");
   return scm_make_real (layout->get_dimension (name));
 }
+
+LY_DEFINE (ly_paper_fonts, "ly:paper-fonts",
+          1, 0, 0,
+          (SCM bp),
+          "Return fonts from the @code{\\paper} block @var{bp}.")
+{
+  Output_def *b = unsmob_output_def (bp);
+
+  
+  SCM_ASSERT_TYPE (b, bp, SCM_ARG1, __FUNCTION__, "paper");
+
+  SCM tab1 = b->lookup_variable (ly_symbol2scm ("scaled-fonts"));
+  SCM tab2 = b->lookup_variable (ly_symbol2scm ("pango-fonts"));
+
+  SCM alist1 = SCM_EOL;
+  if (scm_hash_table_p (tab1) == SCM_BOOL_T)
+    {
+      alist1 = scm_append (ly_alist_vals (ly_hash2alist (tab1)));
+      
+      alist1 = ly_alist_vals (alist1);
+    }
+
+  SCM alist2 = SCM_EOL;
+  if (scm_hash_table_p (tab2) == SCM_BOOL_T)
+    {
+      // strip original-fonts/pango-font-descriptions
+      alist2 = scm_append (ly_alist_vals (ly_hash2alist (tab2)));
+
+      // strip size factors
+      alist2 = ly_alist_vals (alist2); 
+    }
+
+  SCM alist = scm_append (scm_list_2 (alist1, alist2));
+  SCM font_list = SCM_EOL;
+  for (SCM s = alist; scm_is_pair (s); s = scm_cdr (s))
+    {
+      SCM entry = scm_car (s);
+      
+      Font_metric *fm = unsmob_metrics (entry);
+
+      if (dynamic_cast<Modified_font_metric*> (fm)
+         || dynamic_cast<Pango_font*> (fm))
+       font_list = scm_cons (fm->self_scm (), font_list);
+    }
+  
+  return font_list;
+}