Tcl. How to replace line of code with the value that is returned by string map?

StackOverflow https://stackoverflow.com/questions/23260664

  •  08-07-2023
  •  | 
  •  

Question

Note: Below there is part of code that I think will be more then enough for my question. But I also put the zip archive of whole script at the end of this post.

What is need to do: I need to replace line " argc ; number " with the value that is returned by string map [ list // $function_parameter_comment_sign ] "\" argc // number \"" and the line " argv ; arguments " with the value that is returned by string map [ list // $function_parameter_comment_sign ] "\" argv // arguments \""

I tried different ways to do that: to include them to [] or {}, to assign value to variable and place it in that line and many other ways but did not succeed. How can I do it?

if { [ llength $argv ] == 1 } {
  set test [ lindex $argv 0 ]
  testone $test
} else {
  testmain
}


proc testmain { } {
    global ut_all_tests ut_current_test

    foreach test $ut_all_tests {
        set ut_current_test $test
        puts $test
        $test
    }
}

proc testone { torun } {
    global ut_all_tests ut_current_test

    foreach test $ut_all_tests {
    if { $torun == $test } {
      set ut_current_test $test
      puts $test
      $test
    }
    }
}


proc tproc { name args body } {
    global ut_all_tests

    lappend ut_all_tests $name
    proc $name $args $body
}


tproc extract_tcl_signature_test { } {

proc load_generators {} {
        set script_path [ file dirname [ file normalize [ info script ] ] ]
        set drakon_editor_path [string trimright $script_path "unittest" ]
    set scripts [ glob -- "$drakon_editor_path/generators/*.tcl" ]
    foreach script $scripts {
      source $script
    }       
}

namespace eval gen {

array set generators {}

# This procedure is called by language generator files. In the beginning of every language generator there is calling code.
proc add_generator { language generator } {
    variable generators
    if { [ info exists generator($language) ] } {
        error "Generator for language $language already registered."
    }
    set gen::generators($language) $generator
}

}
load_generators
puts "=================================="
puts "Started: extract_tcl_signature_test"
foreach { language generator } [ array get gen::generators ] {
    puts "----------------------------------"
    puts $language
    puts $generator

    namespace eval current_file_generation_info {}
    set current_file_generation_info::language $language
    set current_file_generation_info::generator $generator

    set find [string first :: $generator]
    set generator_namespace [ string range $generator 0 $find-1 ]

    # These 3 lines is to check is current generator have commentator procedure.
    # If not commentator_status_var is set to "" .
    set commentator_for_namespace_text "::commentator"
    set commentator_call_text "$generator_namespace$commentator_for_namespace_text"
    set commentator_status_var [ namespace which $commentator_call_text ]

    # If current language does not have commentator procedure or current languages is in if conditions, then // sign for function parameter commenting will be used.
    # It is done so for compability with diagrams which are made with previous versions of DRAKON Editor.
    # If you are adding new language generator to DRAKON Editor and want to use line comment sign as
    # commenting sign for function parameters, just make commentator procedure in your language generator
    # as it is for example in AutoHotkey code generator.
    if { $commentator_status_var == "" ||
    $language == "C" ||
    $language == "C#" ||
    $language == "C++" ||
    $language == "D" ||
    $language == "Erlang" ||
    $language == "Java" ||
    $language == "Javascript" ||
    $language == "Lua" ||
    $language == "Processing.org" ||
    $language == "Python 2.x" ||
    $language == "Python 3.x" ||
    $language == "Tcl" ||
    $language == "Verilog" } {

            good_signature_tcl { " " " #comment " "" "what?" } comment "" {} ""

            good_signature_tcl { "" 
                    "" 
                    " argc // number "
                    " argv // arguments "
                    " "
                    } procedure public { "argc" "argv" } ""

            good_signature_tcl { "one"
                    "two" } procedure public { "one" "two" } ""

    } else {

            # Get current generator line comment simbol and calculate its length without space sign.
            set function_parameter_comment_sign [ $commentator_call_text "" ]
            set function_parameter_comment_sign [string trim $function_parameter_comment_sign " " ]
            if { $function_parameter_comment_sign == "#" } {

            #good_signature_tcl { " " " #comment " "" "what?" } comment "" {} ""

            good_signature_tcl { "" 
                    "" 
                    " argc # number "
                    " argv # arguments "
                    " "
                    } procedure public { "argc" "argv" } ""

            good_signature_tcl { "one"
                    "two" } procedure public { "one" "two" } ""

            } else {

            good_signature_tcl { " " " #comment " "" "what?" } comment "" {} ""

            good_signature_tcl { "" 
                    "" 
                    " argc ; number "
                    " argv ; arguments "
                    " "
                    } procedure public { "argc" "argv" } ""

            good_signature_tcl { "one"
                    "two" } procedure public { "one" "two" } ""

            }
    }

    #puts $function_parameter_comment_sign

}

puts "----------------------------------"
puts "Successfully ended: extract_tcl_signature_test"
puts "=================================="

}


proc good_signature_tcl { lines type access parameters returns } {
    set text [ join $lines "\n" ]
    unpack [ gen_tcl::extract_signature $text foo ] message signature
    equal $message ""

    unpack $signature atype aaccess aparameters areturns
    equal $atype $type
    equal $aaccess $access
    set par_part0 {}
    foreach par $aparameters {
        lappend par_part0 [ lindex $par 0 ]
    }
    list_equal $par_part0 $parameters
    equal [ lindex $areturns 0 ] $returns
}

Above code parts are from files: unittest.tcl , utest_utils.tcl and gen_test.tcl

Download code link for whole code: https://mega.co.nz/#!QFhlnSIS!8lxgCFbXAweqrj72Gj8KRbc6o9GVlX-V9T1Fw9jwhN0

Était-ce utile?

La solution

I'm not entirely sure what you're looking for, but if I got it right, you could try using something like this:

good_signature_tcl [list "" \
    "" \
    [string map [list // $function_parameter_comment_sign] " argc // number "] \
    [string map [list // $function_parameter_comment_sign] " argv // arguments "] \
    " " \
] procedure public { "argc" "argv" } ""

Since your {} are being used to make a list, then using [list] should yield the same thing with the bonus of having functions and substitutions work.

Autres conseils

Assuming that you always want a constant replacement (i.e., that you're not varying $function_parameter_comment_sign at every site!) then it's not too hard. Just build the map to apply with string map in several stages. (I'm not 100% sure that I've got what you want to replace right, but it should be easy for you to fix it from here.)

# Shared value to keep line length down
set replacer [list "//" $function_parameter_comment_sign]

# Build the map (no need to do it in one monster [list]!)
set map {}
lappend map {" argc ; number "} [string map $replacer "\" argc // number \""]
lappend map {" argv ; arguments "} [string map $replacer "\" argv // arguments \""]

# Apply the map
set theMappedText [string map $map $theInputText]

If you want to do something other than replace each instance of the unwanted string with a constant, things will quite a bit more complex as you would need to use subst (and hence you would also need an extra cleaning step). Fortunately, I don't think you need that; your case appears to be simple enough.

Licencié sous: CC-BY-SA avec attribution
Non affilié à StackOverflow
scroll top