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(