base: add ui_debug1-3

macports · May 31, 2021 · ac8e0e5 · ac8e0e5
1 parent f9f1a33
commit ac8e0e5
Show file tree

Hide file tree

Showing 11 changed files with 113 additions and 13 deletions.
diff --git 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
@@ -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
@@ -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,14 +77,21 @@ proc ui_prefix {priority} {
 
 proc ui_channels {priority} {
 	global logfd
-	switch $priority {
+	switch -regexp -- $priority {
 		debug {
 			if {[ui_isset ports_debug]} {
 				return {stdout}
 			} else {
 				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
@@ -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,14 +343,21 @@ 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
             } else {
                 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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"