From d16cbf94c0375a6cb647cc30ccb3152ac3f7f6d2 Mon Sep 17 00:00:00 2001 From: stefan schippers Date: Thu, 23 Oct 2025 15:11:19 +0200 Subject: [PATCH] improvements in tcl command console (added "=" keybind) --- doc/xschem_man/commands.html | 1 + src/callback.c | 4 +- src/keys.help | 1 + src/xschem.tcl | 47 ++++++++++++++----- .../devices/bindkeys_cheatsheet.sym | 2 +- 5 files changed, 40 insertions(+), 15 deletions(-) diff --git a/doc/xschem_man/commands.html b/doc/xschem_man/commands.html index cb4c264c..66eea84d 100644 --- a/doc/xschem_man/commands.html +++ b/doc/xschem_man/commands.html @@ -273,6 +273,7 @@ alt '-' Set line width ctrl '+' Increase line width - '_' Toggle change line width - '%' Toggle draw grid +- '=' Tclcommand console ctrl '=' Toggle fill rectangles - '$' Toggle pixmap saving ctrl '$' Toggle use XCopyArea vs drawing primitives for drawing the screen diff --git a/src/callback.c b/src/callback.c index 5892a1cb..545ba08f 100644 --- a/src/callback.c +++ b/src/callback.c @@ -3768,7 +3768,9 @@ static void handle_key_press(int event, KeySym key, int state, int rstate, int m break; case '=': - if(state & ControlMask) { /* toggle fill rectangles */ + if(state == 0) { /* tcl command console */ + tcleval("tclcmd"); + } else if(state & ControlMask) { /* toggle fill rectangles */ int x; xctx->fill_pattern++; if(xctx->fill_pattern==2) xctx->fill_pattern=0; diff --git a/src/keys.help b/src/keys.help index 8a1fd7d3..1b20b39f 100644 --- a/src/keys.help +++ b/src/keys.help @@ -214,6 +214,7 @@ alt '-' Set line width ctrl '+' Increase line width - '_' Toggle change line width - '%' Toggle draw grid +- '=' Tclcommand console ctrl '=' Toggle fill rectangles - '$' Toggle pixmap saving ctrl '$' Toggle use XCopyArea vs drawing primitives for drawing the screen diff --git a/src/xschem.tcl b/src/xschem.tcl index e0c715bf..fb84c147 100644 --- a/src/xschem.tcl +++ b/src/xschem.tcl @@ -664,6 +664,10 @@ proc to_eng {args} { return $s } +proc = {args} { + ev7 $args +} + ## evaluate expression with 7 significant digits. ## if expression has errors or does not evaluate return expression as is proc ev7 {args} { @@ -6300,11 +6304,11 @@ proc return_release {window} { $window delete "$curs - 1 chars" $curs } - proc tclcmd_ok_button {} { global tclcmd_txt tclcmd_puts set tclcmd_txt [.tclcmd.t get 1.0 end] + regsub {^ *= *} $tclcmd_txt {= } tclcmd_txt redef_puts catch {uplevel #0 $tclcmd_txt} tclcmd_puts rename puts {} @@ -6318,40 +6322,57 @@ proc tclcmd_ok_button {} { # evaluate a tcl command from GUI proc tclcmd {} { - global tclcmd_txt + global tclcmd_txt tclcmd_default_geometry + set_ne tclcmd_default_geometry {} if {[winfo exists .tclcmd]} { destroy .tclcmd } - toplevel .tclcmd -class Dialog - # wm transient .tclcmd [xschem get topwindow] + toplevel .tclcmd -class dialog label .tclcmd.txtlab -text {Enter TCL expression. Shift-Return will evaluate} panedwindow .tclcmd.p -orient vert - text .tclcmd.t -undo 1 -width 100 -height 3 + + bind .tclcmd { + set tclcmd_default_geometry [wm geometry .tclcmd] + } + + frame .tclcmd.t + text .tclcmd.t.t -width 60 -height 4 -font {Monospace 12} -yscrollcommand ".tclcmd.t.yscroll set" + scrollbar .tclcmd.t.yscroll -command ".tclcmd.t.t yview" + frame .tclcmd.r - text .tclcmd.r.r -undo 1 -width 100 -height 8 -yscrollcommand ".tclcmd.r.yscroll set" + text .tclcmd.r.r -width 60 -height 5 -font {Monospace 12} -yscrollcommand ".tclcmd.r.yscroll set" scrollbar .tclcmd.r.yscroll -command ".tclcmd.r.r yview" + .tclcmd.p add .tclcmd.t .tclcmd.r - .tclcmd.t insert 1.0 $tclcmd_txt + .tclcmd.t.t insert 1.0 $tclcmd_txt frame .tclcmd.b - button .tclcmd.b.clear -text Clear -command { + button .tclcmd.b.cleari -text {Clear Input} -command { + .tclcmd.t.t delete 1.0 end + } + button .tclcmd.b.clear -text {Clear Results} -command { .tclcmd.r.r delete 1.0 end } button .tclcmd.b.close -text Close -command { - set tclcmd_txt [.tclcmd.t get 1.0 {end - 1 chars}] + set tclcmd_txt [.tclcmd.t.t get 1.0 {end - 1 chars}] destroy .tclcmd } button .tclcmd.b.ok -text Evaluate -command {tclcmd_ok_button} # bind .tclcmd.t { .tclcmd.b.ok invoke } - bind .tclcmd.t {return_release %W; .tclcmd.b.ok invoke } + bind .tclcmd.t.t {return_release %W; .tclcmd.b.ok invoke } + bind .tclcmd {.tclcmd.b.close invoke} pack .tclcmd.txtlab -side top -fill x pack .tclcmd.b -side bottom -fill x pack .tclcmd.p -side top -fill both -expand yes pack .tclcmd.r.yscroll -side right -fill y pack .tclcmd.r.r -side top -fill both -expand yes + pack .tclcmd.t.yscroll -side right -fill y + pack .tclcmd.t.t -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 pack .tclcmd.b.clear -side left -expand yes -fill x + pack .tclcmd.b.cleari -side left -expand yes -fill x + pack .tclcmd.b.close -side left -expand yes -fill x + if { $tclcmd_default_geometry ne {}} {wm geometry .tclcmd $tclcmd_default_geometry} } proc select_layers {} { @@ -9324,7 +9345,7 @@ set tctx::global_list { tctx::colors tctx::delay_flag tctx::hsize tctx::recentfile tctx::selected_mode tctx::old_selected_mode tctx::old_selected_tok tctx::selected_tok tctx::rcode tctx::vsize tctx::tctx::retval tctx::retval_orig - text_line_default_geometry text_replace_selection text_tabs_setting + tclcmd_default_geometry text_line_default_geometry text_replace_selection text_tabs_setting textwindow_fileid textwindow_filename textwindow_w toolbar_horiz toolbar_list toolbar_visible top_is_subckt transparent_svg undo_type unselect_partial_sel_wires uppercase_subckt use_cursor_for_selection use_lab_wire use_label_prefix use_tclreadline user_wants_copy_cell @@ -10243,7 +10264,7 @@ proc build_widgets { {topwin {} } } { -accelerator {Print Scrn} $topwin.menubar.tools add command -label "Search" -accelerator Ctrl+F -command property_search $topwin.menubar.tools add command -label "Align to Grid" -accelerator Alt+U -command "xschem align" - $topwin.menubar.tools add command -label "Execute TCL command" -command "tclcmd" + $topwin.menubar.tools add command -label "Execute TCL command" -command "tclcmd" -accelerator {=} $topwin.menubar.tools add command -label "Join/Trim wires" \ -command "xschem trim_wires" -accelerator {&} $topwin.menubar.tools add command -label "Break wires at selected instance pins" \ diff --git a/xschem_library/devices/bindkeys_cheatsheet.sym b/xschem_library/devices/bindkeys_cheatsheet.sym index 5499d8cb..b6fb3676 100644 --- a/xschem_library/devices/bindkeys_cheatsheet.sym +++ b/xschem_library/devices/bindkeys_cheatsheet.sym @@ -414,7 +414,7 @@ T {Flat netlist} 882.5 -183.75 0 0 0.18 0.18 {layer=12} T {Reserved} 882.5 -172.5 0 0 0.18 0.18 {} T {Toggle fill style} 962.5 -355 0 0 0.18 0.18 {layer=4} T {-} 962.5 -343.75 0 0 0.18 0.18 {layer=12} -T {-} 962.5 -332.5 0 0 0.18 0.18 {} +T {Tcl console} 962.5 -332.5 0 0 0.18 0.18 {} T {Decr line width} 882.5 -355 0 0 0.18 0.18 {layer=4} T {Variab. line w.} 882.5 -343.75 0 0 0.18 0.18 {layer=12} T {-} 882.5 -332.5 0 0 0.18 0.18 {}