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