diff --git a/vpacman.tcl b/vpacman.tcl
index b8d92f1..aca633d 100644
--- a/vpacman.tcl
+++ b/vpacman.tcl
@@ -28,7 +28,7 @@ exec wish "$0" -- "$@"
# along with this program. If not, see .
# set the version number
-set version "1.4.1"
+set version "1.4.2"
# save any arguments passed to vpacman
set args $argv
@@ -763,6 +763,8 @@ puts $debug_out(1) "Version $version: User is $env(USER) - Home is $home - Confi
# open a window and display some text in it
# proc view_text_codes
# read through some text and replace a set of codes with a given tag
+# proc view_text_url
+# check for a selection before opening a URL in the browser
proc all_select {} {
@@ -1697,17 +1699,14 @@ global aur_versions aur_versions_TID debug debug_out dlprog editor geometry list
}
}
-### if something changed then set result to success
+ # if something changed then set result to success
if {[expr $count_upgrades + $count_downgrades + $count_installs] >= 1} {
puts $debug_out(2) "aur_upgrade - Some changes were recorded"
set result "success"
}
-# if {$vstate == "indate" || $result == "failed"}
-# puts $debug_out(2) "\tPackage was indate ($vstate) or the result was failed ($result)"
if {$result == "failed"} {
puts $debug_out(2) "\tPackage was $vstate but the result was failed"
-###
# the local database will still be up to date
# if we only did a reinstall then there is nothing to do
} else {
@@ -2147,7 +2146,7 @@ global debug_out su_cmd win_mainx win_mainy
.clean.yes_no configure -text "no"
# now set up a binding to toggle the value of the clean_yes_no label
bind .clean.yes_no {
- if {[string tolower [.clean.yes_no cget -text] == "yes"} {
+ if {[string tolower [.clean.yes_no cget -text]] == "yes"} {
.clean.yes_no configure -text "no"
} else {
.clean.yes_no configure -text "yes"
@@ -3190,8 +3189,10 @@ global aur_only aur_updates aur_versions aur_versions_TID dbpath debug_out dlpro
puts $debug_out(2) "execute - called the start procedure"
# call start
start
+ # see if a local package is included in the selections or the list is set to AUR/Local updates
if {$aur || $selected_list == "aur_updates"} {
puts $debug_out(2) "execute - one or more packages are local, so do not call aur_versions_thread now, leave it to get_aur_versions when it is called by get_aur_updates"
+ puts $debug_out(2) "execute - selected list is $selected_list"
set aur_versions ""
get_aur_updates
} elseif {$threads} {
@@ -3202,20 +3203,22 @@ global aur_only aur_updates aur_versions aur_versions_TID dbpath debug_out dlpro
thread::send -async $aur_versions_TID [list thread_get_aur_versions [thread::id] $dlprog $tmp_dir $list_local]
}
} else {
- puts $debug_out(1) "execute - cannot call aur_versions thread - threading not available"
+ puts $debug_out(2) "execute - cannot call aur_versions thread - threading not available"
set aur_versions ""
get_aur_updates
}
-
puts $debug_out(2) "execute - completed the start procedure"
# selected_list is the list selection. If it is 0 then just run filter
- puts $debug_out(2) "execute - now run the filter for \"$selected_list\""
if {$selected_list == 0} {
+ # get_aur_updates left aur_local set to true
+ set aur_only false
+ puts $debug_out(2) "execute - now run the filter for \"all\""
# if we needed to run get_aur_updates the filter will have been set to aur
set filter "all"
filter
} else {
+ puts $debug_out(2) "execute - now run the filter_checkbutton for \"$selected_list\""
# selected_list is not 0 so run the required filter(_checkbutton)
switch $selected_list {
"orphans" {
@@ -3225,6 +3228,7 @@ global aur_only aur_updates aur_versions aur_versions_TID dbpath debug_out dlpro
filter_checkbutton ".filter_list_not_required" "pacman -b $tmp_dir -Qtq" "Not Required"
}
"aur_updates" {
+ # are we running this twice? get_aur_updates will return if aur_versions is not blank
get_aur_updates
}
}
@@ -4461,8 +4465,13 @@ global aur_all aur_messages aur_only aur_updates aur_versions debug_out filter f
}
# aur_updates should now be a clean list of all the updates including all the local packages if requested
set filter_list $aur_updates
- puts $debug_out(2) "get_aur_updates - configured text \"AUR/Local Updates ([llength $filter_list])\""
- .filter_list_aur_updates configure -text "AUR/Local Updates ([llength $filter_list])"
+ if {$aur_all} {
+ puts $debug_out(2) "get_aur_updates - configured text \"AUR/Local Packages ([llength $filter_list])\""
+ .filter_list_aur_updates configure -text "AUR/Local Packages ([llength $filter_list])"
+ } else {
+ puts $debug_out(2) "get_aur_updates - configured text \"AUR/Local Updates ([llength $filter_list])\""
+ .filter_list_aur_updates configure -text "AUR/Local Updates ([llength $filter_list])"
+ }
puts $debug_out(2) "aur_updates message\n\t$messages\naur_messages $aur_messages"
if {$messages != "" && $aur_messages == "true"} {
set ans [tk_messageBox -default yes -detail "Do you want to view the warning messages now?" -icon question -message "There are warning messages from the AUR/Local Updates." -parent . -title "Upgrade Warnings" -type yesno]
@@ -4524,6 +4533,12 @@ global aur_all aur_messages aur_only aur_updates aur_versions debug_out dlprog f
return 1
}
file delete "$tmp_dir/get_aur_versions.sh"
+ # check if the file has been written
+ set count 0
+ while {[file readable $tmp_dir/vpacman_aur_result] == 0 && $count < 5} {
+ after 100
+ incr count
+ }
puts $debug_out(2) "get_aur_versions - found result ([expr [clock milliseconds] - $start_time])"
# read the results into a variable
set fid [open $tmp_dir/vpacman_aur_result r]
@@ -4786,8 +4801,8 @@ global aur_only browser dataview debug_out pacman_files_upgrade pkgfile_upgrade
# if this is row 1 then change the wording to Repository : ....
if {$count == 1} {
.wp.wftwo.dataview.moreinfo insert end "Repository[string repeat { } [expr $index - 10]]: $repo\n"
- # if we know of a browser, and this is a local package then use the package name to make a URL and insert tags accordingly
- } elseif {$repo == "local" && $browser != "" && $count == 2} {
+ # if we know of a browser, and this is a local package then use the package name to make a URL and insert tags accordingly
+ } elseif {$repo == "local" && $browser != "" && $count == 2} {
# click on the link to view it in the selected browser
.wp.wftwo.dataview.moreinfo tag bind get_aur "puts $debug_out(2) \"GET AUR URL\"; exec $browser https://aur.archlinux.org/packages/[string range $row [expr $index + 2] end] &"
# add the normal text to the text box
@@ -6492,8 +6507,8 @@ global aur_all aur_versions debug_out filter filter_list find group list_all lis
}
# now show the number of packages against AUR/Local Updates
if {$aur_all == true} {
- puts $debug_out(2) "put_aur_versions - configured text \"AUR/Local Updates ([llength $list_local])\""
- .filter_list_aur_updates configure -text "AUR/Local Updates ([llength $list_local])"
+ puts $debug_out(2) "put_aur_versions - configured text \"AUR/Local Packages ([llength $list_local])\""
+ .filter_list_aur_updates configure -text "AUR/Local Packages ([llength $list_local])"
} else {
puts $debug_out(2) "put_aur_versions - configured text to local_newer \"AUR/Local Updates ($local_newer)\""
.filter_list_aur_updates configure -text "AUR/Local Updates ($local_newer)"
@@ -6905,17 +6920,23 @@ global debug_out start_time sync_time
puts $debug_out(1) "set_clock called - ([expr [clock milliseconds] - $start_time])"
# test for a resync and update if requested
if {$test} {test_resync}
-
+
+ set delay 60000
set e_time [expr [clock seconds] - $sync_time]
# now convert the number of elapsed seconds into a string dd:hh:mm
set days [expr int($e_time / 60 / 60 / 24)]
- if {[string length $days] == 1} {set days "0$days"}
set hours [expr int($e_time / 60 / 60) - ($days * 24)]
- set mins [expr round((($e_time / 60.0) +0.5) - ($hours * 60) - ($days * 60 * 24))]
+ set mins [expr round(($e_time / 60.0) - ($hours * 60) - ($days * 60 * 24))]
+ # set the next update to the next full minute
+ set delay [expr (91 - ($e_time - [expr int($e_time / 60) * 60])) * 1000]
+ # show at least 1 minute
+ if {[expr $days + $hours + $mins] == 0} {set mins 1}
+ if {[string length $days] == 1} {set days "0$days"}
+ puts $debug_out(3) "set_clock - update set to ${days}:[string range "0${hours}" end-1 end]:[string range "0${mins}" end-1 end]"
.filter_clock configure -text "${days}:[string range "0${hours}" end-1 end]:[string range "0${mins}" end-1 end]"
-
+ update
# wait a minute
- after 60000 {
+ after $delay {
# update the time since last sync
set_clock true
}
@@ -7309,22 +7330,24 @@ proc test_resync {} {
global aur_versions_TID debug_out dlprog list_local threads sync_time tmp_dir
# test if a resync is required after a failed update or an external intervention
- puts $debug_out(1) "test_resync called"
+ puts $debug_out(1) "test_resync called - sync_time is $sync_time"
# save the last recorded time that the temporary sync database was updated
set prev_tmpsync_time $sync_time
# now get the latest time that the temporary sync database was updated
set latest_tmpsync_time [file mtime "$tmp_dir/sync"]
# now update the temporary sync database if necessary and record the update time
- # get_sync_time checks that the temporary sync database exists and is the same or newer than the pacman database
+ # get_sync_time checks that the temporary sync database exists and is the same or newer than the pacman database
+ # get_sync_time returns the update time of the tmp database and the update time of the real database
set sync_time [lindex [get_sync_time] 0]
- # so we can see if an update occurred to the sync database because it will have changed the temporary sync database time.
- if {$latest_tmpsync_time != [file mtime "$tmp_dir/sync"]} {
+ # get_sync_time may have changed the value of latest_tmpsync_time
+ # see if an update occurred to the sync database because it will have changed the temporary sync database time.
+ if {$latest_tmpsync_time != $sync_time} {
puts $debug_out(2) "test_resync - external pacman sync detected"
# the pacman database has been updated, is the system stable?
test_system ""
}
# now we can see if an update occurred to the temporary sync database because the mtime will have changed from the previously recorded tmpsync time.
- if {$latest_tmpsync_time != $prev_tmpsync_time} {
+ if {$sync_time != $prev_tmpsync_time} {
puts $debug_out(2) "test_resync - external temporary sync detected"
# was anything updated?
set last_update_time [get_file_mtime $tmp_dir/sync db]
@@ -7394,6 +7417,9 @@ proc test_versions {installed available} {
global debug_out start_time
# test if the available version is newer or older than the installed version
+# test_versions is called when the versions in list_all or list_show are not the same.
+# pacman -b $tmp_dir -Qu should produce the same result, but would need to be run at start which could add to the startup time.
+# test_versions is also called for AUR/local packages and to check AUR/Local dependancies
puts $debug_out(1) "test_versions called for installed $installed and available $available ([expr [clock milliseconds] - $start_time])"
@@ -7449,6 +7475,11 @@ global debug_out start_time
set count 0
while {$count < $length} {
puts $debug_out(3) "test_versions - compare $old_version to $new_version, $length items, $count item: [lindex $new_version $count] and [lindex $old_version $count]"
+ # if the first item is blank and the second item is not then the second version is an extended version
+ if {[lindex $new_version $count] != "" && [lindex $old_version $count] == ""} {
+ puts $debug_out(3) "test_versions - version number is extended, available is newer"
+ return "newer"
+ }
# if both versions are integer numbers test them
if {[string is integer [lindex $new_version $count]] && [string is integer [lindex $old_version $count]]} {
if {[lindex $new_version $count] > [lindex $old_version $count]} {
@@ -7479,50 +7510,70 @@ global debug_out start_time
set index2 0
while true {
+ set failindex1 0
+ set failindex2 0
# does each string start with an alpha sub string
set result [string is alpha -failindex failindex1 $string1]
- # is string1 alpha
+ puts $debug_out(3) "test_versions - complex compare is $string1 alpha? Results is $result, Fail index is $failindex1"
+ # what type is string1
if {$result == 1} {
puts $debug_out(3) "test_versions - complex compare $string1 is alpha"
} elseif {$failindex1 != 0} {
puts $debug_out(3) "test_versions - complex compare $string1 is alphanumeric"
} else {
- puts $debug_out(3) "test_versions - complex compare $string1 is numeric"
+ puts $debug_out(3) "test_versions - complex compare $string1 starts with a number"
+ set result [string is integer -failindex failindex1 $string1]
+ if {$result == 1} {
+ puts $debug_out(3) "test_versions - complex compare $string1 is numeric"
+ set failindex1 0
+ }
}
- # is string2 alpha
+ # what type is string2
set result [string is alpha -failindex failindex2 $string2]
+ puts $debug_out(3) "test_versions - complex compare is $string2 alpha? Results is $result, Fail index is $failindex2"
+ # is string1 alpha
if {$result == 1} {
puts $debug_out(3) "test_versions - complex compare $string2 is alpha"
} elseif {$failindex2 != 0} {
puts $debug_out(3) "test_versions - complex compare $string2 is alphanumeric"
} else {
- puts $debug_out(3) "test_versions - complex compare $string2 is numeric"
+ puts $debug_out(3) "test_versions - complex compare $string2 starts with a number"
+ set result [string is integer -failindex failindex2 $string2]
+ if {$result == 1} {
+ puts $debug_out(3) "test_versions - complex compare $string2 is numeric"
+ set failindex2 0
+ }
}
- set sub_string1 [string range $string1 $index1 $failindex1-1]
- set sub_string2 [string range $string2 $index2 $failindex2-1]
- if {$sub_string1 != "" && $sub_string2 != ""} {
- puts $debug_out(3) "test_versions - complex compare $sub_string1 with $sub_string2"
+
+ if {$failindex1 == 0} {
+ set sub_string1 $string1
+ } else {
+ set sub_string1 [string range $string1 $index1 $failindex1-1]
+ }
+ if {$failindex2 == 0} {
+ set sub_string2 $string2
+ } else {
+ set sub_string2 [string range $string2 $index2 $failindex2-1]
}
- if {$failindex1 == 0 && $failindex2 != 0} {
+ puts $debug_out(3) "test_versions - complex compare sub_strings \"$sub_string1\" with \"$sub_string2\""
+ if {[string is integer $sub_string1] == 1 && [string is alpha $sub_string2] == 1} {
puts $debug_out(1) "test_versions - complex compare $sub_string1 is newer (is integer)"
return "newer"
- } elseif {$failindex1 != 0 && $failindex2 == 0} {
+ } elseif {[string is alpha $sub_string1] == 1 && [string is integer $sub_string2] == 1} {
puts $debug_out(1) "test_versions - complex compare $sub_string1 is older (is alpha not integer)"
return "older"
- } elseif {$failindex1 == 0 && $failindex2 == 0} {
- puts $debug_out(3) "test_versions - complex sub_strings are both integers"
- if {$string1 > $string2} {
+ } elseif {[string is integer $sub_string1] == 1 && [string is integer $sub_string2] == 1} {
+ puts $debug_out(3) "test_versions - complex compare sub_strings are both integers"
+ if {$sub_string1 > $sub_string2} {
puts $debug_out(1) "test_versions - complex compare values indicates that available is newer"
return "newer"
- } elseif {$string1 < $string2} {
+ } elseif {$sub_string1 < $sub_string2} {
puts $debug_out(1) "test_versions - complex compare values indicates that available is older"
return "older"
}
} else {
- set sub_string1 [string range $string1 $index1 $failindex1-1]
- set sub_string2 [string range $string2 $index2 $failindex2-1]
set result [string compare $sub_string1 $sub_string2]
- puts $debug_out(3) "test_versions - complex compare $sub_string1 with $sub_string2 returned $result"
+ puts $debug_out(3) "test_versions - complex compare strings $sub_string1 with $sub_string2 returned $result"
if {$result == 1} {
puts $debug_out(1) "test_versions - complex compare strings indicates that available is newer"
return "newer"
@@ -7536,6 +7587,7 @@ global debug_out start_time
set string2 [string range $string2 $failindex2 end]
set index1 $failindex1
set index2 $failindex2
+ puts $debug_out(3) "test_versions - complex compare now test \"$string1\" with \"$string2\""
}
}
incr count
@@ -8795,7 +8847,7 @@ proc view_text {text title} {
global browser debug_out save_geometry geometry_view
# open a window and display some text in it
- puts $debug_out(1) "view-text called"
+ puts $debug_out(1) "view_text called"
catch {destroy .view}
@@ -8811,7 +8863,6 @@ global browser debug_out save_geometry geometry_view
text .view.listbox \
-background white \
- -selectforeground red \
-tabs "[expr {4 * [font measure TkTextFont 0]}] left" \
-tabstyle wordprocessor \
-wrap word \
@@ -8836,7 +8887,7 @@ global browser debug_out save_geometry geometry_view
button .view.close_button \
-command {
- puts $debug_out(1) "View-text closed"
+ puts $debug_out(1) "view_text closed"
if {[string tolower $save_geometry] == "yes"} {set geometry_view [wm geometry .view]; put_configs}
grab release .view
destroy .view
@@ -8866,7 +8917,7 @@ global browser debug_out save_geometry geometry_view
# and set up a binding for it
bind .view.listbox {
- puts $debug_out(2) "view-text button 3 pressed"
+ puts $debug_out(2) "view_text button 3 pressed"
if {[.view.listbox tag ranges sel] != ""} {
tk_popup .dataview_popup %X %Y 0
}
@@ -8874,20 +8925,20 @@ global browser debug_out save_geometry geometry_view
# Set up some tags for the text field '.view.listbox'
- # make the URL blue
- .view.listbox tag configure url_tag -foreground blue
+ # make the URL blue, do not show any selection
+ .view.listbox tag configure url_tag -foreground blue -selectforeground blue
# set the cursor to a left pointer when hovering over the text
.view.listbox tag bind url_cursor_in ".view.listbox configure -cursor left_ptr"
# set the cursor to the default when leaving the text
.view.listbox tag bind url_cursor_out ".view.listbox configure -cursor [.view.listbox cget -cursor]"
# set the text background colour
- .view.listbox tag configure background_tag -background "#F6FAA0" -font "TkFixedFont"
+ .view.listbox tag configure background_tag -background "#F6FAA0" -font "TkFixedFont" -selectbackground #c3c3c3
# set the text to bold
- .view.listbox tag configure bold_tag -font "TkHeadingFont"
+ .view.listbox tag configure bold_tag -font "TkHeadingFont" -selectbackground #c3c3c3
# set the text to centred
- .view.listbox tag configure centred_tag -justify center
+ .view.listbox tag configure centred_tag -justify center -selectbackground #c3c3c3
# set the text to fixed width
- .view.listbox tag configure fixed_tag -font "TkFixedFont"
+ .view.listbox tag configure fixed_tag -font "TkFixedFont" -selectbackground #c3c3c3
# set the one indent value
.view.listbox tag configure indent1_tag -lmargin2 "[expr {4 * [font measure TkTextFont 0]}]"
# set the two indent value
@@ -8931,7 +8982,9 @@ global browser debug_out save_geometry geometry_view
# and the end index of that string, but also the position from which to start the next seach
set start_index $index+[string length $text_url]chars
# set up a bind tag for the text found
- .view.listbox tag bind get_url($count) "exec $browser $text_url &"
+ #.view.listbox tag bind get_url($count) "exec $browser $text_url &"
+ .view.listbox tag bind get_url($count) "view_text_url $text_url"
+
puts $debug_out(2) "view_text - found http at $index : $text_url : get_url($count) set to exec $browser $text_url &"
# now replace the text with the text plus all of its tags
puts $debug_out(2) "view_text - replace text $text_url at $index to $start_index with the text plus tags"
@@ -8970,7 +9023,7 @@ global debug_out
set end_index 0.0
set to 0
- # read through the test and replace any start/end codes with the tag
+ # read through the text and replace any start/end codes with the tag
while {true} {
# set from to the start of the code string
puts $debug_out(3) "view_text_codes - search for ${start_code} in text with result [string first $start_code $text $start]"
@@ -9002,6 +9055,22 @@ global debug_out
puts $debug_out(1) "view_text_codes completed"
}
+proc view_text_url {url} {
+
+global browser debug_out
+# check for a selection before opening a URL in the browser
+
+ puts $debug_out(1) "view_text_url - called for $url"
+
+ if {[.view.listbox tag ranges sel] != ""} {
+ puts $debug_out(1) "view_text_url - there is a selection, do nothing"
+ return 1
+ } else {
+ puts $debug_out(1) "view_text_url - there is no selection, open $url"
+ exec $browser $url &
+ }
+}
+
# MAIN
puts $debug_out(1) "Main reached - ([expr [clock milliseconds] - $start_time])"
@@ -9701,16 +9770,20 @@ frame .filters
}
} \
-onvalue "aur_updates" \
- -text "AUR/Local Updates" \
-variable selected_list
+ if {$aur_all == true} {
+ .filter_list_aur_updates configure -text "AUR/Local Packages"
+ } else {
+ .filter_list_aur_updates configure -text "AUR/Local Updates"
+ }
checkbutton .filter_list_aur_updates_all \
-command {
update idletasks
puts $debug_out(1) "aur_all set to $aur_all"
if {$aur_all} {
- puts $debug_out(2) ".filter_list_aur_updates - configured text \"AUR/Local Updates ([llength $list_local])\""
- .filter_list_aur_updates configure -text "AUR/Local Updates ([llength $list_local])"
+ puts $debug_out(2) ".filter_list_aur_updates - configured text \"AUR/Local Packages ([llength $list_local])\""
+ .filter_list_aur_updates configure -text "AUR/Local Packages ([llength $list_local])"
balloon_set .filter_list_aur_updates "List all AUR/Local packages which have been installed"
} else {
puts $debug_out(2) ".filter_list_aur_updates - configured text to local_newer \"AUR/Local Updates ($local_newer)\""
@@ -11145,7 +11218,7 @@ if {!$aur_all} {
} else {
balloon_set .filter_list_aur_updates "List all AUR/Local packages which have been installed"
}
-balloon_set .filter_list_aur_updates_all "Include all local packages in the AUR/Local Updates list"
+balloon_set .filter_list_aur_updates_all "Include all local packages in the AUR/Local list"
balloon_set .scroll_selectgroup "Use right click to jump"
balloon_set .wp.wfone.ylistview_scroll "Use right click to jump"
balloon_set .wp.wftwo.ydataview_files_scroll "Use right click to jump"