From e85559efec41d3bcbdb1b8686887ff20dff582c8 Mon Sep 17 00:00:00 2001 From: Stefan Frederik Date: Thu, 4 Nov 2021 01:13:44 +0100 Subject: [PATCH] context menu added in drawing area (right mouse button) --- doc/xschem_man/commands.html | 13 +- src/callback.c | 221 +- src/keys.help | 13 +- src/scheduler.c | 7 + src/xschem.tcl | 8808 +++++++++++++++++----------------- 5 files changed, 4628 insertions(+), 4434 deletions(-) diff --git a/doc/xschem_man/commands.html b/doc/xschem_man/commands.html index 7eded0eb..e90bf452 100644 --- a/doc/xschem_man/commands.html +++ b/doc/xschem_man/commands.html @@ -76,12 +76,13 @@ Alt + LeftButton Unselect selected object Alt + LeftButton drag Unselect objects by area -RightButton Edit property of object under the mouse - else edit global schematic / symbol property string +RightButton Context menu -Shift + RightButton Edit property of object under the mouse - else edit global schematic / symbol property string - using the specified (or default) text editor. +Shift + RightButton Select object under the mouse and if label/pin + select attached nets + +Ctrl + RightButton Select object under the mouse and if label/pin + select attached nets up to net junctions LeftButton Double click Terminate Polygon placement @@ -109,7 +110,7 @@ ctrl '0-9' set current layer (4 -13) '0' set selected net or label to logic value '0' '1' set selected net or label to logic value '1' '2' set selected net or label to logic value 'X' - '3' toggle selected net or label: 1->0, 0->1, X->X + '3' toggle selected net or label: 1->0, 0->1, X->X - 'a' Make symbol from pin list of current schematic ctrl 'a' Select all shift 'A' Toggle show netlist diff --git a/src/callback.c b/src/callback.c index 473bf14f..08cbfca2 100644 --- a/src/callback.c +++ b/src/callback.c @@ -1,4 +1,4 @@ -/* File: callback.c +/* file: callback.c * * This file is part of XSCHEM, * a schematic capture and Spice/Vhdl/Verilog netlisting tool for circuit @@ -47,6 +47,26 @@ void redraw_w_a_l_r_p_rubbers(void) } } +void start_place_symbol(double mx, double my) +{ + xctx->last_command = 0; + rebuild_selected_array(); + if(xctx->lastsel && xctx->sel_array[0].type==ELEMENT) { + Tcl_VarEval(interp, "set INITIALINSTDIR [file dirname {", + abs_sym_path(xctx->inst[xctx->sel_array[0].n].name, ""), "}]", NULL); + } + unselect_all(); + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save = xctx->mousex_snap; + xctx->my_double_save = xctx->mousey_snap; + if(place_symbol(-1,NULL,xctx->mousex_snap, xctx->mousey_snap, 0, 0, NULL, 4, 1, 1/* to_push_undo */) ) { + xctx->mousey_snap = xctx->my_double_save; + xctx->mousex_snap = xctx->mx_double_save; + move_objects(START,0,0,0); + xctx->ui_state |= PLACE_SYMBOL; + } +} + void start_line(double mx, double my) { xctx->last_command = STARTLINE; @@ -574,7 +594,7 @@ int callback(int event, int mx, int my, KeySym key, { move_objects(ABORT,0,0,0); if(xctx->ui_state & START_SYMPIN) { - delete(1/*to_push_undo*/); + delete(1/* to_push_undo */); xctx->ui_state &= ~START_SYMPIN; } break; @@ -585,7 +605,7 @@ int callback(int event, int mx, int my, KeySym key, break; } if(xctx->ui_state & STARTMERGE) { - delete(1/*to_push_undo*/); + delete(1/* to_push_undo */); set_modify(0); /* aborted merge: no change, so reset modify flag set by delete() */ } @@ -650,10 +670,10 @@ int callback(int event, int mx, int my, KeySym key, dbg(1, "callback(): new color: %d\n",color_index[xctx->rectcolor]); break; } - if(key==XK_Delete && (xctx->ui_state & SELECTION) ) /* delete objects */ + if(key==XK_Delete && (xctx->ui_state & SELECTION) ) /* delete selection */ { if(xctx->semaphore >= 2) break; - delete(1/*to_push_undo*/);break; + delete(1/* to_push_undo */);break; } if(key==XK_Right) /* left */ { @@ -795,17 +815,17 @@ int callback(int event, int mx, int my, KeySym key, } break; } - if(key=='x' && state == ControlMask) /* cut into clipboard */ + if(key=='x' && state == ControlMask) /* cut selection into clipboard */ { if(xctx->semaphore >= 2) break; rebuild_selected_array(); if(xctx->lastsel) { /* 20071203 check if something selected */ save_selection(2); - delete(1/*to_push_undo*/); + delete(1/* to_push_undo */); } break; } - if(key=='c' && state == ControlMask) /* save clipboard */ + if(key=='c' && state == ControlMask) /* copy selection into clipboard */ { if(xctx->semaphore >= 2) break; rebuild_selected_array(); @@ -814,7 +834,7 @@ int callback(int event, int mx, int my, KeySym key, } break; } - if(key=='C' && state == ShiftMask) /* place arc */ + if(key=='C' && state == ShiftMask) /* place arc */ { if(xctx->semaphore >= 2) break; xctx->mx_save = mx; xctx->my_save = my; @@ -824,7 +844,7 @@ int callback(int event, int mx, int my, KeySym key, new_arc(PLACE, 180.); break; } - if(key=='C' && state == (ControlMask|ShiftMask)) /* place circle */ + if(key=='C' && state == (ControlMask|ShiftMask)) /* place circle */ { if(xctx->semaphore >= 2) break; xctx->mx_save = mx; xctx->my_save = my; @@ -839,7 +859,7 @@ int callback(int event, int mx, int my, KeySym key, Tcl_VarEval(interp, "xschem load [lindex $recentfile 0]", NULL); break; } - if(key=='O' && state == ShiftMask) /* Toggle light/dark colorscheme 20171113 */ + if(key=='O' && state == ShiftMask) /* toggle light/dark colorscheme 20171113 */ { dark_colorscheme=!dark_colorscheme; tclsetvar("dark_colorscheme", dark_colorscheme ? "1" : "0"); @@ -848,17 +868,17 @@ int callback(int event, int mx, int my, KeySym key, draw(); break; } - if(key=='v' && state == ControlMask) /* load clipboard */ + if(key=='v' && state == ControlMask) /* paste from clipboard */ { if(xctx->semaphore >= 2) break; merge_file(2,".sch"); break; } - if(key=='Q' && state == (ControlMask | ShiftMask) ) /* view prop */ + if(key=='Q' && state == (ControlMask | ShiftMask) ) /* view attributes */ { edit_property(2);break; } - if(key=='q' && state==0) /* edit prop */ + if(key=='q' && state==0) /* edit attributes */ { if(xctx->semaphore >= 2) break; edit_property(0); @@ -880,7 +900,7 @@ int callback(int event, int mx, int my, KeySym key, } break; } - if(key=='Q' && state == ShiftMask) /* edit prop with vim */ + if(key=='Q' && state == ShiftMask) /* edit attributes in editor */ { if(xctx->semaphore >= 2) break; edit_property(1);break; @@ -893,26 +913,8 @@ int callback(int event, int mx, int my, KeySym key, if(key==XK_Insert || (key == 'I' && state == ShiftMask) ) /* insert sym */ { if(xctx->semaphore >= 2) break; - xctx->last_command = 0; - #if 1 /* enable on request also in scheduler.c */ - rebuild_selected_array(); - if(xctx->lastsel && xctx->sel_array[0].type==ELEMENT) { - Tcl_VarEval(interp, "set INITIALINSTDIR [file dirname {", - abs_sym_path(xctx->inst[xctx->sel_array[0].n].name, ""), "}]", NULL); - } - #endif - unselect_all(); + start_place_symbol(mx, my); - /* place_symbol(-1,NULL,xctx->mousex_snap, xctx->mousey_snap, 0, 0, NULL,3, 1);*/ - xctx->mx_save = mx; xctx->my_save = my; - xctx->mx_double_save = xctx->mousex_snap; - xctx->my_double_save = xctx->mousey_snap; - if(place_symbol(-1,NULL,xctx->mousex_snap, xctx->mousey_snap, 0, 0, NULL, 4, 1, 1/*to_push_undo*/) ) { - xctx->mousey_snap = xctx->my_double_save; - xctx->mousex_snap = xctx->mx_double_save; - move_objects(START,0,0,0); - xctx->ui_state |= PLACE_SYMBOL; - } break; } if(key=='s' && state & Mod1Mask) /* reload */ @@ -1125,7 +1127,7 @@ int callback(int event, int mx, int my, KeySym key, place_net_label(1); break; } - if(key >= '0' && key <= '4' && state == 0) { /* Toggle pin logic level */ + if(key >= '0' && key <= '4' && state == 0) { /* toggle pin logic level */ if(xctx->semaphore >= 2) break; if(key == '4') logic_set(-1, 1); else logic_set(key - '0', 1); @@ -1135,7 +1137,7 @@ int callback(int event, int mx, int my, KeySym key, place_net_label(0); break; } - if(key=='F' && state==ShiftMask) /* Flip */ + if(key=='F' && state==ShiftMask) /* flip */ { if(xctx->ui_state & STARTMOVE) move_objects(FLIP,0,0,0); else if(xctx->ui_state & STARTCOPY) copy_objects(FLIP); @@ -1151,7 +1153,7 @@ int callback(int event, int mx, int my, KeySym key, } break; } - if(key=='\\' && state==0) /* Fullscreen */ + if(key=='\\' && state==0) /* fullscreen */ { dbg(1, "callback(): toggle fullscreen\n"); toggle_fullscreen(); @@ -1172,7 +1174,7 @@ int callback(int event, int mx, int my, KeySym key, } break; } - if(key=='R' && state==ShiftMask) /* Rotate */ + if(key=='R' && state==ShiftMask) /* rotate */ { if(xctx->ui_state & STARTMOVE) move_objects(ROTATE,0,0,0); else if(xctx->ui_state & STARTCOPY) copy_objects(ROTATE); @@ -1189,7 +1191,7 @@ int callback(int event, int mx, int my, KeySym key, break; } - if(key=='r' && state==Mod1Mask) /* Rotate objects around their anchor points 20171208 */ + if(key=='r' && state==Mod1Mask) /* rotate objects around their anchor points 20171208 */ { if(xctx->ui_state & STARTMOVE) move_objects(ROTATE|ROTATELOCAL,0,0,0); else if(xctx->ui_state & STARTCOPY) copy_objects(ROTATE|ROTATELOCAL); @@ -1204,7 +1206,7 @@ int callback(int event, int mx, int my, KeySym key, } break; } - if(key=='m' && state==0 && !(xctx->ui_state & (STARTMOVE | STARTCOPY)))/* move selected obj. */ + if(key=='m' && state==0 && !(xctx->ui_state & (STARTMOVE | STARTCOPY))) /* move selection */ { xctx->mx_save = mx; xctx->my_save = my; xctx->mx_double_save=xctx->mousex_snap; @@ -1213,7 +1215,7 @@ int callback(int event, int mx, int my, KeySym key, break; } - if(key=='c' && state==0 && /* copy selected obj. */ + if(key=='c' && state==0 && /* duplicate selection */ !(xctx->ui_state & (STARTMOVE | STARTCOPY))) { if(xctx->semaphore >= 2) break; @@ -1223,25 +1225,25 @@ int callback(int event, int mx, int my, KeySym key, copy_objects(START); break; } - if(key=='n' && state==Mod1Mask) /* Empty schematic in new window */ + if(key=='n' && state==Mod1Mask) /* empty schematic in new window */ { if(xctx->semaphore >= 2) break; tcleval("xschem new_window"); break; } - if(key=='N' && state==(ShiftMask|Mod1Mask) ) /* Empty symbol in new window */ + if(key=='N' && state==(ShiftMask|Mod1Mask) ) /* empty symbol in new window */ { if(xctx->semaphore >= 2) break; tcleval("xschem new_symbol_window"); break; } - if(key=='n' && state==ControlMask) /* New schematic */ + if(key=='n' && state==ControlMask) /* new schematic */ { if(xctx->semaphore >= 2) break; tcleval("xschem clear SCHEMATIC"); break; } - if(key=='N' && state==(ShiftMask|ControlMask) ) /* New symbol */ + if(key=='N' && state==(ShiftMask|ControlMask) ) /* new symbol */ { if(xctx->semaphore >= 2) break; tcleval("xschem clear SYMBOL"); @@ -1433,7 +1435,6 @@ int callback(int event, int mx, int my, KeySym key, break; } break; - case ButtonPress: /* end operation */ dbg(1, "callback(): ButtonPress ui_state=%ld state=%d\n",xctx->ui_state,state); if(xctx->ui_state & STARTPAN2) { @@ -1441,40 +1442,134 @@ int callback(int event, int mx, int my, KeySym key, xctx->mx_save = mx; xctx->my_save = my; xctx->mx_double_save=xctx->mousex_snap; xctx->my_double_save=xctx->mousey_snap; - break; } if(button==Button5 && state == 0 ) view_unzoom(CADZOOMSTEP); else if(button == Button3 && state == ControlMask && xctx->semaphore <2) { - if(xctx->semaphore >= 2) break; sel = select_object(xctx->mousex, xctx->mousey, SELECTED, 0); if(sel) select_connected_wires(1); - break; } else if(button == Button3 && state == ShiftMask && xctx->semaphore <2) { - if(xctx->semaphore >= 2) break; sel = select_object(xctx->mousex, xctx->mousey, SELECTED, 0); if(sel) select_connected_wires(0); - break; } else if(button == Button3 && state == 0 && xctx->semaphore <2) { - if(!(xctx->ui_state & STARTPOLYGON) && !(state & Mod1Mask) ) { - xctx->last_command = 0; - unselect_all(); - select_object(xctx->mousex,xctx->mousey,SELECTED, 1); - rebuild_selected_array(); - if(state & ShiftMask) { - edit_property(1); - } else { + int ret; + int prev_state; + tcleval("context_menu"); + ret = atoi(tclresult()); + switch(ret) { + case 1: + start_place_symbol(mx, my); + break; + case 2: + prev_state = xctx->ui_state; + start_wire(mx, my); + if(prev_state == STARTWIRE) { + tcleval("set constrained_move 0" ); + constrained_move=0; + } + break; + case 3: + prev_state = xctx->ui_state; + start_line(mx, my); + if(prev_state == STARTLINE) { + tcleval("set constrained_move 0" ); + constrained_move=0; + } + break; + case 4: + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save=xctx->mousex_snap; + xctx->my_double_save=xctx->mousey_snap; + xctx->last_command = 0; + new_rect(PLACE); + break; + case 5: + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save=xctx->mousex_snap; + xctx->my_double_save=xctx->mousey_snap; + xctx->last_command = 0; + new_polygon(PLACE); + break; + case 6: + xctx->last_command = 0; + place_text(1, xctx->mousex_snap, xctx->mousey_snap); /* 1 = draw text */ + break; + case 7: /* cut selection into clipboard */ + rebuild_selected_array(); + if(xctx->lastsel) { /* 20071203 check if something selected */ + save_selection(2); + delete(1/* to_push_undo */); + } + break; + case 8: /* paste from clipboard */ + merge_file(2,".sch"); + break; + case 9: /* load most recent file */ + Tcl_VarEval(interp, "xschem load [lindex $recentfile 0]", NULL); + break; + case 10: /* edit attributes */ edit_property(0); - } + break; + case 11: /* edit attributes in editor */ + edit_property(1); + break; + case 12: + descend_schematic(0); + break; + case 13: + descend_symbol(); + break; + case 14: + go_back(1); + break; + case 15: /* copy selection into clipboard */ + rebuild_selected_array(); + if(xctx->lastsel) { + save_selection(2); + } + break; + case 16: /* move selection */ + if(!(xctx->ui_state & (STARTMOVE | STARTCOPY))) { + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save=xctx->mousex_snap; + xctx->my_double_save=xctx->mousey_snap; + move_objects(START,0,0,0); + } + break; + case 17: /* duplicate selection */ + if(!(xctx->ui_state & (STARTMOVE | STARTCOPY))) { + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save=xctx->mousex_snap; + xctx->my_double_save=xctx->mousey_snap; + copy_objects(START); + } + break; + case 18: /* delete selection */ + if(xctx->ui_state & SELECTION) delete(1/* to_push_undo */); + break; + case 19: /* place arc */ + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save=xctx->mousex_snap; + xctx->my_double_save=xctx->mousey_snap; + xctx->last_command = 0; + new_arc(PLACE, 180.); + break; + case 20: /* place circle */ + xctx->mx_save = mx; xctx->my_save = my; + xctx->mx_double_save=xctx->mousex_snap; + xctx->my_double_save=xctx->mousey_snap; + xctx->last_command = 0; + new_arc(PLACE, 360.); + break; + default: + break; } - } else if(button==Button4 && state == 0 ) view_zoom(CADZOOMSTEP); - else if(button==Button4 && (state & ShiftMask) && !(state & Button2Mask)) { xctx->xorigin+=-CADMOVESTEP*xctx->zoom/2.; draw(); @@ -1511,7 +1606,6 @@ int callback(int event, int mx, int my, KeySym key, else if(button==Button2 && (state == 0)) { pan2(START, mx, my); xctx->ui_state |= STARTPAN2; - break; } else if(xctx->semaphore >= 2) { /* button1 click to select another instance while edit prop dialog open */ if(button==Button1 && state==0 && tclgetvar("edit_symbol_prop_new_sel")[0]) { @@ -1520,7 +1614,6 @@ int callback(int event, int mx, int my, KeySym key, select_object(xctx->mousex, xctx->mousey, SELECTED, 0); rebuild_selected_array(); } - break; } else if(button==Button1) { diff --git a/src/keys.help b/src/keys.help index fc6d440b..f04374f9 100644 --- a/src/keys.help +++ b/src/keys.help @@ -35,13 +35,14 @@ Alt + LeftButton Unselect selected object Alt + LeftButton drag Unselect objects by area -RightButton Edit property of object under the mouse - else edit global schematic / symbol property string - -Shift + RightButton Edit property of object under the mouse - else edit global schematic / symbol property string - using the specified (or default) text editor. +RightButton Context menu +Shift + RightButton Select object under the mouse and if label/pin + select attached nets + +Ctrl + RightButton Select object under the mouse and if label/pin + select attached nets up to net junctions + LeftButton Double click Terminate Polygon placement diff --git a/src/scheduler.c b/src/scheduler.c index 84ec7502..aaffe1f7 100644 --- a/src/scheduler.c +++ b/src/scheduler.c @@ -611,6 +611,13 @@ int xschem(ClientData clientdata, Tcl_Interp *interp, int argc, const char * arg my_snprintf(s, S(s), "%d",xctx->instances); Tcl_SetResult(interp, s,TCL_VOLATILE); } + else if(!strcmp(argv[2],"lastsel")) { + rebuild_selected_array(); + if( xctx->lastsel != 0 ) + Tcl_SetResult(interp, "1",TCL_STATIC); + else + Tcl_SetResult(interp, "0",TCL_STATIC); + } else if(!strcmp(argv[2],"line_width")) { char s[40]; my_snprintf(s, S(s), "%g", xctx->lw); diff --git a/src/xschem.tcl b/src/xschem.tcl index d3cbc3a6..ff5bfde4 100644 --- a/src/xschem.tcl +++ b/src/xschem.tcl @@ -1,4358 +1,4450 @@ -# -# File: xschem.tcl -# -# This file is part of XSCHEM, -# a schematic capture and Spice/Vhdl/Verilog netlisting tool for circuit -# simulation. -# Copyright (C) 1998-2021 Stefan Frederik Schippers -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - - -### for tclreadline: disable customcompleters -proc completer { text start end line } { return {}} - -### -### set var with $val if var Not existing -### -proc set_ne { var val } { - upvar #0 $var v - if { ![ info exists v ] } { - set v $val - } -} - -### -### Tk procedures -### -# execute service function -proc execute_fileevent {id} { - global execute_pipe execute_data execute_cmd simulate_oldbg - global execute_status execute_callback - append execute_data($id) [read $execute_pipe($id) 1024] - if {[eof $execute_pipe($id)]} { - fileevent $execute_pipe($id) readable "" - # setting pipe to blocking before closing allows to see if pipeline failed - # do not ask status for processes that close stdout/stderr, as eof might - # occur before process ends and following close blocks until process terminates. - fconfigure $execute_pipe($id) -blocking 1 - set status 0 - - if { [ info tclversion] > 8.4} { - set catch_return [eval catch [ list {close $execute_pipe($id)} err options] ] - } else { - set catch_return [eval catch [ list {close $execute_pipe($id)} err] ] - } - if {$catch_return} { - if { [ info tclversion] > 8.4} { - set details [dict get $options -errorcode] - if {[lindex $details 0] eq "CHILDSTATUS"} { - set status [lindex $details 2] - viewdata "Failed: $execute_cmd($id)\nstderr:\n$err\ndata:\n$execute_data($id)" ro - } else { - set status 1 - if {$execute_status($id) } { - viewdata "Completed: $execute_cmd($id)\nstderr:\n$err\ndata:\n$execute_data($id)" ro - } - } - } else { - set status 1 - if {$execute_status($id) } { - viewdata "Completed: $execute_cmd($id)\nstderr:\n$err\ndata:\n$execute_data($id)" ro - } - } - } - if { $status == 0 } { - if {$execute_status($id) } { - viewdata "Completed: $execute_cmd($id)\ndata:\n$execute_data($id)" ro - } - } - if { [info exists execute_callback($id)] } { eval $execute_callback($id); unset execute_callback($id) } - unset execute_pipe($id) - unset execute_data($id) - unset execute_status($id) - unset execute_cmd($id) - } -} - - -proc execute_wait {status args} { - global execute_pipe - set id [eval execute $status $args] - if {$id == -1} { - return -1 - } - xschem set semaphore [expr {[xschem get semaphore] +1}] - vwait execute_pipe($id) - xschem set semaphore [expr {[xschem get semaphore] -1}] - return $id -} - -# equivalent to the 'exec' tcl function but keeps the event loop -# responding, so widgets get updated properly -# while waiting for process to end. -proc execute {status args} { - global execute_id execute_status - global execute_data - global execute_cmd - global execute_pipe - if {![info exists execute_id]} { - set execute_id 0 - } else { - incr execute_id - } - set id $execute_id - if { [catch {open "|$args" r} err] } { - puts stderr "Proc execute error: $err" - return -1 - } else { - set pipe $err - } - set execute_status($id) $status - set execute_pipe($id) $pipe - set execute_cmd($id) $args - set execute_data($id) "" - fconfigure $pipe -blocking 0 - fileevent $pipe readable "execute_fileevent $id" - return $id -} - -proc netlist {source_file show netlist_file} { - global XSCHEM_SHAREDIR flat_netlist hspice_netlist netlist_dir - global verilog_2001 netlist_type debug_var - - simuldir - if {$debug_var <= -1} { puts "netlist: source_file=$source_file, netlist_type=$netlist_type" } - if {$netlist_type eq {spice}} { - if { $hspice_netlist == 1 } { - set simulator {-hspice} - } else { - set simulator {} - } - if { [sim_is_xyce] } { - set xyce {-xyce} - } else { - set xyce {} - } - if {$flat_netlist==0} { - eval exec {awk -f ${XSCHEM_SHAREDIR}/spice.awk -- $simulator $xyce $source_file | \ - awk -f ${XSCHEM_SHAREDIR}/break.awk \ - > $netlist_dir/$netlist_file} - } else { - eval exec {awk -f ${XSCHEM_SHAREDIR}/spice.awk -- $simulator $xyce $source_file | \ - awk -f ${XSCHEM_SHAREDIR}/flatten.awk | awk -f ${XSCHEM_SHAREDIR}/break.awk > $netlist_dir/$netlist_file} - } - if ![string compare $show "show"] { - textwindow $netlist_dir/$netlist_file - } - } - if {$netlist_type eq {vhdl}} { - eval exec {awk -f $XSCHEM_SHAREDIR/vhdl.awk $source_file > $netlist_dir/$netlist_file} - if ![string compare $show "show"] { - textwindow $netlist_dir/$netlist_file - } - } - if {$netlist_type eq {tedax}} { - if {[catch {eval exec {awk -f $XSCHEM_SHAREDIR/tedax.awk $source_file | awk -f $XSCHEM_SHAREDIR/flatten_tedax.awk \ - > $netlist_dir/$netlist_file} } err] } { - puts stderr "tEDAx errors: $err" - } - if ![string compare $show "show"] { - textwindow $netlist_dir/$netlist_file - } - } - if {$netlist_type eq {verilog}} { - eval exec {awk -f ${XSCHEM_SHAREDIR}/verilog.awk $source_file \ - > $netlist_dir/$netlist_file} - - # 20140409 - if { $verilog_2001==1 } { - set vv [pid] - eval exec {awk -f ${XSCHEM_SHAREDIR}/convert_to_verilog2001.awk $netlist_dir/$netlist_file > $netlist_dir/${netlist_file}$vv} - eval exec {mv $netlist_dir/${netlist_file}$vv $netlist_dir/$netlist_file} - } - if ![string compare $show "show"] { - textwindow "$netlist_dir/$netlist_file" - } - } - return {} -} - -# 20161121 -proc convert_to_pdf {filename dest} { - global to_pdf - if { [regexp -nocase {\.pdf$} $dest] } { - set pdffile [file rootname $filename].pdf - # puts "---> $to_pdf $filename $pdffile" - set cmd "exec $to_pdf \$filename \$pdffile" - if {$::OS == "Windows"} { - set cmd "exec $to_pdf \$pdffile \$filename" - } - if { ![catch {eval $cmd} msg] } { - file rename -force $pdffile $dest - # ps2pdf succeeded, so remove original .ps file - if { ![xschem get debug_var] } { - file delete $filename - } - } else { - puts stderr "problems converting postscript to pdf: $msg" - } - } else { - file rename -force $filename $dest - } -} - -# 20161121 -proc convert_to_png {filename dest} { - global to_png debug_var - # puts "---> $to_png $filename $dest" - set cmd "exec $to_png \$filename png:\$dest" - if {$::OS == "Windows"} { - set cmd "exec $to_png \$dest \$filename" - } - if { ![catch {eval $cmd} msg] } { - # conversion succeeded, so remove original .xpm file - if { ![xschem get debug_var] } { - file delete $filename - } - } else { - puts stderr "problems converting xpm to png: $msg" - } -} - -# always specify Shift- modifier for capital letters -# see tk 'man keysyms' for key names -# example format for s, d: Control-Alt-Key-asterisk -# Control-Shift-Key-A -# Alt-Key-c -# ButtonPress-4 -# -proc key_binding { s d } { - regsub {.*-} $d {} key - - - switch $key { - Insert { set keysym 65379 } - Escape { set keysym 65307 } - Return { set keysym 65293 } - Delete { set keysym 65535 } - F1 { set keysym 65470 } - F2 { set keysym 65471 } - F3 { set keysym 65472 } - F4 { set keysym 65473 } - F5 { set keysym 65474 } - F6 { set keysym 65475 } - F7 { set keysym 65476 } - F8 { set keysym 65477 } - F9 { set keysym 65478 } - F10 { set keysym 65479 } - F11 { set keysym 65480 } - F12 { set keysym 65481 } - BackSpace { set keysym 65288 } - default { set keysym [scan "$key" %c] } - } - set state 0 - # not found any portable way to get modifier constants ... - if { [regexp {(Mod1|Alt)-} $d] } { set state [expr {$state +8}] } - if { [regexp Control- $d] } { set state [expr {$state +4}] } - if { [regexp Shift- $d] } { set state [expr {$state +1}] } - if { [regexp ButtonPress-1 $d] } { set state [expr {$state +0x100}] } - if { [regexp ButtonPress-2 $d] } { set state [expr {$state +0x200}] } - if { [regexp ButtonPress-3 $d] } { set state [expr {$state +0x400}] } - # puts "$state $key <${s}>" - if {[regexp ButtonPress- $d]} { - bind .drw "<${s}>" "xschem callback %T %x %y 0 $key 0 $state" - } else { - if {![string compare $d {} ] } { - # puts "bind .drw <${s}> {}" - bind .drw "<${s}>" {} - } else { - # puts "bind .drw <${s}> xschem callback %T %x %y $keysym 0 0 $state" - bind .drw "<${s}>" "xschem callback %T %x %y $keysym 0 0 $state" - } - } - -} - -proc edit_file {filename} { - - global editor - # since $editor can be an executable with options (gvim -f) I *need* to use eval - eval execute 0 $editor $filename - return {} -} - -# ============================================================ -# SIMULATION CONTROL -# ============================================================ - -# ============================================================ -# SIMCONF -# ============================================================ - -## $N : netlist file full path (/home/schippes/simulations/opamp.spice) -## $n : netlist file full path with extension chopped (/home/schippes/simulations/opamp) -## $s : schematic name (opamp) -## $d : netlist directory -## -## Other global vars: -## netlist_dir -## netlist_type -## computerfarm -## terminal -proc save_sim_defaults {f} { - global sim netlist_dir netlist_type computerfarm terminal - - set a [catch {open $f w} fd] - if { $a } { - puts "save_sim_defaults: error opening file $f: $fd" - return - } - puts $fd {# set the list of tools known to xschem} - puts $fd {# Note that no spaces are allowed around commas in array keys} - puts $fd "set sim(tool_list) {$sim(tool_list)}" - puts $fd {} - foreach tool $sim(tool_list) { - puts $fd "#Specify the number of configured $tool tools." - puts $fd "set sim($tool,n) $sim($tool,n) ;# number of configured $tool tools" - puts $fd "# Specify the default $tool tool to use (first=0)" - puts $fd "set sim($tool,default) $sim($tool,default) ;# default $tool tool to launch" - puts $fd {} - for {set i 0} {$i < $sim($tool,n)} { incr i} { - puts $fd "# specify tool command (cmd), name (name), if tool must run\ - in foreground and if exit status must be reported" - puts $fd "set sim($tool,$i,cmd) {$sim($tool,$i,cmd)}" - puts $fd "set sim($tool,$i,name) {$sim($tool,$i,name)}" - puts $fd "set sim($tool,$i,fg) $sim($tool,$i,fg)" - puts $fd "set sim($tool,$i,st) $sim($tool,$i,st)" - puts $fd {} - } - puts $fd {} - } - close $fd -} - - -proc update_recent_file {f} { - global recentfile - set old $recentfile - set recentfile {} - lappend recentfile $f - foreach i $old { - if {[abs_sym_path $i] ne [abs_sym_path $f]} { - lappend recentfile [abs_sym_path $i] - } - } - # tcl8.4 errors if using lreplace past the last element - if { [llength $recentfile] > 10 } { - set recentfile [lreplace $recentfile 10 end] - } - write_recent_file - if { [info exists ::has_x] } setup_recent_menu -} - -proc write_recent_file {} { - global recentfile USER_CONF_DIR - - set a [catch {open $USER_CONF_DIR/recent_files w} fd] - if { $a } { - puts "write_recent_file: error opening file $f: $fd" - return - } - puts $fd "set recentfile {$recentfile}" - close $fd -} - -proc setup_recent_menu {} { - global recentfile - .menubar.file.menu.recent delete 0 9 - set i 0 - if { [info exists recentfile] } { - foreach i $recentfile { - .menubar.file.menu.recent add command \ - -command "xschem load {$i}" \ - -label [file tail $i] - } - } -} - -proc sim_is_xyce {} { - global sim - - set_sim_defaults - - if { [info exists sim(spice,default)] } { - set idx $sim(spice,default) - if { [regexp {[xX]yce} $sim(spice,$idx,cmd)] } { - return 1 - } - } - return 0 -} - - -proc set_sim_defaults {} { - ### spice - global sim terminal USER_CONF_DIR has_x bespice_listen_port env - - set failure 0 - if { [info exists has_x] && [winfo exists .sim] } { - foreach tool $sim(tool_list) { - for {set i 0} {$i < $sim($tool,n)} { incr i} { - set sim($tool,$i,cmd) [.sim.topf.f.scrl.center.$tool.r.$i.cmd get 1.0 {end - 1 chars}] - } - } - } - if { ![info exists sim] } { - if { [file exists ${USER_CONF_DIR}/simrc] } { - # get conf from simrc - if { [catch {source ${USER_CONF_DIR}/simrc} err]} { - puts "Problems opening simrc file: $err" - if {[info exists has_x]} { - tk_messageBox -message "Problems opening simrc file: $err" -icon warning -parent . -type ok - } - set failure 1 - } - } - } - if {![info exists sim] || $failure} { - if {[info exists sim]} {unset sim} - # no simrc, set a reasonable default - set sim(tool_list) {spice spicewave verilog verilogwave vhdl vhdlwave} - if {$::OS == "Windows"} { - set_ne sim(spice,0,cmd) {ngspice -i "$N" -a} - } else { - set_ne sim(spice,0,cmd) {$terminal -e 'ngspice -i "$N" -a || sh'} - } - set_ne sim(spice,0,name) {Ngspice} - set_ne sim(spice,0,fg) 0 - set_ne sim(spice,0,st) 0 - - set_ne sim(spice,1,cmd) {ngspice -b -r "$n.raw" -o "$n.out" "$N"} - set_ne sim(spice,1,name) {Ngspice batch} - set_ne sim(spice,1,fg) 0 - set_ne sim(spice,1,st) 1 - - set_ne sim(spice,2,cmd) {Xyce "$N" -r "$n.raw"} - set_ne sim(spice,2,name) {Xyce batch} - set_ne sim(spice,2,fg) 0 - set_ne sim(spice,2,st) 1 - - # number of configured spice simulators, and default one - set_ne sim(spice,n) 3 - set_ne sim(spice,default) 0 - - ### spice wave view - set_ne sim(spicewave,0,cmd) {gaw "$n.raw" } - set_ne sim(spicewave,0,name) {Gaw viewer} - set_ne sim(spicewave,0,fg) 0 - set_ne sim(spicewave,0,st) 0 - - set_ne sim(spicewave,1,cmd) {$terminal -e ngspice} - set_ne sim(spicewave,1,name) {Ngpice Viewer} - set_ne sim(spicewave,1,fg) 0 - set_ne sim(spicewave,1,st) 0 - - set_ne sim(spicewave,2,cmd) {rawtovcd -v 1.5 "$n.raw" > "$n.vcd" && gtkwave "$n.vcd" "$n.sav" 2>/dev/null} - set_ne sim(spicewave,2,name) {Rawtovcd} - set_ne sim(spicewave,2,fg) 0 - set_ne sim(spicewave,2,st) 0 - - set_ne sim(spicewave,3,cmd) {$env(HOME)/analog_flavor_eval/bin/bspwave --socket localhost $bespice_listen_port "$n.raw" } - set_ne sim(spicewave,3,name) {Bespice wave} - set_ne sim(spicewave,3,fg) 0 - set_ne sim(spicewave,3,st) 0 - # number of configured spice wave viewers, and default one - set_ne sim(spicewave,n) 4 - set_ne sim(spicewave,default) 0 - - ### verilog - set_ne sim(verilog,0,cmd) {iverilog -o .verilog_object -g2012 "$N" && vvp .verilog_object} - set_ne sim(verilog,0,name) {Icarus verilog} - set_ne sim(verilog,0,fg) 0 - set_ne sim(verilog,0,st) 1 - # number of configured verilog simulators, and default one - set_ne sim(verilog,n) 1 - set_ne sim(verilog,default) 0 - - ### verilog wave view - set_ne sim(verilogwave,0,cmd) {gtkwave dumpfile.vcd "$N.sav" 2>/dev/null} - set_ne sim(verilogwave,0,name) {Gtkwave} - set_ne sim(verilogwave,0,fg) 0 - set_ne sim(verilogwave,0,st) 0 - # number of configured verilog wave viewers, and default one - set_ne sim(verilogwave,n) 1 - set_ne sim(verilogwave,default) 0 - - ### vhdl - set_ne sim(vhdl,0,cmd) {ghdl -c --ieee=synopsys -fexplicit "$N" -r "$s" --wave="$n.ghw"} - set_ne sim(vhdl,0,name) {Ghdl} - set_ne sim(vhdl,0,fg) 0 - set_ne sim(vhdl,0,st) 1 - # number of configured vhdl simulators, and default one - set_ne sim(vhdl,n) 1 - set_ne sim(vhdl,default) 0 - - ### vhdl wave view - set_ne sim(vhdlwave,0,cmd) {gtkwave "$n.ghw" "$N.sav" 2>/dev/null} - set_ne sim(vhdlwave,0,name) {Gtkwave} - set_ne sim(vhdlwave,0,fg) 0 - set_ne sim(vhdlwave,0,st) 0 - # number of configured vhdl wave viewers, and default one - set_ne sim(vhdlwave,n) 1 - set_ne sim(vhdlwave,default) 0 - } -} - -proc simconf_yview { args } { - global simconf_vpos - # puts "simconf_yview: $args" - set_ne simconf_vpos 0 - if {[lindex $args 0] eq {place}} { - place .sim.topf.f.scrl -in .sim.topf.f -x 0 -y 0 -relwidth 1 - update - } - set ht [winfo height .sim.topf.f] - set hs [winfo height .sim.topf.f.scrl] - # puts "ht=$ht hs=$hs" - set frac [expr {double($ht)/$hs}] - if { [lindex $args 0] eq {scroll}} { - set simconf_vpos [expr {$simconf_vpos + [lindex $args 1] *(1.0/$frac)/5}] - } elseif { [lindex $args 0] eq {moveto}} { - set simconf_vpos [lindex $args 1] - } - if { $simconf_vpos < 0.0 } { set simconf_vpos 0.0} - if { $simconf_vpos > 1.0-$frac } { set simconf_vpos [expr {1.0 - $frac}]} - .sim.topf.vs set $simconf_vpos [expr {$simconf_vpos + $frac}] - place .sim.topf.f.scrl -in .sim.topf.f -x 0 -y [expr {-$hs * $simconf_vpos}] -relwidth 1 -} - -proc simconf {} { - global sim USER_CONF_DIR simconf_default_geometry - - catch { destroy .sim } - set_sim_defaults - toplevel .sim -class dialog - wm title .sim {Simulation Configuration} - wm geometry .sim 700x340 - frame .sim.topf - frame .sim.topf.f - frame .sim.topf.f.scrl - scrollbar .sim.topf.vs -command {simconf_yview} - pack .sim.topf.f -fill both -expand yes -side left - pack .sim.topf.vs -fill y -expand yes - frame .sim.topf.f.scrl.top - frame .sim.topf.f.scrl.center - frame .sim.bottom - pack .sim.topf.f.scrl.top -fill x - pack .sim.topf.f.scrl.center -fill both -expand yes - set bg(0) {#dddddd} - set bg(1) {#aaaaaa} - set toggle 0 - foreach tool $sim(tool_list) { - frame .sim.topf.f.scrl.center.$tool - label .sim.topf.f.scrl.center.$tool.l -width 12 -text $tool -bg $bg($toggle) - frame .sim.topf.f.scrl.center.$tool.r - pack .sim.topf.f.scrl.center.$tool -fill both -expand yes - pack .sim.topf.f.scrl.center.$tool.l -fill y -side left - pack .sim.topf.f.scrl.center.$tool.r -fill both -expand yes - for {set i 0} { $i < $sim($tool,n)} {incr i} { - frame .sim.topf.f.scrl.center.$tool.r.$i - pack .sim.topf.f.scrl.center.$tool.r.$i -fill x -expand yes - entry .sim.topf.f.scrl.center.$tool.r.$i.lab -textvariable sim($tool,$i,name) -width 15 -bg $bg($toggle) - radiobutton .sim.topf.f.scrl.center.$tool.r.$i.radio -bg $bg($toggle) \ - -variable sim($tool,default) -value $i - text .sim.topf.f.scrl.center.$tool.r.$i.cmd -width 20 -height 3 -wrap none -bg $bg($toggle) - .sim.topf.f.scrl.center.$tool.r.$i.cmd insert 1.0 $sim($tool,$i,cmd) - checkbutton .sim.topf.f.scrl.center.$tool.r.$i.fg -text Fg -variable sim($tool,$i,fg) -bg $bg($toggle) - checkbutton .sim.topf.f.scrl.center.$tool.r.$i.st -text Status -variable sim($tool,$i,st) -bg $bg($toggle) - - pack .sim.topf.f.scrl.center.$tool.r.$i.lab -side left -fill y - pack .sim.topf.f.scrl.center.$tool.r.$i.radio -side left -fill y - pack .sim.topf.f.scrl.center.$tool.r.$i.cmd -side left -fill x -expand yes - pack .sim.topf.f.scrl.center.$tool.r.$i.fg -side left -fill y - pack .sim.topf.f.scrl.center.$tool.r.$i.st -side left -fill y - } - incr toggle - set toggle [expr {$toggle %2}] - } - button .sim.bottom.cancel -text Cancel -command {destroy .sim} - button .sim.bottom.help -text Help -command { - set h {The following variables are defined and will get substituted by -XSCHEM before sending commands to the shell: - - - N: complete filename of netlist for current netlisting mode - (example: /home/schippes/.xschem/simulations/opamp.spice for spice) - (example: /home/schippes/.xschem/simulations/opamp.v for verilog) - - n: complete filename of netlist as above but without extension - (example: /home/schippes/.xschem/simulations/opamp) - - S: full pathname of schematic being used (example: - /home/schippes/.xschem/xschem_library/opamp.sch) - - s: name of schematic being used (example: opamp) - - d: simulation directory (example: /home/schippes/.xschem/simulations) - - terminal: terminal to be used for applications that need to be - executed in terminal (example: $terminal -e ngspice -i "$N" -a) -If for a given tool there are multiple rows then the radiobutton -tells which one will be called by xschem. -Variables should be used with the usual substitution character $: $n, $N, etc. -Foreground checkbutton tells xschem to wait for child process to finish. -Status checkbutton tells xschem to report a status dialog (stdout, stderr, -exit status) when process finishes. -Any changes made in the command or tool name entries will be saved in -~/.xschem/simrc when 'Save Configuration' button is pressed. -If no ~/.xschem/simrc is present then a bare minumum skeleton setup is presented. -To reset to default just delete the ~/.xschem/simrc file manually. - } - viewdata $h ro - } - button .sim.bottom.ok -text {Accept and Save Configuration} -command { - foreach tool $sim(tool_list) { - for {set i 0} { $i < $sim($tool,n)} {incr i} { - set sim($tool,$i,cmd) [.sim.topf.f.scrl.center.$tool.r.$i.cmd get 1.0 {end - 1 chars}] - } - } - # destroy .sim - save_sim_defaults ${USER_CONF_DIR}/simrc - # puts "saving simrc" - } - button .sim.bottom.close -text {Accept and Close} -command { - set_sim_defaults - destroy .sim - } - wm protocol .sim WM_DELETE_WINDOW { set_sim_defaults; destroy .sim } - pack .sim.bottom.cancel -side left -anchor w - pack .sim.bottom.help -side left - #foreach tool $sim(tool_list) { - # button .sim.bottom.add${tool} -text +${tool} -command " - # simconf_add $tool - # destroy .sim - # save_sim_defaults ${USER_CONF_DIR}/simrc - ## simconf - # " - # pack .sim.bottom.add${tool} -side left - #} - pack .sim.bottom.ok -side right -anchor e - pack .sim.bottom.close -side right - pack .sim.topf -fill both -expand yes - pack .sim.bottom -fill x - if { [info exists simconf_default_geometry]} { - wm geometry .sim "${simconf_default_geometry}" - } - - bind .sim.topf.f {simconf_yview} - bind .sim { - set simconf_default_geometry [wm geometry .sim] - } - bind .sim { simconf_yview scroll -0.2} - bind .sim { simconf_yview scroll 0.2} - simconf_yview place - set maxsize [expr {[winfo height .sim.topf.f.scrl] + [winfo height .sim.bottom]}] - wm maxsize .sim 9999 $maxsize - # tkwait window .sim -} - -proc simconf_add {tool} { - global sim - set n $sim($tool,n) - set sim($tool,$n,cmd) {} - set sim($tool,$n,name) {} - set sim($tool,$n,fg) 0 - set sim($tool,$n,st) 0 - incr sim($tool,n) -} - -proc bespice_getdata {sock} { - global bespice_server_getdata - if {[eof $sock] || [catch {gets $sock bespice_server_getdata(line,$sock)}]} { - close $sock - puts "Close $bespice_server_getdata(addr,$sock)" - unset bespice_server_getdata(addr,$sock) - unset bespice_server_getdata(line,$sock) - unset bespice_server_getdata(sock) - } else { - puts "bespice --> $bespice_server_getdata(line,$sock)" - } -} - -proc xschem_getdata {sock} { - global xschem_server_getdata - if {[eof $sock] || [catch {gets $sock xschem_server_getdata(line,$sock)}]} { - close $sock - puts "Close $xschem_server_getdata(addr,$sock)" - unset xschem_server_getdata(addr,$sock) - unset xschem_server_getdata(line,$sock) - unset xschem_server_getdata(res,$sock) - } else { - puts "tcp--> $xschem_server_getdata(line,$sock)" - # xschem command must be executed at global scope... - uplevel #0 [list catch $xschem_server_getdata(line,$sock) xschem_server_getdata(res,$sock)] - puts $sock "$xschem_server_getdata(res,$sock)" - } -} - -proc bespice_server {sock addr port} { - global bespice_server_getdata - if { ![info exists bespice_server_getdata(sock)] } { - puts "Accept $sock from $addr port $port" - fconfigure $sock -buffering line - set bespice_server_getdata(addr,$sock) [list $addr $port] - set bespice_server_getdata(sock) [list $sock] - fileevent $sock readable [list bespice_getdata $sock] - } -} - - -proc xschem_server {sock addr port} { - global xschem_server_getdata - puts "Accept $sock from $addr port $port" - fconfigure $sock -buffering line - set xschem_server_getdata(addr,$sock) [list $addr $port] - fileevent $sock readable [list xschem_getdata $sock] -} - -## given a path (x1.x2.m4) descend into x1.x2 and return m4 whether m4 found or not -proc descend_hierarchy {path {redraw 1}} { - xschem set no_draw 1 - # return to top level if not already there - while { [xschem get currsch] } { xschem go_back } - # recursively descend into sub-schematics - while { [regexp {\.} $path] } { - xschem unselect_all - set inst $path - regsub {\..*} $inst {} inst ;# take 1st path component: xlev1[3].xlev2.m3 -> xlev1[3] - regsub {[^.]+\.} $path {} path ;# take remaining path: xlev1[3].xlev2.m3 -> xlev2.m3 - xschem search exact 1 name $inst - # handle vector instances: xlev1[3:0] -> xlev1[3],xlev1[2],xlev1[1],xlev1[0] - # descend into the right one - set inst_list [split [lindex [xschem expandlabel [lindex [xschem selected_set] 0 ] ] 0] {,}] - set instnum [expr {[lsearch -exact $inst_list $inst] + 1}] - xschem descend $instnum - } - xschem set no_draw 0 - if {$redraw} {xschem redraw} - return $path -} - -## given a hierarchical instname name (x1.xamp.m1) go down in the hierarchy and -## select the specified instance (m1). -## this search assumes it is given from the top of hierarchy -proc select_inst {fullinst {redraw 1 } } { - xschem set no_draw 1 - set inst [descend_hierarchy $fullinst 0] - set res [xschem select instance $inst] - # if nothing found return to top - if {!$res} { - while { [xschem get currsch] } { xschem go_back } - } - xschem set no_draw 0 - if {$redraw} {xschem redraw} - if {$res} {return $inst} else { return {} } -} - -proc pin_label {} { - if { [file exists [abs_sym_path devices/lab_pin.sym]] } { - return {devices/lab_pin.sym} - } - return {lab_pin.sym} -} - -## given a hierarchical net name x1.xamp.netname go down in the hierarchy and -## highlight the specified net. -## this search assumes it is given from the top of hierarchy -proc probe_net {fullnet {redraw 1} } { - xschem set no_draw 1 - set net [descend_hierarchy $fullnet 0] - set res [xschem hilight_netname $net] - if {$res==0 && [regexp {^net[0-9]+$} $net]} { - set net \#$net - set res [xschem hilight_netname $net] - } - if {!$res} { - while { [xschem get currsch] } { xschem go_back } - } - xschem set no_draw 0 - if {$redraw} {xschem redraw} - if {$res} {return $net} else { return {} } -} - -# backannotate newnet to be connected to specified hierarchical instance name and pin. -# places a label close to the instance pin to be re-routed. -# actual reconnect is human assisted! -proc reroute_inst {fullinst pinattr pinval newnet} { - if { [regexp {\.} $fullinst] } { set hier 1 } else { set hier 0 } - set res [descend_hierarchy $fullinst 0] - if {$res ne {} } { - set coord [xschem instance_pin_coord $res $pinattr $pinval] - if { $coord eq {} } { - while { [xschem get currsch] } { xschem go_back } - return 0 - } - set pinname [lindex $coord 0] - set x [expr {[lindex $coord 1] - 10} ] - set y [expr {[lindex $coord 2] - 10} ] - set oldnet [xschem instance_net $res $pinname] - - regsub {.*\.} $newnet {} newnet - if { $oldnet eq $newnet } { - while { [xschem get currsch] } { xschem go_back } - puts "Warning: netlist patch already done? " - return 0 - } - - xschem instance [pin_label] $x $y 0 0 [list name=l1 lab=$newnet] - xschem hilight_netname $newnet - xschem select instance $res - xschem hilight_netname $oldnet - if {$hier} { xschem save} ;# save so we can process other reroute_inst without beink asked to save. - xschem redraw - return 1 - } - return 0 -} - -## put $new net labels close to pins on all elements connected to $old -proc reroute_net {old new} { - xschem push_undo - xschem set no_undo 1 - xschem unhilight - probe_net $old - set old_nopath [regsub {.*\.} $old {}] - set new_nopath [regsub {.*\.} $new {}] - set devlist [xschem instances_to_net $old_nopath] - foreach i $devlist { - set instname [lindex $i 0] - set x [expr {[lindex $i 2] - 10}] - set y [expr {[lindex $i 3] - 10}] - xschem instance [pin_label] $x $y 0 0 [list name=l1 lab=$new_nopath] - xschem select instance $instname - } - xschem hilight_netname $new_nopath - xschem set no_undo 0 -} - -proc simulate {{callback {}}} { - ## $N : netlist file full path (/home/schippes/simulations/opamp.spice) - ## $n : netlist file full path with extension chopped (/home/schippes/simulations/opamp) - ## $s : schematic name (opamp) - ## $S : schematic name full path (/home/schippes/.xschem/xschem_library/opamp.sch) - ## $d : netlist directory - - global netlist_dir netlist_type computerfarm terminal sim - global execute_callback XSCHEM_SHAREDIR has_x - - simuldir - set_sim_defaults - if { [select_netlist_dir 0] ne {}} { - set d ${netlist_dir} - set tool $netlist_type - set S [xschem get schname] - set s [file tail [file rootname $S]] - set n ${netlist_dir}/${s} - if {$tool eq {verilog}} { - set N ${n}.v - } else { - set N ${n}.${tool} - } - if { ![info exists sim($tool,default)] } { - if { $has_x} {alert_ "Warning: simulator for $tool is not configured"} - puts "Warning: simulator for $tool is not configured" - return - } - set def $sim($tool,default) - set fg $sim($tool,$def,fg) - set st $sim($tool,$def,st) - if {$fg} { - set fg {execute_wait} - } else { - set fg {execute} - } - set cmd [subst $sim($tool,$def,cmd)] - if {$::OS == "Windows"} { - # $cmd cannot be surrounded by {} as exec will change forward slash to backward slash - eval exec $cmd - } else { - set id [$fg $st sh -c "cd $netlist_dir; $cmd"] - set execute_callback($id) $callback - if {$fg eq {execute_wait}} { - eval $execute_callback($id); unset execute_callback($id) - } - } - } -} - -proc gaw_echoline {} { - global gaw_fd - gets $gaw_fd line - if {[eof $gaw_fd]} { - puts "finishing connection from gaw" - close $gaw_fd - unset gaw_fd - } else { - # generate a variable event we can vwait for - set gaw_fd $gaw_fd - } - puts "gaw -> $line" -} - -proc gaw_setup_tcp {} { - global gaw_fd gaw_tcp_address netlist_dir has_x - - simuldir - set s [file tail [file rootname [xschem get schname 0]]] - - if { ![info exists gaw_fd] && [catch {eval socket $gaw_tcp_address} gaw_fd] } { - puts "Problems opening socket to gaw on address $gaw_tcp_address" - unset gaw_fd - if {[info exists has_x]} { - tk_messageBox -type ok -title {Tcp socket error} \ - -message [concat "Problems opening socket to gaw on address $gaw_tcp_address. " \ - "Ensure the following line is present uncommented in ~/.gaw/gawrc: up_listenPort = 2020." \ - "If you recently closed gaw the port may be in a TIME_WAIT state for a minute or so ." \ - "Close gaw, Wait a minute or two, then send waves to gaw again."] - } - return - } - chan configure $gaw_fd -blocking 1 -buffering line -encoding binary -translation binary - fileevent $gaw_fd readable gaw_echoline - puts $gaw_fd "table_set $s.raw" -} - -proc gaw_cmd {cmd} { - global gaw_fd gaw_tcp_address netlist_dir has_x - - simuldir - if { ![info exists gaw_fd] && [catch {eval socket $gaw_tcp_address} gaw_fd] } { - puts "Problems opening socket to gaw on address $gaw_tcp_address" - unset gaw_fd - if {[info exists has_x]} { - tk_messageBox -type ok -title {Tcp socket error} \ - -message [concat "Problems opening socket to gaw on address $gaw_tcp_address. " \ - "If you recently closed gaw the port may be in a TIME_WAIT state for a minute or so ." \ - "Close gaw, Wait a minute or two, then send waves to gaw again."] - } - return - } - chan configure $gaw_fd -blocking 0 -buffering line -encoding binary -translation binary - puts $gaw_fd "$cmd" - set n [regexp -all \n $cmd] - incr n - puts "gaw command lines: $n" - fileevent $gaw_fd readable gaw_echoline - while { $n} { - #timeout for abnormal deadlocks - set wd [after 10000 set gaw_fd stalled] - vwait gaw_fd - if { $gaw_fd ne {stalled} } { - after cancel $wd - } else { - puts "timeout waiting for gaw response.." - break - } - incr n -1 - } - close $gaw_fd - unset gaw_fd -} - -proc waves {} { - ## $N : netlist file full path (/home/schippes/simulations/opamp.spice) - ## $n : netlist file full path with extension chopped (/home/schippes/simulations/opamp) - ## $s : schematic name (opamp) - ## $S : schematic name full path (/home/schippes/.xschem/xschem_library/opamp.sch) - ## $d : netlist directory - - global netlist_dir netlist_type computerfarm terminal sim XSCHEM_SHAREDIR has_x - global bespice_listen_port env - - simuldir - set_sim_defaults - if { [select_netlist_dir 0] ne {}} { - set d ${netlist_dir} - set tool ${netlist_type} - set S [xschem get schname] - set s [file tail [file rootname $S]] - set n ${netlist_dir}/${s} - if {$tool eq {verilog}} { - set N ${n}.v - } else { - set N ${n}.${tool} - } - set tool ${tool}wave - if { ![info exists sim($tool,default)] } { - if { $has_x} {alert_ "Warning: viewer for $tool is not configured"} - puts "Warning: viewer for $tool is not configured" - return - } - set def $sim($tool,default) - set fg $sim($tool,$def,fg) - set st $sim($tool,$def,st) - if {$fg} { - set fg {execute_wait} - } else { - set fg {execute} - } - set cmd [subst $sim($tool,$def,cmd)] - $fg $st sh -c "cd $netlist_dir; $cmd" - } -} -# ============================================================ - -proc utile_translate {schname} { - global netlist_dir netlist_type debug_var XSCHEM_SHAREDIR - global utile_gui_path utile_cmd_path - - simuldir - set tmpname [file rootname "$schname"] - eval exec {sh -c "cd \"$netlist_dir\"; \ - XSCHEM_SHAREDIR=\"$XSCHEM_SHAREDIR\" \"$utile_cmd_path\" stimuli.$tmpname"} -} - -proc utile_gui {schname} { - global netlist_dir netlist_type debug_var XSCHEM_SHAREDIR - global utile_gui_path utile_cmd_path - - simuldir - set tmpname [file rootname "$schname"] - eval exec {sh -c "cd \"$netlist_dir\"; \ - XSCHEM_SHAREDIR=\"$XSCHEM_SHAREDIR\" \"$utile_gui_path\" stimuli.$tmpname"} & -} - -proc utile_edit {schname} { - global netlist_dir netlist_type debug_var editor XSCHEM_SHAREDIR - global utile_gui_path utile_cmd_path - - simuldir - set tmpname [file rootname "$schname"] - execute 0 sh -c "cd \"$netlist_dir\" && $editor stimuli.$tmpname && \ - XSCHEM_SHAREDIR=\"$XSCHEM_SHAREDIR\" \"$utile_cmd_path\" stimuli.$tmpname" -} - -proc get_shell { curpath } { - global netlist_dir netlist_type debug_var - global terminal - - simuldir - execute 0 sh -c "cd $curpath && $terminal" -} - -proc edit_netlist {schname } { - global netlist_dir netlist_type debug_var - global editor terminal - - simuldir - set tmpname [file rootname "$schname"] - - if { [regexp vim $editor] } { set ftype "-c \":set filetype=$netlist_type\"" } else { set ftype {} } - if { [select_netlist_dir 0] ne "" } { - # puts "edit_netlist: \"$editor $ftype ${schname}.v\" \"$netlist_dir\" bg" - if { $netlist_type=="verilog" } { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.v\"" - } elseif { $netlist_type=="spice" } { - if {$::OS == "Windows"} { - set cmd "$editor \"$netlist_dir/${tmpname}.spice\"" - eval exec $cmd - } else { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.spice\"" - } - } elseif { $netlist_type=="tedax" } { - if {$::OS == "Windows"} { - set cmd "$editor \"$netlist_dir/${tmpname}.tdx\"" - eval exec $cmd - } else { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.tdx\"" - } - } elseif { $netlist_type=="vhdl" } { - if {$::OS == "Windows"} { - set cmd "$editor \"$netlist_dir/${tmpname}.vhdl\"" - eval exec $cmd - } else { - execute 0 sh -c "cd $netlist_dir && $editor $ftype \"${tmpname}.vhdl\"" - } - } - } - return {} -} - - -# 20180926 -# global_initdir should be set to: -# INITIALLOADDIR for load -# INITIALINSTDIR for instance placement -# ext: .sch or .sym or .sch.sym or .sym.sch -# -proc save_file_dialog { msg ext global_initdir {initialfile {}} {overwrt 1} } { - upvar #0 $global_initdir initdir - set temp $initdir - if { $initialfile ne {}} { - set initialdir [file dirname $initialfile] - set initialfile [file tail $initialfile] - } else { - set initialdir $initdir - set initialfile {} - } - set initdir $initialdir - - set r [load_file_dialog $msg $ext $global_initdir $initialfile 0 $overwrt] - - - set initdir $temp - return $r -} - -proc is_xschem_file {f} { - set a [catch {open "$f" r} fd] - set ret 0 - set score 0 - set instances 0 - if {$a} { - puts stderr "Can not open file $f" - } else { - while { [gets $fd line] >=0 } { - if { [regexp {^[TKGVSE] \{} $line] } { incr score } - if { [regexp {^[BL] +[0-9]+ +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +\{} $line] } {incr score} - if { [regexp {^N +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +[-0-9.eE]+ +\{} $line] } {incr score} - if { [regexp {^C +\{[^{}]+\} +[-0-9.eE]+ +[-0-9.eE]+ +[0-3]+ +[0-3]+ +\{} $line] } {incr instances; incr score} - if { [regexp "^v\[ \t\]+\{xschem\[ \t\]+version\[ \t\]*=.*\[ \t\]+file_version\[ \t\]*=" $line] } { - set ret 1 - } - } - if { $score > 6 } { set ret 1} ;# Heuristic decision :-) - if { $ret } { - if { $instances} { - set ret SCHEMATIC - } else { - set ret SYMBOL - } - } - close $fd - } - # puts "score=$score" - return $ret -} - -proc list_dirs {pathlist } { - global list_dirs_selected_dir INITIALINSTDIR - toplevel .list -class dialog - wm title .list {Select Library:} - wm protocol .list WM_DELETE_WINDOW { set list_dirs_selected_dir {} } - set X [expr {[winfo pointerx .list] - 30}] - set Y [expr {[winfo pointery .list] - 25}] - if { $::wm_fix } { tkwait visibility .list } - wm geometry .list "+$X+$Y" - - set x 0 - set dir {} - label .list.title \ - -text "Choose path to start from. You can navigate anywhere\n with the file selector from there \n" \ - -background {#77dddd} - pack .list.title -fill x -side top - foreach elem $pathlist { - frame .list.${x} - label .list.${x}.l -text [expr {$x+1}] -width 4 - button .list.${x}.b -text $elem -command "set list_dirs_selected_dir $elem" - pack .list.${x}.l -side left - pack .list.${x}.b -side left -fill x -expand yes - pack .list.${x} -side top -fill x - incr x - } - frame .list.${x} - label .list.${x}.l -text [expr {$x+1}] -width 4 - button .list.${x}.b -text {Last used dir} -command "set list_dirs_selected_dir $INITIALINSTDIR" - pack .list.${x}.l -side left - pack .list.${x}.b -side left -fill x -expand yes - pack .list.${x} -side top -fill x - frame .list.but - button .list.but.cancel -text Cancel -command {set list_dirs_selected_dir {} } - - pack .list.but.cancel -side bottom - pack .list.but -fill x -side top - vwait list_dirs_selected_dir - destroy .list - return $list_dirs_selected_dir -} - - -proc myload_set_colors1 {} { - global myload_files1 dircolor - for {set i 0} { $i< [.dialog.l.paneleft.list index end] } { incr i} { - set name "[lindex $myload_files1 $i]" - .dialog.l.paneleft.list itemconfigure $i -foreground black -selectforeground black - foreach j [array names dircolor] { - set pattern $j - set color $dircolor($j) - if { [regexp $pattern $name] } { - .dialog.l.paneleft.list itemconfigure $i -foreground $color -selectforeground $color - } - } - } -} - -proc myload_set_colors2 {} { - global myload_index1 myload_files2 dircolor - set dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - for {set i 0} { $i< [.dialog.l.paneright.list index end] } { incr i} { - set name "$dir1/[lindex $myload_files2 $i]" - if {[ file isdirectory $name]} { - .dialog.l.paneright.list itemconfigure $i -foreground blue - foreach j [array names dircolor] { - set pattern $j - set color $dircolor($j) - if { [regexp $pattern $name] } { - .dialog.l.paneright.list itemconfigure $i -foreground $color -selectforeground $color - } - } - - } else { - .dialog.l.paneright.list itemconfigure $i -foreground black - } - } -} - -proc myload_set_home {dir} { - global pathlist myload_files1 myload_index1 - - set curr_dirname [xschem get current_dirname] - .dialog.l.paneleft.list selection clear 0 end - if { $dir eq {.}} { set dir $curr_dirname} - # puts "set home: dir=$dir, pathlist=$pathlist" - set pl {} - foreach path_elem $pathlist { - if { ![string compare $path_elem .]} { - set path_elem $curr_dirname - } - lappend pl $path_elem - } - set i [lsearch -exact $pl $dir] - if { $i>=0 } { - set myload_files1 $pathlist - update - myload_set_colors1 - .dialog.l.paneleft.list xview moveto 1 - set myload_index1 $i - .dialog.l.paneleft.list selection set $myload_index1 - } else { - set myload_files1 [list $dir] - update - myload_set_colors1 - .dialog.l.paneleft.list xview moveto 1 - set myload_index1 0 - .dialog.l.paneleft.list selection set 0 - } -} - -proc setglob {dir} { - global globfilter myload_files2 - set myload_files2 [lsort [glob -nocomplain -directory $dir -tails -type d .* *]] - if { $globfilter eq {*}} { - set myload_files2 ${myload_files2}\ [lsort [glob -nocomplain -directory $dir -tails -type {f} .* $globfilter]] - } else { - set myload_files2 ${myload_files2}\ [lsort [glob -nocomplain -directory $dir -tails -type {f} $globfilter]] - } -} - -proc load_file_dialog_mkdir {dir} { - global myload_dir1 - if { $dir ne {} } { - file mkdir "${myload_dir1}/$dir" - setglob ${myload_dir1} - myload_set_colors2 - } -} - -proc load_file_dialog {{msg {}} {ext {}} {global_initdir {INITIALINSTDIR}} {initialfile {}} - {loadfile {1}} {confirm_overwrt {1}}} { - global myload_index1 myload_files2 myload_files1 myload_retval myload_dir1 pathlist - global myload_default_geometry myload_sash_pos myload_yview tcl_version globfilter myload_dirs2 - # return value - set myload_retval {} - upvar #0 $global_initdir initdir - if { [winfo exists .dialog] } return - toplevel .dialog -class dialog - wm title .dialog $msg - set_ne myload_index1 0 - if { ![info exists myload_files1]} { - set myload_files1 $pathlist - set myload_index1 0 - } - set_ne myload_files2 {} - - - panedwindow .dialog.l -orient horizontal - - frame .dialog.l.paneleft - if {$tcl_version > 8.5} { set just {-justify right}} else {set just {}} - eval [subst {listbox .dialog.l.paneleft.list -listvariable myload_files1 -width 20 -height 12 $just \ - -yscrollcommand ".dialog.l.paneleft.yscroll set" -selectmode browse \ - -xscrollcommand ".dialog.l.paneleft.xscroll set" -exportselection 0}] - myload_set_colors1 - scrollbar .dialog.l.paneleft.yscroll -command ".dialog.l.paneleft.list yview" - scrollbar .dialog.l.paneleft.xscroll -command ".dialog.l.paneleft.list xview" -orient horiz - pack .dialog.l.paneleft.yscroll -side right -fill y - pack .dialog.l.paneleft.xscroll -side bottom -fill x - pack .dialog.l.paneleft.list -fill both -expand true - bind .dialog.l.paneleft.list <> { - # bind .dialog.l.paneright.pre {} - # .dialog.l.paneright.pre configure -background white - set myload_sel [.dialog.l.paneleft.list curselection] - if { $myload_sel ne {} } { - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_sel]] - set myload_index1 $myload_sel - setglob $myload_dir1 - myload_set_colors2 - } - } - - frame .dialog.l.paneright - frame .dialog.l.paneright.pre -background white -width 200 -height 200 - listbox .dialog.l.paneright.list -listvariable myload_files2 -width 20 -height 12\ - -yscrollcommand ".dialog.l.paneright.yscroll set" -selectmode browswe \ - -xscrollcommand ".dialog.l.paneright.xscroll set" -exportselection 0 - scrollbar .dialog.l.paneright.yscroll -command ".dialog.l.paneright.list yview" - scrollbar .dialog.l.paneright.xscroll -command ".dialog.l.paneright.list xview" -orient horiz - pack .dialog.l.paneright.pre -side bottom -anchor s -fill x - pack .dialog.l.paneright.yscroll -side right -fill y - pack .dialog.l.paneright.xscroll -side bottom -fill x - pack .dialog.l.paneright.list -side bottom -fill both -expand true - - .dialog.l add .dialog.l.paneleft -minsize 40 - .dialog.l add .dialog.l.paneright -minsize 40 - # .dialog.l paneconfigure .dialog.l.paneleft -stretch always - # .dialog.l paneconfigure .dialog.l.paneright -stretch always - frame .dialog.buttons - frame .dialog.buttons_bot - button .dialog.buttons_bot.ok -width 5 -text OK \ - -command { set myload_retval [.dialog.buttons_bot.entry get]; destroy .dialog} - button .dialog.buttons_bot.cancel -width 5 -text Cancel -command {set myload_retval {}; destroy .dialog} - button .dialog.buttons.home -width 5 -text {Home} -command { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - set myload_files1 $pathlist - update - myload_set_colors1 - .dialog.l.paneleft.list xview moveto 1 - set myload_index1 0 - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - setglob $myload_dir1 - myload_set_colors2 - .dialog.l.paneleft.list selection clear 0 end - .dialog.l.paneright.list selection clear 0 end - .dialog.l.paneleft.list selection set $myload_index1 - } - label .dialog.buttons_bot.label -text {File:} - entry .dialog.buttons_bot.entry - if { $initialfile ne {} } { - .dialog.buttons_bot.entry insert 0 $initialfile - } - radiobutton .dialog.buttons_bot.all -text All -variable globfilter -value {*} \ - -command { setglob $myload_dir1 } - radiobutton .dialog.buttons_bot.sym -text .sym -variable globfilter -value {*.sym} \ - -command { setglob $myload_dir1 } - radiobutton .dialog.buttons_bot.sch -text .sch -variable globfilter -value {*.sch} \ - -command { setglob $myload_dir1 } - button .dialog.buttons.up -width 5 -text Up -command { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - set d [file dirname $myload_dir1] - if { [file isdirectory $d]} { - myload_set_home $d - setglob $d - myload_set_colors2 - set myload_dir1 $d - } - } - label .dialog.buttons.mkdirlab -text { New dir: } - entry .dialog.buttons.newdir -width 16 - button .dialog.buttons.mkdir -width 5 -text Create -command { - load_file_dialog_mkdir [.dialog.buttons.newdir get] - } - button .dialog.buttons.rmdir -width 5 -text Delete -command { - if { [.dialog.buttons.newdir get] ne {} } { - file delete "${myload_dir1}/[.dialog.buttons.newdir get]" - setglob ${myload_dir1} - myload_set_colors2 - } - } - button .dialog.buttons.pwd -text {Current file dir} -command { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - set d [xschem get current_dirname] - if { [file isdirectory $d]} { - myload_set_home $d - setglob $d - myload_set_colors2 - set myload_dir1 $d - } - } - pack .dialog.buttons.home .dialog.buttons.up .dialog.buttons.pwd -side left - pack .dialog.buttons.mkdirlab -side left - pack .dialog.buttons.newdir -expand true -fill x -side left - pack .dialog.buttons.rmdir .dialog.buttons.mkdir -side right - pack .dialog.buttons_bot.ok .dialog.buttons_bot.cancel .dialog.buttons_bot.label -side left - pack .dialog.buttons_bot.entry -side left -fill x -expand true - pack .dialog.buttons_bot.all .dialog.buttons_bot.sym .dialog.buttons_bot.sch -side left - pack .dialog.l -expand true -fill both - pack .dialog.buttons -side top -fill x - pack .dialog.buttons_bot -side top -fill x - if { [info exists myload_default_geometry]} { - wm geometry .dialog "${myload_default_geometry}" - } - myload_set_home $initdir - bind .dialog { - set myload_retval [.dialog.buttons_bot.entry get] - if {$myload_retval ne {} } { - destroy .dialog - } - } - bind .dialog.l.paneright.list { - set myload_retval [.dialog.buttons_bot.entry get] - if {$myload_retval ne {} && ![file isdirectory "$myload_dir1/[.dialog.l.paneright.list get $myload_sel]"]} { - bind .dialog.l.paneright.pre {} - destroy .dialog - } - } - bind .dialog { set myload_retval {}; destroy .dialog} - - ### update - if { [ info exists myload_sash_pos] } { - eval .dialog.l sash mark 0 [.dialog.l sash coord 0] - eval .dialog.l sash dragto 0 [subst $myload_sash_pos] - } - ### update - .dialog.l.paneleft.list xview moveto 1 - bind .dialog { - set myload_sash_pos [.dialog.l sash coord 0] - set myload_default_geometry [wm geometry .dialog] - .dialog.l.paneleft.list xview moveto 1 - # regsub {\+.*} $myload_default_geometry {} myload_default_geometry - } - - bind .dialog.l.paneright.yscroll { - set myload_yview [.dialog.l.paneright.list yview] - } - - xschem preview_window create .dialog.l.paneright.pre {} - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - setglob $myload_dir1 - myload_set_colors2 - - bind .dialog.l.paneright.list { - set myload_yview [.dialog.l.paneright.list yview] - } - bind .dialog.l.paneright.list <> { - set myload_yview [.dialog.l.paneright.list yview] - set myload_sel [.dialog.l.paneright.list curselection] - if { $myload_sel ne {} } { - set myload_dir1 [abs_sym_path [.dialog.l.paneleft.list get $myload_index1]] - set myload_dir2 [.dialog.l.paneright.list get $myload_sel] - if {$myload_dir2 eq {..}} { - set myload_d [file dirname $myload_dir1] - } elseif { $myload_dir2 eq {.} } { - set myload_d $myload_dir1 - } else { - if {$::OS == "Windows"} { - if {[regexp {^[A-Za-z]\:/$} $myload_dir1]} { - set myload_d "$myload_dir1$myload_dir2" - } else { - set myload_d "$myload_dir1/$myload_dir2" - } - } else { - if {$myload_dir1 eq "/"} { - set myload_d "$myload_dir1$myload_dir2" - } else { - set myload_d "$myload_dir1/$myload_dir2" - } - } - } - if { [file isdirectory $myload_d]} { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - myload_set_home $myload_d - setglob $myload_d - myload_set_colors2 - set myload_dir1 $myload_d - # .dialog.buttons_bot.entry delete 0 end - } else { - .dialog.buttons_bot.entry delete 0 end - .dialog.buttons_bot.entry insert 0 $myload_dir2 - set t [is_xschem_file $myload_dir1/$myload_dir2] - if { $t ne {0} } { - ### update - if { [winfo exists .dialog] } { - .dialog.l.paneright.pre configure -background {} - xschem preview_window draw .dialog.l.paneright.pre "$myload_dir1/$myload_dir2" - bind .dialog.l.paneright.pre { - xschem preview_window draw .dialog.l.paneright.pre "$myload_dir1/$myload_dir2" - } - } - } else { - bind .dialog.l.paneright.pre {} - .dialog.l.paneright.pre configure -background white - } - # puts "xschem preview_window draw .dialog.l.paneright.pre \"$myload_dir1/$myload_dir2\"" - } - } - } - if { [ info exists myload_yview]} { - .dialog.l.paneright.list yview moveto [lindex $myload_yview 0] - } - tkwait window .dialog - xschem preview_window destroy {} {} - set initdir "$myload_dir1" - if { $myload_retval ne {}} { - if {![file exists "$myload_dir1/$myload_retval"] } { - return "$myload_dir1/$myload_retval" - } - if { $loadfile == 0 } { - if {[file exists "$myload_dir1/$myload_retval"]} { - if {$confirm_overwrt == 1 } { - set answer [tk_messageBox -message "Overwrite $myload_dir1/${myload_retval}?" \ - -icon warning -parent . -type okcancel] - } else { - set answer ok - } - if {$answer eq {ok}} { - return "$myload_dir1/$myload_retval" - } else { - return {} - } - } - } - set t [is_xschem_file "$myload_dir1/$myload_retval"] - if { $t eq {0} } { - set answer [ - tk_messageBox -message "$myload_dir1/$myload_retval does not seem to be an xschem file...\nContinue?" \ - -icon warning -parent . -type yesno] - if { $answer eq "no"} { - set myload_retval {} - return {} - } else { - return "$myload_dir1/$myload_retval" - } - } elseif { $t ne {SYMBOL} && ($ext eq {.sym}) } { - set answer [ - tk_messageBox -message "$myload_dir1/$myload_retval does not seem to be a SYMBOL file...\nContinue?" \ - -icon warning -parent . -type yesno] - if { $answer eq "no"} { - set myload_retval {} - return {} - } else { - return "$myload_dir1/$myload_retval" - } - } else { - return "$myload_dir1/$myload_retval" - } - } else { - return {} - } -} - -# get last n path components: example , n=1 --> /aaa/bbb/ccc/ddd.sch -> ccc/ddd.sch -proc get_cell {s n } { - set slist [file split $s] - set l [llength $slist] - if { $n >= $l } {set n [expr {$l - 1}]} - set p {} - for {set i [expr {$l-1-$n}]} {$i < $l} { incr i } { - append p [lindex $slist $i] - if {$i < $l - 1} { - append p {/} - } - } - return $p -} - -# chop last n path components from s -proc path_head {s n } { - set slist [file split $s] - set l [llength $slist] - if { $n < 0 } { set n 0 } - set p {} - for {set i 0} {$i < [expr {$l - $n}]} { incr i } { - append p [lindex $slist $i] - if {$i < $l -$n- 1 && ([lindex $slist $i] ne {/})} { - append p {/} - } - } - return $p -} - - -proc delete_files { dir } { - if { [ info tclversion] >=8.4} { - set x [tk_getOpenFile -title "DELETE FILES" -multiple 1 -initialdir [file dirname $dir] ] - } else { - set x [tk_getOpenFile -title "DELETE FILES" -initialdir [file dirname $dir] ] - } - foreach i $x { - file delete $i - } -} - -proc create_pins {} { - global env retval USER_CONF_DIR - global filetmp - - set retval [ read_data_nonewline $filetmp ] - regsub -all {<} $retval {[} retval - regsub -all {>} $retval {]} retval - set lines [split $retval \n] - if { [file exists [abs_sym_path devices/ipin.sym]] } { - set indirect 1 - } else { - set indirect 0 - } - # viewdata $retval - set pcnt 0 - set y 0 - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - if {$indirect} { - puts $fd "C \{[rel_sym_path devices/[lindex $i 1].sym]\} 0 [set y [expr {$y-20}]] \ - 0 0 \{ name=p[incr pcnt] lab=[lindex $i 0] \}" - } else { - puts $fd "C \{[rel_sym_path [lindex $i 1].sym]\} 0 [set y [expr {$y-20}]] \ - 0 0 \{ name=p[incr pcnt] lab=[lindex $i 0] \}" - } - } - close $fd - xschem merge $USER_CONF_DIR/.clipboard.sch -} - -proc rectorder {x1 y1 x2 y2} { - if {$x2 < $x1} {set tmp $x1; set x1 $x2; set x2 $tmp} - if {$y2 < $y1} {set tmp $y1; set y1 $y2; set y2 $tmp} - return [list $x1 $y1 $x2 $y2] -} - -proc order {x1 y1 x2 y2} { - if {$x2 < $x1} {set tmp $x1; set x1 $x2; set x2 $tmp; set tmp $y1; set y1 $y2; set y2 $tmp - } elseif {$x2==$x1 && $y2<$y1} {set tmp $y1; set y1 $y2; set y2 $tmp} - return [list $x1 $y1 $x2 $y2] -} - -proc rotation {x0 y0 x y rot flip} { - set tmp [expr {$flip? 2*$x0-$x : $x}] - if {$rot==0} {set rx $tmp; set ry $y } - if {$rot==1} {set rx [expr {$x0 - $y +$y0}]; set ry [expr {$y0+$tmp-$x0}]} - if {$rot==2} {set rx [expr {2*$x0-$tmp}]; set ry [expr {2*$y0-$y}]} - if {$rot==3} {set rx [expr {$x0+$y-$y0}]; set ry [expr {$y0-$tmp+$x0}]} - return [list $rx $ry] -} - -proc schpins_to_sympins {} { - global env USER_CONF_DIR - set pinhsize 2.5 - set first 1 - xschem copy - set clipboard [read_data_nonewline $USER_CONF_DIR/.clipboard.sch] - set lines [split $clipboard \n] - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - set ii [split [regexp -all -inline {\S+} $i]] - if {[regexp {^C \{.*(i|o|io)pin} $i ]} { - if {[regexp {ipin} [lindex $ii 1]]} { set dir in } - if {[regexp {opin} [lindex $ii 1]]} { set dir out } - if {[regexp {iopin} [lindex $ii 1]]} { set dir inout } - set rot [lindex $ii 4] - set flip [lindex $ii 5] - while {1} { - if { [regexp {lab=} $i] } { - regsub {^.*lab=} $i {} lab - regsub {[\} ].*} $lab {} lab - } - if { [regexp {\}} $i]} { break} - } - set x0 [lindex $ii 2] - set y0 [lindex $ii 3] - if {$first} { - puts $fd "G { $x0 $y0 } " - set first 0 - } - set pinx1 [expr {$x0-$pinhsize}] - set pinx2 [expr {$x0+$pinhsize}] - set piny1 [expr {$y0-$pinhsize}] - set piny2 [expr {$y0+$pinhsize}] - if {![string compare $dir "out"] || ![string compare $dir "inout"] } { - set linex1 [expr {$x0-20}] - set liney1 $y0 - set linex2 $x0 - set liney2 $y0 - set textx0 [expr {$x0-25}] - set texty0 [expr {$y0-4}] - set textflip [expr {!$flip}] - } else { - set linex1 [expr {$x0+20}] - set liney1 $y0 - set linex2 $x0 - set liney2 $y0 - set textx0 [expr {$x0+25}] - set texty0 [expr {$y0-4}] - set textflip [expr {$flip}] - } - lassign [rotation $x0 $y0 $linex1 $liney1 $rot $flip] linex1 liney1 - lassign [rotation $x0 $y0 $linex2 $liney2 $rot $flip] linex2 liney2 - lassign [order $linex1 $liney1 $linex2 $liney2] linex1 liney1 linex2 liney2 - lassign [rotation $x0 $y0 $textx0 $texty0 $rot $flip] textx0 texty0 - puts $fd "B 5 $pinx1 $piny1 $pinx2 $piny2 \{name=$lab dir=$dir\}" - puts $fd "L 4 $linex1 $liney1 $linex2 $liney2 \{\}" - puts $fd "T \{$lab\} $textx0 $texty0 $rot $textflip 0.2 0.2 \{\}" - } - } - close $fd - xschem paste -} - - -proc add_lab_no_prefix {} { - global env retval USER_CONF_DIR - global filetmp - - if { [file exists [abs_sym_path devices/ipin.sym]] } { - set indirect 1 - } else { - set indirect 0 - } - set retval [ read_data_nonewline $filetmp ] - regsub -all {<} $retval {[} retval - regsub -all {>} $retval {]} retval - set lines [split $retval \n] - # viewdata $retval - set pcnt 0 - set y 0 - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - if {$indirect} { - puts $fd "C \{devices/lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=wire lab=[lindex $i 0] \}" - } else { - puts $fd "C \{lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=wire lab=[lindex $i 0] \}" - } - } - close $fd - xschem merge $USER_CONF_DIR/.clipboard.sch -} - -proc add_lab_prefix {} { - global env retval USER_CONF_DIR - global filetmp - - if { [file exists [abs_sym_path devices/ipin.sym]] } { - set indirect 1 - } else { - set indirect 0 - } - set retval [ read_data_nonewline $filetmp ] - regsub -all {<} $retval {[} retval - regsub -all {>} $retval {]} retval - set lines [split $retval \n] - # viewdata $retval - set pcnt 0 - set y 0 - set fd [open $USER_CONF_DIR/.clipboard.sch "w"] - foreach i $lines { - if {$indirect} { - puts $fd "C \{devices/lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=reg lab=i[lindex $i 0] \}" - } else { - puts $fd "C \{lab_pin.sym\} 0 [set y [expr {$y+20}]] \ - 0 0 \{ name=p[incr pcnt] verilog_type=reg lab=i[lindex $i 0] \}" - } - } - close $fd - xschem merge $USER_CONF_DIR/.clipboard.sch -} - -proc make_symbol {name} { - global XSCHEM_SHAREDIR symbol_width - set name [abs_sym_path $name ] - # puts "make_symbol{}, executing: ${XSCHEM_SHAREDIR}/make_sym.awk $symbol_width ${name}" - eval exec {awk -f ${XSCHEM_SHAREDIR}/make_sym.awk $symbol_width $name} - return {} -} - -proc make_symbol_lcc {name} { - global XSCHEM_SHAREDIR - set name [abs_sym_path $name] - # puts "make_symbol{}, executing: ${XSCHEM_SHAREDIR}/make_sym_lcc.awk ${name}" - eval exec {awk -f ${XSCHEM_SHAREDIR}/make_sym_lcc.awk $name} - return {} -} - -# create simulation dir 'simulation/' under current schematic directory -proc simuldir {} { - global netlist_dir local_netlist_dir - if { $local_netlist_dir == 1 } { - set simdir [xschem get current_dirname]/simulation - file mkdir $simdir - set netlist_dir $simdir - xschem set_netlist_dir $netlist_dir - return $netlist_dir - } - return {} -} - -# -# force==0: force creation of $netlist_dir (if not empty) -# if netlist_dir empty and no dir given prompt user -# else set netlist_dir to dir -# -# force==1: if no dir given prompt user -# else set netlist_dir to dir -# -proc select_netlist_dir { force {dir {} }} { - global netlist_dir env - - if { ( $force == 0 ) && ( $netlist_dir ne {} ) } { - if {![file exist $netlist_dir]} { - file mkdir $netlist_dir - } - regsub {^~/} $netlist_dir ${env(HOME)}/ netlist_dir - xschem set_netlist_dir $netlist_dir - return $netlist_dir - } - if { $dir eq {} } { - if { $netlist_dir ne {} } { - set initdir $netlist_dir - } else { - if {$::OS == "Windows"} { - set initdir $env(windir) - } else { - set initdir [pwd] - } - } - # 20140409 do not change netlist_dir if user Cancels action - set new_dir [tk_chooseDirectory -initialdir $initdir -parent . -title {Select netlist DIR} -mustexist false] - } else { - set new_dir $dir - } - - if {$new_dir ne {} } { - if {![file exist $new_dir]} { - file mkdir $new_dir - } - set netlist_dir $new_dir - } - regsub {^~/} $netlist_dir ${env(HOME)}/ netlist_dir - xschem set_netlist_dir $netlist_dir - return $netlist_dir -} - - -proc enter_text {textlabel {preserve_disabled disabled}} { - global retval rcode has_cairo preserve_unchanged_attrs - set rcode {} - toplevel .dialog -class Dialog - wm title .dialog {Enter text} - - set X [expr {[winfo pointerx .dialog] - 30}] - set Y [expr {[winfo pointery .dialog] - 25}] - - # 20100203 - if { $::wm_fix } { tkwait visibility .dialog } - wm geometry .dialog "+$X+$Y" - frame .dialog.f1 - label .dialog.f1.txtlab -text $textlabel - text .dialog.txt -width 100 -height 12 - .dialog.txt delete 1.0 end - .dialog.txt insert 1.0 $retval - checkbutton .dialog.f1.l1 -text "preserve unchanged props" -variable preserve_unchanged_attrs \ - -state $preserve_disabled - pack .dialog.f1 -side top -fill x ;# -expand yes - pack .dialog.f1.l1 -side left - pack .dialog.f1.txtlab -side left -expand yes -fill x - - pack .dialog.txt -side top -fill both -expand yes - frame .dialog.edit - frame .dialog.edit.lab - frame .dialog.edit.entries - pack .dialog.edit.lab -side left - pack .dialog.edit.entries -side left -fill x -expand yes - pack .dialog.edit -side top -fill x - if {$has_cairo } { - entry .dialog.edit.entries.hsize -relief sunken -textvariable vsize -width 20 - } else { - entry .dialog.edit.entries.hsize -relief sunken -textvariable hsize -width 20 - } - entry .dialog.edit.entries.vsize -relief sunken -textvariable vsize -width 20 - entry .dialog.edit.entries.props -relief sunken -textvariable props -width 20 - pack .dialog.edit.entries.hsize .dialog.edit.entries.vsize \ - .dialog.edit.entries.props -side top -fill x -expand yes - label .dialog.edit.lab.hlab -text "hsize:" - label .dialog.edit.lab.vlab -text "vsize:" - label .dialog.edit.lab.proplab -text "props:" - pack .dialog.edit.lab.hlab .dialog.edit.lab.vlab \ - .dialog.edit.lab.proplab -side top - frame .dialog.buttons - button .dialog.buttons.ok -text "OK" -command \ - { - set retval [.dialog.txt get 1.0 {end - 1 chars}] - if {$has_cairo} { - set hsize $vsize - } - set rcode {ok} - destroy .dialog - } - button .dialog.buttons.cancel -text "Cancel" -command \ - { - set retval {} - set rcode {} - destroy .dialog - } - button .dialog.buttons.b3 -text "Load" -command \ - { - global INITIALTEXTDIR - if { ![info exists INITIALTEXTDIR] } { set INITIALTEXTDIR [xschem get current_dirname] } - set a [tk_getOpenFile -parent .dialog -initialdir $INITIALTEXTDIR ] - if [string compare $a ""] { - set INITIALTEXTDIR [file dirname $a] - read_data_window .dialog.txt $a - } - } - button .dialog.buttons.b4 -text "Del" -command \ - { - .dialog.txt delete 1.0 end - } - pack .dialog.buttons.ok -side left -fill x -expand yes - pack .dialog.buttons.cancel -side left -fill x -expand yes - pack .dialog.buttons.b3 -side left -fill x -expand yes - pack .dialog.buttons.b4 -side left -fill x -expand yes - pack .dialog.buttons -side bottom -fill x - bind .dialog { - if ![string compare $retval [.dialog.txt get 1.0 {end - 1 chars}]] { - .dialog.buttons.cancel invoke - } - } - bind .dialog {.dialog.buttons.ok invoke} - #grab set .dialog - tkwait window .dialog - return $retval -} - -# evaluate a tcl command from GUI -proc tclcmd {} { - global tclcmd_txt - catch {destroy .tclcmd} - toplevel .tclcmd -class dialog - label .tclcmd.txtlab -text {Enter TCL expression:} - label .tclcmd.result -text {Result:} - text .tclcmd.t -width 100 -height 8 - text .tclcmd.r -width 100 -height 6 -yscrollcommand ".tclcmd.yscroll set" - scrollbar .tclcmd.yscroll -command ".tclcmd.r yview" - .tclcmd.t insert 1.0 $tclcmd_txt - - frame .tclcmd.b - button .tclcmd.b.close -text Close -command { - set tclcmd_txt [.tclcmd.t get 1.0 end] - destroy .tclcmd - } - button .tclcmd.b.ok -text Evaluate -command { - set tclcmd_txt [.tclcmd.t get 1.0 end] - set res [eval $tclcmd_txt] - .tclcmd.r delete 1.0 end - .tclcmd.r insert 1.0 $res - } - pack .tclcmd.txtlab -side top -fill x - pack .tclcmd.t -side top -fill both -expand yes - pack .tclcmd.result -side top -fill x - pack .tclcmd.b -side bottom -fill x - pack .tclcmd.yscroll -side right -fill y - pack .tclcmd.r -side top -fill both -expand yes - pack .tclcmd.b.ok -side left -expand yes -fill x - pack .tclcmd.b.close -side left -expand yes -fill x -} - -proc select_layers {} { - global dark_colorscheme colors enable_layer - toplevel .sl -class dialog - if { $dark_colorscheme == 1 } { - set txt_color black - } else { - set txt_color white - } - set j 0 - set f 0 - frame .sl.f0 - frame .sl.f1 - pack .sl.f0 .sl.f1 -side top -fill x - button .sl.f1.ok -text OK -command { destroy .sl} - pack .sl.f1.ok -side left -expand yes -fill x - frame .sl.f0.f$f - pack .sl.f0.f$f -side left -fill y - foreach i $colors { - if { $dark_colorscheme == 1 } { - set ind_bg white - } else { - set ind_bg black - } - if { $j == [xschem get pinlayer] } { - set laylab [format %2d $j]-PIN - set layfg $txt_color - } elseif { $j == [xschem get wirelayer] } { - set laylab [format %2d $j]-WIRE - set layfg $txt_color - } elseif { $j == [xschem get textlayer] } { - set laylab [format %2d $j]-TEXT - set layfg $txt_color - } elseif { $j == [xschem get backlayer] } { - set laylab [format %2d $j]-BG - if { $dark_colorscheme == 1 } { - set layfg white - set ind_bg black - } else { - set layfg black - set ind_bg white - } - } elseif { $j == [xschem get gridlayer] } { - set laylab [format %2d $j]-GRID - set layfg $txt_color - } else { - set laylab "[format %2d $j] " - set layfg $txt_color - } - - checkbutton .sl.f0.f$f.cb$j -text $laylab -variable enable_layer($j) -activeforeground $layfg \ - -selectcolor $ind_bg -anchor w -foreground $layfg -background $i -activebackground $i \ - -command { - xschem enable_layers - } - pack .sl.f0.f$f.cb$j -side top -fill x - incr j - if { [expr {$j%10}] == 0 } { - incr f - frame .sl.f0.f$f - pack .sl.f0.f$f -side left -fill y - } - } - tkwait window .sl -} - -proc color_dim {} { - toplevel .dim -class dialog - wm title .dim {Dim colors} - checkbutton .dim.bg -text {Dim background} -variable dim_background - scale .dim.scale -digits 2 -label {Dim factor} -length 256 \ - -showvalue 1 -command {xschem color_dim} -orient horizontal \ - -from -5 -to 5 -resolution 0.1 - button .dim.ok -text OK -command {destroy .dim} - .dim.scale set [xschem get dim] - pack .dim.scale - pack .dim.bg -side left - pack .dim.ok -side right -anchor e -} -proc about {} { - if [winfo exists .about] { - bind .about.link {} - bind .about.link2 {} - destroy .about - } - toplevel .about -class dialog - wm title .about {About XSCHEM} - label .about.xschem -text "[xschem get version]" -font {Sans 24 bold} - label .about.descr -text "Schematic editor / netlister for VHDL, Verilog, SPICE, tEDAx" - button .about.link -text {http://repo.hu/projects/xschem} -font Underline-Font -fg blue -relief flat - button .about.link2 -text {https://github.com/StefanSchippers/xschem} -font Underline-Font -fg blue -relief flat - button .about.link3 -text {Online XSCHEM Manual} -font Underline-Font -fg blue -relief flat - label .about.copyright -text "\n Copyright 1998-2021 Stefan Schippers (stefan.schippers@gmail.com) \n - This is free software; see the source for copying conditions. There is NO warranty; - not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE\n" - button .about.close -text Close -command {destroy .about} -font {Sans 18} - pack .about.xschem - pack .about.link - pack .about.link2 - pack .about.link3 - pack .about.descr - pack .about.copyright - pack .about.close - bind .about.link { execute 0 xdg-open http://repo.hu/projects/xschem} - bind .about.link2 { execute 0 xdg-open https://github.com/StefanSchippers/xschem} - bind .about.link3 { execute 0 xdg-open http://repo.hu/projects/xschem/index.html} -} - -proc property_search {} { - global search_value search_found - global search_exact - global search_select - global custom_token - - set search_found 0 - while { !$search_found} { - if { [winfo exists .dialog] } return - toplevel .dialog -class Dialog - wm title .dialog {Search} - if { ![info exists X] } { - set X [expr {[winfo pointerx .dialog] - 60}] - set Y [expr {[winfo pointery .dialog] - 35}] - } - wm geometry .dialog "+$X+$Y" - frame .dialog.custom - label .dialog.custom.l -text "Token" - entry .dialog.custom.e -width 32 - .dialog.custom.e insert 0 $custom_token - pack .dialog.custom.e .dialog.custom.l -side right - frame .dialog.val - label .dialog.val.l -text "Value" - entry .dialog.val.e -width 32 - .dialog.val.e insert 0 $search_value - pack .dialog.val.e .dialog.val.l -side right - frame .dialog.but - button .dialog.but.ok -text OK -command { - set search_value [.dialog.val.e get] - set custom_token [.dialog.custom.e get] - if {$debug_var<=-1} { puts stderr "|$custom_token|" } - set token $custom_token - if { $search_exact==1 } { - set search_found [xschem searchmenu exact $search_select $token $search_value] - } else { - set search_found [xschem searchmenu regex $search_select $token $search_value] - } - destroy .dialog - } - button .dialog.but.cancel -text Cancel -command { set search_found 1; destroy .dialog } - - # Window doesn't support regular expression, has to be exact match for now - if {$::OS == "Windows"} { - set search_exact 1 - checkbutton .dialog.but.sub -text Exact_search -variable search_exact -state disable - } else { - checkbutton .dialog.but.sub -text Exact_search -variable search_exact - } - radiobutton .dialog.but.nosel -text {Highlight} -variable search_select -value 0 - radiobutton .dialog.but.sel -text {Select} -variable search_select -value 1 - # 20171211 added unselect - radiobutton .dialog.but.unsel -text {Unselect} -variable search_select -value -1 - pack .dialog.but.ok -anchor w -side left - pack .dialog.but.sub -side left - pack .dialog.but.nosel -side left - pack .dialog.but.sel -side left - pack .dialog.but.unsel -side left - pack .dialog.but.cancel -anchor e - pack .dialog.custom -anchor e - pack .dialog.val -anchor e - pack .dialog.but -expand yes -fill x - focus .dialog - bind .dialog {.dialog.but.cancel invoke} - bind .dialog {.dialog.but.ok invoke} - bind .dialog {.dialog.but.ok invoke} - grab set .dialog - tkwait window .dialog - } - return {} -} - -#20171029 -# allows to call TCL hooks from 'format' strings during netlisting -# example of symbol spice format definition: -# format="@name @pinlist @symname @tcleval(