base: add ui_debug2/ui_debug3

macports · May 30, 2021 · 3726e3d · 3726e3d
1 parent f9f1a33
commit 3726e3d
Show file tree

Hide file tree

Showing 8 changed files with 72 additions and 4 deletions.
diff --git a/src/macports1.0/macports.tcl b/src/macports1.0/macports.tcl
@@ -347,6 +347,20 @@ proc macports::ui_channels_default {priority} {
                 return {}
             }
         }
+        debug2 {
+            if {[ui_isset ports_debug2]} {
+                return stderr
+            } else {
+                return {}
+            }
+        }
+        debug3 {
+            if {[ui_isset ports_debug3]} {
+                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_debugX(Tcl_Interp *interp, int level, const char *format, va_list va) {
+    char cLevel[20];  // longer than necessary, but also safer
+
+    sprintf(cLevel, "debug%d", 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,24 @@ void ui_debug(Tcl_Interp *interp, const char *format, ...) {
     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_debugX(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_debugX(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,8 @@ 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_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,12 @@ set failures 0
 proc ui_debug {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
@@ -4577,6 +4577,19 @@ proc parse_options { action ui_options_name global_options_name } {
                         # debug implies verbose
                         set ui_options(ports_verbose) yes
                     }
+                    d2 {
+                        set ui_options(ports_debug) yes
+                        set ui_options(ports_debug2) yes
+                        # debug implies verbose
+                        set ui_options(ports_verbose) yes
+                    }
+                    d3 {
+                        set ui_options(ports_debug) yes
+                        set ui_options(ports_debug2) yes
+                        set ui_options(ports_debug3) yes
+                        # debug implies verbose
+                        set ui_options(ports_verbose) yes
+                    }
                     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,13 @@ for {set i 0} {$i < $argc} {incr i} {
         {^-.+} {
             if {$arg eq "-d"} { # Turn on debug output
                 set ui_options(ports_debug) yes
+            elseif {$arg eq "-d2"} { # Turn on debug2 output
+                set ui_options(ports_debug) yes
+                set ui_options(ports_debug2) yes
+            elseif {$arg eq "-d3"} { # Turn on debug3 output
+                set ui_options(ports_debug) yes
+                set ui_options(ports_debug2) yes
+                set ui_options(ports_debug3) yes
             } 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_debug2 "Running callback ${callback}"
 			${callback}
-			ui_debug "Finished running callback ${callback}"
+			ui_debug2 "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_debug2 "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_debug2 "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"