diff --git a/doc/port.1 b/doc/port.1 index 35ee525522d..7b01861f969 100644 --- a/doc/port.1 +++ b/doc/port.1 @@ -448,6 +448,11 @@ Verbose mode, generates verbose messages Debug mode, generate debugging messages, implies \-v .RE .PP +\-dlevel +.RS 4 +Debug mode, generate debugging messages at specified level, implies \-v +.RE +.PP \-q .RS 4 Quiet mode, suppress informational messages to a minimum, implies \-N diff --git a/doc/port.1.txt b/doc/port.1.txt index e6085851988..f436b5eb629 100644 --- a/doc/port.1.txt +++ b/doc/port.1.txt @@ -127,6 +127,9 @@ The port command recognizes several global flags and options. -d:: Debug mode, generate debugging messages, implies -v +-dlevel:: + Debug mode, generate debugging messages at specified level, implies -v + -q:: Quiet mode, suppress informational messages to a minimum, implies -N diff --git a/portmgr/packaging/packageall.tcl b/portmgr/packaging/packageall.tcl index 38f3751c7cc..d6a1405eb2d 100755 --- a/portmgr/packaging/packageall.tcl +++ b/portmgr/packaging/packageall.tcl @@ -45,7 +45,7 @@ array set ui_options {} proc ui_isset {val} { global ui_options if {[info exists ui_options($val)]} { - if {$ui_options($val) eq "yes"} { + if {$ui_options($val) ne "no"} { return 1 } } @@ -55,10 +55,14 @@ proc ui_isset {val} { # UI Callback proc ui_prefix {priority} { - switch $priority { + switch -regexp -- $priority { debug { return "DEBUG: " } + debug[0-9] { + set debug_level [regsub {debug(\d)} ${priority} {\1}] + return "DEBUG${debug_level}: " + } error { return "Error: " } @@ -73,7 +77,7 @@ proc ui_prefix {priority} { proc ui_channels {priority} { global logfd - switch $priority { + switch -regexp -- $priority { debug { if {[ui_isset ports_debug]} { return {stdout} @@ -81,6 +85,13 @@ proc ui_channels {priority} { return {} } } + debug[0-9] { + if {[ui_isset ports_debug_x] && (${priority} le ${ports_debug_x})} { + return {stdout} + } else { + return {} + } + } info { # put verbose stuff only to the log file if {[ui_isset ports_verbose]} { diff --git a/src/macports1.0/macports.tcl b/src/macports1.0/macports.tcl index e9e0b800398..325e26efff4 100644 --- a/src/macports1.0/macports.tcl +++ b/src/macports1.0/macports.tcl @@ -79,7 +79,7 @@ namespace eval macports { variable open_mports {} - variable ui_priorities "error warn msg notice info debug any" + variable ui_priorities "error warn msg notice info debug debug1 debug2 debug3 any" variable current_phase main variable ui_prefix "---> " @@ -120,7 +120,7 @@ proc macports::version {} { # ui_options accessor proc macports::ui_isset {val} { if {[info exists macports::ui_options($val)]} { - return [string is true -strict $macports::ui_options($val)] + return [expr ![string is false $macports::ui_options($val)]] } return 0 } @@ -318,10 +318,14 @@ proc macports::ui_init {priority args} { # Default implementation of ui_prefix proc macports::ui_prefix_default {priority} { - switch -- $priority { + switch -regexp -- $priority { debug { return "DEBUG: " } + debug[0-9] { + set debug_level [regsub {debug(\d)} ${priority} {\1}] + return "DEBUG${debug_level}: " + } error { return "Error: " } @@ -339,7 +343,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 +351,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 1a5420c2beb..6c756a2368d 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 c57e77cb0e8..73b4b98fcab 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 eabe57f6d96..755137e13ec 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 ced83d301c2..ae04a271dad 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,23 @@ proc parse_options { action ui_options_name global_options_name } { # debug implies verbose set ui_options(ports_verbose) yes } + [0-3] { + #d[0-3] + # TEMP HACK: Since args processed char-by-char, just use single-digit + # numeric arg for now. To fix, we either need to pre-process the args, + # and ensure 'dX' is combined before this switch. Or use non-destructive + # lookahead. + + 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 + + set ui_options(ports_debug_x) "debug${c}" + } q { set ui_options(ports_quiet) yes # quiet implies noninteractive diff --git a/src/port/portindex.tcl b/src/port/portindex.tcl index e04708297ec..d3377f16504 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 1ec2de33c7c..b7cb4acb9ba 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 877f3f28402..89033e91e88 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"