Is there a way to ignore backspaces when performing a flush in tcl to capture user input?
I am performing a function where I capture the user input in a variable to be used in another command at a later time. So I perform the following function.
puts -nonewline "What is the username? "
flush stdout
set usrnm [gets stdin]
So let's say using that command as long as I don't use a backspace everything works the way I expect it however if I do use a backspace a "\x7F" is added as a character. Is there a way for the backspace to not be treated as a character?
That seems to depend on your terminal; when I try that code with these key sequences:
BackspaceabcReturn
abcBackspacedReturn
Then I get a length 3 string (measured via string length) in the usrnm variable in both cases. This is what I'd expect when the terminal is properly in cooked mode (the usual default). Since a \x7f is probably not a valid character in a user name anyway, I'd guess that you could filter it out:
set usrnm [string map {\x7f ""} $usrnm]
The only way to be absolutely sure that the character isn't there is to put the terminal in to raw mode (and probably no-echo too) and do all the character input processing yourself. That's a huge amount of work relative to the size of problem; a post-filter seems more sensible to me (and I still wonder what's up with your terminal).
[EDIT]: To put your terminal back into cooked mode, do:
exec stty -raw <#stdin
I just ran into this recently and I wrote a procedure to handle the char 127 character (backspace). If any other input cleansing needs to happen you can do it here too, such as removing special characters. I have a feeling this can be more elegant but it does work.
proc cleanInput {str} {
set return ""
for {set i 0} {$i < [string length $str]} {incr i} {
set char [string index $str $i]
set asc [scan $char %c]
if {$asc == 127} { #backspace
if {[string length $return] > 0} {
set return [string range $return 0 [expr "[string length $return] - 2"]]
}
} else {
append return $char
}
}
return $return
}
Related
When running commands interactively at the tclsh command line, is there a way to truncate how much of a return value gets printed to stdout?
For example, this will take a very long time because the return value will print to stdout.
tclsh> set a [lrepeat 500000000 x]
I know I can add a dummy command in the same line, but this is an ad hoc solution. Is there some I could set in my ~/.tclshrc to truncate stdout to a finite length?
tclsh> set a [lrepeat 500000000 x] ; puts ""
Maybe this is an XY-problem (as turning off or swallowing prints to stdout seems to satisfy the OP), but the actual question was:
Is there some I could set in my ~/.tclshrc to truncate stdout to a
finite length?
You can use an interceptor on stdout (and/ or, stderr) to cap strings to a default limit:
oo::class create capped {
variable max
constructor {m} {
set max $m
}
method initialize {handle mode} {
if {$mode ne "write"} {error "can't handle reading"}
return {finalize initialize write}
}
method finalize {handle} {
# NOOP
}
method write {handle bytes} {
if {[string length $bytes] > $max} {
set enc [encoding system]
set str [encoding convertfrom $enc $bytes]
set newStr [string range $str 0 $max-1]
if {[string index $str end] eq "\n"} {
append newStr "\n"
}
set bytes [encoding convertto $enc $newStr]
}
return $bytes
}
}
Using chan push and chan pop you may turn on/off capping to, e.g., 30 characters:
% chan push stdout [capped new 30]
serial1
% puts [string repeat € 35]
€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
% chan pop stdout
% puts [string repeat € 35]
€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€
Some remarks:
You can use an object, a namespace, or a proc offering the required interface of channel interceptors (initialize, write, ...); I prefer objects.
Ad write: You want to cap based on a character-based limit, not a byte-level one. However, write receives a string of bytes, not a string of characters. So, you need to be careful when enforcing the limit (back-transform the byte string into a char string, and vice versa, using encoding convertfrom and encoding convertto).
Similar, whether certain values of max might not be a good choice or the value range should be restricted. E.g., a max of 1 or 0 will turn off the basic REPL (the prompt % ), effectively.
As for tclshrc: You may want place the interceptor definition and chan push call therein, to enable capping per default?
tclsh is a REPL, and the "P" there is what you're seeing. Without digging into the source, I don't know that there's a simple way to accomplish exactly what you're asking.
If I remember to do it, the list command is useful to provide no output
set a [lrepeat 500000000 x]; list
or perhaps something informative
set a [lrepeat 500000000 x]; llength $a
If you want to get programmy:
proc i {val} {set ::tcl_interactive $val}
Then do i off or i 0 or i false to turn off interactivity and then execute the commands with large results. Going non-interactive silences the printing of command results, but it also turns off the prompt which could be confusing. Restore interactivity with i on or i 1 or i true
I'd like to automatically convert URLs, i.e
"https://sc-uat.ct.example.com/sc/" into "https://invbeta.example.com/sc/"
"https://sc-dev.ct.example.com/sc/" into "https://invtest.example.com/sc/"
"https://sc-qa.ct.example.com/sc/" into "https://invdemo.example.com/sc/"
I've tried following code snippet in TCL
set loc "https://sc-uat.ct.example.com/sc/"
set envs(dev) "test"
set envs(uat) "beta"
set envs(qa) "demo"
puts $envs(uat)
regsub -nocase {://.+-(.+).ct.example.com} $loc {://inv[$envs(\1)].example.com} hostname
puts "new location = $hostname"
But the result is: new location = https://inv[$envs(uat)].example.com/sc/
It seems that [$envs(uat)] is NOT evaluated and substituted further with the real value. Any hints will be appreciated. Thanks in advance
But the result is: new location =
https://inv[$envs(uat)].example.com/sc/ It seems that [$envs(uat)] is eval-ed further.
You meant to say: [$envs(uat)] is not evaluated further?
This is because due to the curly braces in {://inv[$envs(\1)].example.com}, the drop-in string is taken literally, and not subjected to variable or command substitution. Besides, you don't want command and variable substitution ([$envs(\1)]), just one of them: $envs(\1) or [set envs(\1)].
To overcome this, you must treat the regsub-processed string further via subst:
set hostname [subst -nocommands -nobackslashes [regsub -nocase {://.+-(.+).ct.example.com} $loc {://inv$envs(\1).example.com}]]
Suggestions for improvement
I advise to avoid the use of subst in this context, because even when restricted, you might run into conflicts with characters special to Tcl in your hostnames (e.g., brackets in the IPv6 authority parts). Either you have to sanitize the loc string before, or, better work on string ranges like so:
if {[regexp -indices {://(.+-(.+)).ct.example.com} $loc _ replaceRange keyRange]} {
set key [string range $loc {*}$keyRange]
set sub [string cat "inv" $envs($key)]
set hostname [string replace $loc {*}$replaceRange $sub]
}
How can I remove a part of the text file if the pattern I am searching is matched?
eg:
pg_pin (VSS) {
direction : inout;
pg_type : primary_ground;
related_bias_pin : "VBN";
voltage_name : "VSS";
}
leakage_power () {
value : 0;
when : "A1&A2&X";
**related_pg_pin** : VBN;
}
My pattern is related_pg_pin. If this pattern is found i want to remove that particular section(starting from leakage power () { till the closing bracket}).
proc getSection f {
set section ""
set inSection false
while {[gets $f line] >= 0} {
if {$inSection} {
append section $line\n
# find the end of the section (a single right brace, #x7d)
if {[string match \x7d [string trim $line]]} {
return $section
}
} else {
# find the beginning of the section, with a left brace (#x7b) at the end
if {[string match *\x7b [string trim $line]]} {
append section $line\n
set inSection true
}
}
}
return
}
set f [open data.txt]
set g [open output.txt w]
set section [getSection $f]
while {$section ne {}} {
if {![regexp related_pg_pin $section]} {
puts $g $section
}
set section [getSection $f]
}
close $f
close $g
Starting with the last paragraph of the code, we open a file for reading (through the channel $f) and then get a section. (The procedure to get a section is a little bit convoluted, so it goes into a command procedure to be out of the way.) As long as non-empty sections keep coming, we check if the pattern occurs: if not, we print the section to the output file through the channel $g. Then we get the next section and go to the next iteration.
To get a section, first assume we haven't yet seen any part of a section. Then we keep reading lines until the end of the file is found. If a line ending with a left brace is found, we add it to the section and take a note that we are now in a section. From then on, we add every line to the section. If a line consisting of a single right brace is found, we quit the procedure and deliver the section to the caller.
Documentation:
! (operator),
>= (operator),
append,
close,
gets,
if,
ne (operator),
open,
proc,
puts,
regexp,
return,
set,
string,
while,
Syntax of Tcl regular expressions
Syntax of Tcl string matching:
* matches a sequence of zero or more characters
? matches a single character
[chars] matches a single character in the set given by chars (^ does not negate; a range can be given as a-z)
\x matches the character x, even if that character is special (one of *?[]\)
Here's a "clever" way to do it:
proc unknown args {
set body [lindex $args end]
if {[string first "related_pg_pin" $body] == -1} {puts $args}
}
source file.txt
Your data file appears to be Tcl-syntax-compatible, so execute it like a Tcl file, and for unknown commands, check to see if the last argument of the "command" contains the string you want to avoid.
This is clearly insanely risky, but it's fun.
How can I organize a cycle using TCL for searching list's each element existence in file or in another list, and if it doesn't exists there return unmatched element.
If the number of things that you are checking for is significantly smaller than the number of lines/tokens in the file, it is probably best to use the power of associative arrays to do the check as this can be done with linear scans (associative arrays are fast).
proc checkForAllPresent {tokens tokenList} {
foreach token $tokens {
set t($token) "dummy value"
}
foreach token $tokenList {
unset -nocomplain t($token)
}
# If the array is empty, all were found
return [expr {[array size t] == 0}]
}
Then, all we need to do is a little standard stanza to get the lines/tokens from the file and run them through the checker. Assuming we're dealing with lines:
proc getFileLines {filename} {
set f [open $filename]
set data [read $f]
close $f
return [split $data "\n"]
}
set shortList [getFileLines file1.txt]
set longList [getFileLines file2.txt]
if {[checkForAllPresent $shortList $longList]} {
puts "All were there"
} else {
puts "Some were absent"
}
It's probably better to return the list of absent lines (with return [array names t]) instead of whether everything is absent (with the general check of “is everything there” being done with llength) as that gives more useful information. (With more work, you can produce even more information about what is present, but that's a bit more code and makes things less clear.)
(When searching, be aware that leading and trailing whitespace on lines matters. This is all exact matching here. Or use string trim.)
Working with words instead of lines is really just as easy. You just end up with slightly different code to extract the tokens from the read-in contents of the files.
return [regexp -all -inline {\w+} $data]
Everything else is the same.
having issues trying to debug this 'extra characters after close-brace' error. Error message points to my proc line ... I just can't see it for 2 days!
# {{{ MAIN PROGRAM
proc MAIN_PROGRAM { INPUT_GDS_OASIS_FILE L CELL_LIST_FILE } {
if { [file exists $CELL_LIST_FILE] == 0 } {
set celllist [$L cells]
} else {
set fp [open $CELL_LIST_FILE r]
set file_data [read $fp]
close $fp
set celllist [split $file_data "\n"]
set totalcells [expr [llength $celllist] - 1]
}
set counter 0
foreach cell $celllist {
set counter [expr {$counter + 1}]
set value [string length $cell]
set value3 [regexp {\$} $cell]
if { $value > 0 && $value2 == 0 && $value3 == 0 } {
# EXTRACT BOUNDRARY SIZE FIRST
puts "INFO -- READING Num : $counter/$totalcells -- $cell ..."
ONEIP_EXTRACT_BOUNDARY_SIZE $cell $L "IP_SIZE/$cell.txt"
exec gzip -f "IP_SIZE/$cell.txt"
}
}
# }}}
}
# }}}
This seems to be an unfortunate case of using braces in comments. The Tcl parser looks at braces before comments (http://tcl.tk/man/tcl8.5/TclCmd/Tcl.htm). It is a problem if putting braces in comments causes a mismatched number of open/close braces.
Try using a different commenting style, and remove the "{{{" and "}}}" from your comments.
I'm pretty sure that this is down to braces in comments within the proc body.
The wiki page here has a good explaination. In short a Tcl comment isn't like a comment most other languages and having unmatched braces in them leads to all
sorts of issues.
So the braces in the #}}} just before the end of the proc are probably the problem.
Tcl requires procedure bodies to be brace-balanced, even within comments.
OK, that's a total lie. Tcl really requires brace-quoted strings to be brace-balanced (Tcl's brace-quoted strings are just like single-quoted strings in bash, except they nest). The proc command just interprets its third argument as a script (used to define the procedure body) and it's very common to use brace-quoted strings for that sort of thing. This is a feature of Tcl's general syntax, and is why Tcl is very good indeed at handling things like DSLs.
You could instead do this:
proc brace-demo args "puts hi; # {{{"
brace-demo do it yeah
and that will work fine. Totally legal Tcl, and has a comment in a procedure body with unbalanced braces. It just happens that for virtually any real procedure, putting in all the required backslashes to stop interpretation of variable and command substitutions too soon is a total bear. Everyone uses braces for simplicity, and so has to balance them.
It's hardly ever a problem except occasionally for comments.