OpenCores
URL https://opencores.org/ocsvn/socgen/socgen/trunk

Subversion Repositories socgen

[/] [socgen/] [trunk/] [tools/] [geda/] [g_rc.c] - Blame information for rev 135

Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.