tiix.tcl (17583B)
1 #!/usr/bin/env tclsh 2 # tiix: GUI client for ii/idec networks that leverages capabilities 3 # of tiifetch and tiipost and repimplements the tiiview functionality 4 # Depends on tiifetch, tiipost, Tcllib, SQLite3 and Tk 5 # Created by Luxferre in 2024, released into public domain 6 7 package require Tk 8 package require sqlite3 9 10 set scriptpath [file normalize [info script]] 11 set appdir [file dirname $scriptpath] 12 # check if we're running from a starpack 13 if [string match *app-tiix $appdir] { 14 set appdir [file normalize [file join $appdir ".." ".." ".." ]] 15 } 16 17 # include tiifetch and tiipost 18 19 source [file join $appdir "tiifetch.tcl"] 20 source [file join $appdir "tiipost.tcl"] 21 22 # populate general configuration 23 set cfg {} 24 set tiix_font TkFixedFont 25 set tiix_fontsize 10 26 set tiix_fgcolor black 27 set tiix_bgcolor white 28 set tiix_linkcolor blue 29 set useragent "" 30 set proxyhost "" 31 set proxyport 0 32 set net_timeout 5000 33 set cfgfile [file join $appdir "config.txt"] 34 if {[file exists $cfgfile]} { 35 set cfg [readfile $cfgfile] 36 if {[dict exists $cfg useragent]} { 37 set useragent [dict get $cfg useragent] 38 ::http::config -useragent $useragent 39 } 40 if {[dict exists $cfg proxyhost]} { 41 set proxyhost [dict get $cfg proxyhost] 42 ::http::config -proxyhost $proxyhost 43 } 44 if {[dict exists $cfg proxyport]} { 45 set proxyport [dict get $cfg proxyport] 46 ::http::config -proxyport $proxyport 47 } 48 if {[dict exists $cfg net_timeout]} { 49 set net_timeout [dict get $cfg net_timeout] 50 } 51 if {[dict exists $cfg tiix_font]} { 52 set tiix_font [dict get $cfg tiix_font] 53 } 54 if {[dict exists $cfg tiix_fontsize]} { 55 set tiix_fontsize [dict get $cfg tiix_fontsize] 56 } 57 if {[dict exists $cfg tiix_fgcolor]} { 58 set tiix_fgcolor [dict get $cfg tiix_fgcolor] 59 } 60 if {[dict exists $cfg tiix_bgcolor]} { 61 set tiix_bgcolor [dict get $cfg tiix_bgcolor] 62 } 63 if {[dict exists $cfg tiix_linkcolor]} { 64 set tiix_linkcolor [dict get $cfg tiix_linkcolor] 65 } 66 } 67 68 # create the font 69 font create tiix_font -family "$tiix_font" -size $tiix_fontsize -weight normal 70 71 # create the widget font 72 font create tiix_widget_font -family "sans-serif" -size 11 73 option add *font tiix_widget_font 74 ttk::style configure TButton -font tiix_widget_font 75 ttk::style configure TCheckbutton -font tiix_widget_font 76 ttk::style configure TNotebook.Tab -font tiix_widget_font 77 ttk::style configure TEntry -insertcolor $tiix_fgcolor 78 ttk::style configure TCombobox -insertcolor $tiix_fgcolor 79 80 # get auth string mapping 81 set authmap "" 82 set authfile [file join $appdir "auth.txt"] 83 if {[file exists $authfile]} { 84 set authmap [readfile $authfile] 85 } 86 87 # get the local DB file path 88 set localdb [file join $appdir "tii.db"] 89 90 # set default GUI parameters 91 92 set tiix_echoname "" 93 set tiix_post_echoname "" 94 set tiix_post_sturl "" 95 set tiix_post_to "All" 96 set tiix_post_subj "" 97 set tiix_post_repto "" 98 set tiix_filter_num 0 99 set tiix_filter_regex "" 100 set tiix_filter_rev 0 101 set tiix_order_byid 0 102 set tiix_status Ready 103 set tiix_entry 0 104 105 # viewer logic 106 set linklist "" 107 set linkcount 0 108 109 proc clicklink {textw msgid} { 110 set ci [lindex [$textw tag ranges "orig_tiixlink_$msgid"] 0] 111 if {$ci ne ""} {$textw see $ci} 112 } 113 114 proc linkinsert {textw uri is_orig} { 115 global linkcount linklist tiix_bgcolor tiix_linkcolor tiix_post_repto 116 if {$is_orig eq 1} { 117 set tagname "orig_tiixlink_$uri" 118 } else { 119 set tagname "tiixlink_$uri" 120 } 121 $textw insert end $uri $tagname 122 $textw tag configure $tagname -underline on -foreground $tiix_linkcolor -background $tiix_bgcolor 123 $textw tag bind $tagname <Enter> {%W configure -cursor hand2} 124 $textw tag bind $tagname <Leave> {%W configure -cursor $contentcursor} 125 if {$is_orig eq 0} { # scroll on click 126 $textw tag bind $tagname <Button-1> "clicklink $textw $uri" 127 } else { # insert to repto field on click 128 $textw tag bind $tagname <Button-1> "set tiix_post_repto $uri; updatefromreps; .tabbar select .tabbar.p" 129 } 130 incr linkcount 131 lappend linklist $uri 132 } 133 134 proc tiix_viewecho {} { 135 global localdb linkcount tiix_echoname 136 global tiix_filter_num tiix_filter_regex tiix_filter_rev tiix_order_byid 137 if {$tiix_echoname eq ""} { 138 errmsg "Please select an echo conference to read!" 139 return 140 } 141 # open the message db 142 sqlite3 msgdb $localdb -readonly true 143 set query {SELECT * FROM `msg` WHERE `echoname` = $tiix_echoname} 144 if {$tiix_filter_regex ne {}} { 145 set flt "%$tiix_filter_regex%" 146 append query { AND (`body` LIKE $flt OR `subj` LIKE $flt) } 147 } 148 if {$tiix_order_byid eq 1} { 149 append query { ORDER BY `id` } 150 } else { 151 append query { ORDER BY `timestamp` } 152 } 153 if {$tiix_filter_rev eq 1} {append query DESC} else {append query ASC} 154 if {$tiix_filter_num > 0} {append query { LIMIT $tiix_filter_num}} 155 append query ";" 156 set textw .tabbar.r.content.text 157 $textw configure -state normal 158 $textw delete 1.0 end 159 set linkcount 0 160 set linklist "" 161 msgdb eval $query msg { # iterate over the list after filtering 162 set globalline [string repeat = 80] 163 set hdrline [string repeat - 80] 164 set tz "" 165 set renderedts "" 166 catch { # because some servers don't provide timestamps 167 set renderedts [clock format [string trim $msg(timestamp)] -format {%Y-%m-%d %H:%M:%S} -timezone $tz] 168 } 169 set textw .tabbar.r.content.text 170 $textw insert end "\[$renderedts\] " 171 linkinsert $textw $msg(msgid) 1 172 set msg(content_id) [string trim $msg(content_id)] 173 if {$msg(msgid) ne $msg(content_id)} { 174 $textw insert end " (ID hash mismatch!)" 175 } 176 set msg(echoname) [string trim $msg(echoname)] 177 set msg(msgfrom) [string trim $msg(msgfrom)] 178 set msg(msgfromaddr) [string trim $msg(msgfromaddr)] 179 set msg(msgto) [string trim $msg(msgto)] 180 set msg(repto) [string trim $msg(repto)] 181 set msg(subj) [string trim $msg(subj)] 182 $textw insert end "\n$msg(echoname) - $msg(msgfrom) ($msg(msgfromaddr)) to $msg(msgto)\n" 183 if {$msg(repto) ne ""} { 184 $textw insert end "Replied to: " 185 linkinsert $textw $msg(repto) 0 186 $textw insert end "\n" 187 } 188 set msg(body) [lmap s $msg(body) {string trimright $s}] 189 $textw insert end "Subj: $msg(subj)\n$hdrline\n[join $msg(body) \n]\n\n$globalline\n\n" 190 } 191 $textw configure -state disabled 192 # close the message db 193 msgdb close 194 } 195 196 # fetcher frontend 197 proc tiix_fetchecho {echoname} { 198 if {$echoname eq ""} { 199 set answer [tk_messageBox -title "tiix fetch" -message "Fetch all echos from all registered stations?" \ 200 -icon question -type yesno -detail "This can take some time."] 201 switch -- $answer { 202 yes {} 203 no {return} 204 } 205 } 206 global tiix_status localdb 207 set tiix_status "Fetching echo contents..." 208 massfetch $echoname $localdb 0 209 set tiix_status Ready 210 } 211 212 proc errmsg {msg} { 213 tk_messageBox -type ok -title "tiix error" -icon error -message $msg 214 } 215 216 # GUI part 217 set contentcursor "left_ptr" 218 219 wm title . "tiix" 220 wm minsize . 800 600 221 ttk::notebook .tabbar 222 ttk::notebook::enableTraversal .tabbar 223 grid .tabbar -row 0 -column 0 -sticky nswe 224 grid columnconfigure . 0 -weight 1 225 grid rowconfigure . 0 -weight 1 226 .tabbar add [ttk::frame .tabbar.r] -text "Fetch & Read" 227 .tabbar add [ttk::frame .tabbar.p] -text "Post" 228 .tabbar add [ttk::frame .tabbar.c] -text "Configuration" 229 ttk::frame .infoframe 230 ttk::label .infoframe.author -text "tiix by Luxferre, 2024" 231 ttk::label .infoframe.status -textvariable tiix_status 232 pack .infoframe.status -side left 233 pack .infoframe.author -side right 234 grid .infoframe -row 1 -column 0 -sticky we 235 236 # Viewer widgets 237 238 ttk::frame .tabbar.r.addrframe 239 ttk::frame .tabbar.r.addrframe.f 240 ttk::frame .tabbar.r.addrframe.c 241 ttk::label .tabbar.r.addrframe.f.el -text "Echo name" 242 ttk::combobox .tabbar.r.addrframe.f.echo -width 25 -textvariable tiix_echoname -postcommand { 243 sqlite3 msgdb $localdb -readonly true 244 set echonames [msgdb eval {SELECT DISTINCT `echoname` FROM `msg` ORDER BY `echoname`;}] 245 msgdb close 246 .tabbar.r.addrframe.f.echo config -values $echonames 247 } 248 ttk::label .tabbar.r.addrframe.c.aml -text "# Messages:" 249 ttk::entry .tabbar.r.addrframe.c.amt -textvariable tiix_filter_num -width 8 250 ttk::checkbutton .tabbar.r.addrframe.c.rev -variable tiix_filter_rev -offvalue 0 -onvalue 1 -text "Reverse" 251 ttk::checkbutton .tabbar.r.addrframe.c.byid -variable tiix_order_byid -offvalue 0 -onvalue 1 -text "By ID" 252 grid .tabbar.r.addrframe.c.aml -row 0 -column 0 -sticky nse 253 grid .tabbar.r.addrframe.c.amt -row 0 -column 1 -sticky w -padx 5 254 grid .tabbar.r.addrframe.c.rev -row 1 -column 0 -sticky nswe 255 grid .tabbar.r.addrframe.c.byid -row 1 -column 1 -sticky nswe 256 grid rowconfigure .tabbar.r.addrframe.c 0 -weight 1 257 grid rowconfigure .tabbar.r.addrframe.c 1 -weight 1 258 ttk::label .tabbar.r.addrframe.f.rg -text "Search filter" 259 ttk::entry .tabbar.r.addrframe.f.rgx -textvariable tiix_filter_regex -width 25 260 ttk::button .tabbar.r.addrframe.go -text "Read messages" -command tiix_viewecho 261 ttk::button .tabbar.r.addrframe.f.fetchecho -text "Fetch this echo" -command {tiix_fetchecho $tiix_echoname} 262 ttk::button .tabbar.r.addrframe.f.fetchall -text "Fetch all echos " -command {tiix_fetchecho ""} 263 grid .tabbar.r.addrframe.f.fetchecho -row 0 -column 2 -sticky e -padx 5 264 grid .tabbar.r.addrframe.f.fetchall -row 1 -column 2 -sticky e -padx 5 265 grid .tabbar.r.addrframe.f.el -row 0 -column 0 -sticky nsw 266 grid .tabbar.r.addrframe.f.echo -row 0 -column 1 -sticky w 267 grid .tabbar.r.addrframe.f.rg -row 1 -column 0 -sticky nsw 268 grid .tabbar.r.addrframe.f.rgx -row 1 -column 1 -sticky w 269 grid .tabbar.r.addrframe.f -row 0 -column 0 -sticky nswe -pady 2 270 grid .tabbar.r.addrframe.c -row 0 -column 1 -sticky nswe -pady 2 271 grid .tabbar.r.addrframe.go -row 0 -column 2 -sticky nswe -pady 2 -padx 10 272 grid .tabbar.r.addrframe -column 0 -row 0 -sticky nsew 273 grid columnconfigure .tabbar.r.addrframe 2 -weight 1 274 275 ttk::frame .tabbar.r.content 276 tk::text .tabbar.r.content.text -cursor $contentcursor -yscrollcommand ".tabbar.r.content.yscroll set" -wrap word \ 277 -font tiix_font -foreground $tiix_fgcolor -background $tiix_bgcolor -state disabled 278 ttk::scrollbar .tabbar.r.content.yscroll -orient vertical -command ".tabbar.r.content.text yview" 279 grid .tabbar.r.content -column 0 -row 1 -sticky nsew 280 grid .tabbar.r.content.text -column 0 -row 0 -sticky nsew 281 grid .tabbar.r.content.yscroll -column 1 -row 0 -sticky ns 282 grid columnconfigure .tabbar.r.content 0 -weight 1 283 grid rowconfigure .tabbar.r.content 0 -weight 1 284 grid columnconfigure .tabbar.r 0 -weight 1 285 grid rowconfigure .tabbar.r 0 -weight 0 286 grid rowconfigure .tabbar.r 1 -weight 1 287 288 # Poster widgets 289 290 ttk::frame .tabbar.p.addrframe 291 ttk::label .tabbar.p.addrframe.el -text "Echo name" 292 ttk::combobox .tabbar.p.addrframe.echo -width 25 -textvariable tiix_post_echoname -postcommand { 293 sqlite3 msgdb $localdb -readonly true 294 set echonames [msgdb eval {SELECT DISTINCT `echoname` FROM `msg` ORDER BY `echoname`;}] 295 msgdb close 296 .tabbar.p.addrframe.echo config -values $echonames 297 } 298 ttk::label .tabbar.p.addrframe.stlbl -text "Station " 299 ttk::combobox .tabbar.p.addrframe.sturl -textvariable tiix_post_sturl -width 25 -postcommand { 300 .tabbar.p.addrframe.sturl config -values [dict keys $authmap] 301 } 302 ttk::label .tabbar.p.addrframe.tolbl -text "To:" 303 ttk::entry .tabbar.p.addrframe.to -textvariable tiix_post_to -width 20 304 ttk::label .tabbar.p.addrframe.subjlbl -text "Subj:" 305 ttk::entry .tabbar.p.addrframe.subj -textvariable tiix_post_subj -width 20 306 ttk::label .tabbar.p.addrframe.reptolbl -text "Rep:" 307 ttk::entry .tabbar.p.addrframe.repto -textvariable tiix_post_repto -width 20 308 ttk::button .tabbar.p.addrframe.send -text "Send!" -command { 309 set tiix_post_sturl [string trimright [string trim $tiix_post_sturl] "/"] 310 set tiix_post_echoname [string trim $tiix_post_echoname] 311 set tiix_post_to [string trim $tiix_post_to] 312 set tiix_post_subj [string trim $tiix_post_subj] 313 set tiix_post_repto [string trim $tiix_post_repto] 314 set tiix_post_text [string trimright [.tabbar.p.content.text get -displaychars 1.0 end]] 315 if {$tiix_post_sturl eq ""} { 316 errmsg "Station URL is required!" 317 } elseif {$tiix_post_echoname eq ""} { 318 errmsg "Echo name is required!" 319 } elseif {$tiix_post_subj eq ""} { 320 errmsg "Subj field is required!" 321 } elseif {$tiix_post_text eq ""} { 322 errmsg "Post text cannot be empty!" 323 } else { 324 if {$tiix_post_to eq ""} {set tiix_post_to All} 325 # read auth string for the station 326 set authstr "" 327 if {[dict exists $authmap $tiix_post_sturl]} { 328 set authstr [dict get $authmap $tiix_post_sturl] 329 } 330 # call the posting function 331 set answer [tk_messageBox -title "tiix post" -message "Post the message?" -icon question -type yesno] 332 if {$answer eq "yes"} { 333 set prev_status $tiix_status 334 set tiix_status "Posting to $tiix_post_echoname at $tiix_post_sturl..." 335 set res [postiidata $tiix_post_sturl $authstr $tiix_post_echoname $tiix_post_to $tiix_post_subj $tiix_post_repto $tiix_post_text] 336 set status [dict get $res status] 337 set result [dict get $res result] 338 if {$status} { 339 set tiix_status "Posting success: $result" 340 .tabbar.p.content.text delete 1.0 end 341 } else { 342 set tiix_status "Posting error: $result" 343 } 344 after 5000 {set tiix_status $prev_status} 345 } 346 } 347 } 348 grid .tabbar.p.addrframe.el -column 0 -row 0 -sticky nsw 349 grid .tabbar.p.addrframe.echo -column 1 -row 0 -sticky e 350 grid .tabbar.p.addrframe.stlbl -column 0 -row 1 -sticky nsw 351 grid .tabbar.p.addrframe.sturl -column 1 -row 1 -sticky e 352 grid .tabbar.p.addrframe.tolbl -column 2 -row 0 -sticky nsw 353 grid .tabbar.p.addrframe.to -column 3 -row 0 354 grid .tabbar.p.addrframe.subjlbl -column 2 -row 1 -sticky nsw 355 grid .tabbar.p.addrframe.subj -column 3 -row 1 -columnspan 3 -sticky we 356 grid .tabbar.p.addrframe.reptolbl -column 4 -row 0 -sticky nsw 357 grid .tabbar.p.addrframe.repto -column 5 -row 0 358 grid .tabbar.p.addrframe.send -column 6 -rowspan 2 -row 0 -sticky nswe 359 grid rowconfigure .tabbar.p.addrframe 0 -pad 2 360 grid columnconfigure .tabbar.p.addrframe 6 -weight 1 361 grid .tabbar.p.addrframe -column 0 -row 0 -sticky nws -pady 2 362 ttk::frame .tabbar.p.content 363 tk::text .tabbar.p.content.text -cursor $contentcursor -yscrollcommand ".tabbar.p.content.yscroll set" -wrap word \ 364 -font tiix_font -foreground $tiix_fgcolor -background $tiix_bgcolor -insertbackground $tiix_fgcolor -state normal 365 ttk::scrollbar .tabbar.p.content.yscroll -orient vertical -command ".tabbar.p.content.text yview" 366 grid .tabbar.p.content -column 0 -row 1 -sticky nsew 367 grid .tabbar.p.content.text -column 0 -row 0 -sticky nsew 368 grid .tabbar.p.content.yscroll -column 1 -row 0 -sticky ns 369 grid columnconfigure .tabbar.p.content 0 -weight 1 370 grid rowconfigure .tabbar.p.content 0 -weight 1 371 grid columnconfigure .tabbar.p 0 -weight 1 372 grid rowconfigure .tabbar.p 0 -weight 0 373 grid rowconfigure .tabbar.p 1 -weight 1 374 375 # Configuration widgets 376 377 set rownum 0 378 dict for {cname cval} $cfg { 379 ttk::label .tabbar.c.cfglbl_$cname -text $cname 380 if {[string match *color $cname]} { 381 ttk::button .tabbar.c.cfgtxt_$cname -textvariable $cname -command "set $cname \[tk_chooseColor -initialcolor $cval -title {Choose color}\]" 382 } else { 383 ttk::entry .tabbar.c.cfgtxt_$cname -textvariable $cname 384 } 385 grid .tabbar.c.cfglbl_$cname -row $rownum -column 0 -sticky nsw -padx 5 -pady 5 386 grid .tabbar.c.cfgtxt_$cname -row $rownum -column 1 -sticky nswe -pady 5 387 incr rownum 388 } 389 ttk::button .tabbar.c.cfgsave -text "Save configuration" -command { 390 set answer [tk_messageBox -title "tiix config" -message "Save the config file?" -icon question -type yesno] 391 if {$answer eq "yes"} { 392 set cfgtext "" 393 dict for {cname cval} $cfg { 394 append cfgtext "$cname \"[set $cname]\"\n" 395 } 396 writefileln $cfgfile [string trim $cfgtext] 397 tk_messageBox -title "tiix config" -type ok -icon info -message "Configuration saved!" -detail "Restart tiix to see the changes" 398 } 399 } 400 grid .tabbar.c.cfgsave -row $rownum -column 0 -sticky nsw -padx 5 401 grid columnconfigure .tabbar.c 1 -weight 1 402 403 # Custom bindings 404 405 proc updatefromreps {} { 406 global tiix_post_repto localdb tiix_post_to tiix_post_subj tiix_post_echoname 407 set tiix_post_repto [string trim $tiix_post_repto] 408 if {$tiix_post_repto ne ""} { 409 sqlite3 msgdb $localdb -readonly true 410 msgdb eval {SELECT * FROM `msg` WHERE `msgid`=$tiix_post_repto;} msg { 411 set tiix_post_to [string trim $msg(msgfrom)] 412 set tiix_post_subj [string trim $msg(subj)] 413 set tiix_post_echoname [string trim $msg(echoname)] 414 if {![string match "Re: *" $tiix_post_subj]} { 415 set tiix_post_subj "Re: $tiix_post_subj" 416 } 417 set textw .tabbar.p.content.text 418 # some nickname shortening heuristics 419 set shortnick $tiix_post_to 420 set parts [split $shortnick " "] 421 if {[llength $parts] > 1} { 422 set shortnick "" 423 foreach p $parts { 424 append shortnick [string index $p 0] 425 } 426 } 427 if {![string match "$shortnick>*" [$textw get 1.0 1.end]]} { 428 $textw insert 1.0 "[string trimright [join [lmap s $msg(body) {string cat $shortnick {> } [string trimright $s]}] \n]]\n" 429 } 430 } 431 msgdb close 432 433 } 434 } 435 436 bind .tabbar.p.addrframe.repto <Return> updatefromreps 437 bind .tabbar.p.addrframe.repto <Leave> updatefromreps 438 439 # general keybinding switch 440 441 bind .tabbar.r.content.text <Key> { 442 if {$tiix_entry eq 0} { 443 switch "%K" { 444 Prior - 445 h {.tabbar.r.content.text yview scroll -1 pages} 446 Next - 447 l {.tabbar.r.content.text yview scroll 1 pages} 448 Down - 449 j {.tabbar.r.content.text yview scroll 1 units} 450 Up - 451 k {.tabbar.r.content.text yview scroll -1 units} 452 default {} 453 } 454 } 455 } 456 457 # exit 458 bind . <Control-q> {exit 0}