# # 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 [xschem get topwindow] -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 {{reset {}}} { global sim terminal USER_CONF_DIR has_x bespice_listen_port env OS if {$reset eq {reset} } { file delete ${USER_CONF_DIR}/simrc } if { $reset eq {} } { 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 [xschem get topwindow] -type ok } set failure 1 } } } } if {( $reset eq {reset} ) || ![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'} } # can not use set_ne as variables bound to entry widgets always exist if widget exists set 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 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 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 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 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 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 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 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 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 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 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_reset {} { global sim set answer [tk_messageBox -message "Warning: delete simulation configuration file and reset to default?" \ -icon warning -parent .sim -type okcancel] if { $answer eq {ok}} { set_sim_defaults reset foreach tool $sim(tool_list) { for {set i 0} { $i < $sim($tool,n)} {incr i} { .sim.topf.f.scrl.center.$tool.r.$i.cmd delete 1.0 end .sim.topf.f.scrl.center.$tool.r.$i.cmd insert 1.0 $sim($tool,$i,cmd) } } } } 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 {In this dialog box you set the commands xschem uses to launch the various external tools. Xschem has 3 main netlisting modes (spice, verilog, vhdl) and for each netlisting mode some simulators and some viewers can be defined. 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 (Fg) 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 to file' button is pressed. If 'Accept and Close' is pressed then the changes are kept in memory and dialog is closed without writing to a file, if xschem is restarted changes will be lost. If no ~/.xschem/simrc is present then a minimal default setup is presented. To reset to default use the corresponding button or just delete the ~/.xschem/simrc file manually. } ro } button .sim.bottom.ok -text {Save Configuration to file} -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.reset -text {Reset to default} -command { simconf_reset } 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.bottom.reset -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 setup_tcp_gaw {} { 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.drw {} .dialog.l.paneright.drw 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.drw {} # .dialog.l.paneright.drw 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.drw -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.drw -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.drw {} .dialog.l.paneright.drw 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.drw {} 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.drw {} 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.drw {} .dialog.l.paneright.drw 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.drw configure -background {} xschem preview_window draw .dialog.l.paneright.drw "$myload_dir1/$myload_dir2" bind .dialog.l.paneright.drw { xschem preview_window draw .dialog.l.paneright.drw "$myload_dir1/$myload_dir2" } } } else { bind .dialog.l.paneright.drw {} .dialog.l.paneright.drw configure -background white } # puts "xschem preview_window draw .dialog.l.paneright.drw \"$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 [xschem get topwindow] -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 [xschem get topwindow] -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 [xschem get topwindow] -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 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 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 [xschem get topwindow] -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 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 V[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(