Ignore:
Timestamp:
Oct 9, 2002, 9:30:05 AM (16 years ago)
Author:
kevin
Message:

Remove 'register' proc.
Now targets have a handle to the target object directly. Alleviates need for
unique names, and simplifies pre-${target}/post-${target} implementation.
Will allow for future enhancement to options and variants.

File:
1 edited

Legend:

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

    r994 r1015  
    384384}
    385385
    386 ########### External Dependancy Manipulation Procedures ###########
    387 # register
    388 # Creates a target in the global target list using the internal dependancy
    389 #     functions
    390 # Arguments: <identifier> <mode> <args ...>
    391 # The following modes are supported:
    392 #       <identifier> target <procedure to execute> [run type]
    393 #       <identifier> init <procedure to execute>
    394 #       <identifier> prerun <procedure to execute>
    395 #       <identifier> postrun <procedure to execute>
    396 #       <identifier> provides <list of target names>
    397 #       <identifier> requires <list of target names>
    398 #       <identifier> uses <list of target names>
    399 #       <identifier> deplist <list of deplist names>
    400 #       <provides> preflight <proc name>
    401 #       <provides> postflight <proc name>
    402 proc register {name mode args} {
    403     global targets target_uniqid
    404    
    405     set obj [dlist_get_by_name $targets $name]
    406     if {$obj == ""} {
    407         set obj [target_new $name]
    408         lappend targets $obj
    409     }
    410    
    411     if {$mode == "target"} {
    412         set procedure [lindex $args 0]
    413         if {[$obj has procedure]} {
    414             ui_debug "Warning: target '$name' re-registered (new procedure: '$procedure')"
    415         }
    416         $obj set procedure $procedure
    417        
    418         # Set runtype {always,once} if available
    419         if {[llength $args] >= 2} {
    420             $obj set runtype [lindex $args 1]
    421         }
    422     } elseif {$mode == "init"} {
    423         set init [lindex $args 0]
    424         if {[$obj has init]} {
    425             ui_debug "Warning: target '$name' re-registered init procedure (new procedure: '$init')"
    426         }
    427         $obj set init $init
    428     } elseif {$mode == "prerun"} {
    429         set prerun [lindex $args 0]
    430         if {[$obj has prerun]} {
    431             ui_debug "Warning: target '$name' re-registered pre-run procedure (new procedure: '$prerun')"
    432         }
    433         $obj prerun $prerun
    434     } elseif {$mode == "postrun"} {
    435         set postrun [lindex $args 0]
    436         if {[$obj has postrun]} {
    437             ui_debug "Warning: target '$name' re-registered post-run procedure (new procedure: '$postrun')"
    438         }
    439         $obj set postrun $postrun
    440     } elseif {$mode == "requires" || $mode == "uses" || $mode == "provides"} {
    441         $obj append $mode $args
    442        
    443         if {$mode == "provides"} {
    444             # If it's a provides, register the pre-/post- hooks for use in Portfile.
    445             # Portfile syntax: pre-fetch { puts "hello world" }
    446             # User-code exceptions are caught and returned as a result of the target.
    447             # Thus if the user code breaks, dependent targets will not execute.
    448             foreach target $args {
    449                 if {[info commands $target] != ""} {
    450                     ui_error "$name attempted to register provide \'$target\' which is a pre-existing procedure. Ignoring register."
    451                     continue;
    452                 }
    453                 set ident [lindex [depspec_get_matches $targets provides $args] 0]
    454                 set origproc [$ident get procedure]
    455                 set ident [$ident get name]
    456                 eval "proc $target {args} \{ \n\
    457                                         global target_uniqid \n\
    458                                         set id \[incr target_uniqid\] \n\
    459                     register $ident target proc-$target\$id \n\
    460                     eval \"proc proc-$target\$id \{name\} \{ \n\
    461                         if \\\[catch userproc-$target\$id result\\\] \{ \n\
    462                                                         ui_info \\\$result \n\
    463                                                         return 1 \n\
    464                                                 \} else \{ \n\
    465                                                         return 0 \n\
    466                                                 \} \n\
    467                     \}\" \n\
    468                     eval \"proc do-$target \{\} \{ $origproc $target\}\" \n\
    469                     makeuserproc userproc-$target\$id \$args \}"
    470                 eval "proc pre-$target {args} \{ \n\
    471                                         global target_uniqid \n\
    472                                         set id \[incr target_uniqid\] \n\
    473                     register $target preflight pre-$target\$id \n\
    474                     eval \"proc pre-$target\$id \{name\} \{ \n\
    475                         if \\\[catch userproc-pre-$target\$id result\\\] \{ \n\
    476                                                         ui_info \\\$result \n\
    477                                                         return 1 \n\
    478                                                 \} else \{ \n\
    479                                                         return 0 \n\
    480                                                 \} \n\
    481                     \}\" \n\
    482                     makeuserproc userproc-pre-$target\$id \$args \}"
    483                 eval "proc post-$target {args} \{ \n\
    484                                         global target_uniqid \n\
    485                                         set id \[incr target_uniqid\] \n\
    486                     register $target postflight post-$target\$id \n\
    487                     eval \"proc post-$target\$id \{name\} \{ \n\
    488                         if \\\[catch userproc-post-$target\$id result\\\] \{ \n\
    489                                                         ui_info \\\$result \n\
    490                                                         return 1 \n\
    491                                                 \} else \{ \n\
    492                                                         return 0 \n\
    493                                                 \} \n\
    494                     \}\" \n\
    495                     makeuserproc userproc-post-$target\$id \$args \}"
    496             }
    497         }
    498        
    499     } elseif {$mode == "deplist"} {
    500         $obj append $mode $args
    501        
    502     } elseif {$mode == "preflight"} {
    503         # Find target which provides the specified name, and add a preflight.
    504         # XXX: this only returns the first match, is this what we want?
    505         set obj [lindex [depspec_get_matches $targets provides $name] 0]
    506         $obj append pre $args
    507        
    508     } elseif {$mode == "postflight"} {
    509         # Find target which provides the specified name, and add a preflight.
    510         # XXX: this only returns the first match, is this what we want?
    511         set obj [lindex [depspec_get_matches $targets provides $name] 0]
    512         $obj append post $args
    513     }
    514 }
    515 
    516 
    517 # unregister
    518 # Unregisters a target in the global target list
    519 # Arguments: target <target name>
    520 proc unregister {mode target} {
    521 }
    522 
    523386########### Internal Dependancy Manipulation Procedures ###########
    524387
     
    974837        set data [$this _data]
    975838        global $data
    976         eval set ${data}($prop) $args
     839        eval "set ${data}($prop) \"$args\""
    977840}
    978841
     
    1022885array set target_vtbl [array get depspec_vtbl]
    1023886set target_vtbl(run) target_run
     887set target_vtbl(provides) target_provides
     888set target_vtbl(requires) target_requires
     889set target_vtbl(uses) target_uses
     890set target_vtbl(deplist) target_deplist
     891set target_vtbl(prerun) target_prerun
     892set target_vtbl(postrun) target_postrun
    1024893
    1025894# constructor for target depspec class
    1026 proc target_new {name} {
    1027     set obj [depspec_new $name]
     895proc target_new {name procedure} {
     896        global targets
     897        set obj [depspec_new $name]
    1028898   
    1029899    $obj set _vtbl target_vtbl
    1030    
     900        $obj set procedure $procedure
     901   
     902        lappend targets $obj
     903       
    1031904    return $obj
     905}
     906
     907proc target_provides {this args} {
     908        global targets
     909        # Register the pre-/post- hooks for use in Portfile.
     910        # Portfile syntax: pre-fetch { puts "hello world" }
     911        # User-code exceptions are caught and returned as a result of the target.
     912        # Thus if the user code breaks, dependent targets will not execute.
     913        foreach target $args {
     914                if {[info commands $target] != ""} {
     915                        ui_error "$name attempted to register provide \'$target\' which is a pre-existing procedure. Ignoring register."
     916                        continue;
     917                }
     918                set origproc [$this get procedure]
     919                set ident [$this get name]
     920                eval "proc $target {args} \{ \n\
     921                        $this set procedure proc-${ident}-${target}
     922                        eval \"proc proc-${ident}-${target} \{name\} \{ \n\
     923                                if \{\\\[catch userproc-${ident}-${target} result\\\]\} \{ \n\
     924                                        ui_info \\\$result \n\
     925                                        return 1 \n\
     926                                \} else \{ \n\
     927                                        return 0 \n\
     928                                \} \n\
     929                        \}\" \n\
     930                        eval \"proc do-$target \{\} \{ $origproc $target\}\" \n\
     931                        makeuserproc userproc-${ident}-${target} \$args \n\
     932                \}"
     933                eval "proc pre-$target {args} \{ \n\
     934                        $this append pre proc-pre-${ident}-${target}
     935                        eval \"proc proc-pre-${ident}-${target} \{name\} \{ \n\
     936                                if \{\\\[catch userproc-pre-${ident}-${target} result\\\]\} \{ \n\
     937                                        ui_info \\\$result \n\
     938                                        return 1 \n\
     939                                \} else \{ \n\
     940                                        return 0 \n\
     941                                \} \n\
     942                        \}\" \n\
     943                        makeuserproc userproc-pre-${ident}-${target} \$args \n\
     944                \}"
     945                eval "proc post-$target {args} \{ \n\
     946                        $this append post proc-post-${ident}-${target}
     947                        eval \"proc proc-post-${ident}-${target} \{name\} \{ \n\
     948                                if \{\\\[catch userproc-post-${ident}-${target} result\\\]\} \{ \n\
     949                                        ui_info \\\$result \n\
     950                                        return 1 \n\
     951                                \} else \{ \n\
     952                                        return 0 \n\
     953                                \} \n\
     954                        \}\" \n\
     955                        makeuserproc userproc-post-${ident}-${target} \$args \n\
     956                \}"
     957        }
     958        eval "depspec_append $this provides $args"
     959}
     960
     961proc target_requires {this args} {
     962        eval "depspec_append $this requires $args"
     963}
     964
     965proc target_uses {this args} {
     966        eval "depspec_append $this uses $args"
     967}
     968
     969proc target_deplist {this args} {
     970        eval "depspec_append $this deplist $args"
     971}
     972
     973proc target_prerun {this args} {
     974        eval "depspec_append $this prerun $args"
     975}
     976
     977proc target_postrun {this args} {
     978        eval "depspec_append $this postrun $args"
    1032979}
    1033980
Note: See TracChangeset for help on using the changeset viewer.