tiix.tcl (17532B)
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 msg(msgid) [string trim $msg(msgid)] 163 set globalline [string repeat = 80] 164 set hdrline [string repeat - 80] 165 set tz "" 166 set renderedts "" 167 catch { # because some servers don't provide timestamps 168 set renderedts [clock format [string trim $msg(timestamp)] -format {%Y-%m-%d %H:%M:%S} -timezone $tz] 169 } 170 set textw .tabbar.r.content.text 171 $textw insert end "\[$renderedts\] " 172 linkinsert $textw $msg(msgid) 1 173 set msg(content_id) [string trim $msg(content_id)] 174 set msg(echoname) [string trim $msg(echoname)] 175 set msg(msgfrom) [string trim $msg(msgfrom)] 176 set msg(msgfromaddr) [string trim $msg(msgfromaddr)] 177 set msg(msgto) [string trim $msg(msgto)] 178 set msg(repto) [string trim $msg(repto)] 179 set msg(subj) [string trim $msg(subj)] 180 $textw insert end "\n$msg(echoname) - $msg(msgfrom) ($msg(msgfromaddr)) to $msg(msgto)\n" 181 if {$msg(repto) ne ""} { 182 $textw insert end "Replied to: " 183 linkinsert $textw $msg(repto) 0 184 $textw insert end "\n" 185 } 186 set msg(body) [lmap s $msg(body) {string trimright $s}] 187 $textw insert end "Subj: $msg(subj)\n$hdrline\n[join $msg(body) \n]\n\n$globalline\n\n" 188 } 189 $textw configure -state disabled 190 # close the message db 191 msgdb close 192 } 193 194 # fetcher frontend 195 proc tiix_fetchecho {echoname} { 196 if {$echoname eq ""} { 197 set answer [tk_messageBox -title "tiix fetch" -message "Fetch all echos from all registered stations?" \ 198 -icon question -type yesno -detail "This can take some time."] 199 switch -- $answer { 200 yes {} 201 no {return} 202 } 203 } 204 global tiix_status localdb 205 set tiix_status "Fetching echo contents..." 206 massfetch $echoname $localdb 0 207 set tiix_status Ready 208 } 209 210 proc errmsg {msg} { 211 tk_messageBox -type ok -title "tiix error" -icon error -message $msg 212 } 213 214 # GUI part 215 set contentcursor "left_ptr" 216 217 wm title . "tiix" 218 wm minsize . 800 600 219 ttk::notebook .tabbar 220 ttk::notebook::enableTraversal .tabbar 221 grid .tabbar -row 0 -column 0 -sticky nswe 222 grid columnconfigure . 0 -weight 1 223 grid rowconfigure . 0 -weight 1 224 .tabbar add [ttk::frame .tabbar.r] -text "Fetch & Read" 225 .tabbar add [ttk::frame .tabbar.p] -text "Post" 226 .tabbar add [ttk::frame .tabbar.c] -text "Configuration" 227 ttk::frame .infoframe 228 ttk::label .infoframe.author -text "tiix by Luxferre, 2024" 229 ttk::label .infoframe.status -textvariable tiix_status 230 pack .infoframe.status -side left 231 pack .infoframe.author -side right 232 grid .infoframe -row 1 -column 0 -sticky we 233 234 # Viewer widgets 235 236 ttk::frame .tabbar.r.addrframe 237 ttk::frame .tabbar.r.addrframe.f 238 ttk::frame .tabbar.r.addrframe.c 239 ttk::label .tabbar.r.addrframe.f.el -text "Echo name" 240 ttk::combobox .tabbar.r.addrframe.f.echo -width 25 -textvariable tiix_echoname -postcommand { 241 sqlite3 msgdb $localdb -readonly true 242 set echonames [msgdb eval {SELECT DISTINCT `echoname` FROM `msg` ORDER BY `echoname`;}] 243 msgdb close 244 .tabbar.r.addrframe.f.echo config -values $echonames 245 } 246 ttk::label .tabbar.r.addrframe.c.aml -text "# Messages:" 247 ttk::entry .tabbar.r.addrframe.c.amt -textvariable tiix_filter_num -width 8 248 ttk::checkbutton .tabbar.r.addrframe.c.rev -variable tiix_filter_rev -offvalue 0 -onvalue 1 -text "Reverse" 249 ttk::checkbutton .tabbar.r.addrframe.c.byid -variable tiix_order_byid -offvalue 0 -onvalue 1 -text "By ID" 250 grid .tabbar.r.addrframe.c.aml -row 0 -column 0 -sticky nse 251 grid .tabbar.r.addrframe.c.amt -row 0 -column 1 -sticky w -padx 5 252 grid .tabbar.r.addrframe.c.rev -row 1 -column 0 -sticky nswe 253 grid .tabbar.r.addrframe.c.byid -row 1 -column 1 -sticky nswe 254 grid rowconfigure .tabbar.r.addrframe.c 0 -weight 1 255 grid rowconfigure .tabbar.r.addrframe.c 1 -weight 1 256 ttk::label .tabbar.r.addrframe.f.rg -text "Search filter" 257 ttk::entry .tabbar.r.addrframe.f.rgx -textvariable tiix_filter_regex -width 25 258 ttk::button .tabbar.r.addrframe.go -text "Read messages" -command tiix_viewecho 259 ttk::button .tabbar.r.addrframe.f.fetchecho -text "Fetch this echo" -command {tiix_fetchecho $tiix_echoname} 260 ttk::button .tabbar.r.addrframe.f.fetchall -text "Fetch all echos " -command {tiix_fetchecho ""} 261 grid .tabbar.r.addrframe.f.fetchecho -row 0 -column 2 -sticky e -padx 5 262 grid .tabbar.r.addrframe.f.fetchall -row 1 -column 2 -sticky e -padx 5 263 grid .tabbar.r.addrframe.f.el -row 0 -column 0 -sticky nsw 264 grid .tabbar.r.addrframe.f.echo -row 0 -column 1 -sticky w 265 grid .tabbar.r.addrframe.f.rg -row 1 -column 0 -sticky nsw 266 grid .tabbar.r.addrframe.f.rgx -row 1 -column 1 -sticky w 267 grid .tabbar.r.addrframe.f -row 0 -column 0 -sticky nswe -pady 2 268 grid .tabbar.r.addrframe.c -row 0 -column 1 -sticky nswe -pady 2 269 grid .tabbar.r.addrframe.go -row 0 -column 2 -sticky nswe -pady 2 -padx 10 270 grid .tabbar.r.addrframe -column 0 -row 0 -sticky nsew 271 grid columnconfigure .tabbar.r.addrframe 2 -weight 1 272 273 ttk::frame .tabbar.r.content 274 tk::text .tabbar.r.content.text -cursor $contentcursor -yscrollcommand ".tabbar.r.content.yscroll set" -wrap word \ 275 -font tiix_font -foreground $tiix_fgcolor -background $tiix_bgcolor -state disabled 276 ttk::scrollbar .tabbar.r.content.yscroll -orient vertical -command ".tabbar.r.content.text yview" 277 grid .tabbar.r.content -column 0 -row 1 -sticky nsew 278 grid .tabbar.r.content.text -column 0 -row 0 -sticky nsew 279 grid .tabbar.r.content.yscroll -column 1 -row 0 -sticky ns 280 grid columnconfigure .tabbar.r.content 0 -weight 1 281 grid rowconfigure .tabbar.r.content 0 -weight 1 282 grid columnconfigure .tabbar.r 0 -weight 1 283 grid rowconfigure .tabbar.r 0 -weight 0 284 grid rowconfigure .tabbar.r 1 -weight 1 285 286 # Poster widgets 287 288 ttk::frame .tabbar.p.addrframe 289 ttk::label .tabbar.p.addrframe.el -text "Echo name" 290 ttk::combobox .tabbar.p.addrframe.echo -width 25 -textvariable tiix_post_echoname -postcommand { 291 sqlite3 msgdb $localdb -readonly true 292 set echonames [msgdb eval {SELECT DISTINCT `echoname` FROM `msg` ORDER BY `echoname`;}] 293 msgdb close 294 .tabbar.p.addrframe.echo config -values $echonames 295 } 296 ttk::label .tabbar.p.addrframe.stlbl -text "Station " 297 ttk::combobox .tabbar.p.addrframe.sturl -textvariable tiix_post_sturl -width 25 -postcommand { 298 .tabbar.p.addrframe.sturl config -values [dict keys $authmap] 299 } 300 ttk::label .tabbar.p.addrframe.tolbl -text "To:" 301 ttk::entry .tabbar.p.addrframe.to -textvariable tiix_post_to -width 20 302 ttk::label .tabbar.p.addrframe.subjlbl -text "Subj:" 303 ttk::entry .tabbar.p.addrframe.subj -textvariable tiix_post_subj -width 20 304 ttk::label .tabbar.p.addrframe.reptolbl -text "Rep:" 305 ttk::entry .tabbar.p.addrframe.repto -textvariable tiix_post_repto -width 20 306 ttk::button .tabbar.p.addrframe.send -text "Send!" -command { 307 set tiix_post_sturl [string trimright [string trim $tiix_post_sturl] "/"] 308 set tiix_post_echoname [string trim $tiix_post_echoname] 309 set tiix_post_to [string trim $tiix_post_to] 310 set tiix_post_subj [string trim $tiix_post_subj] 311 set tiix_post_repto [string trim $tiix_post_repto] 312 set tiix_post_text [string trimright [.tabbar.p.content.text get -displaychars 1.0 end]] 313 if {$tiix_post_sturl eq ""} { 314 errmsg "Station URL is required!" 315 } elseif {$tiix_post_echoname eq ""} { 316 errmsg "Echo name is required!" 317 } elseif {$tiix_post_subj eq ""} { 318 errmsg "Subj field is required!" 319 } elseif {$tiix_post_text eq ""} { 320 errmsg "Post text cannot be empty!" 321 } else { 322 if {$tiix_post_to eq ""} {set tiix_post_to All} 323 # read auth string for the station 324 set authstr "" 325 if {[dict exists $authmap $tiix_post_sturl]} { 326 set authstr [dict get $authmap $tiix_post_sturl] 327 } 328 # call the posting function 329 set answer [tk_messageBox -title "tiix post" -message "Post the message?" -icon question -type yesno] 330 if {$answer eq "yes"} { 331 set prev_status $tiix_status 332 set tiix_status "Posting to $tiix_post_echoname at $tiix_post_sturl..." 333 set res [postiidata $tiix_post_sturl $authstr $tiix_post_echoname $tiix_post_to $tiix_post_subj $tiix_post_repto $tiix_post_text] 334 set status [dict get $res status] 335 set result [dict get $res result] 336 if {$status} { 337 set tiix_status "Posting success: $result" 338 .tabbar.p.content.text delete 1.0 end 339 } else { 340 set tiix_status "Posting error: $result" 341 } 342 after 5000 {set tiix_status $prev_status} 343 } 344 } 345 } 346 grid .tabbar.p.addrframe.el -column 0 -row 0 -sticky nsw 347 grid .tabbar.p.addrframe.echo -column 1 -row 0 -sticky e 348 grid .tabbar.p.addrframe.stlbl -column 0 -row 1 -sticky nsw 349 grid .tabbar.p.addrframe.sturl -column 1 -row 1 -sticky e 350 grid .tabbar.p.addrframe.tolbl -column 2 -row 0 -sticky nsw 351 grid .tabbar.p.addrframe.to -column 3 -row 0 352 grid .tabbar.p.addrframe.subjlbl -column 2 -row 1 -sticky nsw 353 grid .tabbar.p.addrframe.subj -column 3 -row 1 -columnspan 3 -sticky we 354 grid .tabbar.p.addrframe.reptolbl -column 4 -row 0 -sticky nsw 355 grid .tabbar.p.addrframe.repto -column 5 -row 0 356 grid .tabbar.p.addrframe.send -column 6 -rowspan 2 -row 0 -sticky nswe 357 grid rowconfigure .tabbar.p.addrframe 0 -pad 2 358 grid columnconfigure .tabbar.p.addrframe 6 -weight 1 359 grid .tabbar.p.addrframe -column 0 -row 0 -sticky nws -pady 2 360 ttk::frame .tabbar.p.content 361 tk::text .tabbar.p.content.text -cursor $contentcursor -yscrollcommand ".tabbar.p.content.yscroll set" -wrap word \ 362 -font tiix_font -foreground $tiix_fgcolor -background $tiix_bgcolor -insertbackground $tiix_fgcolor -state normal 363 ttk::scrollbar .tabbar.p.content.yscroll -orient vertical -command ".tabbar.p.content.text yview" 364 grid .tabbar.p.content -column 0 -row 1 -sticky nsew 365 grid .tabbar.p.content.text -column 0 -row 0 -sticky nsew 366 grid .tabbar.p.content.yscroll -column 1 -row 0 -sticky ns 367 grid columnconfigure .tabbar.p.content 0 -weight 1 368 grid rowconfigure .tabbar.p.content 0 -weight 1 369 grid columnconfigure .tabbar.p 0 -weight 1 370 grid rowconfigure .tabbar.p 0 -weight 0 371 grid rowconfigure .tabbar.p 1 -weight 1 372 373 # Configuration widgets 374 375 set rownum 0 376 dict for {cname cval} $cfg { 377 ttk::label .tabbar.c.cfglbl_$cname -text $cname 378 if {[string match *color $cname]} { 379 ttk::button .tabbar.c.cfgtxt_$cname -textvariable $cname -command "set $cname \[tk_chooseColor -initialcolor $cval -title {Choose color}\]" 380 } else { 381 ttk::entry .tabbar.c.cfgtxt_$cname -textvariable $cname 382 } 383 grid .tabbar.c.cfglbl_$cname -row $rownum -column 0 -sticky nsw -padx 5 -pady 5 384 grid .tabbar.c.cfgtxt_$cname -row $rownum -column 1 -sticky nswe -pady 5 385 incr rownum 386 } 387 ttk::button .tabbar.c.cfgsave -text "Save configuration" -command { 388 set answer [tk_messageBox -title "tiix config" -message "Save the config file?" -icon question -type yesno] 389 if {$answer eq "yes"} { 390 set cfgtext "" 391 dict for {cname cval} $cfg { 392 append cfgtext "$cname \"[set $cname]\"\n" 393 } 394 writefileln $cfgfile [string trim $cfgtext] 395 tk_messageBox -title "tiix config" -type ok -icon info -message "Configuration saved!" -detail "Restart tiix to see the changes" 396 } 397 } 398 grid .tabbar.c.cfgsave -row $rownum -column 0 -sticky nsw -padx 5 399 grid columnconfigure .tabbar.c 1 -weight 1 400 401 # Custom bindings 402 403 proc updatefromreps {} { 404 global tiix_post_repto localdb tiix_post_to tiix_post_subj tiix_post_echoname 405 set tiix_post_repto [string trim $tiix_post_repto] 406 if {$tiix_post_repto ne ""} { 407 sqlite3 msgdb $localdb -readonly true 408 msgdb eval {SELECT * FROM `msg` WHERE `msgid`=$tiix_post_repto;} msg { 409 set tiix_post_to [string trim $msg(msgfrom)] 410 set tiix_post_subj [string trim $msg(subj)] 411 set tiix_post_echoname [string trim $msg(echoname)] 412 if {![string match "Re: *" $tiix_post_subj]} { 413 set tiix_post_subj "Re: $tiix_post_subj" 414 } 415 set textw .tabbar.p.content.text 416 # some nickname shortening heuristics 417 set shortnick $tiix_post_to 418 set parts [split $shortnick " "] 419 if {[llength $parts] > 1} { 420 set shortnick "" 421 foreach p $parts { 422 append shortnick [string index $p 0] 423 } 424 } 425 if {![string match "$shortnick>*" [$textw get 1.0 1.end]]} { 426 $textw insert 1.0 "[string trimright [join [lmap s $msg(body) {string cat $shortnick {> } [string trimright $s]}] \n]]\n" 427 } 428 } 429 msgdb close 430 431 } 432 } 433 434 bind .tabbar.p.addrframe.repto <Return> updatefromreps 435 bind .tabbar.p.addrframe.repto <Leave> updatefromreps 436 437 # general keybinding switch 438 439 bind .tabbar.r.content.text <Key> { 440 if {$tiix_entry eq 0} { 441 switch "%K" { 442 Prior - 443 h {.tabbar.r.content.text yview scroll -1 pages} 444 Next - 445 l {.tabbar.r.content.text yview scroll 1 pages} 446 Down - 447 j {.tabbar.r.content.text yview scroll 1 units} 448 Up - 449 k {.tabbar.r.content.text yview scroll -1 units} 450 default {} 451 } 452 } 453 } 454 455 # exit 456 bind . <Control-q> {exit 0}