[65896] branches/new-help-system/base
raimue at macports.org
raimue at macports.org
Fri Apr 2 09:33:43 PDT 2010
Revision: 65896
http://trac.macports.org/changeset/65896
Author: raimue at macports.org
Date: 2010-04-02 09:33:43 -0700 (Fri, 02 Apr 2010)
Log Message:
-----------
Merge from trunk
Modified Paths:
--------------
branches/new-help-system/base/ChangeLog
branches/new-help-system/base/src/macports1.0/macports.tcl
branches/new-help-system/base/src/pextlib1.0/fs-traverse.c
branches/new-help-system/base/src/pextlib1.0/tests/checksums.tcl
branches/new-help-system/base/src/pextlib1.0/tests/filemap.tcl
branches/new-help-system/base/src/pextlib1.0/tests/fs-traverse.tcl
branches/new-help-system/base/src/port/port.tcl
branches/new-help-system/base/src/port1.0/portconfigure.tcl
branches/new-help-system/base/src/port1.0/portdestroot.tcl
branches/new-help-system/base/src/registry2.0/portuninstall.tcl
branches/new-help-system/base/src/registry2.0/receipt_sqlite.tcl
branches/new-help-system/base/src/registry2.0/registry.tcl
Property Changed:
----------------
branches/new-help-system/base/
Property changes on: branches/new-help-system/base
___________________________________________________________________
Modified: svn:mergeinfo
- /branches/gsoc08-privileges/base:37343-46937
/branches/gsoc09-logging/base:51231-60371
/branches/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:49341-65587
/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/universal-sanity/base:51872-52323
/branches/variant-descs-14482/base:34469-34855,34900-37508,37511-37512,41040-41463,42575-42626,42640-42659
/trunk/base:49341-65895
/users/perry/base-bugs_and_notes:45682-46060
/users/perry/base-select:44044-44692
Modified: branches/new-help-system/base/ChangeLog
===================================================================
--- branches/new-help-system/base/ChangeLog 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/ChangeLog 2010-04-02 16:33:43 UTC (rev 65896)
@@ -5,6 +5,9 @@
Release 1.9.0 (unreleased):
+ - Add "fs-traverse" -tails which only returns the part following the
+ specified directory (raimue in r65785)
+
- Allow gcc45 port to be used in configure.compiler (ryandesign in r62223)
- svn checkouts now use peg revisions instead of operative revisions,
Modified: branches/new-help-system/base/src/macports1.0/macports.tcl
===================================================================
--- branches/new-help-system/base/src/macports1.0/macports.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/macports1.0/macports.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -2366,7 +2366,10 @@
set subPorts {}
if {[llength $depends] > 0} {
- set options [ditem_key $mport options]
+ array set optionsarray [ditem_key $mport options]
+ # avoid propagating requested flag from parent
+ set optionsarray(ports_requested) 0
+ set options [array get optionsarray]
set variations [ditem_key $mport variations]
set required_archs [[ditem_key $mport workername] eval get_canonical_archs]
}
@@ -2902,7 +2905,7 @@
# at this point we need to check if a different port will be replacing this one
if {[info exists portinfo(replaced_by)] && ![info exists options(ports_upgrade_no-replace)]} {
- ui_debug "$portname is replaced by $portinfo(replaced_by)"
+ ui_msg "---> $portname is replaced by $portinfo(replaced_by)"
if {[catch {mportlookup $portinfo(replaced_by)} result]} {
global errorInfo
ui_debug "$errorInfo"
Modified: branches/new-help-system/base/src/pextlib1.0/fs-traverse.c
===================================================================
--- branches/new-help-system/base/src/pextlib1.0/fs-traverse.c 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/pextlib1.0/fs-traverse.c 2010-04-02 16:33:43 UTC (rev 65896)
@@ -3,9 +3,10 @@
* $Id$
*
* Find files and execute arbitrary expressions on them.
- * Author: Jordan K. Hubbard, Kevin Ballard
+ * Author: Jordan K. Hubbard, Kevin Ballard, Rainer Mueller
*
* Copyright (c) 2004 Apple Computer, Inc.
+ * Copyright (c) 2010 The MacPorts Project
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
@@ -54,8 +55,9 @@
#define F_DEPTH 0x1
#define F_IGNORE_ERRORS 0x2
+#define F_TAILS 0x4
-/* fs-traverse ?-depth? ?-ignoreErrors? ?--? varname target-list body */
+/* fs-traverse ?-depth? ?-ignoreErrors? ?-tails? ?--? varname target-list body */
int
FsTraverseCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
@@ -84,6 +86,11 @@
++objv, --objc;
continue;
}
+ if (!strcmp(arg, "-tails")) {
+ flags |= F_TAILS;
+ ++objv, --objc;
+ continue;
+ }
if (!strcmp(arg, "--")) {
++objv, --objc;
break;
@@ -93,7 +100,7 @@
/* Parse remaining args */
if (objc != 3) {
- Tcl_WrongNumArgs(interp, 1, objv_orig, "?-depth? ?-ignoreErrors? ?--? varname target-list body");
+ Tcl_WrongNumArgs(interp, 1, objv_orig, "?-depth? ?-ignoreErrors? ?-tails? ?--? varname target-list body");
return TCL_ERROR;
}
@@ -106,8 +113,17 @@
body = *objv;
if ((rval = Tcl_ListObjGetElements(interp, listPtr, &lobjc, &lobjv)) == TCL_OK) {
- char **entries = calloc(lobjc+1, sizeof(char *));
- char **iter = (char **)entries;
+ char **entries;
+ char **iter;
+
+ if (flags & F_TAILS && lobjc > 1) {
+ /* result would be ambiguous with multiple paths, so we do not allow this */
+ Tcl_SetResult(interp, "-tails cannot be used with multiple paths", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ entries = calloc(lobjc+1, sizeof(char *));
+ iter = (char **)entries;
while (lobjc > 0) {
*iter++ = Tcl_GetString(*lobjv);
--lobjc, ++lobjv;
@@ -119,6 +135,23 @@
return rval;
}
+static const char *
+extract_tail(const char *target, const char *path)
+{
+ const char *xpath = path;
+ size_t tlen = strlen(target);
+
+ if (strncmp(xpath, target, tlen) == 0) {
+ if (*(xpath + tlen) == '\0') {
+ xpath = ".";
+ } else if (*(xpath + tlen) == '/') {
+ xpath += tlen + 1;
+ }
+ }
+
+ return xpath;
+}
+
static int
do_compare(const FTSENT **a, const FTSENT **b)
{
@@ -140,7 +173,14 @@
case FTS_DP: /* directory in post-order*/
{
if (!(flags & F_DEPTH) != !(ent->fts_info == FTS_D)) {
- Tcl_Obj *rpath, *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ Tcl_Obj *rpath, *path;
+ if (flags & F_TAILS) {
+ /* there cannot be multiple targets */
+ const char *xpath = extract_tail(targets[0], ent->fts_path);
+ path = Tcl_NewStringObj(xpath, -1);
+ } else {
+ path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ }
Tcl_IncrRefCount(path);
rpath = Tcl_ObjSetVar2(interp, varname, NULL, path, TCL_LEAVE_ERR_MSG);
Tcl_DecrRefCount(path);
@@ -165,7 +205,14 @@
case FTS_SLNONE: /* symbolic link with non-existant target */
case FTS_DEFAULT: /* file type not otherwise handled (e.g., fifo) */
{
- Tcl_Obj *rpath, *path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ Tcl_Obj *rpath, *path;
+ if (flags & F_TAILS) {
+ /* there cannot be multiple targets */
+ const char *xpath = extract_tail(targets[0], ent->fts_path);
+ path = Tcl_NewStringObj(xpath, -1);
+ } else {
+ path = Tcl_NewStringObj(ent->fts_path, ent->fts_pathlen);
+ }
Tcl_IncrRefCount(path);
rpath = Tcl_ObjSetVar2(interp, varname, NULL, path, TCL_LEAVE_ERR_MSG);
Tcl_DecrRefCount(path);
Modified: branches/new-help-system/base/src/pextlib1.0/tests/checksums.tcl
===================================================================
--- branches/new-help-system/base/src/pextlib1.0/tests/checksums.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/pextlib1.0/tests/checksums.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -54,4 +54,4 @@
file delete -force $testfile
}
-main $argv
\ No newline at end of file
+main $argv
Modified: branches/new-help-system/base/src/pextlib1.0/tests/filemap.tcl
===================================================================
--- branches/new-help-system/base/src/pextlib1.0/tests/filemap.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/pextlib1.0/tests/filemap.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -251,4 +251,4 @@
filemap close testmap5
}
-main $argv
\ No newline at end of file
+main $argv
Modified: branches/new-help-system/base/src/pextlib1.0/tests/fs-traverse.tcl
===================================================================
--- branches/new-help-system/base/src/pextlib1.0/tests/fs-traverse.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/pextlib1.0/tests/fs-traverse.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -92,6 +92,28 @@
}
check_output $output $trees(5)
+ # Test -tails option
+ set output [list]
+ fs-traverse -tails file $root {
+ lappend output $file
+ }
+ check_output $output $trees(6) $root
+
+ # Test -tails option with trailing slash
+ set output [list]
+ fs-traverse -tails file $root/ {
+ lappend output $file
+ }
+ check_output $output $trees(6) $root
+
+ # Test -tails option with multiple paths
+ # It should error out
+ if {![catch {
+ fs-traverse -tails file {$root/a $root/b} {}
+ }]} {
+ error "fs-traverse did not error when using multiple paths with -tails"
+ }
+
# Test cutting the traversal short
set output [list]
fs-traverse file $root {
@@ -159,15 +181,15 @@
}
}
-proc check_output {output tree} {
+proc check_output {output tree {root ""}} {
foreach file $output {entry typelist} $tree {
set type [lindex $typelist 0]
set link [lindex $typelist 1]
if {$file ne $entry} {
error "Found `$file', expected `$entry'"
- } elseif {[file type $file] ne $type} {
+ } elseif {[file type [file join $root $file]] ne $type} {
error "File `$file' had type `[file type $file]', expected type `$type'"
- } elseif {$type eq "link" && [file readlink $file] ne $link} {
+ } elseif {$type eq "link" && [file readlink [file join $root $file]] ne $link} {
error "File `$file' linked to `[file readlink $file]', expected link to `$link'"
}
}
@@ -335,13 +357,32 @@
"
set trees(6) "
- $root directory
- $root/a directory
- $root/a/a file
- $root/a/b file
- $root/a/c directory
- $root/a/c/a {link ../d}
+ . directory
+ a directory
+ a/a file
+ a/b file
+ a/c directory
+ a/c/a {link ../d}
+ a/c/b file
+ a/c/c directory
+ a/c/d file
+ a/d directory
+ a/d/a file
+ a/d/b {link ../../b/a}
+ a/d/c directory
+ a/d/d file
+ a/e file
+ b directory
+ b/a directory
+ b/a/a file
+ b/a/b file
+ b/a/c file
+ b/b directory
+ b/c directory
+ b/c/a file
+ b/c/b file
+ b/c/c file
"
}
-main $argv
\ No newline at end of file
+main $argv
Modified: branches/new-help-system/base/src/port/port.tcl
===================================================================
--- branches/new-help-system/base/src/port/port.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/port/port.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -856,7 +856,44 @@
return [get_ports_with_prop requested 0]
}
+proc get_dependent_ports {portname recursive} {
+ registry::open_dep_map
+ set deplist [registry::list_dependents $portname]
+ # could return specific versions here using registry2.0 features
+ set results {}
+ foreach dep $deplist {
+ add_to_portlist results [list name [lindex $dep 2]]
+ }
+ # actually do this iteratively to avoid hitting Tcl's recursion limit
+ if {$recursive} {
+ while 1 {
+ set rportlist {}
+ set newlist {}
+ foreach dep $deplist {
+ set depname [lindex $dep 2]
+ if {![info exists seen($depname)]} {
+ set seen($depname) 1
+ set rdeplist [registry::list_dependents $depname]
+ foreach rdep $rdeplist {
+ lappend newlist $rdep
+ add_to_portlist rportlist [list name [lindex $rdep 2]]
+ }
+ }
+ }
+ if {[llength $rportlist] > 0} {
+ set results [opUnion $results $rportlist]
+ set deplist $newlist
+ } else {
+ break
+ }
+ }
+ }
+
+ return [portlist_sort $results]
+}
+
+
##########################################
# Port expressions
##########################################
@@ -1066,6 +1103,19 @@
set el 1
}
+ ^dependentof: -
+ ^rdependentof: {
+ advance
+
+ # Break up the token, because older Tcl switch doesn't support -matchvar
+ regexp {^(\w+):(.*)} $token matchvar selector portname
+
+ set recursive [string equal $selector rdependentof]
+ add_multiple_ports reslist [get_dependent_ports $portname $recursive]
+
+ set el 1
+ }
+
[][?*] { # Handle portname glob patterns
advance; add_multiple_ports reslist [get_matching_ports $token no glob]
set el 1
@@ -2371,8 +2421,7 @@
set i [lindex $ilist 0]
set iactive [lindex $i 4]
set regref [registry::entry open $portname [lindex $i 1] [lindex $i 2] [lindex $i 3] [lindex $i 5]]
- if {(!$iactive || [registry::run_target $regref deactivate [array get options]])
- && [registry::run_target $regref uninstall [array get options]]} {
+ if {[registry::run_target $regref uninstall [array get options]]} {
continue
}
}
Modified: branches/new-help-system/base/src/port1.0/portconfigure.tcl
===================================================================
--- branches/new-help-system/base/src/port1.0/portconfigure.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/port1.0/portconfigure.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -48,6 +48,7 @@
default configure.env ""
default configure.pre_args {--prefix=${prefix}}
default configure.cmd ./configure
+default configure.nice {${buildnicevalue}}
default configure.dir {${worksrcpath}}
default autoreconf.dir {${worksrcpath}}
default autoreconf.pre_args {--install}
Modified: branches/new-help-system/base/src/port1.0/portdestroot.tcl
===================================================================
--- branches/new-help-system/base/src/port1.0/portdestroot.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/port1.0/portdestroot.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -63,6 +63,7 @@
default destroot.target install
default destroot.post_args {${destroot.destdir}}
default destroot.destdir {DESTDIR=${destroot}}
+default destroot.nice {${buildnicevalue}}
default destroot.umask {$system_options(destroot_umask)}
default destroot.clean no
default destroot.keepdirs ""
Modified: branches/new-help-system/base/src/registry2.0/portuninstall.tcl
===================================================================
--- branches/new-help-system/base/src/registry2.0/portuninstall.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/registry2.0/portuninstall.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -126,9 +126,11 @@
foreach depport [$port dependents] {
# make sure it's still installed, since a previous dep uninstall may have removed it
if {[registry::entry exists $depport] && ([$depport state] == "imaged" || [$depport state] == "installed")} {
- set depname [$depport name]
- set depver "[$depport version]_[$depport revision][$depport variants]"
- registry_uninstall::uninstall $depname $depver [array get options]
+ if {![registry::run_target $depport uninstall $optionslist]} {
+ set depname [$depport name]
+ set depver "[$depport version]_[$depport revision][$depport variants]"
+ registry_uninstall::uninstall $depname $depver $optionslist
+ }
}
}
} else {
@@ -140,7 +142,9 @@
if {[info exists options(ports_dryrun)] && [string is true -strict $options(ports_dryrun)]} {
ui_msg "For $portname @${v}: skipping deactivate (dry run)"
} else {
- portimage::deactivate $portname $v $optionslist
+ if {![registry::run_target $port deactivate $optionslist]} {
+ portimage::deactivate $portname $v $optionslist
+ }
}
}
} else {
@@ -175,7 +179,7 @@
foreach depport $dl {
# make sure it's still installed, since a previous dep uninstall may have removed it
if {[registry::entry_exists_for_name $depport]} {
- registry_uninstall::uninstall $depport "" [array get options]
+ registry_uninstall::uninstall $depport "" $optionslist
}
}
} else {
Modified: branches/new-help-system/base/src/registry2.0/receipt_sqlite.tcl
===================================================================
--- branches/new-help-system/base/src/registry2.0/receipt_sqlite.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/registry2.0/receipt_sqlite.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -209,9 +209,13 @@
set rlist [list]
set searchcmd "registry::entry search"
foreach key {name version revision} {
- append searchcmd " $key [set $key]"
+ if {[set $key] != ""} {
+ append searchcmd " $key [set $key]"
+ }
}
- append searchcmd " variants {$variants}"
+ if {$variants != 0} {
+ append searchcmd " variants {$variants}"
+ }
if {[catch {set ports [eval $searchcmd]}]} {
set ports [list]
}
Modified: branches/new-help-system/base/src/registry2.0/registry.tcl
===================================================================
--- branches/new-help-system/base/src/registry2.0/registry.tcl 2010-04-02 16:31:13 UTC (rev 65895)
+++ branches/new-help-system/base/src/registry2.0/registry.tcl 2010-04-02 16:33:43 UTC (rev 65896)
@@ -362,7 +362,7 @@
}
# List all the ports that depend on this port
-proc list_dependents {name {version ""} {revision ""} {variants ""}} {
+proc list_dependents {name {version ""} {revision ""} {variants 0}} {
global macports::registry.format
return [${macports::registry.format}::list_dependents $name $version $revision $variants]
}
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20100402/56b0a0b4/attachment.html>
More information about the macports-changes
mailing list