[124042] branches/gsoc14-cleanup/src/macports1.0/doctor.tcl

[ksammons at macports.org]

Revision: 124042
          https://trac.macports.org/changeset/124042
Author:   ksammons at macports.org
Date:     2014-08-17 11:18:59 -0700 (Sun, 17 Aug 2014)
Log Message:
-----------
Progress bar output for port-file checking added by Neverpanic.

Modified Paths:
--------------
    branches/gsoc14-cleanup/src/macports1.0/doctor.tcl

Modified: branches/gsoc14-cleanup/src/macports1.0/doctor.tcl
===================================================================
--- branches/gsoc14-cleanup/src/macports1.0/doctor.tcl	2014-08-17 17:44:23 UTC (rev 124041)
+++ branches/gsoc14-cleanup/src/macports1.0/doctor.tcl	2014-08-17 18:18:59 UTC (rev 124042)
@@ -203,7 +203,7 @@
         # Returns:
         #           None
 
-        if {${doctor::quiet} eq 0} {
+        if {${doctor::quiet} == 0} {
             ui_msg -nonewline "Checking for $string... "
         }
     }
@@ -335,38 +335,75 @@
 
         set apps [reclaim::get_info]
 
+        array set activeApps {}
+        set totalFiles 0
+
         foreach app $apps {
 
-            
             set name    [lindex $app 0]
             set active  [lindex $app 4]
             set files   [registry::port_registered $name]
 
-            if {$active} { 
+            if {$active} {
+                set activeApps($name) $files
+                incr totalFiles [llength $files]
+            }
+        }
 
-                foreach file $files {
+        set fancyOutput [expr {![macports::ui_isset ports_debug] && ![macports::ui_isset ports_verbose] && [info exists macports::ui_options(progress_generic)]}]
+        if {$fancyOutput} {
+            set progress $macports::ui_options(progress_generic)
+        }
 
-                    output "file '$file' on disk"
-                    
+        if {$totalFiles > 0} {
+            if {$fancyOutput} {
+                output "files installed by ports on disk"
+                if {${doctor::quiet} == 0} {
+                    # we need a newline here or the progress bar will overwrite the line
+                    ui_msg ""
+                }
+                $progress start
+            }
+
+            set currentFile 1
+            foreach name [lsort [array names activeApps]] {
+                foreach file $activeApps($name) {
+                    if {$fancyOutput} {
+                        $progress update $currentFile $totalFiles
+                    } else {
+                        output "file '$file' on disk"
+                    }
+
                     if {![file exists $file]} {
-                        success_fail 0
+                        if {$fancyOutput} {
+                            $progress intermission
+                        } else {
+                            success_fail 0
+                        }
+
                         ui_warn "couldn't find file '$file' for port '$name'. Please deactivate and reactivate the port to fix this issue."
-
                     } elseif {![file readable $file]} {
-                        success_fail 0
-                        ui_warn "'$file' installed by port '$name' is currently not readable. Please try again. If this problem persists, please contact\
-                                 the mailing list."
+                        if {$fancyOutput} {
+                            $progress intermission
+                        } else {
+                            success_fail 0
+                        }
 
-                    } else {
-
+                        ui_warn "'$file' installed by port '$name' is currently not readable. Please try again. If this problem persists, please contact the mailing list."
+                    } elseif {!$fancyOutput} {
                         success_fail 1
                     }
+
+                    incr currentFile
                 }
             }
+
+            if {$fancyOutput} {
+                $progress finish
+            }
         }
+    }
 
-    } 
-
     proc check_tarballs {} {
 
         # Checks if the archives for each installed port in /opt/local/var/macports/software/$name is actually in there. If not, it warns
@@ -388,7 +425,7 @@
             set variants    [lindex $app 3]
             set epoch       [lindex $app 5]
 
-            output "'$name's tarball on disk"
+            output "'$app's tarball on disk"
 
             set ref         [registry::open_entry $name $version $revision $variants $epoch]
             set image_dir   [registry::property_retrieve $ref location]
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://lists.macosforge.org/pipermail/macports-changes/attachments/20140817/31c58b33/attachment.html>