libgeda/src/g_rc.c

   1 /* gEDA - GPL Electronic Design Automation
   2  * libgeda - gEDA's library
   3  * Copyright (C) 1998-2007 Ales Hvezda
   4  * Copyright (C) 1998-2007 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., 59 Temple Place, Suite 330, Boston, MA 02111 USA
  19  */
  20 #include <config.h>
  21
  22 #include <stdio.h>
  23 #include <sys/stat.h>
  24 #include <ctype.h>
  25 #ifdef HAVE_STRING_H
  26 #include <string.h>
  27 #endif
  28 #ifdef HAVE_DIRENT_H
  29 #include <dirent.h>
  30 #endif
  31 #ifdef HAVE_STDLIB_H
  32 #include <stdlib.h>
  33 #endif
  34 #ifdef HAVE_UNISTD_H
  35 #include <unistd.h>
  36 #endif
  37
  38 #include <gtk/gtk.h>
  39 #include <libguile.h>
  40
  41 #include "defines.h"
  42 #include "struct.h"
  43 #include "globals.h"
  44 #include "o_types.h"
  45 #include "colors.h"
  46
  47 #include "../include/i_vars.h"
  48 #include "../include/papersizes.h"
  49 #include "../include/prototype.h"
  50
  51 #ifdef HAVE_LIBDMALLOC
  52 #include <dmalloc.h>
  53 #endif
  54
  55 /*! \todo Finish function documentation!!!
  56  *  \brief
  57  *  \par Function Description
  58  *
  59  */
  60 int vstbl_lookup_str(const vstbl_entry *table,
  61                             int size, const char *str)
  62 {
  63   int i;
  64
  65   for(i = 0; i < size; i++) {
  66     if(strcmp(table[i].m_str, str) == 0) {
  67       break;
  68     }
  69   }
  70   return i;
  71 }
  72
  73 /*! \todo Finish function documentation!!!
  74  *  \brief
  75  *  \par Function Description
  76  *
  77  */
  78 int vstbl_get_val(const vstbl_entry *table, int index)
  79 {
  80   return table[index].m_val;
  81 }
  82
  83 /*! \todo Finish function documentation!!!
  84  *  \brief
  85  *  \par Function Description
  86  *
  87  */
  88 SCM g_rc_mode_general(SCM scmmode,
  89                       const char *rc_name,
  90                       int *mode_var,
  91                       const vstbl_entry *table,
  92                       int table_size)
  93 {
  94   SCM ret;
  95   int index;
  96   char *mode;
  97
  98   SCM_ASSERT (scm_is_string (scmmode), scmmode,
  99               SCM_ARG1, rc_name);
 100
 101   mode = SCM_STRING_CHARS (scmmode);
 102
 103   index = vstbl_lookup_str(table, table_size, mode);
 104   /* no match? */
 105   if(index == table_size) {
 106     fprintf(stderr,
 107             "Invalid mode [%s] passed to %s\n",
 108             mode,
 109             rc_name);
 110     ret = SCM_BOOL_F;
 111   } else {
 112     *mode_var = vstbl_get_val(table, index);
 113     ret = SCM_BOOL_T;
 114   }
 115
 116   return ret;
 117 }
 118
 119 extern GHashTable *font_char_to_file;
 120
 121 /*! \brief Reads the gafrc file.
 122  *  \par Function Description
 123  *  This is the function which actually reads in the RC file.
 124  *  First, it looks in a list of previously read RC files.  If the file has
 125  *  already been read, it just says OK.  After reading the file, it places
 126  *  the filename in the list of read files.
 127  *
 128  *  \param [in] w_current  The TOPLEVEL object.
 129  *  \param [in] fname      RC file name to read.
 130  *  \param [in] ok_msg     Message to print if file is read ok.
 131  *  \param [in] err_msg    Message to print if file read error occurs
 132  *  \return 1 on success, 0 otherwise.
 133  */
 134 gint g_rc_parse_general(TOPLEVEL *w_current,
 135                         const gchar *fname,
 136                         const gchar *ok_msg, const gchar *err_msg)
 137 {
 138   gint found_rc = FALSE;
 139   GList *found_rc_filename_element;
 140
 141   /* First see if fname is in list of previously read RC files. */
 142   found_rc_filename_element = g_list_find_custom(w_current->RC_list,
 143                                                  (gconstpointer) fname,
 144                                                  (GCompareFunc) strcmp);
 145   if (found_rc_filename_element != NULL) {
 146     /* We've already read this one in. */
 147     s_log_message("RC file [%s] already read in.\n", fname);
 148     return 0;
 149   }
 150
 151   /* Now try to read in contents of RC file.  */
 152   if (access (fname, R_OK) == 0) {
 153     g_read_file (fname);
 154     found_rc = 1;
 155     /* Everything was OK.  Now add this file to list of read RC files. */
 156     w_current->RC_list = g_list_append (w_current->RC_list,
 157                                         g_strdup (fname));
 158     s_log_message (ok_msg, fname);
 159   } else {
 160     found_rc = 0;
 161     s_log_message (err_msg, fname);
 162   }
 163
 164   return found_rc;
 165 }
 166
 167
 168 /*! \brief Read gEDA root path from RC file.
 169  *  \par Function Description
 170  *  This function will read the RC file and parse the root path for gEDA.
 171  *
 172  *  \return String containing rc root path
 173  *
 174  *  \warning Do not free the returned character string.
 175  */
 176 const gchar* g_rc_parse_path(void)
 177 {
 178   const gchar *rc_path;
 179
 180   if (g_strcasecmp (GEDARCDIR, "none") == 0) {
 181     /* rc dir not specified at configure time, so search for config in */
 182     /* the normal GEDADATA directory */
 183     rc_path = g_getenv ("GEDADATA");
 184   } else {
 185     /* rc path specified at configure time, always return specified path */
 186     rc_path = GEDARCDIR;
 187   }
 188
 189   return(rc_path);
 190 }
 191
 192 /*! \brief Parses a system RC file.
 193  *  \par Function Description
 194  *  This function wil open and parse a system rc file.
 195  *
 196  *  \param [in] w_current  The TOPLEVEL object.
 197  *  \param [in] rcname     System RC file name to parse.
 198  *  \return 1 on success, 0 on failure.
 199  */
 200 gint g_rc_parse_system_rc(TOPLEVEL *w_current, const gchar *rcname)
 201 {
 202   const gchar *geda_data = g_getenv ("GEDADATA");
 203   gint found_rc;
 204   gchar *tmp;
 205   char *filename;
 206   gchar *ok_msg, *err_msg;
 207
 208   if (geda_data == NULL) {
 209     fprintf(stderr, "You must set the GEDADATA environment variable!\n");
 210     exit(-1);
 211   }
 212
 213   tmp = g_strconcat (g_rc_parse_path (),
 214                      G_DIR_SEPARATOR_S,
 215                      "system-", rcname,
 216                      NULL);
 217   filename = f_normalize_filename(tmp);
 218   if (filename == NULL) {
 219     return 0;
 220   }
 221
 222   ok_msg  = g_strdup_printf ("Read system-%s file [%%s]\n",
 223                              rcname);
 224   err_msg = g_strdup_printf ("Did not find required system-%s file [%%s]\n",
 225                              rcname);
 226   found_rc = g_rc_parse_general(w_current, filename, ok_msg, err_msg);
 227
 228   g_free(ok_msg);
 229   g_free(err_msg);
 230   g_free(tmp);
 231   g_free(filename);
 232
 233   return found_rc;
 234 }
 235
 236 /*! \brief Parse a RC file in users home directory.
 237  *  \par Function Description
 238  *  This function will open and parse a RC file in the users home directory.
 239  *
 240  *  \param [in] w_current  The TOPLEVEL object.
 241  *  \param [in] rcname     User's RC file name.
 242  *  \return 1 on success, 0 on failure.
 243  */
 244 gint g_rc_parse_home_rc(TOPLEVEL *w_current, const gchar *rcname)
 245 {
 246   const gchar *home = g_getenv ("HOME");
 247   gint found_rc;
 248   gchar *tmp;
 249   char *filename;
 250   gchar *ok_msg, *err_msg;
 251
 252   if (home == NULL) {
 253     return 0;
 254   }
 255
 256   tmp = g_strconcat (home,
 257                      G_DIR_SEPARATOR_S,
 258                      ".gEDA",
 259                      G_DIR_SEPARATOR_S,
 260                      rcname,
 261                      NULL);
 262   filename = f_normalize_filename(tmp);
 263   if (filename == NULL) {
 264     return 0;
 265   }
 266
 267   ok_msg  = g_strdup_printf ("Read ~/.gEDA/%s file [%%s]\n",
 268                              rcname);
 269   err_msg = g_strdup_printf ("Did not find optional ~/.gEDA/%s file [%%s]\n",
 270                              rcname);
 271   found_rc = g_rc_parse_general(w_current, filename, ok_msg, err_msg);
 272
 273   g_free(ok_msg);
 274   g_free(err_msg);
 275   g_free(tmp);
 276   g_free(filename);
 277
 278   return found_rc;
 279 }
 280
 281 /*! \brief Parse rc file in current working directory.
 282  *  \par Function Description
 283  *  This function will open and parse a RC file in the current working directory.
 284  *
 285  *  \param [in] w_current  The TOPLEVEL object.
 286  *  \param [in] rcname     Local directory RC file name.
 287  *  \return 1 on success, 0 on failure.
 288  */
 289 gint g_rc_parse_local_rc(TOPLEVEL *w_current, const gchar *rcname)
 290 {
 291   gint found_rc;
 292   gchar *tmp;
 293   char *filename;
 294   gchar *ok_msg;
 295   gchar *err_msg;
 296
 297   tmp = g_strconcat (".", G_DIR_SEPARATOR_S, rcname, NULL);
 298   filename = f_normalize_filename (tmp);
 299   if (filename == NULL) {
 300     return 0;
 301   }
 302
 303   ok_msg  = g_strdup_printf ("Read local %s file [%%s]\n",
 304                              rcname);
 305   err_msg = g_strdup_printf ("Did not find optional local %s file [%%s]\n",
 306                              rcname);
 307   found_rc = g_rc_parse_general(w_current, filename, ok_msg, err_msg);
 308
 309   g_free(ok_msg);
 310   g_free(err_msg);
 311   g_free(tmp);
 312   g_free(filename);
 313
 314   return found_rc;
 315 }
 316
 317 /*! \brief Parse a RC file from a specified location.
 318  *  \par Function Description
 319  *  This function will open and parse a RC file from a specified location.
 320  *
 321  *  \param [in] w_current  The TOPLEVEL object.
 322  *  \param [in] rcname     Specified location RC file name.
 323  *  \return 1 on success, 0 on failure.
 324  */
 325 gint g_rc_parse_specified_rc(TOPLEVEL *w_current, const gchar *rcname)
 326 {
 327   gint found_rc = 0;
 328   char *filename;
 329   gchar *ok_msg;
 330   gchar *err_msg;
 331
 332   if (rcname == NULL) {
 333     return 0;
 334   }
 335
 336   filename = f_normalize_filename (rcname);
 337
 338   ok_msg  = g_strdup_printf ("Read specified %s file [%%s]\n",
 339                              rcname);
 340   err_msg = g_strdup_printf ("Did not find specified %s file [%%s]\n",
 341                              rcname);
 342   found_rc = g_rc_parse_general(w_current, filename, ok_msg, err_msg);
 343
 344   g_free(ok_msg);
 345   g_free(err_msg);
 346   g_free(filename);
 347
 348   return found_rc;
 349 }
 350
 351 /*! \brief General RC file parsing function.
 352  *  \par Function Description
 353  *  This function will check for System, HOME and Local RC files matching
 354  *  the rcname input parameter.  If none of those three are found it will
 355  *  search for the specified_rc_filename.  When none are found it will
 356  *  call exit(-1) to terminate the program.
 357  *
 358  *  \param [in] w_current              The TOPLEVEL object.
 359  *  \param [in] rcname                 RC file name.
 360  *  \param [in] specified_rc_filename  Specific location RC file name.
 361  *  \return calls exit(-1) when no RC file matching either rcname or
 362  *          specified_rc_filename is found.
 363  */
 364 void g_rc_parse(TOPLEVEL *w_current,
 365                 const gchar *rcname, const gchar *specified_rc_filename)
 366 {
 367   gint found_rc = 0;
 368   char *rc_path;
 369   char *geda_rcdata;
 370
 371   /* set the GEDADATARC environment variable so that the rc files */
 372   /* know where to look for others */
 373   rc_path = f_normalize_filename (g_rc_parse_path ());
 374   /* Reversion to putenv inspired by W. Hoch, 2.17.2005 */
 375   /*  g_setenv ("GEDADATARC", rc_path, TRUE); */  /*requires glib 2.4.x*/
 376   geda_rcdata = g_strdup_printf("GEDADATARC=%s", rc_path);
 377   putenv(geda_rcdata);
 378   g_free(rc_path);
 379
 380   /* visit rc files in order */
 381   /* Changed by SDB 1.2.2005 in response to Peter Kaiser's bug report.
 382    * Read gafrc files first */
 383   found_rc |= g_rc_parse_system_rc(w_current, "gafrc");
 384   found_rc |= g_rc_parse_home_rc(w_current, "gafrc");
 385   found_rc |= g_rc_parse_local_rc(w_current, "gafrc");
 386   /* continue support for individual rc files for each program.  */
 387   found_rc |= g_rc_parse_system_rc(w_current, rcname);
 388   found_rc |= g_rc_parse_home_rc(w_current, rcname);
 389   found_rc |= g_rc_parse_local_rc(w_current, rcname);
 390
 391   /* New fcn introduced by SDB to consolidate this & make it available
 392    * for other programs */
 393   found_rc |= g_rc_parse_specified_rc(w_current, specified_rc_filename);
 394
 395   /* Oh well, I couldn't find any rcfile, exit! */
 396   if (!found_rc) {
 397     /*! \todo these two are basically the
 398      * same. Inefficient!
 399      */
 400     s_log_message("Could not find any %s file!\n", rcname);
 401     fprintf(stderr, "Could not find a %s file\n", rcname);
 402     exit(-1);
 403   }
 404 }
 405
 406 /*! \brief
 407  *  \par Function Description
 408  *
 409  *  \param [in] path
 410  *  \param [in] name Optional descriptive name for library directory.
 411  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 412  */
 413 SCM g_rc_component_library(SCM path, SCM name)
 414 {
 415   char *string;
 416   char *namestr = NULL;
 417
 418   SCM_ASSERT (scm_is_string (path), path,
 419               SCM_ARG1, "component-library");
 420
 421   if (name != SCM_UNDEFINED) {
 422     SCM_ASSERT (scm_is_string (name), name,
 423                 SCM_ARG2, "component-library");
 424     namestr = SCM_STRING_CHARS (name);
 425   }
 426
 427   string = g_strdup (SCM_STRING_CHARS (path));
 428   /* take care of any shell variables */
 429   string = expand_env_variables(string);
 430
 431   /* invalid path? */
 432   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 433     fprintf(stderr,
 434             "Invalid path [%s] passed to component-library\n",
 435             string);
 436     g_free(string);
 437     return SCM_BOOL_F;
 438   }
 439
 440   if (g_path_is_absolute (string)) {
 441     s_clib_add_directory (string, namestr);
 442   } else {
 443     gchar *cwd = g_get_current_dir ();
 444     gchar *temp;
 445 #ifdef __MINGW32__
 446     u_basic_strip_trailing(cwd, G_DIR_SEPARATOR);
 447 #endif
 448     temp = g_strconcat (cwd, G_DIR_SEPARATOR_S, string, NULL);
 449     s_clib_add_directory (temp, namestr);
 450     g_free(temp);
 451     g_free(cwd);
 452   }
 453
 454   if (string) {
 455     g_free(string);
 456   }
 457
 458   return SCM_BOOL_T;
 459 }
 460
 461 /*! \brief Guile callback for adding library commands.
 462  *  \par Function Description
 463  *  Callback function for the "component-library-command" Guile
 464  *  function, which can be used in the rc files to add a command to
 465  *  the component library.
 466  *
 467  *  \param [in] command Command to add.
 468  *  \param [in] name    Optional descriptive name for component source.
 469  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 470  */
 471 SCM g_rc_component_library_command (SCM listcmd, SCM getcmd,
 472                                     SCM name)
 473 {
 474   gchar *namestr = NULL;
 475   gchar *lcmdstr = NULL;
 476   gchar *gcmdstr = NULL;
 477   const CLibSource *src;
 478   char *tmp_str;
 479
 480   SCM_ASSERT (scm_is_string (listcmd), listcmd, SCM_ARG1,
 481               "component-library-command");
 482   tmp_str = scm_to_locale_string (listcmd);
 483   lcmdstr = g_strdup (tmp_str);
 484   free (tmp_str); /* this should stay as free (allocated from guile) */
 485
 486   SCM_ASSERT (scm_is_string (getcmd), getcmd, SCM_ARG2,
 487               "component-library-command");
 488   tmp_str = scm_to_locale_string (getcmd);
 489   gcmdstr = g_strdup (tmp_str);
 490   free (tmp_str); /* this should stay as free (allocated from guile) */
 491
 492   SCM_ASSERT (scm_is_string (name), name, SCM_ARG3,
 493               "component-library-command");
 494   tmp_str = scm_to_locale_string (name);
 495   namestr = g_strdup (tmp_str);
 496   free (tmp_str); /* this should stay as free (allocated from guile) */
 497
 498   /* take care of any shell variables */
 499   /*! \bug this may be a security risk! */
 500   lcmdstr = expand_env_variables(lcmdstr);
 501   gcmdstr = expand_env_variables(gcmdstr);
 502
 503   src = s_clib_add_command (lcmdstr, gcmdstr, namestr);
 504
 505   g_free (lcmdstr);
 506   g_free (gcmdstr);
 507   g_free (namestr);
 508
 509   if (src != NULL) return SCM_BOOL_T;
 510
 511   return SCM_BOOL_F;
 512 }
 513
 514 /*! \brief Guile callback for adding library functions.
 515  *  \par Function Description
 516  *  Callback function for the "component-library-funcs" Guile
 517  *  function, which can be used in the rc files to add a set of Guile
 518  *  procedures for listing and generating symbols.
 519  *
 520  *  \param [in] listfunc A Scheme procedure which takes no arguments
 521  *                       and returns a Scheme list of component names.
 522  *  \param [in] getfunc A Scheme procedure which takes a component
 523  *                      name as an argument and returns a symbol
 524  *                      encoded in a string in gEDA format, or the \b
 525  *                      \#f if the component name is unknown.
 526  *  \param [in] name    A descriptive name for this component source.
 527  *
 528  *  \returns SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 529  */
 530 SCM g_rc_component_library_funcs (SCM listfunc, SCM getfunc, SCM name)
 531 {
 532   SCM_ASSERT (scm_is_true (scm_procedure_p (listfunc)), listfunc, SCM_ARG1,
 533               "component-library-funcs");
 534   SCM_ASSERT (scm_is_true (scm_procedure_p (getfunc)), getfunc, SCM_ARG2,
 535               "component-library-funcs");
 536   SCM_ASSERT (scm_is_string (name), name, SCM_ARG1,
 537               "component-library-funcs");
 538
 539   if (s_clib_add_scm (listfunc, getfunc, SCM_STRING_CHARS (name)) != NULL) {
 540     return SCM_BOOL_T;
 541   } else {
 542     return SCM_BOOL_F;
 543   }
 544 }
 545
 546 /*! \todo Finish function description!!!
 547  *  \brief
 548  *  \par Function Description
 549  *
 550  *  \param [in] path
 551  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 552  */
 553 SCM g_rc_component_library_search(SCM path)
 554 {
 555   char *string;
 556   GDir *dir;
 557   const gchar *entry;
 558
 559   SCM_ASSERT (scm_is_string (path), path,
 560               SCM_ARG1, "component-library-search");
 561
 562   string = g_strdup (SCM_STRING_CHARS (path));
 563   /* take care of any shell variables */
 564   string = expand_env_variables(string);
 565
 566   /* invalid path? */
 567   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 568     fprintf (stderr,
 569              "Invalid path [%s] passed to component-library-search\n",
 570              string);
 571     g_free(string);
 572     return SCM_BOOL_F;
 573   }
 574
 575   dir = g_dir_open (string, 0, NULL);
 576   if (dir == NULL) {
 577     fprintf (stderr,
 578              "Invalid path [%s] passed to component-library-search\n",
 579              string);
 580     g_free(string);
 581     return SCM_BOOL_F;
 582   }
 583
 584   while ((entry = g_dir_read_name (dir))) {
 585     /* don't do . and .. and special case font */
 586     if ((g_strcasecmp (entry, ".")    != 0) &&
 587         (g_strcasecmp (entry, "..")   != 0) &&
 588         (g_strcasecmp (entry, "font") != 0))
 589     {
 590       gchar *fullpath = g_strconcat (string,
 591                                      G_DIR_SEPARATOR_S,
 592                                      entry,
 593                                      NULL);
 594
 595       if (g_file_test (fullpath, G_FILE_TEST_IS_DIR)) {
 596         if (g_path_is_absolute (fullpath)) {
 597           s_clib_add_directory (fullpath, NULL);
 598         } else {
 599           gchar *cwd = g_get_current_dir ();
 600           gchar *temp;
 601 #ifdef __MINGW32__
 602           u_basic_strip_trailing(cwd, G_DIR_SEPARATOR);
 603 #endif
 604           temp = g_strconcat (cwd,
 605                               G_DIR_SEPARATOR_S,
 606                               fullpath,
 607                               NULL);
 608           s_clib_add_directory (temp, NULL);
 609           g_free(temp);
 610           g_free(cwd);
 611         }
 612       }
 613       g_free(fullpath);
 614     }
 615   }
 616
 617   if (string) {
 618     g_free(string);
 619   }
 620
 621   return SCM_BOOL_T;
 622 }
 623
 624 /*! \todo Finish function description!!!
 625  *  \brief
 626  *  \par Function Description
 627  *
 628  *  \param [in] path
 629  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 630  */
 631 SCM g_rc_source_library(SCM path)
 632 {
 633   char *string;
 634
 635   SCM_ASSERT (scm_is_string (path), path,
 636               SCM_ARG1, "source-library");
 637
 638   string = g_strdup (SCM_STRING_CHARS (path));
 639   /* take care of any shell variables */
 640   string = expand_env_variables(string);
 641
 642   /* invalid path? */
 643   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 644     fprintf (stderr,
 645              "Invalid path [%s] passed to source-library\n",
 646              string);
 647     g_free(string);
 648     return SCM_BOOL_F;
 649   }
 650
 651   if (g_path_is_absolute (string)) {
 652     s_slib_add_entry (string);
 653   } else {
 654     gchar *cwd = g_get_current_dir ();
 655     gchar *temp;
 656 #ifdef __MINGW32__
 657     u_basic_strip_trailing(cwd, G_DIR_SEPARATOR);
 658 #endif
 659     temp = g_strconcat (cwd,
 660                         G_DIR_SEPARATOR_S,
 661                         string,
 662                         NULL);
 663     s_slib_add_entry (temp);
 664     g_free(temp);
 665     g_free(cwd);
 666   }
 667
 668   if (string) {
 669     g_free(string);
 670   }
 671
 672   return SCM_BOOL_T;
 673 }
 674
 675 /*! \todo Finish function description!!!
 676  *  \brief
 677  *  \par Function Description
 678  *
 679  *  \param [in] path
 680  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 681  */
 682 SCM g_rc_source_library_search(SCM path)
 683 {
 684   char *string;
 685   GDir *dir;
 686   const gchar *entry;
 687
 688   SCM_ASSERT (scm_is_string (path), path,
 689               SCM_ARG1, "source-library-search");
 690
 691   string = g_strdup (SCM_STRING_CHARS (path));
 692   /* take care of any shell variables */
 693   string = expand_env_variables(string);
 694
 695   /* invalid path? */
 696   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 697     fprintf (stderr,
 698              "Invalid path [%s] passed to source-library-search\n",
 699              string);
 700     g_free(string);
 701     return SCM_BOOL_F;
 702   }
 703
 704   dir = g_dir_open (string, 0, NULL);
 705   if (dir == NULL) {
 706     fprintf (stderr,
 707              "Invalid path [%s] passed to source-library-search\n",
 708              string);
 709     if (string) {
 710       g_free(string);
 711     }
 712     return SCM_BOOL_F;
 713   }
 714
 715   while ((entry = g_dir_read_name (dir))) {
 716     /* don't do . and .. and special case font */
 717     if ((g_strcasecmp (entry, ".")    != 0) &&
 718         (g_strcasecmp (entry, "..")   != 0) &&
 719         (g_strcasecmp (entry, "font") != 0))
 720     {
 721       gchar *fullpath = g_strconcat (string,
 722                                      G_DIR_SEPARATOR_S,
 723                                      entry,
 724                                      NULL);
 725
 726       if (g_file_test (fullpath, G_FILE_TEST_IS_DIR)) {
 727         if (s_slib_uniq (fullpath)) {
 728           if (g_path_is_absolute (fullpath)) {
 729             s_slib_add_entry (fullpath);
 730           } else {
 731             gchar *cwd = g_get_current_dir ();
 732             gchar *temp;
 733 #ifdef __MINGW32__
 734             u_basic_strip_trailing(cwd, G_DIR_SEPARATOR);
 735 #endif
 736             temp = g_strconcat (cwd,
 737                                 G_DIR_SEPARATOR_S,
 738                                 fullpath,
 739                                 NULL);
 740             s_slib_add_entry (temp);
 741             g_free(temp);
 742             g_free(cwd);
 743           }
 744         }
 745       }
 746       g_free(fullpath);
 747     }
 748   }
 749
 750   if (string) {
 751     g_free(string);
 752   }
 753
 754   return SCM_BOOL_T;
 755 }
 756
 757 /*! \todo Finish function description!!!
 758  *  \brief
 759  *  \par Function Description
 760  *
 761  *  \param [in] width
 762  *  \param [in] height
 763  *  \param [in] border
 764  *  \return SCM_BOOL_T always.
 765  */
 766 SCM g_rc_world_size(SCM width, SCM height, SCM border)
 767 #define FUNC_NAME "world-size"
 768 {
 769   int i_width, i_height, i_border;
 770   int init_right, init_bottom;
 771
 772   SCM_ASSERT (SCM_NIMP (width) && SCM_REALP (width), width,
 773               SCM_ARG1, FUNC_NAME);
 774   SCM_ASSERT (SCM_NIMP (height) && SCM_REALP (height), height,
 775               SCM_ARG2, FUNC_NAME);
 776   SCM_ASSERT (SCM_NIMP (border) && SCM_REALP (border), border,
 777               SCM_ARG3, FUNC_NAME);
 778
 779   /* yes this is legit, we are casing the resulting double to an int */
 780   i_width  = (int) (SCM_NUM2DOUBLE (0, width)  * MILS_PER_INCH);
 781   i_height = (int) (SCM_NUM2DOUBLE (0, height) * MILS_PER_INCH);
 782   i_border = (int) (SCM_NUM2DOUBLE (0, border) * MILS_PER_INCH);
 783
 784   PAPERSIZEtoWORLD(i_width, i_height, i_border,
 785                    &init_right, &init_bottom);
 786
 787 #if DEBUG
 788   printf("%d %d\n", i_width, i_height);
 789   printf("%d %d\n", init_right, init_bottom);
 790 #endif
 791
 792   default_init_right  = init_right;
 793   default_init_bottom = init_bottom;
 794
 795   return SCM_BOOL_T;
 796 }
 797 #undef FUNC_NAME
 798
 799 /*! \todo Finish function description!!!
 800  *  \brief
 801  *  \par Function Description
 802  *
 803  *  \param [in] name
 804  *  \return SCM_BOOL_T always.
 805  */
 806 SCM g_rc_default_series_name(SCM name)
 807 {
 808   SCM_ASSERT (scm_is_string (name), name,
 809               SCM_ARG1, "default-series-name");
 810
 811   if (default_series_name) {
 812     g_free(default_series_name);
 813   }
 814
 815   default_series_name = g_strdup (SCM_STRING_CHARS (name));
 816
 817   return SCM_BOOL_T;
 818 }
 819
 820 /*! \todo Finish function description!!!
 821  *  \brief
 822  *  \par Function Description
 823  *
 824  *  \param [in] name
 825  *  \return SCM_BOOL_T always.
 826  */
 827 SCM g_rc_untitled_name(SCM name)
 828 {
 829   SCM_ASSERT (scm_is_string (name), name,
 830               SCM_ARG1, "untitled-name");
 831
 832   if (default_untitled_name) {
 833     g_free(default_untitled_name);
 834   }
 835
 836   default_untitled_name = g_strdup (SCM_STRING_CHARS (name));
 837
 838   return SCM_BOOL_T;
 839 }
 840
 841 /*! \todo Finish function description!!!
 842  *  \brief
 843  *  \par Function Description
 844  *
 845  *  \param [in] path
 846  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 847  */
 848 SCM g_rc_font_directory(SCM path)
 849 {
 850   char *string;
 851
 852   SCM_ASSERT (scm_is_string (path), path,
 853               SCM_ARG1, "font-directory");
 854
 855   string = g_strdup (SCM_STRING_CHARS (path));
 856   /* take care of any shell variables */
 857   string = expand_env_variables(string);
 858
 859   /* invalid path? */
 860   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 861     fprintf (stderr,
 862              "Invalid path [%s] passed to font-directory\n",
 863              string);
 864     if (string) {
 865       g_free(string);
 866     }
 867     return SCM_BOOL_F;
 868   }
 869
 870   if (default_font_directory) {
 871     g_free(default_font_directory);
 872   }
 873   default_font_directory = string;
 874
 875   return SCM_BOOL_T;
 876 }
 877
 878 /*! \todo Finish function description!!!
 879  *  \brief
 880  *  \par Function Description
 881  *
 882  *  \param [in] path
 883  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 884  */
 885 SCM g_rc_scheme_directory(SCM path)
 886 {
 887   char *string;
 888
 889   SCM_ASSERT (scm_is_string (path), path,
 890               SCM_ARG1, "scheme-directory");
 891
 892   string = g_strdup (SCM_STRING_CHARS (path));
 893   /* take care of any shell variables */
 894   string = expand_env_variables(string);
 895
 896   /* invalid path? */
 897   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 898     fprintf (stderr,
 899              "Invalid path [%s] passed to scheme-directory\n",
 900              string);
 901     if (string) {
 902       g_free(string);
 903     }
 904     return SCM_BOOL_F;
 905   }
 906
 907   if (default_scheme_directory) {
 908     g_free(default_scheme_directory);
 909   }
 910   default_scheme_directory = string;
 911
 912   return SCM_BOOL_T;
 913 }
 914
 915 /*! \todo Finish function description!!!
 916  *  \brief
 917  *  \par Function Description
 918  *
 919  *  \param [in] path
 920  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 921  */
 922 SCM g_rc_bitmap_directory(SCM path)
 923 {
 924   char *string;
 925
 926   SCM_ASSERT (scm_is_string (path), path,
 927               SCM_ARG1, "bitmap-directory");
 928
 929   string = g_strdup (SCM_STRING_CHARS (path));
 930   /* take care of any shell variables */
 931   string = expand_env_variables(string);
 932
 933   /* invalid path? */
 934   if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
 935     fprintf (stderr,
 936              "Invalid path [%s] passed to bitmap-directory\n",
 937              string);
 938     if (string) {
 939       g_free(string);
 940     }
 941     return SCM_BOOL_F;
 942   }
 943
 944   if (default_bitmap_directory) {
 945     g_free(default_bitmap_directory);
 946   }
 947   default_bitmap_directory = string;
 948
 949   return SCM_BOOL_T;
 950 }
 951
 952 /*! \todo Finish function description!!!
 953  *  \brief
 954  *  \par Function Description
 955  *
 956  *  \param [in] scmsymname
 957  *  \return SCM_BOOL_T always.
 958  */
 959 SCM g_rc_bus_ripper_symname(SCM scmsymname)
 960 {
 961   SCM_ASSERT (scm_is_string (scmsymname), scmsymname,
 962               SCM_ARG1, "bus-ripper-symname");
 963
 964   if (default_bus_ripper_symname) {
 965     g_free(default_bus_ripper_symname);
 966   }
 967   default_bus_ripper_symname = g_strdup (SCM_STRING_CHARS (scmsymname));
 968
 969   return SCM_BOOL_T;
 970 }
 971
 972 /*! \todo Finish function description!!!
 973  *  \brief
 974  *  \par Function Description
 975  *
 976  *  \param [in] scmsymname
 977  *  \return SCM_BOOL_T always.
 978  */
 979 SCM g_rc_postscript_prolog(SCM scmsymname)
 980 {
 981   char *string;
 982
 983   SCM_ASSERT (scm_is_string (scmsymname), scmsymname,
 984               SCM_ARG1, "postsript-prolog");
 985
 986   if (default_postscript_prolog) {
 987     g_free(default_postscript_prolog);
 988   }
 989
 990   string = g_strdup (SCM_STRING_CHARS (scmsymname));
 991   /* take care of any shell variables */
 992   string = expand_env_variables(string);
 993
 994   default_postscript_prolog = g_strdup (string);
 995
 996   return SCM_BOOL_T;
 997 }
 998
 999 /*! \todo Finish function description!!!
1000  *  \brief
1001  *  \par Function Description
1002  *
1003  *  \return SCM_BOOL_T always.
1004  */
1005 SCM g_rc_reset_component_library(void)
1006 {
1007   s_clib_init();
1008
1009   return SCM_BOOL_T;
1010 }
1011
1012 /*! \todo Finish function description!!!
1013  *  \brief
1014  *  \par Function Description
1015  *
1016  *  \return SCM_BOOL_T always.
1017  */
1018 SCM g_rc_reset_source_library(void)
1019 {
1020   s_slib_free();
1021   s_slib_init();
1022
1023   return SCM_BOOL_T;
1024 }
1025
1026 /*! \todo Finish function description!!!
1027  *  \brief
1028  *  \par Function Description
1029  *
1030  *  \param [in] scmcharstr
1031  *  \param [in] scmfilename
1032  *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
1033  */
1034 SCM g_rc_map_font_character_to_file(SCM scmcharstr, SCM scmfilename)
1035 {
1036   gchar *charstr, *filename;
1037   gunichar character;
1038
1039   SCM_ASSERT (scm_is_string (scmcharstr), scmcharstr,
1040               SCM_ARG1, "map-font-character-to-file");
1041   SCM_ASSERT (scm_is_string (scmfilename), scmfilename,
1042               SCM_ARG2, "map-font-character-to-file");
1043
1044   charstr  = SCM_STRING_CHARS (scmcharstr);
1045   filename = SCM_STRING_CHARS (scmfilename);
1046
1047   if (charstr == NULL || filename == NULL) {
1048     fprintf(stderr,
1049             "%s requires two strings as parameters\n",
1050             "map-font-character-to-file"
1051             );
1052     return SCM_BOOL_F;
1053   }
1054
1055   /* take care of expansion of any shell variables in filename */
1056   filename = expand_env_variables (g_strdup (filename));
1057
1058   character = g_utf8_get_char_validated (charstr, -1);
1059
1060   /* insert the new character declaration in the hash table */
1061   g_hash_table_insert (font_char_to_file,
1062                        GUINT_TO_POINTER ((guint)character),
1063                        filename);
1064
1065   return SCM_BOOL_T;
1066 }
1067
1068 /*! \todo Finish function documentation!!!
1069  *  \brief
1070  *  \par Function Description
1071  *
1072  */
1073 SCM g_rc_attribute_promotion(SCM mode)
1074 {
1075   static const vstbl_entry mode_table[] = {
1076     {TRUE , "enabled" },
1077     {FALSE, "disabled"},
1078   };
1079
1080   RETURN_G_RC_MODE("attribute-promotion",
1081                    default_attribute_promotion,
1082                    2);
1083 }
1084
1085 /*! \todo Finish function documentation!!!
1086  *  \brief
1087  *  \par Function Description
1088  *
1089  */
1090 SCM g_rc_promote_invisible(SCM mode)
1091 {
1092   static const vstbl_entry mode_table[] = {
1093     {TRUE , "enabled" },
1094     {FALSE, "disabled"},
1095   };
1096
1097   RETURN_G_RC_MODE("promote-invisible",
1098                    default_promote_invisible,
1099                    2);
1100 }
1101
1102 /*! \todo Finish function documentation!!!
1103  *  \brief
1104  *  \par Function Description
1105  *
1106  */
1107 SCM g_rc_keep_invisible(SCM mode)
1108 {
1109   static const vstbl_entry mode_table[] = {
1110     {TRUE , "enabled" },
1111     {FALSE, "disabled"},
1112   };
1113
1114   RETURN_G_RC_MODE("keep-invisible",
1115                    default_keep_invisible,
1116                    2);
1117 }
1118
1119 /*! \todo Finish function description!!!
1120  *  \brief
1121  *  \par Function Description
1122  *
1123  *  \param [in] scmsymname
1124  *  \return SCM_BOOL_T always.
1125  */
1126 SCM g_rc_always_promote_attributes(SCM scmsymname)
1127 {
1128   SCM_ASSERT (scm_is_string (scmsymname), scmsymname,
1129               SCM_ARG1, "always-promote-attributes");
1130
1131   if (default_always_promote_attributes) {
1132     g_free(default_always_promote_attributes);
1133   }
1134   default_always_promote_attributes =
1135     g_strdup_printf(" %s ", SCM_STRING_CHARS (scmsymname));
1136
1137   return SCM_BOOL_T;
1138 }