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)
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.
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.
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
35 #include "libgeda_priv.h"
37 #ifdef HAVE_LIBDMALLOC
41 /*! \todo Finish function documentation!!!
43 * \par Function Description
46 int vstbl_lookup_str(const vstbl_entry
*table
,
47 int size
, const char *str
)
51 for(i
= 0; i
< size
; i
++) {
52 if(strcmp(table
[i
].m_str
, str
) == 0) {
59 /*! \todo Finish function documentation!!!
61 * \par Function Description
64 int vstbl_get_val(const vstbl_entry
*table
, int index
)
66 return table
[index
].m_val
;
69 /*! \todo Finish function documentation!!!
71 * \par Function Description
74 SCM
g_rc_mode_general(SCM scmmode
,
77 const vstbl_entry
*table
,
84 SCM_ASSERT (scm_is_string (scmmode
), scmmode
,
87 mode
= SCM_STRING_CHARS (scmmode
);
89 index
= vstbl_lookup_str(table
, table_size
, mode
);
91 if(index
== table_size
) {
93 "Invalid mode [%s] passed to %s\n",
98 *mode_var
= vstbl_get_val(table
, index
);
106 /*! \brief Reads the gafrc file.
107 * \par Function Description
108 * This is the function which actually reads in the RC file.
109 * First, it looks in a list of previously read RC files. If the file has
110 * already been read, it just says OK. After reading the file, it places
111 * the filename in the list of read files.
113 * \param [in] toplevel The TOPLEVEL object.
114 * \param [in] fname RC file name to read.
115 * \param [in] ok_msg Message to print if file is read ok.
116 * \param [in] err_msg Message to print if file read error occurs
117 * \return 1 on success, 0 otherwise.
119 gint
g_rc_parse_general(TOPLEVEL
*toplevel
,
121 const gchar
*ok_msg
, const gchar
*err_msg
)
123 gint found_rc
= FALSE
;
124 GList
*found_rc_filename_element
;
126 /* First see if fname is in list of previously read RC files. */
127 found_rc_filename_element
= g_list_find_custom(toplevel
->RC_list
,
128 (gconstpointer
) fname
,
129 (GCompareFunc
) strcmp
);
130 if (found_rc_filename_element
!= NULL
) {
131 /* We've already read this one in. */
132 s_log_message(_("RC file [%s] already read in.\n"), fname
);
136 /* Now try to read in contents of RC file. */
137 if (access (fname
, R_OK
) == 0) {
140 /* Everything was OK. Now add this file to list of read RC files. */
141 toplevel
->RC_list
= g_list_append (toplevel
->RC_list
,
143 s_log_message (ok_msg
, fname
);
146 s_log_message (err_msg
, fname
);
153 /*! \brief Parses a system RC file.
154 * \par Function Description
155 * This function wil open and parse a system rc file.
157 * \param [in] toplevel The TOPLEVEL object.
158 * \param [in] rcname System RC file name to parse.
159 * \return 1 on success, 0 on failure.
161 gint
g_rc_parse_system_rc(TOPLEVEL
*toplevel
, const gchar
*rcname
)
166 gchar
*ok_msg
, *err_msg
;
168 tmp
= g_strconcat (s_path_sys_config (),
172 filename
= f_normalize_filename (tmp
, NULL
);
173 if (filename
== NULL
) {
177 ok_msg
= g_strdup_printf (_("Read system config file [%%s]\n"));
178 err_msg
= g_strdup_printf (_("Did not find required system config file [%%s]\n"));
179 found_rc
= g_rc_parse_general(toplevel
, filename
, ok_msg
, err_msg
);
189 /*! \brief Parse a RC file in users home directory.
190 * \par Function Description
191 * This function will open and parse a RC file in the users home directory.
193 * \param [in] toplevel The TOPLEVEL object.
194 * \param [in] rcname User's RC file name.
195 * \return 1 on success, 0 on failure.
197 gint
g_rc_parse_home_rc(TOPLEVEL
*toplevel
, const gchar
*rcname
)
202 gchar
*ok_msg
, *err_msg
;
204 if (s_path_user_config () == NULL
) return 0;
206 tmp
= g_build_filename (s_path_user_config (), rcname
, NULL
);
207 filename
= f_normalize_filename (tmp
, NULL
);
208 if (filename
== NULL
) {
212 ok_msg
= g_strdup_printf (_("Read user config file [%%s]\n"));
213 err_msg
= g_strdup_printf (_("Did not find optional user config file [%%s]\n"));
214 found_rc
= g_rc_parse_general(toplevel
, filename
, ok_msg
, err_msg
);
224 /*! \brief Parse rc file in current working directory.
225 * \par Function Description
226 * This function will open and parse a RC file in the current working directory.
228 * \param [in] toplevel The TOPLEVEL object.
229 * \param [in] rcname Local directory RC file name.
230 * \return 1 on success, 0 on failure.
232 gint
g_rc_parse_local_rc(TOPLEVEL
*toplevel
, const gchar
*rcname
)
239 filename
= f_normalize_filename (rcname
, NULL
);
240 if (filename
== NULL
) {
244 ok_msg
= g_strdup_printf (_("Read local config file [%%s]\n"));
245 err_msg
= g_strdup_printf (_("Did not find optional local config file [%%s]\n"));
246 found_rc
= g_rc_parse_general(toplevel
, filename
, ok_msg
, err_msg
);
255 /*! \brief Parse a RC file from a specified location.
256 * \par Function Description
257 * This function will open and parse a RC file from a specified location.
259 * \param [in] toplevel The TOPLEVEL object.
260 * \param [in] rcname Specified location RC file name.
261 * \return 1 on success, 0 on failure.
263 gint
g_rc_parse_specified_rc(TOPLEVEL
*toplevel
, const gchar
*rcname
)
271 if (rcname
== NULL
) {
275 filename
= f_normalize_filename (rcname
, NULL
);
276 if (filename
== NULL
) {
280 rcbasename
= g_path_get_basename (rcname
);
282 ok_msg
= g_strdup_printf (_("Read specified %s file [%%s]\n"),
284 err_msg
= g_strdup_printf (_("Did not find specified %s file [%%s]\n"),
286 found_rc
= g_rc_parse_general(toplevel
, filename
, ok_msg
, err_msg
);
296 /*! \brief General RC file parsing function.
297 * \par Function Description
298 * This function will check for System, HOME and Local RC files matching
299 * the rcname input parameter. If none of those three are found it will
300 * search for the specified_rc_filename. When none are found it will
301 * call exit(-1) to terminate the program.
303 * \param [in] toplevel The TOPLEVEL object.
304 * \param [in] rcname RC file name.
305 * \param [in] specified_rc_filename Specific location RC file name.
306 * \return calls exit(-1) when no RC file matching either rcname or
307 * specified_rc_filename is found.
309 void g_rc_parse(TOPLEVEL
*toplevel
,
310 const gchar
*rcname
, const gchar
*specified_rc_filename
)
314 /* visit rc files in order */
315 /* Changed by SDB 1.2.2005 in response to Peter Kaiser's bug report.
316 * Read gafrc files first */
317 found_rc
|= g_rc_parse_system_rc(toplevel
, "gafrc");
318 found_rc
|= g_rc_parse_home_rc(toplevel
, "gafrc");
319 found_rc
|= g_rc_parse_local_rc(toplevel
, "gafrc");
320 /* continue support for individual rc files for each program. */
321 found_rc
|= g_rc_parse_system_rc(toplevel
, rcname
);
322 found_rc
|= g_rc_parse_home_rc(toplevel
, rcname
);
323 found_rc
|= g_rc_parse_local_rc(toplevel
, rcname
);
325 /* New fcn introduced by SDB to consolidate this & make it available
326 * for other programs */
327 found_rc
|= g_rc_parse_specified_rc(toplevel
, specified_rc_filename
);
329 /* Oh well, I couldn't find any rcfile, exit! */
331 /*! \todo these two are basically the
334 s_log_message(_("Could not find any %s file!\n"), rcname
);
340 * \par Function Description
343 * \param [in] name Optional descriptive name for library directory.
344 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
346 SCM
g_rc_component_library(SCM path
, SCM name
)
349 char *namestr
= NULL
;
351 SCM_ASSERT (scm_is_string (path
), path
,
352 SCM_ARG1
, "component-library");
354 if (name
!= SCM_UNDEFINED
) {
355 SCM_ASSERT (scm_is_string (name
), name
,
356 SCM_ARG2
, "component-library");
357 namestr
= SCM_STRING_CHARS (name
);
360 /* take care of any shell variables */
361 string
= s_expand_env_variables (SCM_STRING_CHARS (path
));
364 if (!g_file_test (string
, G_FILE_TEST_IS_DIR
)) {
366 "Invalid path [%s] passed to component-library\n",
372 if (g_path_is_absolute (string
)) {
373 s_clib_add_directory (string
, namestr
);
375 gchar
*cwd
= g_get_current_dir ();
377 temp
= g_build_filename (cwd
, string
, NULL
);
378 s_clib_add_directory (temp
, namestr
);
388 /*! \brief Guile callback for adding library commands.
389 * \par Function Description
390 * Callback function for the "component-library-command" Guile
391 * function, which can be used in the rc files to add a command to
392 * the component library.
394 * \param [in] listcmd command to get a list of symbols
395 * \param [in] getcmd command to get a symbol from the library
396 * \param [in] name Optional descriptive name for component source.
397 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
399 SCM
g_rc_component_library_command (SCM listcmd
, SCM getcmd
,
402 const CLibSource
*src
;
403 gchar
*lcmdstr
, *gcmdstr
;
404 char *tmp_str
, *namestr
;
406 SCM_ASSERT (scm_is_string (listcmd
), listcmd
, SCM_ARG1
,
407 "component-library-command");
408 SCM_ASSERT (scm_is_string (getcmd
), getcmd
, SCM_ARG2
,
409 "component-library-command");
410 SCM_ASSERT (scm_is_string (name
), name
, SCM_ARG3
,
411 "component-library-command");
413 /* take care of any shell variables */
414 /*! \bug this may be a security risk! */
415 tmp_str
= scm_to_locale_string (listcmd
);
416 lcmdstr
= s_expand_env_variables (tmp_str
);
417 free (tmp_str
); /* this should stay as free (allocated from guile) */
419 /* take care of any shell variables */
420 /*! \bug this may be a security risk! */
421 tmp_str
= scm_to_locale_string (getcmd
);
422 gcmdstr
= s_expand_env_variables (tmp_str
);
423 free (tmp_str
); /* this should stay as free (allocated from guile) */
425 namestr
= scm_to_locale_string (name
);
427 src
= s_clib_add_command (lcmdstr
, gcmdstr
, namestr
);
429 free (namestr
); /* this should stay as free (allocated from guile) */
433 if (src
!= NULL
) return SCM_BOOL_T
;
438 /*! \brief Guile callback for adding library functions.
439 * \par Function Description
440 * Callback function for the "component-library-funcs" Guile
441 * function, which can be used in the rc files to add a set of Guile
442 * procedures for listing and generating symbols.
444 * \param [in] listfunc A Scheme procedure which takes no arguments
445 * and returns a Scheme list of component names.
446 * \param [in] getfunc A Scheme procedure which takes a component
447 * name as an argument and returns a symbol
448 * encoded in a string in gEDA format, or the \b
449 * \#f if the component name is unknown.
450 * \param [in] name A descriptive name for this component source.
452 * \returns SCM_BOOL_T on success, SCM_BOOL_F otherwise.
454 SCM
g_rc_component_library_funcs (SCM listfunc
, SCM getfunc
, SCM name
)
456 SCM_ASSERT (scm_is_true (scm_procedure_p (listfunc
)), listfunc
, SCM_ARG1
,
457 "component-library-funcs");
458 SCM_ASSERT (scm_is_true (scm_procedure_p (getfunc
)), getfunc
, SCM_ARG2
,
459 "component-library-funcs");
460 SCM_ASSERT (scm_is_string (name
), name
, SCM_ARG1
,
461 "component-library-funcs");
463 if (s_clib_add_scm (listfunc
, getfunc
, SCM_STRING_CHARS (name
)) != NULL
) {
470 /*! \todo Finish function description!!!
472 * \par Function Description
475 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
477 SCM
g_rc_component_library_search(SCM path
)
483 SCM_ASSERT (scm_is_string (path
), path
,
484 SCM_ARG1
, "component-library-search");
486 /* take care of any shell variables */
487 string
= s_expand_env_variables (SCM_STRING_CHARS (path
));
490 if (!g_file_test (string
, G_FILE_TEST_IS_DIR
)) {
492 "Invalid path [%s] passed to component-library-search\n",
498 dir
= g_dir_open (string
, 0, NULL
);
501 "Invalid path [%s] passed to component-library-search\n",
507 while ((entry
= g_dir_read_name (dir
))) {
508 /* don't do . and .. and special case font */
509 if ((g_strcasecmp (entry
, ".") != 0) &&
510 (g_strcasecmp (entry
, "..") != 0) &&
511 (g_strcasecmp (entry
, "font") != 0))
513 gchar
*fullpath
= g_build_filename (string
, entry
, NULL
);
515 if (g_file_test (fullpath
, G_FILE_TEST_IS_DIR
)) {
516 if (g_path_is_absolute (fullpath
)) {
517 s_clib_add_directory (fullpath
, NULL
);
519 gchar
*cwd
= g_get_current_dir ();
521 temp
= g_build_filename (cwd
, fullpath
, NULL
);
522 s_clib_add_directory (temp
, NULL
);
536 /*! \todo Finish function description!!!
538 * \par Function Description
541 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
543 SCM
g_rc_source_library(SCM path
)
547 SCM_ASSERT (scm_is_string (path
), path
,
548 SCM_ARG1
, "source-library");
550 /* take care of any shell variables */
551 string
= s_expand_env_variables (SCM_STRING_CHARS (path
));
554 if (!g_file_test (string
, G_FILE_TEST_IS_DIR
)) {
556 "Invalid path [%s] passed to source-library\n",
562 if (g_path_is_absolute (string
)) {
563 s_slib_add_entry (string
);
565 gchar
*cwd
= g_get_current_dir ();
567 temp
= g_build_filename (cwd
, string
, NULL
);
568 s_slib_add_entry (temp
);
578 /*! \todo Finish function description!!!
580 * \par Function Description
583 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
585 SCM
g_rc_source_library_search(SCM path
)
591 SCM_ASSERT (scm_is_string (path
), path
,
592 SCM_ARG1
, "source-library-search");
594 /* take care of any shell variables */
595 string
= s_expand_env_variables (SCM_STRING_CHARS (path
));
598 if (!g_file_test (string
, G_FILE_TEST_IS_DIR
)) {
600 "Invalid path [%s] passed to source-library-search\n",
606 dir
= g_dir_open (string
, 0, NULL
);
609 "Invalid path [%s] passed to source-library-search\n",
615 while ((entry
= g_dir_read_name (dir
))) {
616 /* don't do . and .. and special case font */
617 if ((g_strcasecmp (entry
, ".") != 0) &&
618 (g_strcasecmp (entry
, "..") != 0) &&
619 (g_strcasecmp (entry
, "font") != 0))
621 gchar
*fullpath
= g_build_filename (string
, entry
, NULL
);
623 if (g_file_test (fullpath
, G_FILE_TEST_IS_DIR
)) {
624 if (s_slib_uniq (fullpath
)) {
625 if (g_path_is_absolute (fullpath
)) {
626 s_slib_add_entry (fullpath
);
628 gchar
*cwd
= g_get_current_dir ();
630 temp
= g_build_filename (cwd
, fullpath
, NULL
);
631 s_slib_add_entry (temp
);
646 /*! \todo Finish function description!!!
648 * \par Function Description
653 * \return SCM_BOOL_T always.
655 SCM
g_rc_world_size(SCM width
, SCM height
, SCM border
)
656 #define FUNC_NAME "world-size"
658 int i_width
, i_height
, i_border
;
659 int init_right
, init_bottom
;
661 SCM_ASSERT (SCM_NIMP (width
) && SCM_REALP (width
), width
,
662 SCM_ARG1
, FUNC_NAME
);
663 SCM_ASSERT (SCM_NIMP (height
) && SCM_REALP (height
), height
,
664 SCM_ARG2
, FUNC_NAME
);
665 SCM_ASSERT (SCM_NIMP (border
) && SCM_REALP (border
), border
,
666 SCM_ARG3
, FUNC_NAME
);
668 /* yes this is legit, we are casing the resulting double to an int */
669 i_width
= (int) (SCM_NUM2DOUBLE (0, width
) * MILS_PER_INCH
);
670 i_height
= (int) (SCM_NUM2DOUBLE (0, height
) * MILS_PER_INCH
);
671 i_border
= (int) (SCM_NUM2DOUBLE (0, border
) * MILS_PER_INCH
);
673 PAPERSIZEtoWORLD(i_width
, i_height
, i_border
,
674 &init_right
, &init_bottom
);
677 printf("%d %d\n", i_width
, i_height
);
678 printf("%d %d\n", init_right
, init_bottom
);
681 default_init_right
= init_right
;
682 default_init_bottom
= init_bottom
;
688 /*! \todo Finish function description!!!
690 * \par Function Description
693 * \return SCM_BOOL_T always.
695 SCM
g_rc_untitled_name(SCM name
)
697 SCM_ASSERT (scm_is_string (name
), name
,
698 SCM_ARG1
, "untitled-name");
700 g_free(default_untitled_name
);
702 default_untitled_name
= g_strdup (SCM_STRING_CHARS (name
));
708 /*! \todo Finish function description!!!
710 * \par Function Description
713 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
715 SCM
g_rc_scheme_directory(SCM path
)
719 SCM_ASSERT (scm_is_string (path
), path
,
720 SCM_ARG1
, "scheme-directory");
722 /* take care of any shell variables */
723 string
= s_expand_env_variables (SCM_STRING_CHARS (path
));
726 if (!g_file_test (string
, G_FILE_TEST_IS_DIR
)) {
728 "Invalid path [%s] passed to scheme-directory\n",
734 g_free(default_scheme_directory
);
735 default_scheme_directory
= string
;
740 /*! \todo Finish function description!!!
742 * \par Function Description
745 * \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
747 SCM
g_rc_bitmap_directory(SCM path
)
751 SCM_ASSERT (scm_is_string (path
), path
,
752 SCM_ARG1
, "bitmap-directory");
754 /* take care of any shell variables */
755 string
= s_expand_env_variables (SCM_STRING_CHARS (path
));
758 if (!g_file_test (string
, G_FILE_TEST_IS_DIR
)) {
760 "Invalid path [%s] passed to bitmap-directory\n",
766 g_free(default_bitmap_directory
);
767 default_bitmap_directory
= string
;
772 /*! \todo Finish function description!!!
774 * \par Function Description
776 * \param [in] scmsymname
777 * \return SCM_BOOL_T always.
779 SCM
g_rc_bus_ripper_symname(SCM scmsymname
)
781 SCM_ASSERT (scm_is_string (scmsymname
), scmsymname
,
782 SCM_ARG1
, "bus-ripper-symname");
784 g_free(default_bus_ripper_symname
);
785 default_bus_ripper_symname
= g_strdup (SCM_STRING_CHARS (scmsymname
));
790 /*! \todo Finish function description!!!
792 * \par Function Description
794 * \param [in] scmsymname
795 * \return SCM_BOOL_T always.
797 SCM
g_rc_postscript_prolog(SCM scmsymname
)
799 SCM_ASSERT (scm_is_string (scmsymname
), scmsymname
,
800 SCM_ARG1
, "postsript-prolog");
802 g_free(default_postscript_prolog
);
804 /* take care of any shell variables */
805 default_postscript_prolog
=
806 s_expand_env_variables (SCM_STRING_CHARS (scmsymname
));
811 /*! \todo Finish function description!!!
813 * \par Function Description
815 * \return SCM_BOOL_T always.
817 SCM
g_rc_reset_component_library(void)
824 /*! \todo Finish function description!!!
826 * \par Function Description
828 * \return SCM_BOOL_T always.
830 SCM
g_rc_reset_source_library(void)
839 /*! \todo Finish function documentation!!!
841 * \par Function Description
844 SCM
g_rc_attribute_promotion(SCM mode
)
846 static const vstbl_entry mode_table
[] = {
851 RETURN_G_RC_MODE("attribute-promotion",
852 default_attribute_promotion
,
856 /*! \todo Finish function documentation!!!
858 * \par Function Description
861 SCM
g_rc_promote_invisible(SCM mode
)
863 static const vstbl_entry mode_table
[] = {
868 RETURN_G_RC_MODE("promote-invisible",
869 default_promote_invisible
,
873 /*! \todo Finish function documentation!!!
875 * \par Function Description
878 SCM
g_rc_keep_invisible(SCM mode
)
880 static const vstbl_entry mode_table
[] = {
885 RETURN_G_RC_MODE("keep-invisible",
886 default_keep_invisible
,
890 /*! \todo Finish function description!!!
892 * \par Function Description
894 * \param [in] attrlist
895 * \return SCM_BOOL_T always.
897 SCM
g_rc_always_promote_attributes(SCM attrlist
)
904 g_list_foreach(default_always_promote_attributes
, (GFunc
)g_free
, NULL
);
905 g_list_free(default_always_promote_attributes
);
907 if (scm_is_string (attrlist
)) {
908 s_log_message(_("WARNING: using a string for 'always-promote-attributes'"
909 " is deprecated. Use a list of strings instead\n"));
911 /* convert the space separated strings into a GList */
912 attr2
= g_strsplit(SCM_STRING_CHARS (attrlist
)," ", 0);
913 for (i
=0; attr2
[i
] != NULL
; i
++) {
914 if (strlen(attr2
[i
]) > 0) {
915 list
= g_list_prepend(list
, g_strdup(attr2
[i
]));
920 SCM_ASSERT(scm_list_p(attrlist
), attrlist
, SCM_ARG1
, "always-promote-attributes");
921 length
= scm_ilength(attrlist
);
922 /* convert the scm list into a GList */
923 for (i
=0; i
< length
; i
++) {
924 SCM_ASSERT(scm_is_string(scm_list_ref(attrlist
, scm_from_int(i
))),
925 scm_list_ref(attrlist
, scm_from_int(i
)), SCM_ARG1
,
926 "always-promote-attribute: list element is not a string");
927 attr
= g_strdup(SCM_STRING_CHARS(scm_list_ref(attrlist
, scm_from_int(i
))));
928 list
= g_list_prepend(list
, attr
);
932 default_always_promote_attributes
= g_list_reverse(list
);
937 extern COLOR print_colors
[MAX_COLORS
];
939 SCM
g_rc_print_color_map (SCM scm_map
)
941 if (scm_map
== SCM_UNDEFINED
) {
942 return s_color_map_to_scm (print_colors
);
945 SCM_ASSERT (scm_is_true (scm_list_p (scm_map
)),
946 scm_map
, SCM_ARG1
, "print-color-map");
948 s_color_map_from_scm (print_colors
, scm_map
, "print-color-map");