450 lines
17 KiB
Tcl
Executable File
450 lines
17 KiB
Tcl
Executable File
#!/usr/bin/env tclsh
|
|
# tiix: GUI client for ii/idec networks that leverages capabilities
|
|
# of tiifetch and tiipost and repimplements the tiiview functionality
|
|
# Depends on tiifetch, tiipost, Tcllib, SQLite3 and Tk
|
|
# Created by Luxferre in 2024, released into public domain
|
|
|
|
package require Tk
|
|
package require sqlite3
|
|
|
|
set scriptpath [file normalize [info script]]
|
|
set appdir [file dirname $scriptpath]
|
|
# check if we're running from a starpack
|
|
if [string match *app-tiix $appdir] {
|
|
set appdir [file normalize [file join $appdir ".." ".." ".." ]]
|
|
}
|
|
|
|
# include tiifetch and tiipost
|
|
|
|
source [file join $appdir "tiifetch.tcl"]
|
|
source [file join $appdir "tiipost.tcl"]
|
|
|
|
# populate general configuration
|
|
set cfg {}
|
|
set tiix_font TkFixedFont
|
|
set tiix_fontsize 10
|
|
set tiix_fgcolor black
|
|
set tiix_bgcolor white
|
|
set tiix_linkcolor blue
|
|
set useragent ""
|
|
set proxyhost ""
|
|
set proxyport 0
|
|
set cfgfile [file join $appdir "config.txt"]
|
|
if {[file exists $cfgfile]} {
|
|
set cfg [readfile $cfgfile]
|
|
if {[dict exists $cfg useragent]} {
|
|
set useragent [dict get $cfg useragent]
|
|
::http::config -useragent $useragent
|
|
}
|
|
if {[dict exists $cfg proxyhost]} {
|
|
set proxyhost [dict get $cfg proxyhost]
|
|
::http::config -proxyhost $proxyhost
|
|
}
|
|
if {[dict exists $cfg proxyport]} {
|
|
set proxyport [dict get $cfg proxyport]
|
|
::http::config -proxyport $proxyport
|
|
}
|
|
if {[dict exists $cfg tiix_font]} {
|
|
set tiix_font [dict get $cfg tiix_font]
|
|
}
|
|
if {[dict exists $cfg tiix_fontsize]} {
|
|
set tiix_fontsize [dict get $cfg tiix_fontsize]
|
|
}
|
|
if {[dict exists $cfg tiix_fgcolor]} {
|
|
set tiix_fgcolor [dict get $cfg tiix_fgcolor]
|
|
}
|
|
if {[dict exists $cfg tiix_bgcolor]} {
|
|
set tiix_bgcolor [dict get $cfg tiix_bgcolor]
|
|
}
|
|
if {[dict exists $cfg tiix_linkcolor]} {
|
|
set tiix_linkcolor [dict get $cfg tiix_linkcolor]
|
|
}
|
|
}
|
|
|
|
# create the font
|
|
font create tiix_font -family "$tiix_font" -size $tiix_fontsize -weight normal
|
|
|
|
# create the widget font
|
|
font create tiix_widget_font -family "sans-serif" -size 11
|
|
option add *font tiix_widget_font
|
|
ttk::style configure TButton -font tiix_widget_font
|
|
ttk::style configure TCheckbutton -font tiix_widget_font
|
|
ttk::style configure TNotebook.Tab -font tiix_widget_font
|
|
ttk::style configure TEntry -insertcolor $tiix_fgcolor
|
|
ttk::style configure TCombobox -insertcolor $tiix_fgcolor
|
|
|
|
# get auth string mapping
|
|
set authmap ""
|
|
set authfile [file join $appdir "auth.txt"]
|
|
if {[file exists $authfile]} {
|
|
set authmap [readfile $authfile]
|
|
}
|
|
|
|
# get the local DB file path
|
|
set localdb [file join $appdir "tii.db"]
|
|
|
|
# set default GUI parameters
|
|
|
|
set tiix_echoname ""
|
|
set tiix_post_echoname ""
|
|
set tiix_post_sturl ""
|
|
set tiix_post_to "All"
|
|
set tiix_post_subj ""
|
|
set tiix_post_repto ""
|
|
set tiix_filter_num 0
|
|
set tiix_filter_regex ""
|
|
set tiix_filter_rev 0
|
|
set tiix_order_byid 0
|
|
set tiix_status Ready
|
|
set tiix_entry 0
|
|
|
|
# viewer logic
|
|
set linklist ""
|
|
set linkcount 0
|
|
|
|
proc clicklink {textw msgid} {
|
|
set ci [lindex [$textw tag ranges "orig_tiixlink_$msgid"] 0]
|
|
if {$ci ne ""} {$textw see $ci}
|
|
}
|
|
|
|
proc linkinsert {textw uri is_orig} {
|
|
global linkcount linklist tiix_bgcolor tiix_linkcolor tiix_post_repto
|
|
if {$is_orig eq 1} {
|
|
set tagname "orig_tiixlink_$uri"
|
|
} else {
|
|
set tagname "tiixlink_$uri"
|
|
}
|
|
$textw insert end $uri $tagname
|
|
$textw tag configure $tagname -underline on -foreground $tiix_linkcolor -background $tiix_bgcolor
|
|
$textw tag bind $tagname <Enter> {%W configure -cursor hand2}
|
|
$textw tag bind $tagname <Leave> {%W configure -cursor $contentcursor}
|
|
if {$is_orig eq 0} { # scroll on click
|
|
$textw tag bind $tagname <Button-1> "clicklink $textw $uri"
|
|
} else { # insert to repto field on click
|
|
$textw tag bind $tagname <Button-1> "set tiix_post_repto $uri; updatefromreps; .tabbar select .tabbar.p"
|
|
}
|
|
incr linkcount
|
|
lappend linklist $uri
|
|
}
|
|
|
|
proc tiix_viewecho {} {
|
|
global localdb linkcount tiix_echoname
|
|
global tiix_filter_num tiix_filter_regex tiix_filter_rev tiix_order_byid
|
|
if {$tiix_echoname eq ""} {
|
|
errmsg "Please select an echo conference to read!"
|
|
return
|
|
}
|
|
# open the message db
|
|
sqlite3 msgdb $localdb -readonly true
|
|
set query {SELECT * FROM `msg` WHERE `echoname` = $tiix_echoname}
|
|
if {$tiix_filter_regex ne {}} {
|
|
append query { AND (`body` LIKE $tiix_filter_regex OR `subj` LIKE $tiix_filter_regex) }
|
|
}
|
|
if {$tiix_order_byid eq 1} {
|
|
append query { ORDER BY `id` }
|
|
} else {
|
|
append query { ORDER BY `timestamp` }
|
|
}
|
|
if {$tiix_filter_rev eq 1} {append query DESC} else {append query ASC}
|
|
if {$tiix_filter_num > 0} {append query { LIMIT $tiix_filter_num}}
|
|
append query ";"
|
|
set textw .tabbar.r.content.text
|
|
$textw configure -state normal
|
|
$textw delete 1.0 end
|
|
set linkcount 0
|
|
set linklist ""
|
|
msgdb eval $query msg { # iterate over the list after filtering
|
|
set globalline [string repeat = 80]
|
|
set hdrline [string repeat - 80]
|
|
set tz ""
|
|
set renderedts ""
|
|
catch { # because some servers don't provide timestamps
|
|
set renderedts [clock format [string trim $msg(timestamp)] -format {%Y-%m-%d %H:%M:%S} -timezone $tz]
|
|
}
|
|
set textw .tabbar.r.content.text
|
|
$textw insert end "\[$renderedts\] "
|
|
linkinsert $textw $msg(msgid) 1
|
|
set msg(echoname) [string trim $msg(echoname)]
|
|
set msg(msgfrom) [string trim $msg(msgfrom)]
|
|
set msg(msgfromaddr) [string trim $msg(msgfromaddr)]
|
|
set msg(msgto) [string trim $msg(msgto)]
|
|
set msg(repto) [string trim $msg(repto)]
|
|
set msg(subj) [string trim $msg(subj)]
|
|
$textw insert end "\n$msg(echoname) - $msg(msgfrom) ($msg(msgfromaddr)) to $msg(msgto)\n"
|
|
if {$msg(repto) ne ""} {
|
|
$textw insert end "Replied to: "
|
|
linkinsert $textw $msg(repto) 0
|
|
$textw insert end "\n"
|
|
}
|
|
set msg(body) [lmap s $msg(body) {string trimright $s}]
|
|
$textw insert end "Subj: $msg(subj)\n$hdrline\n[join $msg(body) \n]\n\n$globalline\n\n"
|
|
}
|
|
$textw configure -state disabled
|
|
# close the message db
|
|
msgdb close
|
|
}
|
|
|
|
# fetcher frontend
|
|
proc tiix_fetchecho {echoname} {
|
|
if {$echoname eq ""} {
|
|
set answer [tk_messageBox -title "tiix fetch" -message "Fetch all echos from all registered stations?" \
|
|
-icon question -type yesno -detail "This can take some time."]
|
|
switch -- $answer {
|
|
yes {}
|
|
no {return}
|
|
}
|
|
}
|
|
global tiix_status localdb
|
|
set tiix_status "Fetching echo contents..."
|
|
massfetch $echoname $localdb 0
|
|
set tiix_status Ready
|
|
}
|
|
|
|
proc errmsg {msg} {
|
|
tk_messageBox -type ok -title "tiix error" -icon error -message $msg
|
|
}
|
|
|
|
# GUI part
|
|
set contentcursor "left_ptr"
|
|
|
|
wm title . "tiix"
|
|
wm minsize . 800 600
|
|
ttk::notebook .tabbar
|
|
ttk::notebook::enableTraversal .tabbar
|
|
grid .tabbar -row 0 -column 0 -sticky nswe
|
|
grid columnconfigure . 0 -weight 1
|
|
grid rowconfigure . 0 -weight 1
|
|
.tabbar add [ttk::frame .tabbar.r] -text "Fetch & Read"
|
|
.tabbar add [ttk::frame .tabbar.p] -text "Post"
|
|
.tabbar add [ttk::frame .tabbar.c] -text "Configuration"
|
|
ttk::frame .infoframe
|
|
ttk::label .infoframe.author -text "tiix by Luxferre, 2024"
|
|
ttk::label .infoframe.status -textvariable tiix_status
|
|
pack .infoframe.status -side left
|
|
pack .infoframe.author -side right
|
|
grid .infoframe -row 1 -column 0 -sticky we
|
|
|
|
# Viewer widgets
|
|
|
|
ttk::frame .tabbar.r.addrframe
|
|
ttk::frame .tabbar.r.addrframe.f
|
|
ttk::frame .tabbar.r.addrframe.c
|
|
ttk::label .tabbar.r.addrframe.f.el -text "Echo name"
|
|
ttk::combobox .tabbar.r.addrframe.f.echo -width 25 -textvariable tiix_echoname -postcommand {
|
|
sqlite3 msgdb $localdb -readonly true
|
|
set echonames [msgdb eval {SELECT DISTINCT `echoname` FROM `msg` ORDER BY `echoname`;}]
|
|
msgdb close
|
|
.tabbar.r.addrframe.f.echo config -values $echonames
|
|
}
|
|
ttk::label .tabbar.r.addrframe.c.aml -text "# Messages:"
|
|
ttk::entry .tabbar.r.addrframe.c.amt -textvariable tiix_filter_num -width 8
|
|
ttk::checkbutton .tabbar.r.addrframe.c.rev -variable tiix_filter_rev -offvalue 0 -onvalue 1 -text "Reverse"
|
|
ttk::checkbutton .tabbar.r.addrframe.c.byid -variable tiix_order_byid -offvalue 0 -onvalue 1 -text "By ID"
|
|
grid .tabbar.r.addrframe.c.aml -row 0 -column 0 -sticky nse
|
|
grid .tabbar.r.addrframe.c.amt -row 0 -column 1 -sticky w -padx 5
|
|
grid .tabbar.r.addrframe.c.rev -row 1 -column 0 -sticky nswe
|
|
grid .tabbar.r.addrframe.c.byid -row 1 -column 1 -sticky nswe
|
|
grid rowconfigure .tabbar.r.addrframe.c 0 -weight 1
|
|
grid rowconfigure .tabbar.r.addrframe.c 1 -weight 1
|
|
ttk::label .tabbar.r.addrframe.f.rg -text "Search filter"
|
|
ttk::entry .tabbar.r.addrframe.f.rgx -textvariable tiix_filter_regex -width 25
|
|
ttk::button .tabbar.r.addrframe.go -text "Read messages" -command tiix_viewecho
|
|
ttk::button .tabbar.r.addrframe.f.fetchecho -text "Fetch this echo" -command {tiix_fetchecho $tiix_echoname}
|
|
ttk::button .tabbar.r.addrframe.f.fetchall -text "Fetch all echos " -command {tiix_fetchecho ""}
|
|
grid .tabbar.r.addrframe.f.fetchecho -row 0 -column 2 -sticky e -padx 5
|
|
grid .tabbar.r.addrframe.f.fetchall -row 1 -column 2 -sticky e -padx 5
|
|
grid .tabbar.r.addrframe.f.el -row 0 -column 0 -sticky nsw
|
|
grid .tabbar.r.addrframe.f.echo -row 0 -column 1 -sticky w
|
|
grid .tabbar.r.addrframe.f.rg -row 1 -column 0 -sticky nsw
|
|
grid .tabbar.r.addrframe.f.rgx -row 1 -column 1 -sticky w
|
|
grid .tabbar.r.addrframe.f -row 0 -column 0 -sticky nswe -pady 2
|
|
grid .tabbar.r.addrframe.c -row 0 -column 1 -sticky nswe -pady 2
|
|
grid .tabbar.r.addrframe.go -row 0 -column 2 -sticky nswe -pady 2 -padx 10
|
|
grid .tabbar.r.addrframe -column 0 -row 0 -sticky nsew
|
|
grid columnconfigure .tabbar.r.addrframe 2 -weight 1
|
|
|
|
ttk::frame .tabbar.r.content
|
|
tk::text .tabbar.r.content.text -cursor $contentcursor -yscrollcommand ".tabbar.r.content.yscroll set" -wrap word \
|
|
-font tiix_font -foreground $tiix_fgcolor -background $tiix_bgcolor -state disabled
|
|
ttk::scrollbar .tabbar.r.content.yscroll -orient vertical -command ".tabbar.r.content.text yview"
|
|
grid .tabbar.r.content -column 0 -row 1 -sticky nsew
|
|
grid .tabbar.r.content.text -column 0 -row 0 -sticky nsew
|
|
grid .tabbar.r.content.yscroll -column 1 -row 0 -sticky ns
|
|
grid columnconfigure .tabbar.r.content 0 -weight 1
|
|
grid rowconfigure .tabbar.r.content 0 -weight 1
|
|
grid columnconfigure .tabbar.r 0 -weight 1
|
|
grid rowconfigure .tabbar.r 0 -weight 0
|
|
grid rowconfigure .tabbar.r 1 -weight 1
|
|
|
|
# Poster widgets
|
|
|
|
ttk::frame .tabbar.p.addrframe
|
|
ttk::label .tabbar.p.addrframe.el -text "Echo name"
|
|
ttk::combobox .tabbar.p.addrframe.echo -width 25 -textvariable tiix_post_echoname -postcommand {
|
|
sqlite3 msgdb $localdb -readonly true
|
|
set echonames [msgdb eval {SELECT DISTINCT `echoname` FROM `msg` ORDER BY `echoname`;}]
|
|
msgdb close
|
|
.tabbar.p.addrframe.echo config -values $echonames
|
|
}
|
|
ttk::label .tabbar.p.addrframe.stlbl -text "Station "
|
|
ttk::combobox .tabbar.p.addrframe.sturl -textvariable tiix_post_sturl -width 25 -postcommand {
|
|
.tabbar.p.addrframe.sturl config -values [dict keys $authmap]
|
|
}
|
|
ttk::label .tabbar.p.addrframe.tolbl -text "To:"
|
|
ttk::entry .tabbar.p.addrframe.to -textvariable tiix_post_to -width 20
|
|
ttk::label .tabbar.p.addrframe.subjlbl -text "Subj:"
|
|
ttk::entry .tabbar.p.addrframe.subj -textvariable tiix_post_subj -width 20
|
|
ttk::label .tabbar.p.addrframe.reptolbl -text "Rep:"
|
|
ttk::entry .tabbar.p.addrframe.repto -textvariable tiix_post_repto -width 20
|
|
ttk::button .tabbar.p.addrframe.send -text "Send!" -command {
|
|
set tiix_post_sturl [string trimright [string trim $tiix_post_sturl] "/"]
|
|
set tiix_post_echoname [string trim $tiix_post_echoname]
|
|
set tiix_post_to [string trim $tiix_post_to]
|
|
set tiix_post_subj [string trim $tiix_post_subj]
|
|
set tiix_post_repto [string trim $tiix_post_repto]
|
|
set tiix_post_text [string trimright [.tabbar.p.content.text get -displaychars 1.0 end]]
|
|
if {$tiix_post_sturl eq ""} {
|
|
errmsg "Station URL is required!"
|
|
} elseif {$tiix_post_echoname eq ""} {
|
|
errmsg "Echo name is required!"
|
|
} elseif {$tiix_post_subj eq ""} {
|
|
errmsg "Subj field is required!"
|
|
} elseif {$tiix_post_text eq ""} {
|
|
errmsg "Post text cannot be empty!"
|
|
} else {
|
|
if {$tiix_post_to eq ""} {set tiix_post_to All}
|
|
# read auth string for the station
|
|
set authstr ""
|
|
if {[dict exists $authmap $tiix_post_sturl]} {
|
|
set authstr [dict get $authmap $tiix_post_sturl]
|
|
}
|
|
# call the posting function
|
|
set answer [tk_messageBox -title "tiix post" -message "Post the message?" -icon question -type yesno]
|
|
if {$answer eq "yes"} {
|
|
set prev_status $tiix_status
|
|
set tiix_status "Posting to $tiix_post_echoname at $tiix_post_sturl..."
|
|
set res [postiidata $tiix_post_sturl $authstr $tiix_post_echoname $tiix_post_to $tiix_post_subj $tiix_post_repto $tiix_post_text]
|
|
set status [dict get $res status]
|
|
set result [dict get $res result]
|
|
if {$status} {
|
|
set tiix_status "Posting success: $result"
|
|
.tabbar.p.content.text delete 1.0 end
|
|
} else {
|
|
set tiix_status "Posting error: $result"
|
|
}
|
|
after 5000 {set tiix_status $prev_status}
|
|
}
|
|
}
|
|
}
|
|
grid .tabbar.p.addrframe.el -column 0 -row 0 -sticky nsw
|
|
grid .tabbar.p.addrframe.echo -column 1 -row 0 -sticky e
|
|
grid .tabbar.p.addrframe.stlbl -column 0 -row 1 -sticky nsw
|
|
grid .tabbar.p.addrframe.sturl -column 1 -row 1 -sticky e
|
|
grid .tabbar.p.addrframe.tolbl -column 2 -row 0 -sticky nsw
|
|
grid .tabbar.p.addrframe.to -column 3 -row 0
|
|
grid .tabbar.p.addrframe.subjlbl -column 2 -row 1 -sticky nsw
|
|
grid .tabbar.p.addrframe.subj -column 3 -row 1 -columnspan 3 -sticky we
|
|
grid .tabbar.p.addrframe.reptolbl -column 4 -row 0 -sticky nsw
|
|
grid .tabbar.p.addrframe.repto -column 5 -row 0
|
|
grid .tabbar.p.addrframe.send -column 6 -rowspan 2 -row 0 -sticky nswe
|
|
grid rowconfigure .tabbar.p.addrframe 0 -pad 2
|
|
grid columnconfigure .tabbar.p.addrframe 6 -weight 1
|
|
grid .tabbar.p.addrframe -column 0 -row 0 -sticky nws -pady 2
|
|
ttk::frame .tabbar.p.content
|
|
tk::text .tabbar.p.content.text -cursor $contentcursor -yscrollcommand ".tabbar.p.content.yscroll set" -wrap word \
|
|
-font tiix_font -foreground $tiix_fgcolor -background $tiix_bgcolor -insertbackground $tiix_fgcolor -state normal
|
|
ttk::scrollbar .tabbar.p.content.yscroll -orient vertical -command ".tabbar.p.content.text yview"
|
|
grid .tabbar.p.content -column 0 -row 1 -sticky nsew
|
|
grid .tabbar.p.content.text -column 0 -row 0 -sticky nsew
|
|
grid .tabbar.p.content.yscroll -column 1 -row 0 -sticky ns
|
|
grid columnconfigure .tabbar.p.content 0 -weight 1
|
|
grid rowconfigure .tabbar.p.content 0 -weight 1
|
|
grid columnconfigure .tabbar.p 0 -weight 1
|
|
grid rowconfigure .tabbar.p 0 -weight 0
|
|
grid rowconfigure .tabbar.p 1 -weight 1
|
|
|
|
# Configuration widgets
|
|
|
|
set rownum 0
|
|
dict for {cname cval} $cfg {
|
|
ttk::label .tabbar.c.cfglbl_$cname -text $cname
|
|
if {[string match *color $cname]} {
|
|
ttk::button .tabbar.c.cfgtxt_$cname -textvariable $cname -command "set $cname \[tk_chooseColor -initialcolor $cval -title {Choose color}\]"
|
|
} else {
|
|
ttk::entry .tabbar.c.cfgtxt_$cname -textvariable $cname
|
|
}
|
|
grid .tabbar.c.cfglbl_$cname -row $rownum -column 0 -sticky nsw -padx 5 -pady 5
|
|
grid .tabbar.c.cfgtxt_$cname -row $rownum -column 1 -sticky nswe -pady 5
|
|
incr rownum
|
|
}
|
|
ttk::button .tabbar.c.cfgsave -text "Save configuration" -command {
|
|
set answer [tk_messageBox -title "tiix config" -message "Save the config file?" -icon question -type yesno]
|
|
if {$answer eq "yes"} {
|
|
set cfgtext ""
|
|
dict for {cname cval} $cfg {
|
|
append cfgtext "$cname \"[set $cname]\"\n"
|
|
}
|
|
writefileln $cfgfile [string trim $cfgtext]
|
|
tk_messageBox -title "tiix config" -type ok -icon info -message "Configuration saved!" -detail "Restart tiix to see the changes"
|
|
}
|
|
}
|
|
grid .tabbar.c.cfgsave -row $rownum -column 0 -sticky nsw -padx 5
|
|
grid columnconfigure .tabbar.c 1 -weight 1
|
|
|
|
# Custom bindings
|
|
|
|
proc updatefromreps {} {
|
|
global tiix_post_repto localdb tiix_post_to tiix_post_subj tiix_post_echoname
|
|
set tiix_post_repto [string trim $tiix_post_repto]
|
|
if {$tiix_post_repto ne ""} {
|
|
sqlite3 msgdb $localdb -readonly true
|
|
msgdb eval {SELECT * FROM `msg` WHERE `msgid`=$tiix_post_repto;} msg {
|
|
set tiix_post_to [string trim $msg(msgfrom)]
|
|
set tiix_post_subj [string trim $msg(subj)]
|
|
set tiix_post_echoname [string trim $msg(echoname)]
|
|
if {![string match "Re: *" $tiix_post_subj]} {
|
|
set tiix_post_subj "Re: $tiix_post_subj"
|
|
}
|
|
set textw .tabbar.p.content.text
|
|
# some nickname shortening heuristics
|
|
set shortnick $tiix_post_to
|
|
set parts [split $shortnick " "]
|
|
if {[llength $parts] > 1} {
|
|
set shortnick ""
|
|
foreach p $parts {
|
|
append shortnick [string index $p 0]
|
|
}
|
|
}
|
|
if {![string match "$shortnick>*" [$textw get 1.0 1.end]]} {
|
|
$textw insert 1.0 "[string trimright [join [lmap s $msg(body) {string cat $shortnick {> } $s}] \n]]\n"
|
|
}
|
|
}
|
|
msgdb close
|
|
|
|
}
|
|
}
|
|
|
|
bind .tabbar.p.addrframe.repto <Return> updatefromreps
|
|
bind .tabbar.p.addrframe.repto <Leave> updatefromreps
|
|
|
|
# general keybinding switch
|
|
|
|
bind .tabbar.r.content.text <Key> {
|
|
if {$tiix_entry eq 0} {
|
|
switch "%K" {
|
|
Prior -
|
|
h {.tabbar.r.content.text yview scroll -1 pages}
|
|
Next -
|
|
l {.tabbar.r.content.text yview scroll 1 pages}
|
|
Down -
|
|
j {.tabbar.r.content.text yview scroll 1 units}
|
|
Up -
|
|
k {.tabbar.r.content.text yview scroll -1 units}
|
|
default {}
|
|
}
|
|
}
|
|
}
|
|
|
|
# exit
|
|
bind . <Control-q> {exit 0}
|