1;;; Lepton EDA Schematic Capture
2;;; Scheme API
3;;; Copyright (C) 2020-2021 Lepton EDA Contributors
4;;;
5;;; This program is free software; you can redistribute it and/or modify
6;;; it under the terms of the GNU General Public License as published by
7;;; the Free Software Foundation; either version 2 of the License, or
8;;; (at your option) any later version.
9;;;
10;;; This program is distributed in the hope that it will be useful,
11;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13;;; GNU General Public License for more details.
14;;;
15;;; You should have received a copy of the GNU General Public License
16;;; along with this program; if not, write to the Free Software
17;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
18
19(define-module (schematic ffi)
20  #:use-module (system foreign)
21  #:use-module (lepton ffi lib)
22
23  #:export (g_init_action
24            g_init_attrib
25            g_init_hook
26            g_init_keys
27            g_init_select
28            g_init_util
29            g_init_window
30            g_register_funcs
31            generic_confirm_dialog
32            generic_filesel_dialog
33            generic_msg_dialog
34            gschem_toplevel_get_toplevel
35            i_callback_add_arc
36            i_callback_add_attribute
37            i_callback_add_box
38            i_callback_add_bus
39            i_callback_add_circle
40            i_callback_add_component
41            i_callback_add_line
42            i_callback_add_net
43            i_callback_add_path
44            i_callback_add_picture
45            i_callback_add_pin
46            i_callback_add_text
47            i_callback_attributes_show_both
48            i_callback_attributes_show_name
49            i_callback_attributes_show_value
50            i_callback_attributes_visibility_toggle
51            i_callback_cancel
52            i_callback_clipboard_copy
53            i_callback_clipboard_cut
54            i_callback_clipboard_paste
55            i_callback_edit_autonumber_text
56            i_callback_edit_copy
57            i_callback_edit_delete
58            i_callback_edit_deselect
59            i_callback_edit_edit
60            i_callback_edit_embed
61            i_callback_edit_find
62            i_callback_edit_hide_text
63            i_callback_edit_invoke_macro
64            i_callback_edit_lock
65            i_callback_edit_mcopy
66            i_callback_edit_mirror
67            i_callback_edit_move
68            i_callback_edit_object_properties
69            i_callback_edit_redo
70            i_callback_edit_rotate_90
71            i_callback_edit_select
72            i_callback_edit_select_all
73            i_callback_edit_show_hidden
74            i_callback_edit_show_text
75            i_callback_edit_slot
76            i_callback_edit_text
77            i_callback_edit_translate
78            i_callback_edit_undo
79            i_callback_edit_unembed
80            i_callback_edit_unlock
81            i_callback_edit_update
82            i_callback_file_close
83            i_callback_file_new
84            i_callback_file_new_window
85            i_callback_file_open
86            i_callback_file_print
87            i_callback_file_quit
88            i_callback_file_save
89            i_callback_file_save_all
90            i_callback_file_save_as
91            i_callback_file_script
92            i_callback_file_write_png
93            i_callback_help_about
94            i_callback_help_hotkeys
95            i_callback_hierarchy_down_schematic
96            i_callback_hierarchy_down_symbol
97            i_callback_hierarchy_up
98            i_callback_options_afeedback
99            i_callback_options_draw_grips
100            i_callback_options_grid
101            i_callback_options_magneticnet
102            i_callback_options_rubberband
103            i_callback_options_scale_down_snap_size
104            i_callback_options_scale_up_snap_size
105            i_callback_options_select_font
106            i_callback_options_show_coord_window
107            i_callback_options_show_log_window
108            i_callback_options_snap
109            i_callback_options_snap_size
110            i_callback_page_close
111            i_callback_page_manager
112            i_callback_page_next
113            i_callback_page_next_tab
114            i_callback_page_prev
115            i_callback_page_prev_tab
116            i_callback_page_print
117            i_callback_page_revert
118            i_callback_view_bw_colors
119            i_callback_view_color_edit
120            i_callback_view_dark_colors
121            i_callback_view_find_text_state
122            i_callback_view_light_colors
123            i_callback_view_pan
124            i_callback_view_pan_down
125            i_callback_view_pan_left
126            i_callback_view_pan_right
127            i_callback_view_pan_up
128            i_callback_view_redraw
129            i_callback_view_sidebar
130            i_callback_view_status
131            i_callback_view_zoom_box
132            i_callback_view_zoom_extents
133            i_callback_view_zoom_full
134            i_callback_view_zoom_in
135            i_callback_view_zoom_out
136            make_menu_action
137            make_separator_menu_item
138            o_buffer_init
139            o_undo_init
140            scheme_init_undo
141            set_quiet_mode
142            set_verbose_mode
143            x_color_init
144            x_menu_attach_recent_files_submenu
145            x_stroke_init
146            x_widgets_show_log
147            x_window_create_main
148            x_window_new
149            x_window_open_page
150            x_window_set_current_page
151            x_window_setup
152            ))
153
154
155(define libleptongui
156  (dynamic-link (or (getenv "LIBLEPTONGUI") %libleptongui)))
157
158;;; Brief syntax macro for defining lazy foreign functions.
159(define-syntax define-lff
160  (syntax-rules ()
161    ((_ name type args)
162     (define name
163       (let ((proc (delay (pointer->procedure
164                           type
165                           (dynamic-func (symbol->string (quote name)) libleptongui)
166                           args))))
167         (force proc))))))
168
169
170(define-lff g_init_action void '())
171(define-lff g_init_attrib void '())
172(define-lff g_init_hook void '())
173(define-lff g_init_keys void '())
174(define-lff g_init_select void '())
175(define-lff g_init_util void '())
176(define-lff g_init_window void '())
177(define-lff g_register_funcs void '())
178(define-lff gschem_toplevel_get_toplevel '* '(*))
179(define-lff o_buffer_init void '())
180(define-lff o_undo_init void '())
181(define-lff scheme_init_undo void '())
182(define-lff set_quiet_mode void '())
183(define-lff set_verbose_mode void '())
184(define-lff x_color_init void '())
185(define-lff x_widgets_show_log void (list '*))
186;;; x_menus.c
187(define-lff make_separator_menu_item '* '())
188(define-lff make_menu_action '* '(* * * * *))
189(define-lff x_menu_attach_recent_files_submenu void '(* *))
190;;; x_window.c
191(define-lff x_window_new '* '())
192(define-lff x_window_open_page '* '(* *))
193(define-lff x_window_set_current_page void '(* *))
194(define-lff x_window_setup '* '(*))
195(define-lff x_window_create_main '* '(* *))
196;;; x_dialog.c
197(define-lff generic_confirm_dialog int '(*))
198(define-lff generic_filesel_dialog '* (list '* '* int))
199(define-lff generic_msg_dialog void '(*))
200;;; i_callbacks.c
201(define-lff i_callback_add_arc void '(* *))
202(define-lff i_callback_add_attribute void '(* *))
203(define-lff i_callback_add_box void '(* *))
204(define-lff i_callback_add_bus void '(* *))
205(define-lff i_callback_add_circle void '(* *))
206(define-lff i_callback_add_component void '(* *))
207(define-lff i_callback_add_line void '(* *))
208(define-lff i_callback_add_net void '(* *))
209(define-lff i_callback_add_path void '(* *))
210(define-lff i_callback_add_picture void '(* *))
211(define-lff i_callback_add_pin void '(* *))
212(define-lff i_callback_add_text void '(* *))
213(define-lff i_callback_attributes_show_both void '(* *))
214(define-lff i_callback_attributes_show_name void '(* *))
215(define-lff i_callback_attributes_show_value void '(* *))
216(define-lff i_callback_attributes_visibility_toggle void '(* *))
217(define-lff i_callback_cancel void '(* *))
218(define-lff i_callback_clipboard_copy void '(* *))
219(define-lff i_callback_clipboard_cut void '(* *))
220(define-lff i_callback_clipboard_paste void '(* *))
221(define-lff i_callback_edit_autonumber_text void '(* *))
222(define-lff i_callback_edit_copy void '(* *))
223(define-lff i_callback_edit_delete void '(* *))
224(define-lff i_callback_edit_deselect void '(* *))
225(define-lff i_callback_edit_edit void '(* *))
226(define-lff i_callback_edit_embed void '(* *))
227(define-lff i_callback_edit_find void '(* *))
228(define-lff i_callback_edit_hide_text void '(* *))
229(define-lff i_callback_edit_invoke_macro void '(* *))
230(define-lff i_callback_edit_lock void '(* *))
231(define-lff i_callback_edit_mcopy void '(* *))
232(define-lff i_callback_edit_mirror void '(* *))
233(define-lff i_callback_edit_move void '(* *))
234(define-lff i_callback_edit_object_properties void '(* *))
235(define-lff i_callback_edit_redo void '(* *))
236(define-lff i_callback_edit_rotate_90 void '(* *))
237(define-lff i_callback_edit_select void '(* *))
238(define-lff i_callback_edit_select_all void '(* *))
239(define-lff i_callback_edit_show_hidden void '(* *))
240(define-lff i_callback_edit_show_text void '(* *))
241(define-lff i_callback_edit_slot void '(* *))
242(define-lff i_callback_edit_text void '(* *))
243(define-lff i_callback_edit_translate void '(* *))
244(define-lff i_callback_edit_undo void '(* *))
245(define-lff i_callback_edit_unembed void '(* *))
246(define-lff i_callback_edit_unlock void '(* *))
247(define-lff i_callback_edit_update void '(* *))
248(define-lff i_callback_file_close void '(* *))
249(define-lff i_callback_file_new void '(* *))
250(define-lff i_callback_file_new_window void '(* *))
251(define-lff i_callback_file_open void '(* *))
252(define-lff i_callback_file_print void '(* *))
253(define-lff i_callback_file_quit void '(* *))
254(define-lff i_callback_file_save void '(* *))
255(define-lff i_callback_file_save_all void '(* *))
256(define-lff i_callback_file_save_as void '(* *))
257(define-lff i_callback_file_script void '(* *))
258(define-lff i_callback_file_write_png void '(* *))
259(define-lff i_callback_help_about void '(* *))
260(define-lff i_callback_help_hotkeys void '(* *))
261(define-lff i_callback_hierarchy_down_schematic void '(* *))
262(define-lff i_callback_hierarchy_down_symbol void '(* *))
263(define-lff i_callback_hierarchy_up void '(* *))
264(define-lff i_callback_options_afeedback void '(* *))
265(define-lff i_callback_options_draw_grips void '(* *))
266(define-lff i_callback_options_grid void '(* *))
267(define-lff i_callback_options_magneticnet void '(* *))
268(define-lff i_callback_options_rubberband void '(* *))
269(define-lff i_callback_options_scale_down_snap_size void '(* *))
270(define-lff i_callback_options_scale_up_snap_size void '(* *))
271(define-lff i_callback_options_select_font void '(* *))
272(define-lff i_callback_options_show_coord_window void '(* *))
273(define-lff i_callback_options_show_log_window void '(* *))
274(define-lff i_callback_options_snap void '(* *))
275(define-lff i_callback_options_snap_size void '(* *))
276(define-lff i_callback_view_bw_colors void '(* *))
277(define-lff i_callback_view_color_edit void '(* *))
278(define-lff i_callback_view_dark_colors void '(* *))
279(define-lff i_callback_view_find_text_state void '(* *))
280(define-lff i_callback_view_light_colors void '(* *))
281(define-lff i_callback_view_pan void '(* *))
282(define-lff i_callback_view_pan_down void '(* *))
283(define-lff i_callback_view_pan_left void '(* *))
284(define-lff i_callback_view_pan_right void '(* *))
285(define-lff i_callback_view_pan_up void '(* *))
286(define-lff i_callback_view_redraw void '(* *))
287(define-lff i_callback_view_sidebar void '(* *))
288(define-lff i_callback_view_status void '(* *))
289(define-lff i_callback_view_zoom_box void '(* *))
290(define-lff i_callback_view_zoom_extents void '(* *))
291(define-lff i_callback_view_zoom_full void '(* *))
292(define-lff i_callback_view_zoom_in void '(* *))
293(define-lff i_callback_view_zoom_out void '(* *))
294(define-lff i_callback_page_close void '(* *))
295(define-lff i_callback_page_manager void '(* *))
296(define-lff i_callback_page_next void '(* *))
297(define-lff i_callback_page_next_tab void '(* *))
298(define-lff i_callback_page_prev void '(* *))
299(define-lff i_callback_page_prev_tab void '(* *))
300(define-lff i_callback_page_print void '(* *))
301(define-lff i_callback_page_revert void '(* *))
302
303;;; This is a special case: the function may be not defined in C
304;;; if libstroke was not found on the configure stage.
305(define (x_stroke_init)
306  (let ((func (delay (false-if-exception (dynamic-func "x_stroke_init"
307                                                       libleptongui)))))
308    (and (force func)
309         (let ((proc (delay (pointer->procedure void (force func) '()))))
310           ((force proc))))))
311