Changeset 124243 for trunk/base


Ignore:
Timestamp:
Aug 21, 2014, 6:36:26 PM (6 years ago)
Author:
shasha@…
Message:

Merge of Interactive Port Command project. Details: http://trac.macports.org/wiki/SummerOfCode2014_interactive

Location:
trunk/base
Files:
13 edited

Legend:

Unmodified
Added
Removed
  • trunk/base

  • trunk/base/doc/port.1

    r123679 r124243  
    2525.sp
    2626.nf
    27 \fBport\fR [\fB\-bcdfknopqRstuvy\fR] [\fB\-D\fR \fIportdir\fR] [\fB\-F\fR \fIcmdfile\fR] [\fIaction\fR] [\fIactionflags\fR]
     27\fBport\fR [\fB\-bcdfknNopqRstuvy\fR] [\fB\-D\fR \fIportdir\fR] [\fB\-F\fR \fIcmdfile\fR] [\fIaction\fR] [\fIactionflags\fR]
    2828     [[\fIportname\fR | \fIpseudo\-portname\fR | \fIport\-expressions\fR | \fIport\-url\fR]]
    2929     [[\fI@version\fR] [+/\-variant \&...] \&... [option=value \&...]]
     
    465465\-q
    466466.RS 4
    467 Quiet mode, suppress informational messages to a minimum
     467Quiet mode, suppress informational messages to a minimum, implies \-N
     468.RE
     469.PP
     470\-N
     471.RS 4
     472Non-Interactive mode, no interactive questions asked
    468473.RE
    469474.PP
  • trunk/base/doc/port.1.txt

    r123677 r124243  
    1111--------
    1212[cmdsynopsis]
    13 *port* [*-bcdfknopqRstuvy*] [*-D* 'portdir'] [*-F* 'cmdfile'] ['action'] ['actionflags']
     13*port* [*-bcdfknNopqRstuvy*] [*-D* 'portdir'] [*-F* 'cmdfile'] ['action'] ['actionflags']
    1414     [['portname' | 'pseudo-portname' | 'port-expressions' | 'port-url']]
    1515     [['@version'] [+/-variant ...] ... [option=value ...]]
     
    131131
    132132-q::
    133     Quiet mode, suppress informational messages to a minimum
     133    Quiet mode, suppress informational messages to a minimum, implies -N
     134
     135-N::
     136    Non-interactive mode, interactive questions are not asked
    134137
    135138.Installation and upgrade
  • trunk/base/src/macports1.0/macports.tcl

    r124047 r124243  
    20582058        # print the dep list
    20592059        if {[llength $dlist] > 0} {
    2060             set depstring "$macports::ui_prefix Dependencies to be installed:"
    2061             foreach ditem $dlist {
    2062                 append depstring " [ditem_key $ditem provides]"
    2063             }
    2064             ui_msg $depstring
    2065         }
    2066 
     2060            ##
     2061            # User Interaction Question
     2062            # Asking before installing dependencies
     2063            if {[info exists macports::ui_options(questions_yesno)]} {
     2064                set deplist {}
     2065                foreach ditem $dlist {
     2066                    lappend deplist [ditem_key $ditem provides]
     2067                }
     2068                set retvalue [$macports::ui_options(questions_yesno) "The following dependencies will be installed: " "TestCase#2" [lsort $deplist] {y} 0]
     2069                if {$retvalue == 1} {
     2070                    return 0
     2071                }
     2072            } else {
     2073                set depstring "$macports::ui_prefix Dependencies to be installed:"
     2074                foreach ditem $dlist {
     2075                    append depstring " [ditem_key $ditem provides]"
     2076                }
     2077                ui_msg $depstring
     2078            }
     2079        }
     2080               
    20672081        # install them
    20682082        set result [dlist_eval $dlist _mportactive [list _mportexec activate]]
     
    48714885        }
    48724886
    4873         ui_msg "$macports::ui_prefix Rebuilding in order"
     4887        set broken_portnames {}
     4888        if {![info exists macports::ui_options(questions_yesno)]} {
     4889            ui_msg "$macports::ui_prefix Rebuilding in order"
     4890        }
    48744891        foreach port $topsort_ports {
    4875             ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
     4892            lappend broken_portnames [$port name]@[$port version][$port variants]
     4893            if {![info exists macports::ui_options(questions_yesno)]} {
     4894                ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
     4895            }
     4896        }
     4897
     4898        ##
     4899        # User Interaction Question
     4900        # Asking before rebuilding in rev-upgrade
     4901        if {[info exists macports::ui_options(questions_yesno)]} {
     4902            ui_msg "You can always run 'port rev-upgrade' again to fix errors."
     4903            set retvalue [$macports::ui_options(questions_yesno) "The following ports will be rebuilt:" "TestCase#1" $broken_portnames {y} 0]
     4904            if {$retvalue == 1} {
     4905                # quit as user answered 'no'
     4906                return 0
     4907            }
     4908            unset macports::ui_options(questions_yesno)
    48764909        }
    48774910
  • trunk/base/src/pextlib1.0/Makefile.in

  • trunk/base/src/pextlib1.0/sha2.c

  • trunk/base/src/pextlib1.0/sha2.h

  • trunk/base/src/port/port.tcl

    r124047 r124243  
    316316        set portname [lindex $ilist 0 0]
    317317        ui_notice "The following versions of $portname are currently installed:"
    318         foreach i [portlist_sortint $ilist] { 
     318        foreach i [portlist_sortint $ilist] {
    319319            set iname [lindex $i 0]
    320320            set iversion [lindex $i 1]
     
    333333    }
    334334}
    335 
    336335
    337336proc entry_for_portlist {portentry} {
     
    44944493                    q {
    44954494                        set ui_options(ports_quiet) yes
     4495                        # quiet implies noninteractive
     4496                        set ui_options(ports_noninteractive) yes
    44964497                    }
    44974498                    p {
    44984499                        # Ignore errors while processing within a command
    44994500                        set ui_options(ports_processall) yes
     4501                    }
     4502                    N {
     4503                        # Interactive mode is available or not
     4504                        set ui_options(ports_noninteractive) yes
    45004505                    }
    45014506                    f {
     
    52865291}
    52875292
     5293# Create namespace for questions
     5294namespace eval portclient::questions {
     5295       
     5296        package require Tclx
     5297        ##
     5298        # Function that handles printing of a timeout.
     5299        #
     5300        # @param time
     5301        #        The amount of time for which a timeout is to occur.
     5302        # @param def
     5303        #        The default action to be taken in the occurence of a timeout.
     5304        proc ui_timeout {def timeout} {
     5305                fconfigure stdin -blocking 0
     5306
     5307                signal error {TERM INT}
     5308                while {$timeout >= 0} {
     5309                        if {[catch {set inp [read stdin]} err]} {
     5310                                return -code error "Ctrl-C"
     5311                        }
     5312                        if {$inp eq "\n"} {
     5313                                return $def
     5314                        }
     5315                        puts -nonewline "\r"
     5316                        puts -nonewline [format "Continuing in %02d s. Press Ctrl-C to exit: " $timeout]
     5317                        flush stdout
     5318                        after 1000
     5319                        incr timeout -1
     5320                }
     5321                puts ""
     5322                fconfigure stdin -blocking 1
     5323                signal -restart error {TERM INT}
     5324                return $def
     5325        }
     5326       
     5327        ##
     5328        # Main function that displays numbered choices for a multiple choice question.
     5329        #
     5330        # @param msg
     5331        #        The question specific message that is to be printed before asking the question.
     5332        # @param ???name???
     5333        #        May be a qid will be of better use instead as the client does not do anything port specific.
     5334        # @param ports
     5335        #        The list of ports for which the question is being asked.
     5336        proc ui_choice {msg name ports} {
     5337                # Print the main message
     5338                puts $msg
     5339               
     5340                # Print portname or port list suitably
     5341                set i 1
     5342                foreach port $ports {
     5343                        puts -nonewline " $i) "
     5344                        puts [string map {@ " @" ( " ("} $port]
     5345                        incr i
     5346                }
     5347        }
     5348       
     5349        ##
     5350        # Displays a question with 'yes' and 'no' as options.
     5351        # Waits for user input indefinitely unless a timeout is specified.
     5352        # Shows the list of port passed to it without any numbers.
     5353        #
     5354        # @param msg
     5355        #        The question specific message that is to be printed before asking the question.
     5356        # @param ???name???
     5357        #        May be a qid will be of better use instead as the client does not do anything port specific.
     5358        # @param ports
     5359        #        The port/list of ports for which the question is being asked.
     5360        # @param def
     5361        #        The default answer to the question.
     5362        # @param time
     5363        #                The amount of time for which a timeout is to occur.
     5364        proc ui_ask_yesno {msg name ports def {timeout 0}} {
     5365                # Set number default to the given letter default
     5366                if {$def == {y}} {
     5367                        set default 0
     5368                } else {
     5369                        set default 1
     5370                }
     5371               
     5372                puts -nonewline $msg
     5373                set leftmargin " "
     5374               
     5375                # Print portname or port list suitably
     5376                if {[llength $ports] == 1} {
     5377                        puts -nonewline " "
     5378                        puts [string map {@ " @"} $ports]
     5379                } else {
     5380                        puts ""
     5381                        foreach port $ports {
     5382                                puts -nonewline $leftmargin 
     5383                                puts [string map {@ " @"} $port]
     5384                        }
     5385                }
     5386               
     5387                # Check if timeout is set or not
     5388                if {$timeout > 0} {
     5389                        # Run ui_timeout and skip the rest of the stuff here
     5390                        return [ui_timeout $default $timeout]
     5391                }
     5392                               
     5393                # Check for the default and print accordingly
     5394                if {$def == {y}} {
     5395                        puts -nonewline "Continue? \[Y/n\]: "
     5396                        flush stdout
     5397                } else {
     5398                        puts -nonewline "Continue? \[y/N\]: "
     5399                        flush stdout
     5400                }
     5401               
     5402                # User input (probably requires some input error checking code)
     5403                while 1 {
     5404                        signal error {TERM INT}
     5405                        if {[catch {set input [gets stdin]} err]} {
     5406                                return -code error "Ctrl-C"
     5407                        }
     5408                        signal -restart error {TERM INT}
     5409                        if {$input in {y Y}} {
     5410                                return 0
     5411                        } elseif {$input in {n N}} {
     5412                                return 1
     5413                        } elseif {$input == ""} {
     5414                                return $default
     5415                        } else {
     5416                                puts "Please enter either 'y' or 'n'."
     5417                        }
     5418                }
     5419        }
     5420       
     5421        ##
     5422        # Displays a question with a list of numbered choices and asks the user to enter a number to specify their choice.
     5423        # Waits for user input indefinitely.
     5424        #
     5425        # @param msg
     5426        #        The question specific message that is to be printed before asking the question.
     5427        # @param ???name???
     5428        #        May be a qid will be of better use instead as the client does not do anything port specific.
     5429        # @param ports
     5430        #        The port/list of ports for which the question is being asked.
     5431        proc ui_ask_singlechoice {msg name ports} {
     5432                ui_choice $msg $name $ports
     5433                               
     5434                # User Input (single input restriction)
     5435                while 1 {
     5436                        puts -nonewline "Enter a number to select an option: "
     5437                        flush stdout
     5438                        signal error {TERM INT}
     5439                        if {[catch {set input [gets stdin]} err]} {
     5440                                return -code error "Ctrl-C"
     5441                        }
     5442                        signal -restart error {TERM INT}
     5443                        if {($input <= [llength $ports] && [string is integer -strict $input])} {
     5444                                return $input
     5445                        } else {
     5446                                puts "Please enter an index from the above list."
     5447                        }
     5448                }
     5449        }
     5450       
     5451        ##
     5452        # Displays a question with a list of numbered choices and asks the user to enter a space separated string of numbers to specify their choice.
     5453        # Waits for user input indefinitely.
     5454        #
     5455        # @param msg
     5456        #        The question specific message that is to be printed before asking the question.
     5457        # @param ???name???
     5458        #        May be a qid will be of better use instead as the client does not do anything port specific.
     5459        # @param ports
     5460        #        The list of ports for which the question is being asked.
     5461        proc ui_ask_multichoice {msg name ports} {
     5462               
     5463                ui_choice $msg $name $ports
     5464                               
     5465                # User Input (with Multiple input parsing)
     5466                while 1 {
     5467                        puts -nonewline "Enter the numbers to select the options: "
     5468                        flush stdout
     5469                        signal error {TERM INT}
     5470                        if {[catch {set input [gets stdin]} err]} {
     5471                                return -code error "Ctrl-C"
     5472                        }
     5473                        signal -restart error {TERM INT}
     5474                        set count 0
     5475                        # check if input is non-empty and otherwise fine
     5476                        if {$input == ""} {
     5477                                continue
     5478                        }
     5479                        foreach num $input {
     5480                                if {($num <= [llength $ports] && [string is integer -strict $num])} {
     5481                                        incr count
     5482                                } else {
     5483                                        puts "Please enter numbers separated by a space which are indices from the above list."
     5484                                        break
     5485                                }
     5486                        }
     5487                        if {$count == [llength $input]} {
     5488                                return $input
     5489                        }
     5490                }
     5491        }
     5492}
    52885493
    52895494##########################################
     
    53395544    set ui_options(progress_download) portclient::progress::download
    53405545    set ui_options(progress_generic)  portclient::progress::generic
     5546}
     5547
     5548if {[isatty stdin]
     5549        && [isatty stdout]
     5550        && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")
     5551        && (![info exists ui_options(ports_noninteractive)] || $ui_options(ports_noninteractive) ne "yes")} {
     5552        set ui_options(questions_yesno) portclient::questions::ui_ask_yesno
     5553        set ui_options(questions_singlechoice) portclient::questions::ui_ask_singlechoice
     5554        set ui_options(questions_multichoice) portclient::questions::ui_ask_multichoice
    53415555}
    53425556
  • trunk/base/src/registry2.0/portimage.tcl

    r121711 r124243  
    186186    }
    187187
    188     ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $specifier]"
    189 
    190188    if { [$requested installtype] ne "image" } {
    191189        return -code error "Image error: ${name} @${specifier} not installed as an image."
     
    195193        return -code error "Image error: ${name} @${specifier} is not active."
    196194    }
    197 
     195       
    198196    if {![info exists options(ports_nodepcheck)] || ![string is true -strict $options(ports_nodepcheck)]} {
    199         registry::check_dependents $requested $force "deactivate"
    200     }
    201 
     197        set retvalue [registry::check_dependents $requested $force "deactivate"]
     198        if {$retvalue eq "quit"} {
     199            return
     200        }
     201    }
     202
     203    ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $specifier]"
     204       
    202205    _deactivate_contents $requested [$requested files] $force
    203206}
     
    221224
    222225    if { [llength $ilist] > 1 } {
    223         ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
     226        set portilist {}
     227        set msg "The following versions of $name are currently installed:"
     228        if {[macports::ui_isset ports_noninteractive]} {
     229            ui_msg "$UI_PREFIX [msgcat::mc $msg]"
     230        }
    224231        foreach i $ilist {
    225232            set iname [$i name]
     
    227234            set irevision [$i revision]
    228235            set ivariants [$i variants]
    229             if { [$i state] eq "installed" } {
    230                 ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
     236            ##
     237            # User Interaction Question
     238            # Asking choice to select option in case of ambiguous activate
     239            if {[info exists macports::ui_options(questions_singlechoice)]} {
     240                if { [$i state] eq "installed" } {
     241                    lappend portilist $iname@${iversion}_${irevision}${ivariants}(active)
     242                } else {
     243                    lappend portilist $iname@${iversion}_${irevision}${ivariants}
     244                }
    231245            } else {
    232                 ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
    233             }
     246                if { [$i state] eq "installed" } {
     247                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
     248                } else {
     249                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
     250                }
     251            }
     252        }
     253        if {[info exists macports::ui_options(questions_singlechoice)]} {
     254            set retvalue [$macports::ui_options(questions_singlechoice) $msg "Choice_Q1" $portilist]
     255            set index [expr { $retvalue - 1 }]
     256            return [lindex $ilist $index]
    234257        }
    235258        throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
  • trunk/base/src/registry2.0/portuninstall.tcl

    r119694 r124243  
    4242namespace eval registry_uninstall {
    4343
     44# generate list of all dependencies of the port
     45proc generate_deplist {port {optslist ""}} {
     46    array set options $optslist
     47    # note deps before we uninstall if we're going to uninstall them too
     48    if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
     49        set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
     50        set all_dependencies {}
     51        # look up deps from the saved portfile if possible
     52        if {![catch {set mport [mportopen_installed [$port name] [$port version] [$port revision] [$port variants] $optslist]}]} {
     53            array set depportinfo [mportinfo $mport]
     54            mportclose $mport
     55            foreach type $deptypes {
     56                if {[info exists depportinfo($type)]} {
     57                    foreach dep $depportinfo($type) {
     58                        lappend all_dependencies [lindex [split $dep :] end]
     59                    }
     60                }
     61            }
     62            # append those from the registry (could be different because of path deps)
     63            foreach dep [$port dependencies] {
     64                lappend all_dependencies [$dep name]
     65            }
     66        } else {
     67            # grab the deps from the dep map
     68            set portname [$port name]
     69            set depmaplist [registry::list_depends $portname [$port version] [$port revision] [$port variants]]
     70            foreach dep $depmaplist {
     71                lappend all_dependencies [lindex $dep 0]
     72            }
     73            # and the ones from the current portfile
     74            if {![catch {mportlookup $portname} result] && [llength $result] >= 2} {
     75                array set depportinfo [lindex $result 1]
     76                set porturl $depportinfo(porturl)
     77                set variations {}
     78                set minusvariant [lrange [split [registry::property_retrieve $port negated_variants] -] 1 end]
     79                set plusvariant [lrange [split [$port variants] +] 1 end]
     80                foreach v $plusvariant {
     81                    lappend variations $v "+"
     82                }
     83                foreach v $minusvariant {
     84                    lappend variations $v "-"
     85                            }
     86                if {![catch {set mport [mportopen $porturl [concat $optionslist subport $portname] [array get variations]]} result]} {
     87                    array unset depportinfo
     88                    array set depportinfo [mportinfo $mport]
     89                    mportclose $mport
     90                }
     91                foreach type $deptypes {
     92                    if {[info exists depportinfo($type)]} {
     93                        foreach dep $depportinfo($type) {
     94                            lappend all_dependencies [lindex [split $dep :] end]
     95                        }
     96                    }
     97                }
     98            }
     99        }
     100        array unset depportinfo
     101        set all_dependencies [lsort -unique $all_dependencies]
     102        return $all_dependencies
     103    }
     104    return {}
     105}
     106
    44107# takes a composite version spec rather than separate version,revision,variants
    45108proc uninstall_composite {portname {v ""} {optionslist ""}} {
     
    90153        # set portname again since the one we were passed may not have had the correct case
    91154        set portname [[lindex $ilist 0] name]
    92         ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $portname are currently installed:"]"
    93         foreach i [portlist_sortint $ilist] {
     155        set msg "The following versions of $portname are currently installed:"
     156        if {[macports::ui_isset ports_noninteractive]} {
     157            ui_msg "$UI_PREFIX [msgcat::mc $msg]"
     158        }
     159        set sortedlist [portlist_sortint $ilist]
     160        foreach i $sortedlist {
    94161            set ispec "[$i version]_[$i revision][$i variants]"
    95             if {[$i state] eq "installed"} {
    96                 ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s (active)"] [$i name] $ispec]"
     162            ##
     163            # User Interaction Question
     164            # Asking choice to select option in case of ambiguous uninstall
     165            if {[info exists macports::ui_options(questions_multichoice)]} {
     166                if { [$i state] eq "installed" } {
     167                    lappend portilist [$i name]@[$i version]_[$i revision][$i variants](active)
     168                } else {
     169                    lappend portilist [$i name]@[$i version]_[$i revision][$i variants]
     170                }
    97171            } else {
    98                 ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s"] [$i name] $ispec]"
    99             }
     172                if {[$i state] eq "installed"} {
     173                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s (active)"] [$i name] $ispec]"
     174                } else {
     175                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s"] [$i name] $ispec]"
     176                }
     177            }
     178        }
     179        if {[info exists macports::ui_options(questions_multichoice)]} {
     180            set retstring [$macports::ui_options(questions_multichoice) $msg "Choice_Q2" $portilist]
     181            foreach index $retstring {
     182                set uport [lindex $sortedlist [expr { $index - 1 }]]
     183                uninstall [$uport name] [$uport version] [$uport revision] [$uport variants]
     184            }
     185            return 0
    100186        }
    101187        throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
     
    113199    }
    114200
     201    set userinput {}
    115202    # uninstall dependents if requested
    116203    if {[info exists options(ports_uninstall_follow-dependents)] && $options(ports_uninstall_follow-dependents) eq "yes"} {
     
    135222    } else {
    136223        # check its dependents
    137         registry::check_dependents $port ${uninstall.force} "uninstall"
     224        set userinput [registry::check_dependents $port ${uninstall.force} "uninstall"]
     225        if {$userinput eq "quit"} {
     226            return 0
     227        }
    138228    }
    139229    # if it's active, deactivate it
     
    142232            ui_msg "For $portname @${composite_spec}: skipping deactivate (dry run)"
    143233        } else {
    144             if {[info exists options(ports_uninstall_no-exec)] || ![registry::run_target $port deactivate $optionslist]} {
    145                 portimage::deactivate $portname $version $revision $variants [array get options]
     234            if {$userinput eq "forcedbyuser"} {
     235                set options(ports_nodepcheck) "yes"
     236            }
     237            if {[info exists options(ports_uninstall_no-exec)] || ![registry::run_target $port deactivate [array get options]]} {
     238                if {$userinput eq "forcedbyuser"} {
     239                    portimage::deactivate $portname $version $revision $variants [array get options]
     240                    unset options(ports_nodepcheck)
     241                } else {
     242                    portimage::deactivate $portname $version $revision $variants [array get options]
     243                }
    146244            }
    147245        }
     
    149247
    150248    set ref $port
    151 
    152     # note deps before we uninstall if we're going to uninstall them too
    153     if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
    154         set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
    155         set all_dependencies {}
    156         # look up deps from the saved portfile if possible
    157         if {![catch {set mport [mportopen_installed [$port name] [$port version] [$port revision] [$port variants] $optionslist]}]} {
    158             array set depportinfo [mportinfo $mport]
    159             mportclose $mport
    160             foreach type $deptypes {
    161                 if {[info exists depportinfo($type)]} {
    162                     foreach dep $depportinfo($type) {
    163                         lappend all_dependencies [lindex [split $dep :] end]
    164                     }
    165                 }
    166             }
    167             # append those from the registry (could be different because of path deps)
    168             foreach dep [$port dependencies] {
    169                 lappend all_dependencies [$dep name]
    170             }
    171         } else {
    172             # grab the deps from the dep map
    173             set depmaplist [registry::list_depends $portname $version $revision $variants]
    174             foreach dep $depmaplist {
    175                 lappend all_dependencies [lindex $dep 0]
    176             }
    177             # and the ones from the current portfile
    178             if {![catch {mportlookup $portname} result] && [llength $result] >= 2} {
    179                 array set depportinfo [lindex $result 1]
    180                 set porturl $depportinfo(porturl)
    181                 set variations {}
    182                 set minusvariant [lrange [split [registry::property_retrieve $ref negated_variants] -] 1 end]
    183                 set plusvariant [lrange [split $variants +] 1 end]
    184                 foreach v $plusvariant {
    185                     lappend variations $v "+"
    186                 }
    187                 foreach v $minusvariant {
    188                     lappend variations $v "-"
    189                 }
    190                 if {![catch {set mport [mportopen $porturl [concat $optionslist subport $portname] [array get variations]]} result]} {
    191                     array unset depportinfo
    192                     array set depportinfo [mportinfo $mport]
    193                     mportclose $mport
    194                 }
    195                 foreach type $deptypes {
    196                     if {[info exists depportinfo($type)]} {
    197                         foreach dep $depportinfo($type) {
    198                             lappend all_dependencies [lindex [split $dep :] end]
    199                         }
    200                     }
    201                 }
    202             }
    203         }
    204         array unset depportinfo
    205         set all_dependencies [lsort -unique $all_dependencies]
     249    # save list of dependencies if --follow-dependencies specified
     250    if {[info exists options(ports_uninstall_follow-dependencies)]} {
     251        set all_dependencies [registry_uninstall::generate_deplist $port $optionslist]
    206252    }
    207253
     
    251297    }
    252298   
    253     # uninstall dependencies if requested
     299    set uports {}
     300    # create list of all dependencies that will be uninstalled, if requested
    254301    if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
    255302        # don't uninstall dependencies' dependents
     
    258305            set optionslist [array get options]
    259306        }
    260         while 1 {
    261             set remaining_list {}
    262             foreach dep $all_dependencies {
    263                 if {![catch {set ilist [registry::installed $dep]}]} {
    264                     set remaining 0
    265                     foreach i $ilist {
    266                         set iversion [lindex $i 1]
    267                         set irevision [lindex $i 2]
    268                         set ivariants [lindex $i 3]
    269                         if {[llength [registry::list_dependents $dep $iversion $irevision $ivariants]] == 0} {
    270                             set regref [registry::open_entry $dep $iversion $irevision $ivariants [lindex $i 5]]
    271                             if {![registry::property_retrieve $regref requested] && ([info exists options(ports_uninstall_no-exec)] || ![registry::run_target $regref uninstall $optionslist])} {
    272                                 registry_uninstall::uninstall $dep $iversion $irevision $ivariants $optionslist
     307        set alldeps $all_dependencies
     308        set portilist {}
     309        for {set j 0} {$j < [llength $alldeps]} {incr j} {
     310            set dep [lindex $alldeps $j]
     311            if {![catch {set ilist [registry::installed $dep]}]} {
     312                foreach i $ilist {
     313                    set dependents {}
     314                    set iversion [lindex $i 1]
     315                    set irevision [lindex $i 2]
     316                    set ivariants [lindex $i 3]
     317                    set dependentlist [registry::list_dependents $dep $iversion $irevision $ivariants]
     318                    foreach depdt $dependentlist {
     319                        lappend dependents [lindex $depdt 2]
     320                    }
     321                    set regref [registry::open_entry $dep $iversion $irevision $ivariants [lindex $i 5]]
     322                    if {![registry::property_retrieve $regref requested]} {
     323                        if {[llength $dependents] == 0} {
     324                            lappend uports $dep
     325                            lappend portilist $dep@[lindex $i 1]_$irevision
     326                        } else {
     327                            foreach depdt $dependents {
     328                                set count 0
     329                                foreach p $uports {
     330                                    if {[string match $p $depdt]} {
     331                                        incr count
     332                                    }
     333                                }
     334                                if {$count == [llength $dependents]} {
     335                                    lappend uports $dep
     336                                    lappend portilist $dep@[lindex $i 1]_$irevision
     337                                }
    273338                            }
    274                         } else {
    275                             set remaining 1
    276339                        }
    277340                    }
    278                     if {$remaining} {
    279                         lappend remaining_list $dep
    280                     }
    281                 }
    282             }
    283             if {[llength $remaining_list] == 0 || [llength $remaining_list] == [llength $all_dependencies]} {
    284                 break
    285             }
    286             set all_dependencies $remaining_list
    287         }
    288     }
    289    
     341                }
     342            }
     343            set depref [registry::entry imaged $dep]
     344            set depdeps [registry_uninstall::generate_deplist $depref $optionslist]
     345            foreach d $depdeps {
     346                set index [lsearch $alldeps $d]
     347                if {$index == -1} {
     348                    lappend alldeps $d
     349                }
     350            }
     351        }
     352        ## User Interaction Question
     353        # show a list of all dependencies to be uninstalled with a timeout when --follow-dependencies is specified
     354        if {[info exists macports::ui_options(questions_yesno)]} {
     355            $macports::ui_options(questions_yesno) "The following dependencies will be uninstalled:" "Timeout_1" $portilist {y} 10
     356        }
     357        unset options(ports_uninstall_follow-dependencies)
     358    }
     359
     360    # uninstall all dependencies in order from uports
     361    foreach dp $uports {
     362        if {![catch {set ilist [registry::installed $dp]}]} {
     363            foreach i $ilist {
     364                set iversion [lindex $i 1]
     365                set irevision [lindex $i 2]
     366                set ivariants [lindex $i 3]
     367                set regref [registry::open_entry $dp $iversion $irevision $ivariants [lindex $i 5]]
     368                if {[info exists options(ports_uninstall_no-exec)] || ![registry::run_target $regref uninstall [array get options]]} {
     369                    registry_uninstall::uninstall $dp $iversion $irevision $ivariants [array get options]
     370                }
     371            }
     372        }
     373    }
     374
    290375    return 0
    291376}
  • trunk/base/src/registry2.0/receipt_sqlite.tcl

  • trunk/base/src/registry2.0/registry_util.tcl

    r117407 r124243  
    7878        }
    7979        if { [llength $deplist] > 0 } {
    80             ui_msg "$UI_PREFIX [format [msgcat::mc "Unable to %s %s @%s_%s%s, the following ports depend on it:"] $action [$port name] [$port version] [$port revision] [$port variants]]"
    81             foreach depport $deplist {
    82                 ui_msg "$UI_PREFIX [format [msgcat::mc "        %s @%s_%s%s"] [$depport name] [$depport version] [$depport revision] [$depport variants]]"
     80            ## User Interaction Question
     81            # ask if user wants to uninstall a port and thereby break its dependents
     82            if {[info exists macports::ui_options(questions_yesno)] && ![string is true -strict $force]} {
     83                set portulist {}
     84                foreach depport $deplist {
     85                    lappend portulist [$depport name]@[$depport version]_[$depport revision]
     86                }
     87                ui_msg "Note: It is not recommended to uninstall/deactivate a port that has dependents as it breaks the dependents."
     88                set retvalue [$macports::ui_options(questions_yesno) "The following ports will break:" "breakDeps" $portulist {n} 0]
     89                if {$retvalue == 0} {
     90                    set force "yes"
     91                } else {
     92                    return quit
     93                }
     94            } else {   
     95                ui_msg "$UI_PREFIX [format [msgcat::mc "Unable to %s %s @%s_%s%s, the following ports depend on it:"] $action [$port name] [$port version] [$port revision] [$port variants]]"
     96                foreach depport $deplist {
     97                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] [$depport name] [$depport version] [$depport revision] [$depport variants]]"
     98                }
    8399            }
    84100            if { [string is true -strict $force] } {
    85101                ui_warn "[string totitle $action] forced.  Proceeding despite dependencies."
     102                return forcedbyuser
    86103            } else {
    87104                throw registry::uninstall-error "Please uninstall the ports that depend on [$port name] first."
  • trunk/base/tests/test/library.tcl.in

    r120186 r124243  
    8686    cd $pwd
    8787
    88     set result [catch {exec env PORTSRC=${portsrc} ${bindir}/port -d test >&output} ]
     88    set result [catch {exec env PORTSRC=${portsrc} ${bindir}/port -d -N test >&output} ]
    8989    cd $back
    9090    return $result
Note: See TracChangeset for help on using the changeset viewer.