# # 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 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 debug_var simuldir set netlist_type [xschem get netlist_type] 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 OS 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 OS # 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 { topwin {} } } { 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 $topwin.drw "<${s}>" "xschem callback %W %T %x %y 0 $key 0 $state" } else { if {![string compare $d {} ] } { # puts "bind .drw <${s}> {}" bind $topwin.drw "<${s}>" {} } else { # puts "bind .drw <${s}> xschem callback %W %T %x %y $keysym 0 0 $state" bind $topwin.drw "<${s}>" "xschem callback %W %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 ## computerfarm ## terminal ## netlist_type can be obtained with [xschem get netlist_type] proc save_sim_defaults {f} { global sim netlist_dir 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 load_recent_file {} { global USER_CONF_DIR recentfile has_x # recent files set recentfile {} if { [file exists $USER_CONF_DIR/recent_files] } { if {[catch { source $USER_CONF_DIR/recent_files } err] } { puts "Problems opening recent_files: $err" if {[info exists has_x]} { tk_messageBox -message "Problems opening recent_files: $err" -icon warning -parent . -type ok } } } } proc update_recent_file {f {topwin {} } } { global recentfile has_x # puts "update recent file, f=$f, topwin=$topwin" 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 0 $topwin} if { [info exists has_x] } {setup_recent_menu 1 $topwin} } proc write_recent_file {} { global recentfile USER_CONF_DIR # puts "write recent file recentfile=$recentfile" 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 { {in_new_window 0} { topwin {} } } { global recentfile # puts "setup recent menu in_new_window=$in_new_window" if {$in_new_window} { $topwin.menubar.file.menu.recent_new_window delete 0 9 } else { $topwin.menubar.file.menu.recent delete 0 9 } set i 0 if { [info exists recentfile] } { foreach i $recentfile { if {$in_new_window} { $topwin.menubar.file.menu.recent_new_window add command \ -command "xschem load_new_window {$i}" \ -label [file tail $i] } else { $topwin.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 OS 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 if {[winfo exists .sim]} { destroy .sim xschem set semaphore [expr {[xschem get semaphore] -1}] } xschem set semaphore [expr {[xschem get semaphore] +1}] 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 xschem set semaphore [expr {[xschem get semaphore] -1}] } button .sim.bottom.help -text Help -command { viewdata {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 'Accept and Save Configuration' button is pressed. If 'Accept and Close' is pressed then the changes are kept in memory without writing to a file. If xschem is restarted changes will be lost. 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. } 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 # xschem set semaphore [expr {[xschem get semaphore] -1}] save_sim_defaults ${USER_CONF_DIR}/simrc # puts "saving simrc" } button .sim.bottom.close -text {Accept and Close} -command { set_sim_defaults destroy .sim xschem set semaphore [expr {[xschem get semaphore] -1}] } wm protocol .sim WM_DELETE_WINDOW { set_sim_defaults destroy .sim xschem set semaphore [expr {[xschem get semaphore] -1}] } 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 # xschem set semaphore [expr {[xschem get semaphore] -1}] # 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 computerfarm terminal sim global execute_callback XSCHEM_SHAREDIR has_x OS simuldir set_sim_defaults set netlist_type [xschem get netlist_type] 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 computerfarm terminal sim XSCHEM_SHAREDIR has_x global bespice_listen_port env simuldir set netlist_type [xschem get netlist_type] 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 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 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 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 debug_var global terminal simuldir execute 0 sh -c "cd $curpath && $terminal" } proc edit_netlist {schname } { global netlist_dir debug_var global editor terminal OS simuldir set netlist_type [xschem get netlist_type] 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 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_up {dir} { global myload_dir1 bind .dialog.l.paneright.pre {} .dialog.l.paneright.pre configure -background white set d [file dirname $dir] if { [file isdirectory $d]} { myload_set_home $d setglob $d myload_set_colors2 set myload_dir1 $d } } 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 OS global myload_default_geometry myload_sash_pos myload_yview tcl_version globfilter myload_dirs2 set myload_retval {} upvar #0 $global_initdir initdir if { [winfo exists .dialog] } return xschem set semaphore [expr {[xschem get semaphore] +1}] 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 browse \ -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 {load_file_dialog_up $myload_dir1} 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 {load_file_dialog_up $myload_dir1} 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 myload_type [is_xschem_file $myload_dir1/$myload_dir2] if { $myload_type 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 set semaphore [expr {[xschem get semaphore] -1}] 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 myload_type [is_xschem_file "$myload_dir1/$myload_retval"] if { $myload_type 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 { $myload_type 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 OS 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 wm_fix set rcode {} xschem set semaphore [expr {[xschem get semaphore] +1}] 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 xschem set semaphore [expr {[xschem get semaphore] -1}] return $retval } # evaluate a tcl command from GUI proc tclcmd {} { global tclcmd_txt if {[winfo exists .tclcmd]} { destroy .tclcmd xschem set semaphore [expr {[xschem get semaphore] -1}] } xschem set semaphore [expr {[xschem get semaphore] +1}] 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 xschem set semaphore [expr {[xschem get semaphore] -1}] } 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 xschem set semaphore [expr {[xschem get semaphore] +1}] 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 xschem set semaphore [expr {[xschem get semaphore] -1}] } proc color_dim {} { global dim_bg dim_value enable_dim_bg xschem set semaphore [expr {[xschem get semaphore] +1}] toplevel .dim -class dialog wm title .dim {Dim colors} checkbutton .dim.bg -text {Dim background} -variable enable_dim_bg # xschem color_dim sets also dim_value variable 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 $dim_value pack .dim.scale pack .dim.bg -side left pack .dim.ok -side right -anchor e tkwait window .dim xschem set semaphore [expr {[xschem get semaphore] -1}] } 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 OS set search_found 0 while { !$search_found} { if { [winfo exists .dialog] } return xschem set semaphore [expr {[xschem get semaphore] +1}] 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 xschem set semaphore [expr {[xschem get semaphore] -1}] } return {} } #20171029 # allows to call TCL hooks from 'format' strings during netlisting # example of symbol spice format definition: # format="@name @pinlist @symname @tcleval(