diff --git a/src/macports1.0/macports.tcl b/src/macports1.0/macports.tcl index e9e0b80039..d971678301 100644 --- a/src/macports1.0/macports.tcl +++ b/src/macports1.0/macports.tcl @@ -339,7 +339,7 @@ proc macports::ui_prefix_default {priority} { # ui_options(ports_verbose) - If set, output info messages (ui_info) # ui_options(ports_quiet) - If set, don't output "standard messages" proc macports::ui_channels_default {priority} { - switch -- $priority { + switch -regexp -- $priority { debug { if {[ui_isset ports_debug]} { return stderr @@ -347,6 +347,13 @@ proc macports::ui_channels_default {priority} { return {} } } + debug[0-9] { + if {[ui_isset ports_debug_x] && (${priority} le ${ports_debug_x})} { + return stderr + } else { + return {} + } + } info { if {[ui_isset ports_verbose]} { return stdout diff --git a/src/pextlib1.0/Pextlib.c b/src/pextlib1.0/Pextlib.c index 1a5420c2be..6c756a2368 100644 --- a/src/pextlib1.0/Pextlib.c +++ b/src/pextlib1.0/Pextlib.c @@ -135,6 +135,14 @@ static void ui_message(Tcl_Interp *interp, const char *severity, const char *for free(tclcmd); } +__attribute__((format(printf, 3, 0))) +static void ui_debug_x(Tcl_Interp *interp, unsigned int level, const char *format, va_list va) { + char cLevel[20]; // longer than necessary, but also safer + + sprintf(cLevel, "debug%u", level); + ui_message(interp, cLevel, format, va); +} + __attribute__((format(printf, 2, 3))) void ui_error(Tcl_Interp *interp, const char *format, ...) { va_list va; @@ -187,6 +195,33 @@ void ui_debug(Tcl_Interp *interp, const char *format, ...) { va_end(va); } +__attribute__((format(printf, 2, 3))) +void ui_debug1(Tcl_Interp *interp, const char *format, ...) { + va_list va; + + va_start(va, format); + ui_debug_x(interp, 1 /*debug level*/, format, va); + va_end(va); +} + +__attribute__((format(printf, 2, 3))) +void ui_debug2(Tcl_Interp *interp, const char *format, ...) { + va_list va; + + va_start(va, format); + ui_debug_x(interp, 2 /*debug level*/, format, va); + va_end(va); +} + +__attribute__((format(printf, 2, 3))) +void ui_debug3(Tcl_Interp *interp, const char *format, ...) { + va_list va; + + va_start(va, format); + ui_debug_x(interp, 3 /*debug level*/, format, va); + va_end(va); +} + int StrsedCmd(ClientData clientData UNUSED, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]) { char *pattern, *string, *res; diff --git a/src/pextlib1.0/Pextlib.h b/src/pextlib1.0/Pextlib.h index c57e77cb0e..73b4b98fca 100644 --- a/src/pextlib1.0/Pextlib.h +++ b/src/pextlib1.0/Pextlib.h @@ -35,6 +35,9 @@ void ui_msg(Tcl_Interp *interp, const char *format, ...) __attribute__((format(p void ui_notice(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3))); void ui_info(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3))); void ui_debug(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3))); +void ui_debug1(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3))); +void ui_debug2(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3))); +void ui_debug3(Tcl_Interp *interp, const char *format, ...) __attribute__((format(printf, 2, 3))); /* Mount point file system case-sensitivity caching infrastructure. */ typedef struct _mount_cs_cache mount_cs_cache_t; diff --git a/src/pextlib1.0/tests/system.tcl b/src/pextlib1.0/tests/system.tcl index eabe57f6d9..755137e13e 100644 --- a/src/pextlib1.0/tests/system.tcl +++ b/src/pextlib1.0/tests/system.tcl @@ -12,6 +12,15 @@ set failures 0 proc ui_debug {args} { # ignored } +proc ui_debug1 {args} { + # ignored +} +proc ui_debug2 {args} { + # ignored +} +proc ui_debug3 {args} { + # ignored +} proc ui_info {args} { global output append output "$args\n" diff --git a/src/port/port.tcl b/src/port/port.tcl index ced83d301c..9dcf4fe686 100755 --- a/src/port/port.tcl +++ b/src/port/port.tcl @@ -50,7 +50,7 @@ package require Pextlib 1.0 proc print_usage {{verbose 1}} { global cmdname set syntax { - [-bcdfknNopqRstuvy] [-D portdir|portname] [-F cmdfile] action [actionflags] + [-bcdfknNopqRstuvy] [-d[level]] [-D portdir|portname] [-F cmdfile] action [actionflags] [[portname|pseudo-portname|port-url] [@version] [+-variant]... [option=value]...]... } @@ -4568,7 +4568,7 @@ proc parse_options { action ui_options_name global_options_name } { # Process short arg(s) set opts [string range $arg 1 end] foreach c [split $opts {}] { - switch -- $c { + switch -regexp -- $c { v { set ui_options(ports_verbose) yes } @@ -4577,6 +4577,15 @@ proc parse_options { action ui_options_name global_options_name } { # debug implies verbose set ui_options(ports_verbose) yes } + d[0-3] { + set ui_options(ports_debug) yes + # debug implies verbose + set ui_options(ports_verbose) yes + + set debug_level [regsub {d(\d)} ${c} {\1}] + set ui_options(ports_debug_x) "debug${debug_level}" + unset debug_level + } q { set ui_options(ports_quiet) yes # quiet implies noninteractive diff --git a/src/port/portindex.tcl b/src/port/portindex.tcl index e04708297e..d3377f1650 100644 --- a/src/port/portindex.tcl +++ b/src/port/portindex.tcl @@ -197,6 +197,12 @@ for {set i 0} {$i < $argc} {incr i} { {^-.+} { if {$arg eq "-d"} { # Turn on debug output set ui_options(ports_debug) yes + elseif {[regexp {\-d[0-3]} ${arg}] == 1} { # Turn on debugX output + set ui_options(ports_debug) yes + + set debug_level [regsub {\-d(\d)} ${arg} {\1}] + set ui_options(ports_debug_x) "debug${debug_level}" + unset debug_level } elseif {$arg eq "-o"} { # Set output directory incr i set outdir [file join [pwd] [lindex $argv $i]] diff --git a/src/port1.0/port.tcl b/src/port1.0/port.tcl index 1ec2de33c7..b7cb4acb9b 100644 --- a/src/port1.0/port.tcl +++ b/src/port1.0/port.tcl @@ -54,9 +54,9 @@ namespace eval port { proc run_callbacks {} { variable _callback_list foreach callback ${_callback_list} { - ui_debug "Running callback ${callback}" + ui_debug1 "Running callback ${callback}" ${callback} - ui_debug "Finished running callback ${callback}" + ui_debug1 "Finished running callback ${callback}" } set _callback_list [list] } diff --git a/src/port1.0/portutil.tcl b/src/port1.0/portutil.tcl index 877f3f2840..89033e91e8 100644 --- a/src/port1.0/portutil.tcl +++ b/src/port1.0/portutil.tcl @@ -2607,7 +2607,7 @@ proc PortGroup {group version} { if {[file exists $groupFile]} { lappend PortInfo(portgroups) [list $group $version $groupFile] uplevel "source $groupFile" - ui_debug "Sourcing PortGroup $group $version from $groupFile" + ui_debug1 "Sourcing PortGroup $group $version from $groupFile" return } } @@ -2618,7 +2618,7 @@ proc PortGroup {group version} { if {[file exists $groupFile]} { lappend PortInfo(portgroups) [list $group $version $groupFile] uplevel "source $groupFile" - ui_debug "Sourcing PortGroup $group $version from $groupFile" + ui_debug1 "Sourcing PortGroup $group $version from $groupFile" } else { ui_error "${subport}: PortGroup ${group} ${version} could not be located. ${group}-${version}.tcl does not exist." return -code error "PortGroup not found"