Changeset 124243

Timestamp:

Aug 21, 2014, 6:36:26 PM (10 years ago)

Author:

shasha@…

Message:

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

Location:

trunk/base

Files:

• . (modified) (1 prop)
• doc/port.1 (modified) (2 diffs)
• doc/port.1.txt (modified) (2 diffs)
• src/macports1.0/macports.tcl (modified) (2 diffs)
• src/pextlib1.0/Makefile.in (modified) (1 prop)
• src/pextlib1.0/sha2.c (modified) (1 prop)
• src/pextlib1.0/sha2.h (modified) (1 prop)
• src/port/port.tcl (modified) (5 diffs)
• src/registry2.0/portimage.tcl (modified) (4 diffs)
• src/registry2.0/portuninstall.tcl (modified) (8 diffs)
• src/registry2.0/receipt_sqlite.tcl (modified) (1 prop)
• src/registry2.0/registry_util.tcl (modified) (1 diff)
• tests/test/library.tcl.in (modified) (1 diff)

trunk/base/doc/port.1

@@ -25 +25 @@
 .sp
 .nf
-\fBport\fR [\fB\-bcdfknopqRstuvy\fR] [\fB\-D\fR \fIportdir\fR] [\fB\-F\fR \fIcmdfile\fR] [\fIaction\fR] [\fIactionflags\fR]
+\fBport\fR [\fB\-bcdfknNopqRstuvy\fR] [\fB\-D\fR \fIportdir\fR] [\fB\-F\fR \fIcmdfile\fR] [\fIaction\fR] [\fIactionflags\fR]
      [[\fIportname\fR | \fIpseudo\-portname\fR | \fIport\-expressions\fR | \fIport\-url\fR]]
      [[\fI@version\fR] [+/\-variant \&...] \&... [option=value \&...]]
@@ -465 +465 @@
 \-q
 .RS 4
-Quiet mode, suppress informational messages to a minimum
+Quiet mode, suppress informational messages to a minimum, implies \-N
+.RE
+.PP
+\-N
+.RS 4
+Non-Interactive mode, no interactive questions asked
 .RE
 .PP

trunk/base/doc/port.1.txt

@@ -11 +11 @@
 --------
 [cmdsynopsis]
-*port* [*-bcdfknopqRstuvy*] [*-D* 'portdir'] [*-F* 'cmdfile'] ['action'] ['actionflags']
+*port* [*-bcdfknNopqRstuvy*] [*-D* 'portdir'] [*-F* 'cmdfile'] ['action'] ['actionflags']
      [['portname' | 'pseudo-portname' | 'port-expressions' | 'port-url']]
      [['@version'] [+/-variant ...] ... [option=value ...]]
@@ -131 +131 @@
 
 -q::
-    Quiet mode, suppress informational messages to a minimum
+    Quiet mode, suppress informational messages to a minimum, implies -N
+
+-N::
+    Non-interactive mode, interactive questions are not asked 
 
 .Installation and upgrade

trunk/base/src/macports1.0/macports.tcl

@@ -2058 +2058 @@
         # print the dep list
         if {[llength $dlist] > 0} {
-            set depstring "$macports::ui_prefix Dependencies to be installed:"
-            foreach ditem $dlist {
-                append depstring " [ditem_key $ditem provides]"
-            }
-            ui_msg $depstring
-        }
-
+            ##
+            # User Interaction Question
+            # Asking before installing dependencies
+            if {[info exists macports::ui_options(questions_yesno)]} {
+                set deplist {}
+                foreach ditem $dlist {
+                    lappend deplist [ditem_key $ditem provides]
+                }
+                set retvalue [$macports::ui_options(questions_yesno) "The following dependencies will be installed: " "TestCase#2" [lsort $deplist] {y} 0]
+                if {$retvalue == 1} {
+                    return 0
+                } 
+            } else {
+                set depstring "$macports::ui_prefix Dependencies to be installed:"
+                foreach ditem $dlist {
+                    append depstring " [ditem_key $ditem provides]"
+                }
+                ui_msg $depstring
+            }
+        }
+                
         # install them
         set result [dlist_eval $dlist _mportactive [list _mportexec activate]]
@@ -4871 +4885 @@
         }
 
-        ui_msg "$macports::ui_prefix Rebuilding in order"
+        set broken_portnames {}
+        if {![info exists macports::ui_options(questions_yesno)]} {
+            ui_msg "$macports::ui_prefix Rebuilding in order"
+        }
         foreach port $topsort_ports {
-            ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
+            lappend broken_portnames [$port name]@[$port version][$port variants]
+            if {![info exists macports::ui_options(questions_yesno)]} {
+                ui_msg "     [$port name] @[$port version] [$port variants][$port negated_variants]"
+            }
+        }
+
+        ##
+        # User Interaction Question
+        # Asking before rebuilding in rev-upgrade
+        if {[info exists macports::ui_options(questions_yesno)]} {
+            ui_msg "You can always run 'port rev-upgrade' again to fix errors."
+            set retvalue [$macports::ui_options(questions_yesno) "The following ports will be rebuilt:" "TestCase#1" $broken_portnames {y} 0]
+            if {$retvalue == 1} {
+                # quit as user answered 'no'
+                return 0
+            }
+            unset macports::ui_options(questions_yesno)
         }
 

trunk/base/src/port/port.tcl

@@ -316 +316 @@
         set portname [lindex $ilist 0 0]
         ui_notice "The following versions of $portname are currently installed:"
-        foreach i [portlist_sortint $ilist] { 
+        foreach i [portlist_sortint $ilist] {
             set iname [lindex $i 0]
             set iversion [lindex $i 1]
@@ -333 +333 @@
     }
 }
-
 
 proc entry_for_portlist {portentry} {
@@ -4494 +4493 @@
                     q {
                         set ui_options(ports_quiet) yes
+                        # quiet implies noninteractive
+                        set ui_options(ports_noninteractive) yes
                     }
                     p {
                         # Ignore errors while processing within a command
                         set ui_options(ports_processall) yes
+                    }
+                    N { 
+                        # Interactive mode is available or not
+                        set ui_options(ports_noninteractive) yes
                     }
                     f {
@@ -5286 +5291 @@
 }
 
+# Create namespace for questions
+namespace eval portclient::questions {
+        
+        package require Tclx
+        ##
+        # Function that handles printing of a timeout.
+        #
+        # @param time
+        #        The amount of time for which a timeout is to occur.
+        # @param def
+        #        The default action to be taken in the occurence of a timeout.
+        proc ui_timeout {def timeout} {
+                fconfigure stdin -blocking 0
+
+                signal error {TERM INT}
+                while {$timeout >= 0} {
+                        if {[catch {set inp [read stdin]} err]} {
+                                return -code error "Ctrl-C"
+                        }
+                        if {$inp eq "\n"} {
+                                return $def
+                        }
+                        puts -nonewline "\r"
+                        puts -nonewline [format "Continuing in %02d s. Press Ctrl-C to exit: " $timeout]
+                        flush stdout
+                        after 1000
+                        incr timeout -1
+                }
+                puts ""
+                fconfigure stdin -blocking 1
+                signal -restart error {TERM INT}
+                return $def
+        }
+        
+        ##
+        # Main function that displays numbered choices for a multiple choice question.
+        #
+        # @param msg
+        #        The question specific message that is to be printed before asking the question.
+        # @param ???name???
+        #        May be a qid will be of better use instead as the client does not do anything port specific.
+        # @param ports
+        #        The list of ports for which the question is being asked.
+        proc ui_choice {msg name ports} {
+                # Print the main message
+                puts $msg
+                
+                # Print portname or port list suitably
+                set i 1
+                foreach port $ports {
+                        puts -nonewline " $i) "
+                        puts [string map {@ " @" ( " ("} $port]
+                        incr i
+                }
+        }
+        
+        ##
+        # Displays a question with 'yes' and 'no' as options. 
+        # Waits for user input indefinitely unless a timeout is specified.
+        # Shows the list of port passed to it without any numbers.
+        #
+        # @param msg
+        #        The question specific message that is to be printed before asking the question.
+        # @param ???name???
+        #        May be a qid will be of better use instead as the client does not do anything port specific.
+        # @param ports
+        #        The port/list of ports for which the question is being asked.
+        # @param def
+        #        The default answer to the question.
+        # @param time
+        #                The amount of time for which a timeout is to occur.
+        proc ui_ask_yesno {msg name ports def {timeout 0}} {
+                # Set number default to the given letter default
+                if {$def == {y}} {
+                        set default 0
+                } else {
+                        set default 1
+                }
+                
+                puts -nonewline $msg
+                set leftmargin " "
+                
+                # Print portname or port list suitably
+                if {[llength $ports] == 1} {
+                        puts -nonewline " "
+                        puts [string map {@ " @"} $ports]
+                } else {
+                        puts ""
+                        foreach port $ports {
+                                puts -nonewline $leftmargin  
+                                puts [string map {@ " @"} $port]
+                        }
+                }
+                
+                # Check if timeout is set or not
+                if {$timeout > 0} {
+                        # Run ui_timeout and skip the rest of the stuff here
+                        return [ui_timeout $default $timeout] 
+                }
+                                
+                # Check for the default and print accordingly
+                if {$def == {y}} {
+                        puts -nonewline "Continue? \[Y/n\]: "
+                        flush stdout
+                } else {
+                        puts -nonewline "Continue? \[y/N\]: "
+                        flush stdout
+                }
+                
+                # User input (probably requires some input error checking code) 
+                while 1 {
+                        signal error {TERM INT}
+                        if {[catch {set input [gets stdin]} err]} {
+                                return -code error "Ctrl-C"
+                        }
+                        signal -restart error {TERM INT}
+                        if {$input in {y Y}} {
+                                return 0
+                        } elseif {$input in {n N}} {
+                                return 1
+                        } elseif {$input == ""} {
+                                return $default
+                        } else {
+                                puts "Please enter either 'y' or 'n'."
+                        }
+                }
+        }
+        
+        ##
+        # Displays a question with a list of numbered choices and asks the user to enter a number to specify their choice.
+        # Waits for user input indefinitely.
+        #
+        # @param msg
+        #        The question specific message that is to be printed before asking the question.
+        # @param ???name???
+        #        May be a qid will be of better use instead as the client does not do anything port specific.
+        # @param ports
+        #        The port/list of ports for which the question is being asked.
+        proc ui_ask_singlechoice {msg name ports} {
+                ui_choice $msg $name $ports
+                                
+                # User Input (single input restriction)
+                while 1 {
+                        puts -nonewline "Enter a number to select an option: "
+                        flush stdout
+                        signal error {TERM INT}
+                        if {[catch {set input [gets stdin]} err]} {
+                                return -code error "Ctrl-C"
+                        }
+                        signal -restart error {TERM INT}
+                        if {($input <= [llength $ports] && [string is integer -strict $input])} {
+                                return $input
+                        } else {
+                                puts "Please enter an index from the above list."
+                        }
+                }
+        }
+        
+        ##
+        # 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.
+        # Waits for user input indefinitely.
+        #
+        # @param msg
+        #        The question specific message that is to be printed before asking the question.
+        # @param ???name???
+        #        May be a qid will be of better use instead as the client does not do anything port specific.
+        # @param ports
+        #        The list of ports for which the question is being asked.
+        proc ui_ask_multichoice {msg name ports} {
+                
+                ui_choice $msg $name $ports
+                                
+                # User Input (with Multiple input parsing) 
+                while 1 {
+                        puts -nonewline "Enter the numbers to select the options: "
+                        flush stdout
+                        signal error {TERM INT}
+                        if {[catch {set input [gets stdin]} err]} {
+                                return -code error "Ctrl-C"
+                        }
+                        signal -restart error {TERM INT}
+                        set count 0
+                        # check if input is non-empty and otherwise fine
+                        if {$input == ""} {
+                                continue
+                        }
+                        foreach num $input {
+                                if {($num <= [llength $ports] && [string is integer -strict $num])} {
+                                        incr count
+                                } else {
+                                        puts "Please enter numbers separated by a space which are indices from the above list."
+                                        break
+                                }
+                        }
+                        if {$count == [llength $input]} {
+                                return $input
+                        }
+                }
+        }
+}
 
 ##########################################
@@ -5339 +5544 @@
     set ui_options(progress_download) portclient::progress::download
     set ui_options(progress_generic)  portclient::progress::generic
+}
+
+if {[isatty stdin]
+        && [isatty stdout]
+        && (![info exists ui_options(ports_quiet)] || $ui_options(ports_quiet) ne "yes")
+        && (![info exists ui_options(ports_noninteractive)] || $ui_options(ports_noninteractive) ne "yes")} {
+        set ui_options(questions_yesno) portclient::questions::ui_ask_yesno
+        set ui_options(questions_singlechoice) portclient::questions::ui_ask_singlechoice
+        set ui_options(questions_multichoice) portclient::questions::ui_ask_multichoice
 }
 

trunk/base/src/registry2.0/portimage.tcl

@@ -186 +186 @@
     }
 
-    ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $specifier]"
-
     if { [$requested installtype] ne "image" } {
         return -code error "Image error: ${name} @${specifier} not installed as an image."
@@ -195 +193 @@
         return -code error "Image error: ${name} @${specifier} is not active."
     }
-
+        
     if {![info exists options(ports_nodepcheck)] || ![string is true -strict $options(ports_nodepcheck)]} {
-        registry::check_dependents $requested $force "deactivate"
-    }
-
+        set retvalue [registry::check_dependents $requested $force "deactivate"]
+        if {$retvalue eq "quit"} {
+            return
+        }
+    }
+
+    ui_msg "$UI_PREFIX [format [msgcat::mc "Deactivating %s @%s"] $name $specifier]"
+        
     _deactivate_contents $requested [$requested files] $force
 }
@@ -221 +224 @@
 
     if { [llength $ilist] > 1 } {
-        ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $name are currently installed:"]"
+        set portilist {}
+        set msg "The following versions of $name are currently installed:"
+        if {[macports::ui_isset ports_noninteractive]} {
+            ui_msg "$UI_PREFIX [msgcat::mc $msg]"
+        }
         foreach i $ilist {
             set iname [$i name]
@@ -227 +234 @@
             set irevision [$i revision]
             set ivariants [$i variants]
-            if { [$i state] eq "installed" } {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
+            ##
+            # User Interaction Question
+            # Asking choice to select option in case of ambiguous activate
+            if {[info exists macports::ui_options(questions_singlechoice)]} {
+                if { [$i state] eq "installed" } {
+                    lappend portilist $iname@${iversion}_${irevision}${ivariants}(active)
+                } else {
+                    lappend portilist $iname@${iversion}_${irevision}${ivariants}
+                }
             } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
-            }
+                if { [$i state] eq "installed" } {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s (active)"] $iname $iversion $irevision $ivariants]"
+                } else {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] $iname $iversion $irevision $ivariants]"
+                }
+            }
+        }
+        if {[info exists macports::ui_options(questions_singlechoice)]} {
+            set retvalue [$macports::ui_options(questions_singlechoice) $msg "Choice_Q1" $portilist]
+            set index [expr { $retvalue - 1 }]
+            return [lindex $ilist $index]
         }
         throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."

trunk/base/src/registry2.0/portuninstall.tcl

@@ -42 +42 @@
 namespace eval registry_uninstall {
 
+# generate list of all dependencies of the port
+proc generate_deplist {port {optslist ""}} {
+    array set options $optslist
+    # note deps before we uninstall if we're going to uninstall them too
+    if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
+        set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
+        set all_dependencies {}
+        # look up deps from the saved portfile if possible
+        if {![catch {set mport [mportopen_installed [$port name] [$port version] [$port revision] [$port variants] $optslist]}]} {
+            array set depportinfo [mportinfo $mport]
+            mportclose $mport
+            foreach type $deptypes {
+                if {[info exists depportinfo($type)]} {
+                    foreach dep $depportinfo($type) {
+                        lappend all_dependencies [lindex [split $dep :] end]
+                    }
+                }
+            }
+            # append those from the registry (could be different because of path deps)
+            foreach dep [$port dependencies] {
+                lappend all_dependencies [$dep name]
+            }
+        } else {
+            # grab the deps from the dep map
+            set portname [$port name]
+            set depmaplist [registry::list_depends $portname [$port version] [$port revision] [$port variants]]
+            foreach dep $depmaplist {
+                lappend all_dependencies [lindex $dep 0]
+            }
+            # and the ones from the current portfile
+            if {![catch {mportlookup $portname} result] && [llength $result] >= 2} {
+                array set depportinfo [lindex $result 1]
+                set porturl $depportinfo(porturl)
+                set variations {}
+                set minusvariant [lrange [split [registry::property_retrieve $port negated_variants] -] 1 end]
+                set plusvariant [lrange [split [$port variants] +] 1 end]
+                foreach v $plusvariant {
+                    lappend variations $v "+"
+                }
+                foreach v $minusvariant {
+                    lappend variations $v "-"
+                            }
+                if {![catch {set mport [mportopen $porturl [concat $optionslist subport $portname] [array get variations]]} result]} {
+                    array unset depportinfo
+                    array set depportinfo [mportinfo $mport]
+                    mportclose $mport
+                }
+                foreach type $deptypes {
+                    if {[info exists depportinfo($type)]} {
+                        foreach dep $depportinfo($type) {
+                            lappend all_dependencies [lindex [split $dep :] end]
+                        }
+                    }
+                }
+            }
+        }
+        array unset depportinfo
+        set all_dependencies [lsort -unique $all_dependencies]
+        return $all_dependencies
+    }
+    return {}
+}
+
 # takes a composite version spec rather than separate version,revision,variants
 proc uninstall_composite {portname {v ""} {optionslist ""}} {
@@ -90 +153 @@
         # set portname again since the one we were passed may not have had the correct case
         set portname [[lindex $ilist 0] name]
-        ui_msg "$UI_PREFIX [msgcat::mc "The following versions of $portname are currently installed:"]"
-        foreach i [portlist_sortint $ilist] {
+        set msg "The following versions of $portname are currently installed:"
+        if {[macports::ui_isset ports_noninteractive]} {
+            ui_msg "$UI_PREFIX [msgcat::mc $msg]"
+        }
+        set sortedlist [portlist_sortint $ilist]
+        foreach i $sortedlist {
             set ispec "[$i version]_[$i revision][$i variants]"
-            if {[$i state] eq "installed"} {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s (active)"] [$i name] $ispec]"
+            ##
+            # User Interaction Question
+            # Asking choice to select option in case of ambiguous uninstall
+            if {[info exists macports::ui_options(questions_multichoice)]} {
+                if { [$i state] eq "installed" } {
+                    lappend portilist [$i name]@[$i version]_[$i revision][$i variants](active)
+                } else {
+                    lappend portilist [$i name]@[$i version]_[$i revision][$i variants]
+                }
             } else {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s"] [$i name] $ispec]"
-            }
+                if {[$i state] eq "installed"} {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s (active)"] [$i name] $ispec]"
+                } else {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s"] [$i name] $ispec]"
+                }
+            }
+        }
+        if {[info exists macports::ui_options(questions_multichoice)]} {
+            set retstring [$macports::ui_options(questions_multichoice) $msg "Choice_Q2" $portilist]
+            foreach index $retstring {
+                set uport [lindex $sortedlist [expr { $index - 1 }]]
+                uninstall [$uport name] [$uport version] [$uport revision] [$uport variants]
+            }
+            return 0
         }
         throw registry::invalid "Registry error: Please specify the full version as recorded in the port registry."
@@ -113 +199 @@
     }
 
+    set userinput {}
     # uninstall dependents if requested
     if {[info exists options(ports_uninstall_follow-dependents)] && $options(ports_uninstall_follow-dependents) eq "yes"} {
@@ -135 +222 @@
     } else {
         # check its dependents
-        registry::check_dependents $port ${uninstall.force} "uninstall"
+        set userinput [registry::check_dependents $port ${uninstall.force} "uninstall"]
+        if {$userinput eq "quit"} {
+            return 0
+        }
     }
     # if it's active, deactivate it
@@ -142 +232 @@
             ui_msg "For $portname @${composite_spec}: skipping deactivate (dry run)"
         } else {
-            if {[info exists options(ports_uninstall_no-exec)] || ![registry::run_target $port deactivate $optionslist]} {
-                portimage::deactivate $portname $version $revision $variants [array get options]
+            if {$userinput eq "forcedbyuser"} {
+                set options(ports_nodepcheck) "yes"
+            }
+            if {[info exists options(ports_uninstall_no-exec)] || ![registry::run_target $port deactivate [array get options]]} {
+                if {$userinput eq "forcedbyuser"} {
+                    portimage::deactivate $portname $version $revision $variants [array get options]
+                    unset options(ports_nodepcheck) 
+                } else {
+                    portimage::deactivate $portname $version $revision $variants [array get options]
+                }
             }
         }
@@ -149 +247 @@
 
     set ref $port
-
-    # note deps before we uninstall if we're going to uninstall them too
-    if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
-        set deptypes {depends_fetch depends_extract depends_build depends_lib depends_run}
-        set all_dependencies {}
-        # look up deps from the saved portfile if possible
-        if {![catch {set mport [mportopen_installed [$port name] [$port version] [$port revision] [$port variants] $optionslist]}]} {
-            array set depportinfo [mportinfo $mport]
-            mportclose $mport
-            foreach type $deptypes {
-                if {[info exists depportinfo($type)]} {
-                    foreach dep $depportinfo($type) {
-                        lappend all_dependencies [lindex [split $dep :] end]
-                    }
-                }
-            }
-            # append those from the registry (could be different because of path deps)
-            foreach dep [$port dependencies] {
-                lappend all_dependencies [$dep name]
-            }
-        } else {
-            # grab the deps from the dep map
-            set depmaplist [registry::list_depends $portname $version $revision $variants]
-            foreach dep $depmaplist {
-                lappend all_dependencies [lindex $dep 0]
-            }
-            # and the ones from the current portfile
-            if {![catch {mportlookup $portname} result] && [llength $result] >= 2} {
-                array set depportinfo [lindex $result 1]
-                set porturl $depportinfo(porturl)
-                set variations {}
-                set minusvariant [lrange [split [registry::property_retrieve $ref negated_variants] -] 1 end]
-                set plusvariant [lrange [split $variants +] 1 end]
-                foreach v $plusvariant {
-                    lappend variations $v "+"
-                }
-                foreach v $minusvariant {
-                    lappend variations $v "-"
-                }
-                if {![catch {set mport [mportopen $porturl [concat $optionslist subport $portname] [array get variations]]} result]} {
-                    array unset depportinfo
-                    array set depportinfo [mportinfo $mport]
-                    mportclose $mport
-                }
-                foreach type $deptypes {
-                    if {[info exists depportinfo($type)]} {
-                        foreach dep $depportinfo($type) {
-                            lappend all_dependencies [lindex [split $dep :] end]
-                        }
-                    }
-                }
-            }
-        }
-        array unset depportinfo
-        set all_dependencies [lsort -unique $all_dependencies]
+    # save list of dependencies if --follow-dependencies specified
+    if {[info exists options(ports_uninstall_follow-dependencies)]} {
+        set all_dependencies [registry_uninstall::generate_deplist $port $optionslist]
     }
 
@@ -251 +297 @@
     }
     
-    # uninstall dependencies if requested
+    set uports {}
+    # create list of all dependencies that will be uninstalled, if requested
     if {[info exists options(ports_uninstall_follow-dependencies)] && [string is true -strict $options(ports_uninstall_follow-dependencies)]} {
         # don't uninstall dependencies' dependents
@@ -258 +305 @@
             set optionslist [array get options]
         }
-        while 1 {
-            set remaining_list {}
-            foreach dep $all_dependencies {
-                if {![catch {set ilist [registry::installed $dep]}]} {
-                    set remaining 0
-                    foreach i $ilist {
-                        set iversion [lindex $i 1]
-                        set irevision [lindex $i 2]
-                        set ivariants [lindex $i 3]
-                        if {[llength [registry::list_dependents $dep $iversion $irevision $ivariants]] == 0} {
-                            set regref [registry::open_entry $dep $iversion $irevision $ivariants [lindex $i 5]]
-                            if {![registry::property_retrieve $regref requested] && ([info exists options(ports_uninstall_no-exec)] || ![registry::run_target $regref uninstall $optionslist])} {
-                                registry_uninstall::uninstall $dep $iversion $irevision $ivariants $optionslist
+        set alldeps $all_dependencies
+        set portilist {}
+        for {set j 0} {$j < [llength $alldeps]} {incr j} {
+            set dep [lindex $alldeps $j]
+            if {![catch {set ilist [registry::installed $dep]}]} {
+                foreach i $ilist {
+                    set dependents {}
+                    set iversion [lindex $i 1]
+                    set irevision [lindex $i 2]
+                    set ivariants [lindex $i 3]
+                    set dependentlist [registry::list_dependents $dep $iversion $irevision $ivariants]
+                    foreach depdt $dependentlist {
+                        lappend dependents [lindex $depdt 2]
+                    }
+                    set regref [registry::open_entry $dep $iversion $irevision $ivariants [lindex $i 5]]
+                    if {![registry::property_retrieve $regref requested]} {
+                        if {[llength $dependents] == 0} { 
+                            lappend uports $dep
+                            lappend portilist $dep@[lindex $i 1]_$irevision 
+                        } else {
+                            foreach depdt $dependents {
+                                set count 0
+                                foreach p $uports {
+                                    if {[string match $p $depdt]} {
+                                        incr count
+                                    }
+                                }
+                                if {$count == [llength $dependents]} {
+                                    lappend uports $dep
+                                    lappend portilist $dep@[lindex $i 1]_$irevision
+                                }
                             }
-                        } else {
-                            set remaining 1
                         }
                     }
-                    if {$remaining} {
-                        lappend remaining_list $dep
-                    }
-                }
-            }
-            if {[llength $remaining_list] == 0 || [llength $remaining_list] == [llength $all_dependencies]} {
-                break
-            }
-            set all_dependencies $remaining_list
-        }
-    }
-    
+                }
+            }
+            set depref [registry::entry imaged $dep]
+            set depdeps [registry_uninstall::generate_deplist $depref $optionslist]
+            foreach d $depdeps {
+                set index [lsearch $alldeps $d]
+                if {$index == -1} {
+                    lappend alldeps $d 
+                }
+            }
+        }
+        ## User Interaction Question
+        # show a list of all dependencies to be uninstalled with a timeout when --follow-dependencies is specified
+        if {[info exists macports::ui_options(questions_yesno)]} {
+            $macports::ui_options(questions_yesno) "The following dependencies will be uninstalled:" "Timeout_1" $portilist {y} 10
+        }
+        unset options(ports_uninstall_follow-dependencies)
+    }
+
+    # uninstall all dependencies in order from uports
+    foreach dp $uports {
+        if {![catch {set ilist [registry::installed $dp]}]} {
+            foreach i $ilist {
+                set iversion [lindex $i 1]
+                set irevision [lindex $i 2]
+                set ivariants [lindex $i 3]
+                set regref [registry::open_entry $dp $iversion $irevision $ivariants [lindex $i 5]]
+                if {[info exists options(ports_uninstall_no-exec)] || ![registry::run_target $regref uninstall [array get options]]} {
+                    registry_uninstall::uninstall $dp $iversion $irevision $ivariants [array get options]
+                }
+            }
+        }
+    }
+
     return 0
 }

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

@@ -78 +78 @@
         }
         if { [llength $deplist] > 0 } {
-            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]]"
-            foreach depport $deplist {
-                ui_msg "$UI_PREFIX [format [msgcat::mc "        %s @%s_%s%s"] [$depport name] [$depport version] [$depport revision] [$depport variants]]"
+            ## User Interaction Question
+            # ask if user wants to uninstall a port and thereby break its dependents
+            if {[info exists macports::ui_options(questions_yesno)] && ![string is true -strict $force]} { 
+                set portulist {}
+                foreach depport $deplist {
+                    lappend portulist [$depport name]@[$depport version]_[$depport revision]
+                }
+                ui_msg "Note: It is not recommended to uninstall/deactivate a port that has dependents as it breaks the dependents."
+                set retvalue [$macports::ui_options(questions_yesno) "The following ports will break:" "breakDeps" $portulist {n} 0]
+                if {$retvalue == 0} {
+                    set force "yes"
+                } else {
+                    return quit
+                }
+            } else {    
+                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]]"
+                foreach depport $deplist {
+                    ui_msg "$UI_PREFIX [format [msgcat::mc "    %s @%s_%s%s"] [$depport name] [$depport version] [$depport revision] [$depport variants]]"
+                }
             }
             if { [string is true -strict $force] } {
                 ui_warn "[string totitle $action] forced.  Proceeding despite dependencies."
+                return forcedbyuser
             } else {
                 throw registry::uninstall-error "Please uninstall the ports that depend on [$port name] first."

trunk/base/tests/test/library.tcl.in

@@ -86 +86 @@
     cd $pwd
 
-    set result [catch {exec env PORTSRC=${portsrc} ${bindir}/port -d test >&output} ]
+    set result [catch {exec env PORTSRC=${portsrc} ${bindir}/port -d -N test >&output} ]
     cd $back
     return $result