[124243] trunk/base
shasha at macports.org
shasha at macports.org
Thu Aug 21 11:36:26 PDT 2014
Revision: 124243
https://trac.macports.org/changeset/124243
Author: shasha at macports.org
Date: 2014-08-21 11:36:26 -0700 (Thu, 21 Aug 2014)
Log Message:
-----------
Merge of Interactive Port Command project. Details: http://trac.macports.org/wiki/SummerOfCode2014_interactive
Modified Paths:
--------------
trunk/base/doc/port.1
trunk/base/doc/port.1.txt
trunk/base/src/macports1.0/macports.tcl
trunk/base/src/port/port.tcl
trunk/base/src/registry2.0/portimage.tcl
trunk/base/src/registry2.0/portuninstall.tcl
trunk/base/src/registry2.0/registry_util.tcl
trunk/base/tests/test/library.tcl.in
Property Changed:
----------------
trunk/base/
trunk/base/src/pextlib1.0/Makefile.in
trunk/base/src/pextlib1.0/sha2.c
trunk/base/src/pextlib1.0/sha2.h
trunk/base/src/registry2.0/receipt_sqlite.tcl
Property changes on: trunk/base
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base:37343-46937
/branches/gsoc09-logging/base:51231-60371
/branches/gsoc11-rev-upgrade/base:78828-88375
/branches/gsoc11-statistics/base:79520,79666
/branches/gsoc13-tests:106692-111324
/branches/gsoc14-cleanup:123738-124046
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
+ /branches/gsoc08-privileges/base:37343-46937
/branches/gsoc09-logging/base:51231-60371
/branches/gsoc11-rev-upgrade/base:78828-88375
/branches/gsoc11-statistics/base:79520,79666
/branches/gsoc13-tests:106692-111324
/branches/gsoc14-cleanup:123738-124046
/branches/gsoc14-interactive/base:119516-124240
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
Modified: trunk/base/doc/port.1
===================================================================
--- trunk/base/doc/port.1 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/doc/port.1 2014-08-21 18:36:26 UTC (rev 124243)
@@ -24,7 +24,7 @@
.SH "SYNOPSIS"
.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 at version\fR] [+/\-variant \&...] \&... [option=value \&...]]
.fi
@@ -464,9 +464,14 @@
.PP
\-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
\fBInstallation and upgrade\fR
.PP
\-n
Modified: trunk/base/doc/port.1.txt
===================================================================
--- trunk/base/doc/port.1.txt 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/doc/port.1.txt 2014-08-21 18:36:26 UTC (rev 124243)
@@ -10,7 +10,7 @@
SYNOPSIS
--------
[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 ...]]
@@ -130,8 +130,11 @@
Debug mode, generate debugging messages, implies -v
-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
-n::
Don't follow dependencies in upgrade (affects 'upgrade' and 'install')
Modified: trunk/base/src/macports1.0/macports.tcl
===================================================================
--- trunk/base/src/macports1.0/macports.tcl 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/src/macports1.0/macports.tcl 2014-08-21 18:36:26 UTC (rev 124243)
@@ -2057,13 +2057,27 @@
# 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]"
+ ##
+ # 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
}
- ui_msg $depstring
}
-
+
# install them
set result [dlist_eval $dlist _mportactive [list _mportexec activate]]
@@ -4870,11 +4884,30 @@
}
}
- 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)
+ }
+
# shared depscache for all ports that are going to be rebuilt
array set depscache {}
set status 0
Property changes on: trunk/base/src/pextlib1.0/Makefile.in
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base/src/pextlib1.0/Makefile:37343-46937
/branches/gsoc08-privileges/base/src/pextlib1.0/Makefile.in:37343-46937
/branches/gsoc09-logging/base/src/pextlib1.0/Makefile:51231-60371
/branches/gsoc09-logging/base/src/pextlib1.0/Makefile.in:51231-60371
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/Makefile:78828-88375
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/Makefile.in:78828-88375
/branches/gsoc13-tests/src/pextlib1.0/Makefile.in:106692-111324
/branches/universal-sanity/base/src/pextlib1.0/Makefile:51872-52323
/branches/universal-sanity/base/src/pextlib1.0/Makefile.in:51872-52323
/branches/variant-descs-14482/base/src/pextlib1.0/Makefile:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/branches/variant-descs-14482/base/src/pextlib1.0/Makefile.in:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/pextlib1.0/Makefile.in:49341-104698
/users/perry/base-bugs_and_notes/src/pextlib1.0/Makefile:45682-46060
/users/perry/base-bugs_and_notes/src/pextlib1.0/Makefile.in:45682-46060
/users/perry/base-select/src/pextlib1.0/Makefile:44044-44692
/users/perry/base-select/src/pextlib1.0/Makefile.in:44044-44692
+ /branches/gsoc08-privileges/base/src/pextlib1.0/Makefile:37343-46937
/branches/gsoc08-privileges/base/src/pextlib1.0/Makefile.in:37343-46937
/branches/gsoc09-logging/base/src/pextlib1.0/Makefile:51231-60371
/branches/gsoc09-logging/base/src/pextlib1.0/Makefile.in:51231-60371
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/Makefile:78828-88375
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/Makefile.in:78828-88375
/branches/gsoc13-tests/src/pextlib1.0/Makefile.in:106692-111324
/branches/gsoc14-interactive/base/src/pextlib1.0/Makefile.in:119516-124240
/branches/universal-sanity/base/src/pextlib1.0/Makefile:51872-52323
/branches/universal-sanity/base/src/pextlib1.0/Makefile.in:51872-52323
/branches/variant-descs-14482/base/src/pextlib1.0/Makefile:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/branches/variant-descs-14482/base/src/pextlib1.0/Makefile.in:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/pextlib1.0/Makefile.in:49341-104698
/users/perry/base-bugs_and_notes/src/pextlib1.0/Makefile:45682-46060
/users/perry/base-bugs_and_notes/src/pextlib1.0/Makefile.in:45682-46060
/users/perry/base-select/src/pextlib1.0/Makefile:44044-44692
/users/perry/base-select/src/pextlib1.0/Makefile.in:44044-44692
Property changes on: trunk/base/src/pextlib1.0/sha2.c
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base/src/pextlib1.0/sha2.c:37343-46937
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/sha2.c:78828-88375
/branches/gsoc13-tests/src/pextlib1.0/sha2.c:106692-111324
/branches/universal-sanity/base/src/pextlib1.0/sha2.c:51872-52323
/branches/variant-descs-14482/base/src/pextlib1.0/sha2.c:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/pextlib1.0/sha2.c:57914-66452
/users/perry/base-bugs_and_notes/src/pextlib1.0/sha2.c:45682-46060
/users/perry/base-select/src/pextlib1.0/sha2.c:44044-44692
+ /branches/gsoc08-privileges/base/src/pextlib1.0/sha2.c:37343-46937
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/sha2.c:78828-88375
/branches/gsoc13-tests/src/pextlib1.0/sha2.c:106692-111324
/branches/gsoc14-interactive/base/src/pextlib1.0/sha2.c:119516-124240
/branches/universal-sanity/base/src/pextlib1.0/sha2.c:51872-52323
/branches/variant-descs-14482/base/src/pextlib1.0/sha2.c:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/pextlib1.0/sha2.c:57914-66452
/users/perry/base-bugs_and_notes/src/pextlib1.0/sha2.c:45682-46060
/users/perry/base-select/src/pextlib1.0/sha2.c:44044-44692
Property changes on: trunk/base/src/pextlib1.0/sha2.h
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base/src/pextlib1.0/sha2.h:37343-46937
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/sha2.h:78828-88375
/branches/gsoc13-tests/src/pextlib1.0/sha2.h:106692-111324
/branches/universal-sanity/base/src/pextlib1.0/sha2.h:51872-52323
/branches/variant-descs-14482/base/src/pextlib1.0/sha2.h:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/pextlib1.0/sha2.h:57914-66452
/users/perry/base-bugs_and_notes/src/pextlib1.0/sha2.h:45682-46060
/users/perry/base-select/src/pextlib1.0/sha2.h:44044-44692
+ /branches/gsoc08-privileges/base/src/pextlib1.0/sha2.h:37343-46937
/branches/gsoc11-rev-upgrade/base/src/pextlib1.0/sha2.h:78828-88375
/branches/gsoc13-tests/src/pextlib1.0/sha2.h:106692-111324
/branches/gsoc14-interactive/base/src/pextlib1.0/sha2.h:119516-124240
/branches/universal-sanity/base/src/pextlib1.0/sha2.h:51872-52323
/branches/variant-descs-14482/base/src/pextlib1.0/sha2.h:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/pextlib1.0/sha2.h:57914-66452
/users/perry/base-bugs_and_notes/src/pextlib1.0/sha2.h:45682-46060
/users/perry/base-select/src/pextlib1.0/sha2.h:44044-44692
Modified: trunk/base/src/port/port.tcl
===================================================================
--- trunk/base/src/port/port.tcl 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/src/port/port.tcl 2014-08-21 18:36:26 UTC (rev 124243)
@@ -315,7 +315,7 @@
# set portname again since the one we were passed may not have had the correct case
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]
set irevision [lindex $i 2]
@@ -333,7 +333,6 @@
}
}
-
proc entry_for_portlist {portentry} {
global global_options global_variations
@@ -4493,11 +4492,17 @@
}
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 {
set global_options(ports_force) yes
}
@@ -5285,7 +5290,207 @@
}
}
+# 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
+ }
+ }
+ }
+}
+
##########################################
# Main
##########################################
@@ -5340,6 +5545,15 @@
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
+}
+
set ui_options(notifications_append) portclient::notifications::append
# Get arguments remaining after option processing
Modified: trunk/base/src/registry2.0/portimage.tcl
===================================================================
--- trunk/base/src/registry2.0/portimage.tcl 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/src/registry2.0/portimage.tcl 2014-08-21 18:36:26 UTC (rev 124243)
@@ -185,8 +185,6 @@
return -code error "Active version of $name is not $v but ${specifier}."
}
- 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."
}
@@ -194,11 +192,16 @@
if { [$requested state] ne "installed" } {
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
}
@@ -220,18 +223,38 @@
set ilist [registry::entry imaged {*}$searchkeys]
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]
set iversion [$i version]
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."
} elseif { [llength $ilist] == 1 } {
return [lindex $ilist 0]
Modified: trunk/base/src/registry2.0/portuninstall.tcl
===================================================================
--- trunk/base/src/registry2.0/portuninstall.tcl 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/src/registry2.0/portuninstall.tcl 2014-08-21 18:36:26 UTC (rev 124243)
@@ -41,6 +41,69 @@
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 ""}} {
if {$v eq ""} {
@@ -89,15 +152,38 @@
if { [llength $ilist] > 1 } {
# 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."
} elseif { [llength $ilist] == 1 } {
set port [lindex $ilist 0]
@@ -112,6 +198,7 @@
throw registry::invalid "Registry error: ${portname}${composite_spec} not registered as installed"
}
+ set userinput {}
# uninstall dependents if requested
if {[info exists options(ports_uninstall_follow-dependents)] && $options(ports_uninstall_follow-dependents) eq "yes"} {
# don't uninstall dependents' dependencies
@@ -134,75 +221,34 @@
}
} 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
if {[$port state] eq "installed"} {
if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
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]
+ }
+ }
}
}
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]
}
if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
@@ -250,43 +296,82 @@
}
}
- # 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
if {[info exists options(ports_uninstall_follow-dependents)]} {
unset options(ports_uninstall_follow-dependents)
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 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
+ }
}
- set all_dependencies $remaining_list
}
+ ## 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
}
Property changes on: trunk/base/src/registry2.0/receipt_sqlite.tcl
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base/src/registry1.0/receipt_sqlite.tcl:37343-46937
/branches/gsoc09-logging/base/src/registry1.0/receipt_sqlite.tcl:51231-60371
/branches/gsoc11-rev-upgrade/base/src/registry2.0/receipt_sqlite.tcl:78828-88375
/branches/gsoc13-tests/src/registry2.0/receipt_sqlite.tcl:106692-111324
/branches/universal-sanity/base/src/registry1.0/receipt_sqlite.tcl:51872-52323
/branches/variant-descs-14482/base/src/registry1.0/receipt_sqlite.tcl:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/registry2.0/receipt_sqlite.tcl:57889-64075
/users/perry/base-bugs_and_notes/src/registry1.0/receipt_sqlite.tcl:45682-46060
/users/perry/base-select/src/registry1.0/receipt_sqlite.tcl:44044-44692
+ /branches/gsoc08-privileges/base/src/registry1.0/receipt_sqlite.tcl:37343-46937
/branches/gsoc09-logging/base/src/registry1.0/receipt_sqlite.tcl:51231-60371
/branches/gsoc11-rev-upgrade/base/src/registry2.0/receipt_sqlite.tcl:78828-88375
/branches/gsoc13-tests/src/registry2.0/receipt_sqlite.tcl:106692-111324
/branches/gsoc14-interactive/base/src/registry2.0/receipt_sqlite.tcl:119516-124240
/branches/universal-sanity/base/src/registry1.0/receipt_sqlite.tcl:51872-52323
/branches/variant-descs-14482/base/src/registry1.0/receipt_sqlite.tcl:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base/src/registry2.0/receipt_sqlite.tcl:57889-64075
/users/perry/base-bugs_and_notes/src/registry1.0/receipt_sqlite.tcl:45682-46060
/users/perry/base-select/src/registry1.0/receipt_sqlite.tcl:44044-44692
Modified: trunk/base/src/registry2.0/registry_util.tcl
===================================================================
--- trunk/base/src/registry2.0/registry_util.tcl 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/src/registry2.0/registry_util.tcl 2014-08-21 18:36:26 UTC (rev 124243)
@@ -77,12 +77,29 @@
set deplist $active_deplist
}
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."
}
Modified: trunk/base/tests/test/library.tcl.in
===================================================================
--- trunk/base/tests/test/library.tcl.in 2014-08-21 18:07:56 UTC (rev 124242)
+++ trunk/base/tests/test/library.tcl.in 2014-08-21 18:36:26 UTC (rev 124243)
@@ -85,7 +85,7 @@
set back [pwd]
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
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20140821/f166dcec/attachment-0001.html>
More information about the macports-changes
mailing list