error handling & UX improvements

thanoulis · Dec 10, 2020 · 66e31e4 · 66e31e4
1 parent 8171ab8
commit 66e31e4
Showing 1 changed file with 92 additions and 44 deletions.
diff --git a/tqemu b/tqemu
@@ -65,15 +65,36 @@ namespace eval tqemu {
 ################################################################################
 # PROCEDURES
 #
-proc tqemu::Message {msg} {
+proc tqemu::ReadArgs {args} {
+  set i 0
+  foreach option $args {
+    if {[file isfile $option]} {
+      set filetype [string tolower [file extension $option]]
+      switch -- $filetype {
+        .iso {
+          set tqemu::cdrom $option
+        }
+        .qcow2 {
+          dict set tqemu::filelist $i $option
+          incr i
+        }
+      }
+    } else {
+      lappend tqemu::extra $option
+    }
+  }
+  tqemu::Start [tqemu::BuildCmd]
+}
+
+proc tqemu::Message {msg {time 5000}} {
   after cancel {set tqemu::msg ""}
   if {[string length $msg] > 50} {
     set tqemu::msg [string cat [string range $msg 0 20] \
       "..." [string range $msg end-30 end]]
   } else {
     set tqemu::msg $msg
   }
-  after 5000 {set tqemu::msg ""}
+  after $time {set tqemu::msg ""}
 }
 
 proc tqemu::StartState {} {
@@ -87,8 +108,8 @@ proc tqemu::SelectISO {w} {
   set filetypes {
     {{ISO Files} {.iso .ISO}}
   }
-  set tqemu::cdrom [file nativename [tk_getOpenFile -parent . \
-    -title "Select CD-ROM" -filetypes $filetypes -multiple false]]
+  set tqemu::cdrom [tk_getOpenFile -parent . \
+    -title "Select CD-ROM" -filetypes $filetypes -multiple false]
   if {$tqemu::cdrom ne ""} {
     $w xview end
     tqemu::Message "$tqemu::cdrom ready"
@@ -101,14 +122,25 @@ proc tqemu::SelectImage {tree} {
     {{QCOW2}     {.qcow2 .QCOW2}}
     {{All Files} {*}}
   }
-  set filelist [file nativename [tk_getOpenFile -parent . \
-    -title "Select QEMU Image Files" -filetypes $filetypes -multiple true]]
+  set filelist [tk_getOpenFile -parent . \
+    -title "Select QEMU Image Files" -filetypes $filetypes -multiple true]
   if {$filelist eq ""} {return 1}
   foreach file $filelist {
     if {$file ni [dict values $tqemu::filelist]} {
+      try {
+        tk busy hold .
+        update
+        set statelist [exec -- qemu-img snapshot -l $file]
+      } on error msg {
+        tk_messageBox -title "Error loading [file tail $file]" \
+          -icon error -type ok -parent . \
+          -message [lindex [split $msg ":"] 0] -detail $msg
+        return 1
+      } finally {
+        tk busy forget .
+      }
       set node [$tree insert {} end -text [file tail $file]]
       $tree tag add File $node
-      set statelist [exec -ignorestderr -- qemu-img snapshot -l $file]
       set statelist [lsearch -all -inline \
         -regexp $statelist {vm-([[:digit:]]){14}\M}]
       if {$statelist ne ""} {
@@ -140,18 +172,29 @@ proc tqemu::CreateImage {} {
     {{QCOW2}     {.qcow2 .QCOW2}}
     {{All Files} {*}}
   }
-  set filename [file nativename [tk_getSaveFile -parent . \
+  set filename [tk_getSaveFile -parent . \
     -title "Create QEMU Image File" -filetypes $filetypes \
-    -defaultextension .qcow2]]
+    -defaultextension .qcow2]
   if {$filename eq ""} {return 2}
   append imgsize $tqemu::imgsize "G"
-  exec -ignorestderr -- qemu-img create -f qcow2 $filename $imgsize
+  try {
+    tk busy hold .
+    update
+    exec -- qemu-img create -f qcow2 $filename $imgsize
+  } on error msg {
+    tk_messageBox -title "Error creating [file tail $filename]" \
+      -icon error -type ok -parent . \
+      -message [lindex [split $msg ":"] 0] -detail $msg
+    return 1
+  } finally {
+    tk busy forget .
+  }
   tqemu::Message "$filename created Size:${imgsize}"
 }
 
 proc tqemu::Share {w} {
-  set tqemu::smb [file nativename [tk_chooseDirectory -parent . \
-    -title "Select Shared Directory" -mustexist true]]
+  set tqemu::smb [tk_chooseDirectory -parent . \
+    -title "Select Shared Directory" -mustexist true]
   if {$tqemu::smb eq ""} {
     tqemu::Message "share disabled"
     return 2
@@ -161,11 +204,12 @@ proc tqemu::Share {w} {
 }
 
 proc tqemu::Binary {} {
-  set executable [file nativename [tk_getOpenFile -parent . \
-    -title "Select QEMU Executable File" -multiple false]]
+  set executable [tk_getOpenFile -parent . \
+    -title "Select QEMU Executable File" -multiple false]
   if {$executable eq ""} {return 2}
   if {[auto_execok $executable] eq ""} {
-    tk_messageBox -title "ERROR" -icon error -type ok -parent . \
+    tk_messageBox -title "Error loading [file tail $executable]" \
+      -icon error -type ok -parent . \
       -message "[file tail $executable]:" \
       -detail "Not a valid executable file"
     return 1
@@ -179,8 +223,7 @@ proc tqemu::LoadState {node tree} {
   set command [tqemu::BuildCmd "loadvm"]
   lappend command --blockdev driver=qcow2,node-name=QEMUDisk0,file.driver=file,file.filename=${filename} \
     --device ${tqemu::storage},drive=QEMUDisk0 --loadvm $loadvm
-  tqemu::Start $command
-  tqemu::Message "QEMU is loading $loadvm"
+  tqemu::Start $command $loadvm
 }
 
 proc tqemu::RemoveFile {node tree} {
@@ -195,9 +238,20 @@ proc tqemu::RemoveFile {node tree} {
 proc tqemu::DeleteState {node tree} {
   set state [$tree item $node -text]
   set file [dict get $tqemu::filelist [$tree parent $node]]
+  try {
+    tk busy hold .
+    update
+    exec -- qemu-img snapshot -d $state $file
+  } on error msg {
+    tk_messageBox -title "Error deleting $state" \
+      -icon error -type ok -parent . \
+      -message [lindex [split $msg ":"] 0] -detail $msg
+    return 1
+  } finally {
+    tk busy forget .
+  }
   $tree tag remove State $node
   $tree delete $node
-  exec -ignorestderr -- qemu-img snapshot -d $state $file &
   tqemu::Message "$state deleted"
 }
 
@@ -259,13 +313,28 @@ proc tqemu::BuildCmd {{loadvm ""}} {
   return $command
 }
 
-proc tqemu::Start {command} {
+proc tqemu::Start {command {loadvm ""}} {
+  set command [file nativename [tqemu::BuildCmd]]
   if {$tqemu::cdrom ne ""} {
     tqemu::Message "QEMU is starting $tqemu::cdrom"
   } else {
     tqemu::Message "QEMU is starting [lindex $tqemu::filelist 1]"
   }
-  exec -ignorestderr -- {*}$command
+  if {$loadvm ne ""} {
+    tqemu::Message "QEMU is loading $loadvm" 10000
+  }
+  try {
+    tk busy hold .
+    update
+    exec  -- {*}$command
+  } on error msg {
+    tk_messageBox -title "Error executing $tqemu::bin" \
+      -icon error -type ok -parent . \
+      -message [lindex [split $msg ":"] 0] -detail $msg
+    return 1
+  } finally {
+    tk busy forget .
+  }
 }
 
 proc tqemu::DnD::Start {W x y X Y} {
@@ -354,13 +423,13 @@ proc tqemu::History {w extra} {
 }
 
 proc tqemu::ShowCommand {} {
-  set command [tqemu::BuildCmd]
+  set command [file nativename [tqemu::BuildCmd]]
   tk_messageBox -title "Show Command" -icon info -type ok -parent . \
     -message "QEMU Command:" -detail $command
 }
 
 proc tqemu::CopyCommand {} {
-  set command [tqemu::BuildCmd]
+  set command [file nativename [tqemu::BuildCmd]]
   clipboard clear
   clipboard append -type STRING -- $command
   tqemu::Message "Command copied to clipboard"
@@ -673,28 +742,7 @@ wm minsize   . 550 290
 wm resizable . 0 0
 wm protocol  . WM_DELETE_WINDOW {exit}
 
-################################################################################
-# COMMAND LINE
-#
 if {$::argc > 0} {
-  set i 0
-  foreach option $::argv {
-    if {[file isfile $option]} {
-      set filetype [string tolower [file extension $option]]
-      switch -- $filetype {
-        .iso {
-          set tqemu::cdrom [file nativename $option]
-        }
-        .qcow2 {
-          dict set tqemu::filelist $i [file nativename $option]
-          incr i
-        }
-      }
-    } else {
-      lappend tqemu::extra $option
-    }
-  }
-  unset -nocomplain -- option filetype i
-  tqemu::Start [tqemu::BuildCmd]
+  tqemu::ReadArgs $::argv
   exit
 }