libgeda/src/g_rc.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * libgeda - gEDA's library
   3  * Copyright (C) 1998-2010 Ales Hvezda
   4  * Copyright (C) 1998-2010 gEDA Contributors (see ChangeLog for details)
   5  *
   6  * This program 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 2 of the License, or
   9  * (at your option) any later version.
  10  *
  11  * This program 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 this program; if not, write to the Free Software
  18  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  19  */
  20 #include <config.h>
  21 #include <missing.h>
  22
  23 #include <errno.h>
  24 #include <stdio.h>
  25 #include <sys/stat.h>
  26 #include <ctype.h>
  27 #ifdef HAVE_STRING_H
  28 #include <string.h>
  29 #endif
  30 #ifdef HAVE_STDLIB_H
  31 #include <stdlib.h>
  32 #endif
  33 #ifdef HAVE_UNISTD_H
  34 #include <unistd.h>
  35 #endif
  36
  37 #include "libgeda_priv.h"
  38
  39 #ifdef HAVE_LIBDMALLOC
  40 #include <dmalloc.h>
  41 #endif
  42
  43 /*! \todo Finish function documentation!!!
  44  *  \brief
  45  *  \par Function Description
  46  *
  47  */
  48 int vstbl_lookup_str(const vstbl_entry *table,
  49                             int size, const char *str)
  50 {
  51   int i;
  52
  53   for(i = 0; i < size; i++) {
  54     if(strcmp(table[i].m_str, str) == 0) {
  55       break;
  56     }
  57   }
  58   return i;
  59 }
  60
  61 /*! \todo Finish function documentation!!!
  62  *  \brief
  63  *  \par Function Description
  64  *
  65  */
  66 int vstbl_get_val(const vstbl_entry *table, int index)
  67 {
  68   return table[index].m_val;
  69 }
  70
  71 /*! \todo Finish function documentation!!!
  72  *  \brief
  73  *  \par Function Description
  74  *
  75  */
  76 SCM g_rc_mode_general(SCM scmmode,
  77                       const char *rc_name,
  78                       int *mode_var,
  79                       const vstbl_entry *table,
  80                       int table_size)
  81 {
  82   SCM ret;
  83   int index;
  84   char *mode;
  85
  86   SCM_ASSERT (scm_is_string (scmmode), scmmode,
  87               SCM_ARG1, rc_name);
  88
  89   mode = scm_to_utf8_string (scmmode);
  90
  91   index = vstbl_lookup_str(table, table_size, mode);
  92   /* no match? */
  93   if(index == table_size) {
  94     fprintf(stderr,
  95             "Invalid mode [%s] passed to %s\n",
  96             mode,
  97             rc_name);
  98     ret = SCM_BOOL_F;
  99   } else {
 100     *mode_var = vstbl_get_val(table, index);
 101     ret = SCM_BOOL_T;
 102   }
 103
 104   free (mode);
 105
 106   return ret;
 107 }
 108
 109 /*! \brief Load a system configuration file.
 110  * \par Function Description
 111  * Attempts to load the system configuration file with basename \a
 112  * rcname.  The string "system-" is prefixed to \a rcname.  If \a
 113  * rcname is NULL, the default value of "gafrc" is used.
 114  *
 115  * \param toplevel  The current #TOPLEVEL structure.
 116  * \param rcfile    The basename of the configuration file to load, or NULL.
 117  * \param err       Return location for errors, or NULL.
 118  * \return TRUE on success, FALSE on failure.
 119  */
 120 gboolean
 121 g_rc_parse_system (TOPLEVEL *toplevel, const gchar *rcname, GError **err)
 122 {
 123   gchar *sysname = NULL;
 124   gboolean status;
 125
 126   /* Default to gafrc */
 127   rcname = (rcname != NULL) ? rcname : "gafrc";
 128
 129   sysname = g_strdup_printf ("system-%s", rcname);
 130   status = g_rc_parse_local (toplevel, sysname, s_path_sys_config (), err);
 131   g_free (sysname);
 132   return status;
 133 }
 134
 135 /*! \brief Load a user configuration file.
 136  * \par Function Description
 137  * Attempts to load the user configuration file with basename \a
 138  * rcname.  If \a rcname is NULL, the default value of "gafrc" is
 139  * used.
 140  *
 141  * \param toplevel  The current #TOPLEVEL structure.
 142  * \param rcfile    The basename of the configuration file to load, or NULL.
 143  * \param err       Return location for errors, or NULL.
 144  * \return TRUE on success, FALSE on failure.
 145  */
 146 gboolean
 147 g_rc_parse_user (TOPLEVEL *toplevel, const gchar *rcname, GError **err)
 148 {
 149   /* Default to gafrc */
 150   rcname = (rcname != NULL) ? rcname : "gafrc";
 151
 152   return g_rc_parse_local (toplevel, rcname, s_path_user_config (), err);
 153 }
 154
 155 /*! \brief Load a local configuration file.
 156  * \par Function Description
 157  * Attempts to load the configuration file with basename \a rcname
 158  * corresponding to \a path, reporting errors via \a err.  If \a path
 159  * is a directory, looks for a file named \a rcname in that
 160  * directory. Otherwise, looks for a file named \a rcname in the same
 161  * directory as \a path. If \a path is NULL, looks in the current
 162  * directory. If \a rcname is NULL, the default value of "gafrc" is
 163  * used.
 164  *
 165  * \param toplevel  The current #TOPLEVEL structure.
 166  * \param rcname    The basename of the configuration file to load, or NULL.
 167  * \param path      The path to load a configuration file for, or NULL.
 168  * \param err       Return location for errors, or NULL.
 169  * \return TRUE on success, FALSE on failure.
 170  */
 171 gboolean
 172 g_rc_parse_local (TOPLEVEL *toplevel, const gchar *rcname, const gchar *path,
 173                   GError **err)
 174 {
 175   gchar *dir = NULL;
 176   gchar *rcfile = NULL;
 177   gboolean status;
 178   g_return_val_if_fail ((toplevel != NULL), FALSE);
 179
 180   /* Default to gafrc */
 181   rcname = (rcname != NULL) ? rcname : "gafrc";
 182   /* Default to cwd */
 183   path = (path != NULL) ? path : ".";
 184
 185   /* If path isn't a directory, get the dirname. */
 186   if (g_file_test (path, G_FILE_TEST_IS_DIR)) {
 187     dir = g_strdup (path);
 188   } else {
 189     dir = g_path_get_dirname (path);
 190   }
 191
 192   rcfile = g_build_filename (dir, rcname, NULL);
 193   status = g_rc_parse_file (toplevel, rcfile, err);
 194
 195   g_free (dir);
 196   g_free (rcfile);
 197   return status;
 198 }
 199
 200 /*! \brief Mark a configuration file as read.
 201  * \par Function Description
 202  * If the config file \a filename has not already been loaded, mark it
 203  * as loaded and return TRUE, storing \a filename in \a toplevel (\a
 204  * filename should not subsequently be freed).  Otherwise, return
 205  * FALSE, and set \a err appropriately.
 206  *
 207  * \note Should only be called by g_rc_parse_file().
 208  *
 209  * \param toplevel  The current #TOPLEVEL structure.
 210  * \param filename  The config file name to test.
 211  * \param err       Return location for errors, or NULL.
 212  * \return TRUE if \a filename not already loaded, FALSE otherwise.
 213  */
 214 static gboolean
 215 g_rc_try_mark_read (TOPLEVEL *toplevel, gchar *filename, GError **err)
 216 {
 217   GList *found = NULL;
 218   g_return_val_if_fail ((toplevel != NULL), FALSE);
 219   g_return_val_if_fail ((filename != NULL), FALSE);
 220
 221   /* Test if marked read already */
 222   found = g_list_find_custom (toplevel->RC_list, filename,
 223                               (GCompareFunc) strcmp);
 224   if (found != NULL) {
 225     g_set_error (err, EDA_ERROR, EDA_ERROR_RC_TWICE,
 226                  _("Config file already loaded"));
 227     return FALSE;
 228   }
 229
 230   toplevel->RC_list = g_list_append (toplevel->RC_list, filename);
 231   /* N.b. don't free name_norm here; it's stored in the TOPLEVEL. */
 232   return TRUE;
 233 }
 234
 235 /*! \brief Load a configuration file.
 236  * \par Function Description
 237  * Load the configuration file \a rcfile, reporting errors via \a err.
 238  *
 239  * \param toplevel  The current #TOPLEVEL structure.
 240  * \param rcfile    The filename of the configuration file to load.
 241  * \param err       Return location for errors, or NULL;
 242  * \return TRUE on success, FALSE on failure.
 243  */
 244 gboolean
 245 g_rc_parse_file (TOPLEVEL *toplevel, const gchar *rcfile, GError **err)
 246 {
 247   gchar *name_norm = NULL;
 248   GError *tmp_err = NULL;
 249   g_return_val_if_fail ((toplevel != NULL), FALSE);
 250   g_return_val_if_fail ((rcfile != NULL), FALSE);
 251
 252   /* Normalise filename */
 253   name_norm = f_normalize_filename (rcfile, &tmp_err);
 254   if (name_norm == NULL) goto parse_file_error;
 255
 256   /* Attempt to load the rc file, if it hasn't been loaded already.
 257    * If g_rc_try_mark_read() succeeds, it stores name_norm in
 258    * toplevel, so we *don't* free it. */
 259   if (g_rc_try_mark_read (toplevel, name_norm, &tmp_err)
 260       && g_read_file (toplevel, name_norm, &tmp_err)) {
 261     s_log_message (_("Parsed config from [%s]\n"), name_norm);
 262     return TRUE;
 263   }
 264
 265  parse_file_error:
 266   /* Copy tmp_err into err, with a prefixed message. */
 267   /*! \todo We should upgrade to GLib >= 2.16 and use
 268    * g_propagate_prefixed_error(). */
 269   if (err == NULL) {
 270     g_error_free (tmp_err);
 271   } else {
 272     gchar *orig_msg = tmp_err->message;
 273     tmp_err->message =
 274       g_strdup_printf (_("Unable to parse config from [%s]: %s"),
 275                        (name_norm != NULL) ? name_norm : rcfile, orig_msg);
 276     g_free (orig_msg);
 277     *err = tmp_err;
 278   }
 279   g_free (name_norm);
 280   return FALSE;
 281 }
 282
 283 static void
 284 g_rc_parse__process_error (GError **err, const gchar *pname)
 285 {
 286   char *pbase;
 287
 288   /* Take no chances; if err was not set for some reason, bail out. */
 289   if (*err == NULL) {
 290     const gchar *msgl =
 291       _("ERROR: An unknown error occurred while parsing configuration files.");
 292     s_log_message ("%s\n", msgl);
 293     fprintf(stderr, "%s\n", msgl);
 294
 295   } else {
 296     /* Config files are allowed to be missing or skipped; check for
 297      * this. */
 298     if (g_error_matches (*err, G_FILE_ERROR, G_FILE_ERROR_NOENT) ||
 299         g_error_matches (*err, EDA_ERROR, EDA_ERROR_RC_TWICE)) {
 300       return;
 301     }
 302
 303     s_log_message (_("ERROR: %s\n"), (*err)->message);
 304     fprintf (stderr, _("ERROR: %s\n"), (*err)->message);
 305   }
 306
 307   /* g_path_get_basename() allocates memory, but we don't care
 308    * because we're about to exit. */
 309   pbase = g_path_get_basename (pname);
 310   fprintf (stderr, _("ERROR: The %s log may contain more information.\n"),
 311            pbase);
 312   exit (1);
 313 }
 314
 315 /*! \brief General RC file parsing function.
 316  * \par Function Description
 317  * Calls g_rc_parse_handler() with the default error handler. If any
 318  * error other than ENOENT occurs while parsing a configuration file,
 319  * prints an informative message and calls exit(1).
 320  *
 321  * \bug libgeda shouldn't call exit().
 322  *
 323  * \warning Since this function may not return, it should only be used
 324  * on application startup or when there is no chance of data loss from
 325  * an unexpected exit().
 326  *
 327  * \param [in] toplevel  The current #TOPLEVEL structure.
 328  * \param [in] pname     The name of the application (usually argv[0]).
 329  * \param [in] rcname    Config file basename, or NULL.
 330  * \param [in] rcfile    Specific config file path, or NULL.
 331  */
 332 void
 333 g_rc_parse (TOPLEVEL *toplevel, const gchar *pname,
 334             const gchar *rcname, const gchar *rcfile)
 335 {
 336   g_rc_parse_handler (toplevel, rcname, rcfile,
 337                       (ConfigParseErrorFunc) g_rc_parse__process_error,
 338                       (void *) pname);
 339 }
 340
 341 /*! \brief General RC file parsing function.
 342  * \par Function Description
 343  * Attempt to load system, user and local (current working directory)
 344  * configuration files, first with the default "gafrc" basename and
 345  * then with the basename \a rcname, if \a rcname is not NULL.
 346  * Additionally, attempt to load configuration from \a rcfile if \a
 347  * rcfile is not NULL.
 348  *
 349  * If an error occurs, calls \a handler with the provided \a user_data
 350  * and a GError.
 351  *
 352  * \see g_rc_parse().
 353  *
 354  * \param toplevel  The current #TOPLEVEL structure.
 355  * \param rcname    Config file basename, or NULL.
 356  * \param rcfile    Specific config file path, or NULL.
 357  * \param handler   Handler function for config parse errors.
 358  * \param user_data Data to be passed to \a handler.
 359  */
 360 void
 361 g_rc_parse_handler (TOPLEVEL *toplevel,
 362                     const gchar *rcname, const gchar *rcfile,
 363                     ConfigParseErrorFunc handler, void *user_data)
 364 {
 365   GError *err = NULL;
 366
 367 #ifdef HANDLER_DISPATCH
 368 #  error HANDLER_DISPATCH already defined
 369 #endif
 370 #define HANDLER_DISPATCH \
 371   do { if (err == NULL) break;  handler (&err, user_data);        \
 372        g_error_free (err); err = NULL; } while (0)
 373
 374   /* Load configuration files in order. */
 375   /* First gafrc files. */
 376   g_rc_parse_system (toplevel, NULL, &err); HANDLER_DISPATCH;
 377   g_rc_parse_user (toplevel, NULL, &err); HANDLER_DISPATCH;
 378   g_rc_parse_local (toplevel, NULL, NULL, &err); HANDLER_DISPATCH;
 379   /* Next application-specific rcname. */
 380   if (rcname != NULL) {
 381     g_rc_parse_system (toplevel, rcname, &err); HANDLER_DISPATCH;
 382     g_rc_parse_user (toplevel, rcname, &err); HANDLER_DISPATCH;
 383     g_rc_parse_local (toplevel, rcname, NULL, &err); HANDLER_DISPATCH;
 384   }
 385   /* Finally, optional additional config file. */
 386   if (rcfile != NULL) {
 387     g_rc_parse_file (toplevel, rcfile, &err); HANDLER_DISPATCH;
 388   }
 389
 390 #undef HANDLER_DISPATCH
 391 }
 392
 393 /*! \brief
 394  *  \par Function Description
 395  *
 396  *  \param [in] path
 397  *  \param [in] name Optional descriptive name for library directory.
 398  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 399  */
 400 SCM g_rc_component_library(SCM path, SCM name)
 401 {
 402   gchar *string;
 403   char *temp;
 404   char *namestr = NULL;
 405
 406   SCM_ASSERT (scm_is_string (path), path,
 407               SCM_ARG1, "component-library");
 408
 409   if (name != SCM_UNDEFINED) {
 410     SCM_ASSERT (scm_is_string (name), name,
 411                 SCM_ARG2, "component-library");
 412     namestr = scm_to_utf8_string (name);
 413   }
 414
 415   /* take care of any shell variables */
 416   temp = scm_to_utf8_string (path);
 417   string = s_expand_env_variables (temp);
 418   free (temp);
 419
 420   /* invalid path? */
 421   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 422     fprintf(stderr,
 423             "Invalid path [%s] passed to component-library\n",
 424             string);
 425     if (namestr != NULL) {
 426       free (namestr);
 427     }
 428     g_free(string);
 429     return SCM_BOOL_F;
 430   }
 431
 432   if (g_path_is_absolute (string)) {
 433     s_clib_add_directory (string, namestr);
 434   } else {
 435     gchar *cwd = g_get_current_dir ();
 436     gchar *temp;
 437     temp = g_build_filename (cwd, string, NULL);
 438     s_clib_add_directory (temp, namestr);
 439     g_free(temp);
 440     g_free(cwd);
 441   }
 442
 443   if (namestr != NULL) {
 444     free (namestr);
 445   }
 446   g_free(string);
 447
 448   return SCM_BOOL_T;
 449 }
 450
 451 /*! \brief Guile callback for adding library commands.
 452  *  \par Function Description
 453  *  Callback function for the "component-library-command" Guile
 454  *  function, which can be used in the rc files to add a command to
 455  *  the component library.
 456  *
 457  *  \param [in] listcmd command to get a list of symbols
 458  *  \param [in] getcmd  command to get a symbol from the library
 459  *  \param [in] name    Optional descriptive name for component source.
 460  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 461  */
 462 SCM g_rc_component_library_command (SCM listcmd, SCM getcmd,
 463                                     SCM name)
 464 {
 465   const CLibSource *src;
 466   gchar *lcmdstr, *gcmdstr;
 467   char *tmp_str, *namestr;
 468
 469   SCM_ASSERT (scm_is_string (listcmd), listcmd, SCM_ARG1,
 470               "component-library-command");
 471   SCM_ASSERT (scm_is_string (getcmd), getcmd, SCM_ARG2,
 472               "component-library-command");
 473   SCM_ASSERT (scm_is_string (name), name, SCM_ARG3,
 474               "component-library-command");
 475
 476   /* take care of any shell variables */
 477   /*! \bug this may be a security risk! */
 478   tmp_str = scm_to_utf8_string (listcmd);
 479   lcmdstr = s_expand_env_variables (tmp_str);
 480   free (tmp_str); /* this should stay as free (allocated from guile) */
 481
 482   /* take care of any shell variables */
 483   /*! \bug this may be a security risk! */
 484   tmp_str = scm_to_utf8_string (getcmd);
 485   gcmdstr = s_expand_env_variables (tmp_str);
 486   free (tmp_str); /* this should stay as free (allocated from guile) */
 487
 488   namestr = scm_to_utf8_string (name);
 489
 490   src = s_clib_add_command (lcmdstr, gcmdstr, namestr);
 491
 492   free (namestr); /* this should stay as free (allocated from guile) */
 493   g_free (lcmdstr);
 494   g_free (gcmdstr);
 495
 496   if (src != NULL) return SCM_BOOL_T;
 497
 498   return SCM_BOOL_F;
 499 }
 500
 501 /*! \brief Guile callback for adding library functions.
 502  *  \par Function Description
 503  *  Callback function for the "component-library-funcs" Guile
 504  *  function, which can be used in the rc files to add a set of Guile
 505  *  procedures for listing and generating symbols.
 506  *
 507  *  \param [in] listfunc A Scheme procedure which takes no arguments
 508  *                       and returns a Scheme list of component names.
 509  *  \param [in] getfunc A Scheme procedure which takes a component
 510  *                      name as an argument and returns a symbol
 511  *                      encoded in a string in gEDA format, or the \b
 512  *                      \#f if the component name is unknown.
 513  *  \param [in] name    A descriptive name for this component source.
 514  *
 515  *  \returns SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 516  */
 517 SCM g_rc_component_library_funcs (SCM listfunc, SCM getfunc, SCM name)
 518 {
 519   char *namestr;
 520   SCM result = SCM_BOOL_F;
 521
 522   SCM_ASSERT (scm_is_true (scm_procedure_p (listfunc)), listfunc, SCM_ARG1,
 523               "component-library-funcs");
 524   SCM_ASSERT (scm_is_true (scm_procedure_p (getfunc)), getfunc, SCM_ARG2,
 525               "component-library-funcs");
 526   SCM_ASSERT (scm_is_string (name), name, SCM_ARG3,
 527               "component-library-funcs");
 528
 529   namestr = scm_to_utf8_string (name);
 530
 531   if (s_clib_add_scm (listfunc, getfunc, namestr) != NULL) {
 532     result = SCM_BOOL_T;
 533   }
 534
 535   free (namestr);
 536   return result;
 537 }
 538
 539 /*! \todo Finish function description!!!
 540  *  \brief
 541  *  \par Function Description
 542  *
 543  *  \param [in] path
 544  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 545  */
 546 SCM g_rc_component_library_search(SCM path)
 547 {
 548   gchar *string;
 549   char *temp;
 550   GDir *dir;
 551   const gchar *entry;
 552
 553   SCM_ASSERT (scm_is_string (path), path,
 554               SCM_ARG1, "component-library-search");
 555
 556   /* take care of any shell variables */
 557   temp = scm_to_utf8_string (path);
 558   string = s_expand_env_variables (temp);
 559   free (temp);
 560
 561   /* invalid path? */
 562   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 563     fprintf (stderr,
 564              "Invalid path [%s] passed to component-library-search\n",
 565              string);
 566     g_free(string);
 567     return SCM_BOOL_F;
 568   }
 569
 570   dir = g_dir_open (string, 0, NULL);
 571   if (dir == NULL) {
 572     fprintf (stderr,
 573              "Invalid path [%s] passed to component-library-search\n",
 574              string);
 575     g_free(string);
 576     return SCM_BOOL_F;
 577   }
 578
 579   while ((entry = g_dir_read_name (dir))) {
 580     /* don't do . and .. and special case font */
 581     if ((g_strcasecmp (entry, ".")    != 0) &&
 582         (g_strcasecmp (entry, "..")   != 0) &&
 583         (g_strcasecmp (entry, "font") != 0))
 584     {
 585       gchar *fullpath = g_build_filename (string, entry, NULL);
 586
 587       if (g_file_test (fullpath, G_FILE_TEST_IS_DIR)) {
 588         if (g_path_is_absolute (fullpath)) {
 589           s_clib_add_directory (fullpath, NULL);
 590         } else {
 591           gchar *cwd = g_get_current_dir ();
 592           gchar *temp;
 593           temp = g_build_filename (cwd, fullpath, NULL);
 594           s_clib_add_directory (temp, NULL);
 595           g_free(temp);
 596           g_free(cwd);
 597         }
 598       }
 599       g_free(fullpath);
 600     }
 601   }
 602
 603   g_free(string);
 604   g_dir_close(dir);
 605
 606   return SCM_BOOL_T;
 607 }
 608
 609 /*! \todo Finish function description!!!
 610  *  \brief
 611  *  \par Function Description
 612  *
 613  *  \param [in] path
 614  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 615  */
 616 SCM g_rc_source_library(SCM path)
 617 {
 618   gchar *string;
 619   char *temp;
 620
 621   SCM_ASSERT (scm_is_string (path), path,
 622               SCM_ARG1, "source-library");
 623
 624   /* take care of any shell variables */
 625   temp = scm_to_utf8_string (path);
 626   string = s_expand_env_variables (temp);
 627   free (temp);
 628
 629   /* invalid path? */
 630   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 631     fprintf (stderr,
 632              "Invalid path [%s] passed to source-library\n",
 633              string);
 634     g_free(string);
 635     return SCM_BOOL_F;
 636   }
 637
 638   if (g_path_is_absolute (string)) {
 639     s_slib_add_entry (string);
 640   } else {
 641     gchar *cwd = g_get_current_dir ();
 642     gchar *temp;
 643     temp = g_build_filename (cwd, string, NULL);
 644     s_slib_add_entry (temp);
 645     g_free(temp);
 646     g_free(cwd);
 647   }
 648
 649   g_free(string);
 650
 651   return SCM_BOOL_T;
 652 }
 653
 654 /*! \todo Finish function description!!!
 655  *  \brief
 656  *  \par Function Description
 657  *
 658  *  \param [in] path
 659  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 660  */
 661 SCM g_rc_source_library_search(SCM path)
 662 {
 663   gchar *string;
 664   char *temp;
 665   GDir *dir;
 666   const gchar *entry;
 667
 668   SCM_ASSERT (scm_is_string (path), path,
 669               SCM_ARG1, "source-library-search");
 670
 671   /* take care of any shell variables */
 672   temp = scm_to_utf8_string (path);
 673   string = s_expand_env_variables (temp);
 674   free (temp);
 675
 676   /* invalid path? */
 677   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 678     fprintf (stderr,
 679              "Invalid path [%s] passed to source-library-search\n",
 680              string);
 681     g_free(string);
 682     return SCM_BOOL_F;
 683   }
 684
 685   dir = g_dir_open (string, 0, NULL);
 686   if (dir == NULL) {
 687     fprintf (stderr,
 688              "Invalid path [%s] passed to source-library-search\n",
 689              string);
 690     g_free(string);
 691     return SCM_BOOL_F;
 692   }
 693
 694   while ((entry = g_dir_read_name (dir))) {
 695     /* don't do . and .. and special case font */
 696     if ((g_strcasecmp (entry, ".")    != 0) &&
 697         (g_strcasecmp (entry, "..")   != 0) &&
 698         (g_strcasecmp (entry, "font") != 0))
 699     {
 700       gchar *fullpath = g_build_filename (string, entry, NULL);
 701
 702       if (g_file_test (fullpath, G_FILE_TEST_IS_DIR)) {
 703         if (s_slib_uniq (fullpath)) {
 704           if (g_path_is_absolute (fullpath)) {
 705             s_slib_add_entry (fullpath);
 706           } else {
 707             gchar *cwd = g_get_current_dir ();
 708             gchar *temp;
 709             temp = g_build_filename (cwd, fullpath, NULL);
 710             s_slib_add_entry (temp);
 711             g_free(temp);
 712             g_free(cwd);
 713           }
 714         }
 715       }
 716       g_free(fullpath);
 717     }
 718   }
 719
 720   g_free(string);
 721   g_dir_close(dir);
 722
 723   return SCM_BOOL_T;
 724 }
 725
 726 /*! \todo Finish function description!!!
 727  *  \brief
 728  *  \par Function Description
 729  *
 730  *  \param [in] width
 731  *  \param [in] height
 732  *  \param [in] border
 733  *  \return SCM_BOOL_T always.
 734  */
 735 SCM g_rc_world_size(SCM width, SCM height, SCM border)
 736 #define FUNC_NAME "world-size"
 737 {
 738   int i_width, i_height, i_border;
 739   int init_right, init_bottom;
 740
 741   SCM_ASSERT (SCM_NIMP (width) && SCM_REALP (width), width,
 742               SCM_ARG1, FUNC_NAME);
 743   SCM_ASSERT (SCM_NIMP (height) && SCM_REALP (height), height,
 744               SCM_ARG2, FUNC_NAME);
 745   SCM_ASSERT (SCM_NIMP (border) && SCM_REALP (border), border,
 746               SCM_ARG3, FUNC_NAME);
 747
 748   /* yes this is legit, we are casing the resulting double to an int */
 749   i_width  = (int) (scm_to_double (width)  * MILS_PER_INCH);
 750   i_height = (int) (scm_to_double (height) * MILS_PER_INCH);
 751   i_border = (int) (scm_to_double (border) * MILS_PER_INCH);
 752
 753   PAPERSIZEtoWORLD(i_width, i_height, i_border,
 754                    &init_right, &init_bottom);
 755
 756 #if DEBUG
 757   printf("%d %d\n", i_width, i_height);
 758   printf("%d %d\n", init_right, init_bottom);
 759 #endif
 760
 761   default_init_right  = init_right;
 762   default_init_bottom = init_bottom;
 763
 764   return SCM_BOOL_T;
 765 }
 766 #undef FUNC_NAME
 767
 768 /*! \todo Finish function description!!!
 769  *  \brief
 770  *  \par Function Description
 771  *
 772  *  \param [in] name
 773  *  \return SCM_BOOL_T always.
 774  */
 775 SCM g_rc_untitled_name(SCM name)
 776 {
 777   char *temp;
 778   SCM_ASSERT (scm_is_string (name), name,
 779               SCM_ARG1, "untitled-name");
 780
 781   g_free(default_untitled_name);
 782
 783   temp = scm_to_utf8_string (name);
 784   default_untitled_name = g_strdup (temp);
 785   free (temp);
 786
 787   return SCM_BOOL_T;
 788 }
 789
 790
 791 /*! \brief Add a directory to the Guile load path.
 792  * \par Function Description
 793  * Prepends \a s_path to the Guile system '%load-path', after
 794  * expanding environment variables.
 795  *
 796  *  \param [in] s_path  Path to be added.
 797  *  \return SCM_BOOL_T.
 798  */
 799 SCM g_rc_scheme_directory(SCM s_path)
 800 {
 801   char *temp;
 802   gchar *expanded;
 803   SCM s_load_path_var;
 804   SCM s_load_path;
 805
 806   SCM_ASSERT (scm_is_string (s_path), s_path,
 807               SCM_ARG1, "scheme-directory");
 808
 809   /* take care of any shell variables */
 810   temp = scm_to_utf8_string (s_path);
 811   expanded = s_expand_env_variables (temp);
 812   s_path = scm_from_utf8_string (expanded);
 813   free (temp);
 814   g_free (expanded);
 815
 816   s_load_path_var = scm_c_lookup ("%load-path");
 817   s_load_path = scm_variable_ref (s_load_path_var);
 818   scm_variable_set_x (s_load_path_var, scm_cons (s_path, s_load_path));
 819
 820   scm_remember_upto_here_2 (s_load_path_var, s_load_path);
 821   scm_remember_upto_here_1 (s_path);
 822
 823   return SCM_BOOL_T;
 824 }
 825
 826 /*! \todo Finish function description!!!
 827  *  \brief
 828  *  \par Function Description
 829  *
 830  *  \param [in] path
 831  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 832  */
 833 SCM g_rc_bitmap_directory(SCM path)
 834 {
 835   gchar *string;
 836   char *temp;
 837
 838   SCM_ASSERT (scm_is_string (path), path,
 839               SCM_ARG1, "bitmap-directory");
 840
 841   /* take care of any shell variables */
 842   temp = scm_to_utf8_string (path);
 843   string = s_expand_env_variables (temp);
 844   free (temp);
 845
 846   /* invalid path? */
 847   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 848     fprintf (stderr,
 849              "Invalid path [%s] passed to bitmap-directory\n",
 850              string);
 851     g_free(string);
 852     return SCM_BOOL_F;
 853   }
 854
 855   g_free(default_bitmap_directory);
 856   default_bitmap_directory = string;
 857
 858   return SCM_BOOL_T;
 859 }
 860
 861 /*! \todo Finish function description!!!
 862  *  \brief
 863  *  \par Function Description
 864  *
 865  *  \param [in] scmsymname
 866  *  \return SCM_BOOL_T always.
 867  */
 868 SCM g_rc_bus_ripper_symname(SCM scmsymname)
 869 {
 870   char *temp;
 871
 872   SCM_ASSERT (scm_is_string (scmsymname), scmsymname,
 873               SCM_ARG1, "bus-ripper-symname");
 874
 875   g_free(default_bus_ripper_symname);
 876
 877   temp = scm_to_utf8_string (scmsymname);
 878   default_bus_ripper_symname = g_strdup (temp);
 879   free (temp);
 880
 881   return SCM_BOOL_T;
 882 }
 883
 884 /*! \todo Finish function description!!!
 885  *  \brief
 886  *  \par Function Description
 887  *
 888  *  \param [in] scmsymname
 889  *  \return SCM_BOOL_T always.
 890  */
 891 SCM g_rc_postscript_prolog(SCM scmsymname)
 892 {
 893   char *temp;
 894
 895   SCM_ASSERT (scm_is_string (scmsymname), scmsymname,
 896               SCM_ARG1, "postsript-prolog");
 897
 898   g_free(default_postscript_prolog);
 899
 900   /* take care of any shell variables */
 901   temp = scm_to_utf8_string (scmsymname);
 902   default_postscript_prolog =
 903     s_expand_env_variables (temp);
 904   free (temp);
 905
 906   return SCM_BOOL_T;
 907 }
 908
 909 /*! \todo Finish function description!!!
 910  *  \brief
 911  *  \par Function Description
 912  *
 913  *  \return SCM_BOOL_T always.
 914  */
 915 SCM g_rc_reset_component_library(void)
 916 {
 917   s_clib_init();
 918
 919   return SCM_BOOL_T;
 920 }
 921
 922 /*! \todo Finish function description!!!
 923  *  \brief
 924  *  \par Function Description
 925  *
 926  *  \return SCM_BOOL_T always.
 927  */
 928 SCM g_rc_reset_source_library(void)
 929 {
 930   s_slib_free();
 931   s_slib_init();
 932
 933   return SCM_BOOL_T;
 934 }
 935
 936
 937 /*! \todo Finish function documentation!!!
 938  *  \brief
 939  *  \par Function Description
 940  *
 941  */
 942 SCM g_rc_attribute_promotion(SCM mode)
 943 {
 944   static const vstbl_entry mode_table[] = {
 945     {TRUE , "enabled" },
 946     {FALSE, "disabled"},
 947   };
 948
 949   RETURN_G_RC_MODE("attribute-promotion",
 950                    default_attribute_promotion,
 951                    2);
 952 }
 953
 954 /*! \todo Finish function documentation!!!
 955  *  \brief
 956  *  \par Function Description
 957  *
 958  */
 959 SCM g_rc_promote_invisible(SCM mode)
 960 {
 961   static const vstbl_entry mode_table[] = {
 962     {TRUE , "enabled" },
 963     {FALSE, "disabled"},
 964   };
 965
 966   RETURN_G_RC_MODE("promote-invisible",
 967                    default_promote_invisible,
 968                    2);
 969 }
 970
 971 /*! \todo Finish function documentation!!!
 972  *  \brief
 973  *  \par Function Description
 974  *
 975  */
 976 SCM g_rc_keep_invisible(SCM mode)
 977 {
 978   static const vstbl_entry mode_table[] = {
 979     {TRUE , "enabled" },
 980     {FALSE, "disabled"},
 981   };
 982
 983   RETURN_G_RC_MODE("keep-invisible",
 984                    default_keep_invisible,
 985                    2);
 986 }
 987
 988 /*! \todo Finish function description!!!
 989  *  \brief
 990  *  \par Function Description
 991  *
 992  *  \param [in] attrlist
 993  *  \return SCM_BOOL_T always.
 994  */
 995 SCM g_rc_always_promote_attributes(SCM attrlist)
 996 {
 997   GList *list=NULL;
 998   int length, i;
 999   gchar *attr;
1000   gchar **attr2;
1001
1002   g_list_foreach(default_always_promote_attributes, (GFunc)g_free, NULL);
1003   g_list_free(default_always_promote_attributes);
1004
1005   if (scm_is_string (attrlist)) {
1006     char *temp;
1007     s_log_message(_("WARNING: using a string for 'always-promote-attributes'"
1008                     " is deprecated. Use a list of strings instead\n"));
1009
1010     /* convert the space separated strings into a GList */
1011     temp = scm_to_utf8_string (attrlist);
1012     attr2 = g_strsplit(temp," ", 0);
1013     free (temp);
1014
1015     for (i=0; attr2[i] != NULL; i++) {
1016       if (strlen(attr2[i]) > 0) {
1017         list = g_list_prepend(list, g_strdup(attr2[i]));
1018       }
1019     }
1020     g_strfreev(attr2);
1021   } else {
1022     SCM_ASSERT(scm_list_p(attrlist), attrlist, SCM_ARG1, "always-promote-attributes");
1023     length = scm_ilength(attrlist);
1024     /* convert the scm list into a GList */
1025     for (i=0; i < length; i++) {
1026       char *temp;
1027       SCM_ASSERT(scm_is_string(scm_list_ref(attrlist, scm_from_int(i))),
1028                  scm_list_ref(attrlist, scm_from_int(i)), SCM_ARG1,
1029                  "always-promote-attribute: list element is not a string");
1030       temp = scm_to_utf8_string (scm_list_ref (attrlist, scm_from_int (i)));
1031       attr = g_strdup(temp);
1032       free (temp);
1033       list = g_list_prepend(list, attr);
1034     }
1035   }
1036
1037   default_always_promote_attributes = g_list_reverse(list);
1038
1039   return SCM_BOOL_T;
1040 }
1041
1042 extern COLOR print_colors[MAX_COLORS];
1043
1044 SCM g_rc_print_color_map (SCM scm_map)
1045 {
1046   if (scm_map == SCM_UNDEFINED) {
1047     return s_color_map_to_scm (print_colors);
1048   }
1049
1050   SCM_ASSERT (scm_is_true (scm_list_p (scm_map)),
1051               scm_map, SCM_ARG1, "print-color-map");
1052
1053   s_color_map_from_scm (print_colors, scm_map, "print-color-map");
1054   return SCM_BOOL_T;
1055 }