base: add ui_debug[1-3]

macports · May 30, 2021 · 99ca671 · 99ca671
1 parent f9f1a33
commit 99ca671
Show file tree

Hide file tree

Showing 10 changed files with 84 additions and 7 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/src/macports1.0/macports.tcl b/src/macports1.0/macports.tcl
@@ -339,14 +339,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,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
@@ -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"