lily/translator-ctors.cc

   1 /*
   2   This file is part of LilyPond, the GNU music typesetter.
   3
   4   Copyright (C) 1997--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
   5
   6   LilyPond is free software: you can redistribute it and/or modify
   7   it under the terms of the GNU General Public License as published by
   8   the Free Software Foundation, either version 3 of the License, or
   9   (at your option) any later version.
  10
  11   LilyPond is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU General Public License for more details.
  15
  16   You should have received a copy of the GNU General Public License
  17   along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 */
  19
  20 #include "context.hh"
  21 #include "translator.hh"
  22 #include "lily-imports.hh"
  23 #include "international.hh"
  24 #include "scm-hash.hh"
  25 #include "warn.hh"
  26 #include "protected-scm.hh"
  27
  28 SCM
  29 Translator_creator::call (SCM ctx)
  30 {
  31   return (allocate_ (LY_ASSERT_SMOB (Context, ctx, 1)))->unprotect ();
  32 }
  33
  34 Protected_scm global_translator_dict;
  35 Protected_scm global_translator_dict_rev;
  36
  37 LY_DEFINE (get_all_translators, "ly:get-all-translators", 0, 0, 0, (),
  38            "Return a list of all translator objects that may be"
  39            " instantiated.")
  40 {
  41   Scheme_hash_table *dict = unsmob<Scheme_hash_table> (global_translator_dict);
  42   SCM l = dict ? dict->to_alist () : SCM_EOL;
  43
  44   for (SCM s = l; scm_is_pair (s); s = scm_cdr (s))
  45     scm_set_car_x (s, scm_cdar (s));
  46
  47   return l;
  48 }
  49
  50 void
  51 add_translator_creator (SCM creator, SCM name, SCM description)
  52 {
  53   Scheme_hash_table *dict = unsmob<Scheme_hash_table> (global_translator_dict);
  54   if (!dict)
  55     {
  56       global_translator_dict = Scheme_hash_table::make_smob ();
  57       global_translator_dict_rev =
  58         scm_make_weak_key_hash_table (scm_from_int (119));
  59       dict = unsmob<Scheme_hash_table> (global_translator_dict);
  60     }
  61   dict->set (name, creator);
  62   scm_hashq_set_x (global_translator_dict_rev, creator, scm_cons (name, description));
  63 }
  64
  65 LY_DEFINE (ly_translator_name, "ly:translator-name",
  66            1, 0, 0, (SCM creator),
  67            "Return the type name of the translator definition @var{creator}."
  68            "  The name is a symbol.")
  69 {
  70   SCM res = global_translator_dict_rev.is_bound ()
  71     ? scm_hashq_ref (global_translator_dict_rev, creator, SCM_BOOL_F)
  72     : SCM_BOOL_F;
  73   SCM_ASSERT_TYPE (scm_is_pair (res),
  74                    creator, SCM_ARG1, __FUNCTION__, "translator definition");
  75   return scm_car (res);
  76 }
  77
  78 LY_DEFINE (ly_translator_description, "ly:translator-description",
  79            1, 0, 0, (SCM creator),
  80            "Return an alist of properties of translator definition @var{creator}.")
  81 {
  82   SCM res = global_translator_dict_rev.is_bound ()
  83     ? scm_hashq_ref (global_translator_dict_rev, creator, SCM_BOOL_F)
  84     : SCM_BOOL_F;
  85   SCM_ASSERT_TYPE (scm_is_pair (res),
  86                    creator, SCM_ARG1, __FUNCTION__, "translator definition");
  87   return scm_cdr (res);
  88 }
  89
  90 LY_DEFINE (ly_register_translator, "ly:register-translator",
  91            2, 1, 0, (SCM creator, SCM name, SCM description),
  92            "Register a translator @var{creator} (usually a descriptive"
  93            " alist or a function/closure returning one when given a"
  94            " context argument) with the given symbol @var{name} and"
  95            " the given @var{description} alist.")
  96 {
  97   SCM_ASSERT_TYPE (ly_is_procedure (creator) || scm_is_pair (creator),
  98                    creator, SCM_ARG1, __FUNCTION__, "translator creator");
  99   LY_ASSERT_TYPE (ly_is_symbol, name, 2);
 100   if (SCM_UNBNDP (description))
 101     description = SCM_EOL;
 102   else
 103     LY_ASSERT_TYPE (ly_is_list, description, 3);
 104   add_translator_creator (creator, name, description);
 105   return SCM_UNSPECIFIED;
 106 }
 107
 108 SCM
 109 get_translator_creator (SCM sym)
 110 {
 111   SCM v = SCM_BOOL_F;
 112   Scheme_hash_table *dict = unsmob<Scheme_hash_table> (global_translator_dict);
 113   if (dict)
 114     dict->try_retrieve (sym, &v);
 115
 116   if (scm_is_false (v))
 117     {
 118       warning (_f ("unknown translator: `%s'", ly_symbol2string (sym).c_str ()));
 119     }
 120
 121   return v;
 122 }