Ignore:
Timestamp:
Feb 12, 2007, 6:42:51 AM (12 years ago)
Author:
eridius@…
Message:

Clean up a bunch more of the useless evals in portutil
The ones that are left are there to pass multiple dynamic args (e.g. to lappend or ditem_append), plus the one lame makeuserproc implementation that I want to replace later

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/base/src/port1.0/portutil.tcl

    r21950 r21951  
    9191proc options {args} {
    9292    foreach option $args {
    93         eval "proc $option {args} \{ \n\
    94             global ${option} user_options option_procs \n\
    95                 \if \{!\[info exists user_options(${option})\]\} \{ \n\
    96                      set ${option} \$args \n\
    97                 \} \n\
    98         \}"
    99        
    100         eval "proc ${option}-delete {args} \{ \n\
    101             global ${option} user_options option_procs \n\
    102                 \if \{!\[info exists user_options(${option})\]\ && \[info exists ${option}\]\} \{ \n\
    103                     foreach val \$args \{ \n\
    104                        set ${option} \[ldelete \$\{$option\} \$val\] \n\
    105                     \} \n\
    106                     if \{\[string length \$\{${option}\}\] == 0\} \{ \n\
    107                         unset ${option} \n\
    108                     \} \n\
    109                 \} \n\
    110         \}"
    111         eval "proc ${option}-append {args} \{ \n\
    112             global ${option} user_options option_procs \n\
    113                 \if \{!\[info exists user_options(${option})\]\} \{ \n\
    114                     if \{\[info exists ${option}\]\} \{ \n\
    115                         set ${option} \[concat \$\{$option\} \$args\] \n\
    116                     \} else \{ \n\
    117                         set ${option} \$args \n\
    118                     \} \n\
    119                 \} \n\
    120         \}"
     93        proc $option {args} "
     94            global ${option} user_options option_procs
     95            if {!\[info exists user_options(${option})\]} {
     96                set ${option} \$args
     97            }
     98        "
     99        proc ${option}-delete {args} "
     100            global ${option} user_options option_procs
     101            if {!\[info exists user_options(${option})\] && \[info exists ${option}\]} {
     102                foreach val \$args {
     103                   set ${option} \[ldelete \${$option} \$val\]
     104                }
     105                if {\[string length \${${option}}\] == 0} {
     106                    unset ${option}
     107                }
     108            }
     109        "
     110        proc ${option}-append {args} "
     111            global ${option} user_options option_procs
     112            if {!\[info exists user_options(${option})\]} {
     113                if {\[info exists ${option}\]} {
     114                    set ${option} \[concat \${$option} \$args\]
     115                } else {
     116                    set ${option} \$args
     117                }
     118            }
     119        "
    121120    }
    122121}
     
    128127            if {\[info exists ${option}\]} {
    129128                set PortInfo(${option}) \${${option}}
    130                 } else {
    131                     unset PortInfo(${option})
    132                 }
     129            } else {
     130                unset PortInfo(${option})
    133131            }
    134132        "
     
    143141    # Display a warning
    144142    if {$newoption != ""} {
    145         eval "proc warn_deprecated_$option \{option action args\} \{ \n\
    146             global portname $option $newoption \n\
    147             if \{\$action != \"read\"\} \{ \n\
    148                 $newoption \$$option \n\
    149             \} else \{ \n\
    150                 ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\" \n\
    151                 $option \[set $newoption\] \n\
    152             \} \n\
    153         \}"
     143        proc warn_deprecated_${option} {option action args} "
     144            global portname $option $newoption
     145            if {\$action != \"read\"} {
     146                $newoption \$$option
     147            } else {
     148                ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\"
     149                $option \[set $newoption\]
     150            }
     151        "
    154152    } else {
    155         eval "proc warn_deprecated_$option \{option action args\} \{ \n\
    156             global portname $option $newoption \n\
    157             ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\" \n\
    158         \}"
     153        proc warn_deprecated_$option {option action args} "
     154            global portname $option $newoption
     155            ui_warn \"Port \$portname using deprecated option \\\"$option\\\".\"
     156        "
    159157    }
    160158    option_proc $option warn_deprecated_$option
     
    174172    upvar $optionName optionValue
    175173    switch $op {
    176         w {
    177             foreach p $option_procs($optionName) {
    178                 eval "$p $optionName set ${optionValue}"
    179             }
    180             return
    181         }
    182         r {
    183             foreach p $option_procs($optionName) {
    184                 eval "$p $optionName read"
    185             }
    186             return
    187         }
    188         u {
    189             foreach p $option_procs($optionName) {
    190                 eval "$p $optionName delete"
    191                 trace vdelete $optionName rwu $p
    192             }
    193             return
    194         }
     174        w {
     175            foreach p $option_procs($optionName) {
     176                $p $optionName set $optionValue
     177            }
     178            return
     179        }
     180        r {
     181            foreach p $option_procs($optionName) {
     182                $p $optionName read
     183            }
     184            return
     185        }
     186        u {
     187            foreach p $option_procs($optionName) {
     188                $p $optionName delete
     189                trace vdelete $optionName rwu $p
     190            }
     191            return
     192        }
    195193    }
    196194}
     
    10301028    # Thus if the user code breaks, dependent targets will not execute.
    10311029    foreach target $args {
    1032         set origproc [ditem_key $ditem procedure]
    1033         set ident [ditem_key $ditem name]
    1034         if {[info commands $target] != ""} {
    1035             ui_debug "$ident registered provides \'$target\', a pre-existing procedure. Target override will not be provided"
    1036         } else {
    1037             eval "proc $target {args} \{ \n\
    1038                         variable proc_index \n\
    1039                         set proc_index \[llength \[ditem_key $ditem proc\]\] \n\
    1040                         ditem_key $ditem procedure proc-${ident}-${target}-\${proc_index}
    1041                         eval \"proc proc-${ident}-${target}-\${proc_index} \{name\} \{ \n\
    1042                                 if \{\\\[catch userproc-${ident}-${target}-\${proc_index} result\\\]\} \{ \n\
    1043                                         return -code error \\\$result \n\
    1044                                 \} else \{ \n\
    1045                                         return 0 \n\
    1046                                 \} \n\
    1047                         \}\" \n\
    1048                         eval \"proc do-$target \{\} \{ $origproc $target\}\" \n\
    1049                         makeuserproc userproc-${ident}-${target}-\${proc_index} \$args \n\
    1050                 \}"
    1051         }
    1052         eval "proc pre-$target {args} \{ \n\
    1053                         variable proc_index \n\
    1054                         set proc_index \[llength \[ditem_key $ditem pre\]\] \n\
    1055                         ditem_append $ditem pre proc-pre-${ident}-${target}-\${proc_index}
    1056                         eval \"proc proc-pre-${ident}-${target}-\${proc_index} \{name\} \{ \n\
    1057                                 if \{\\\[catch userproc-pre-${ident}-${target}-\${proc_index} result\\\]\} \{ \n\
    1058                                         return -code error \\\$result \n\
    1059                                 \} else \{ \n\
    1060                                         return 0 \n\
    1061                                 \} \n\
    1062                         \}\" \n\
    1063                         makeuserproc userproc-pre-${ident}-${target}-\${proc_index} \$args \n\
    1064                 \}"
    1065         eval "proc post-$target {args} \{ \n\
    1066                         variable proc_index \n\
    1067                         set proc_index \[llength \[ditem_key $ditem post\]\] \n\
    1068                         ditem_append $ditem post proc-post-${ident}-${target}-\${proc_index}
    1069                         eval \"proc proc-post-${ident}-${target}-\${proc_index} \{name\} \{ \n\
    1070                                 if \{\\\[catch userproc-post-${ident}-${target}-\${proc_index} result\\\]\} \{ \n\
    1071                                         return -code error \\\$result \n\
    1072                                 \} else \{ \n\
    1073                                         return 0 \n\
    1074                                 \} \n\
    1075                         \}\" \n\
    1076                         makeuserproc userproc-post-${ident}-${target}-\${proc_index} \$args \n\
    1077                 \}"
     1030        set origproc [ditem_key $ditem procedure]
     1031        set ident [ditem_key $ditem name]
     1032        if {[info commands $target] != ""} {
     1033            ui_debug "$ident registered provides '$target', a pre-existing procedure. Target override will not be provided"
     1034        } else {
     1035            proc $target {args} "
     1036                variable proc_index
     1037                set proc_index \[llength \[ditem_key $ditem proc\]\]
     1038                ditem_key $ditem procedure proc-${ident}-${target}-\${proc_index}
     1039                proc proc-${ident}-${target}-\${proc_index} {name} \"
     1040                    if {\\\[catch userproc-${ident}-${target}-\${proc_index} result\\\]} {
     1041                        return -code error \\\$result
     1042                    } else {
     1043                        return 0
     1044                    }
     1045                \"
     1046                proc do-$target {} { $origproc $target }
     1047                makeuserproc userproc-${ident}-${target}-\${proc_index} \$args
     1048            "
     1049        }
     1050        proc pre-$target {args} "
     1051            variable proc_index
     1052            set proc_index \[llength \[ditem_key $ditem pre\]\]
     1053            ditem_append $ditem pre proc-pre-${ident}-${target}-\${proc_index}
     1054            proc proc-pre-${ident}-${target}-\${proc_index} {name} \"
     1055                if {\\\[catch userproc-pre-${ident}-${target}-\${proc_index} result\\\]} {
     1056                    return -code error \\\$result
     1057                } else {
     1058                    return 0
     1059                }
     1060            \"
     1061            makeuserproc userproc-pre-${ident}-${target}-\${proc_index} \$args
     1062        "
     1063        proc post-$target {args} "
     1064            variable proc_index
     1065            set proc_index \[llength \[ditem_key $ditem post\]\]
     1066            ditem_append $ditem post proc-post-${ident}-${target}-\${proc_index}
     1067            proc proc-post-${ident}-${target}-\${proc_index} {name} \"
     1068                if {\\\[catch userproc-post-${ident}-${target}-\${proc_index} result\\\]} {
     1069                    return -code error \\\$result
     1070                } else {
     1071                    return 0
     1072                }
     1073            \"
     1074            makeuserproc userproc-post-${ident}-${target}-\${proc_index} \$args
     1075        "
    10781076    }
    10791077    eval "ditem_append $ditem provides $args"
Note: See TracChangeset for help on using the changeset viewer.