commit 5f77e76d18814c12a01c35c16bf208d3fb5c59b1
parent f255d39dee3e928a66228cadb424cd2836a265ab
Author: Luxferre <lux@ferre>
Date: Wed, 23 Oct 2024 15:06:24 +0300
tiix dev started
Diffstat:
| M | tiipost.tcl | | | 8 | +++----- |
| A | tiix.tcl | | | 400 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
2 files changed, 403 insertions(+), 5 deletions(-)
diff --git a/tiipost.tcl b/tiipost.tcl
@@ -28,12 +28,10 @@ proc readfile {fname} {
}
# main data posting function
-proc postiidata {rooturl authstr echoname msgto subj repto text add_enc} {
+proc postiidata {rooturl authstr echoname msgto subj repto text} {
if {$repto ne ""} {set text "@repto:$repto\r\n$text"}
set rawdata "$echoname\n$msgto\n$subj\n\n$text"
- if {$add_enc eq 1} {
- set rawdata [encoding convertto utf-8 $rawdata]
- }
+ set rawdata [encoding convertto utf-8 $rawdata]
set based [binary encode base64 $rawdata]
# perform the posting if the length fits
if {[string length $based] <= 87382} {
@@ -95,7 +93,7 @@ if {$argc > 3} {
}
set msgtext [readfile stdin]
puts "Posting the message to $sturl..."
- set res [postiidata $sturl $authstr $echoname $msgto $subj $repto $msgtext 1]
+ set res [postiidata $sturl $authstr $echoname $msgto $subj $repto $msgtext]
set status [dict get $res status]
set result [dict get $res result]
if {$status} {puts "Success: $result"} else {puts "Error: $result"}
diff --git a/tiix.tcl b/tiix.tcl
@@ -0,0 +1,400 @@
+#!/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 and Tk
+# Created by Luxferre in 2024, released into public domain
+
+package require Tk
+
+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 textfont TkFixedFont
+set textfontsize 10
+set tiix_fgcolor black
+set tiix_bgcolor white
+set tiix_linkcolor blue
+set cfgfile [file join $appdir "config.txt"]
+if {[file exists $cfgfile]} {
+ set cfg [readfile $cfgfile]
+ if {[dict exists $cfg useragent]} {
+ ::http::config -useragent [dict get $cfg useragent]
+ }
+ if {[dict exists $cfg proxyhost]} {
+ ::http::config -proxyhost [dict get $cfg proxyhost]
+ }
+ if {[dict exists $cfg proxyport]} {
+ ::http::config -proxyport [dict get $cfg proxyport]
+ }
+ if {[dict exists $cfg tiix_font]} {
+ set textfont [dict get $cfg tiix_font]
+ }
+ if {[dict exists $cfg tiix_fontsize]} {
+ set textfontsize [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 "$textfont" -size $textfontsize -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 directory path
+set localdbdir [file join $appdir "tiidb"]
+set msgdir [file join $localdbdir "msg"]
+set echodir [file join $localdbdir "echo"]
+
+# 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_filter_tail 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
+ if {$is_orig eq 1} {
+ set tagname "orig_tiixlink_$uri"
+ } else {
+ set tagname "tiixlink_$uri"
+ }
+ $textw insert end $uri $tagname
+ if {$is_orig eq 0} {
+ $textw tag configure $tagname -underline on -foreground $tiix_linkcolor -background $tiix_bgcolor
+ $textw tag bind $tagname <Button-1> "clicklink $textw $uri"
+ $textw tag bind $tagname <Enter> {%W configure -cursor hand2}
+ $textw tag bind $tagname <Leave> {%W configure -cursor $contentcursor}
+ }
+ incr linkcount
+ lappend linklist $uri
+}
+
+proc tiix_formatmessage {msgdata msgid} {
+ set globalline [string repeat = 80]
+ set hdrline [string repeat - 80]
+ set msglines [lmap s [split $msgdata "\n"] {string trimright $s}]
+ # parsing according to the spec, first 7 lines are:
+ # tags, echoarea, timestamp, msgfrom, msgfrom_addr, msgto, subj
+ # and then an empty line and the message body follows
+ set tags [split [lindex $msglines 0] "/"]
+ if {[dict exists $tags repto]} {
+ set replyto [dict get $tags repto]
+ } else {set replyto ""}
+ set echoarea [lindex $msglines 1]
+ set timestamp [lindex $msglines 2]
+ set msgfrom [lindex $msglines 3]
+ set msgfromaddr [lindex $msglines 4]
+ set msgto [lindex $msglines 5]
+ set subj [lindex $msglines 6]
+ set msgbody [join [lrange $msglines 8 end] "\n"]
+ set tz ""
+ set renderedts ""
+ catch { # because some servers don't provide timestamps
+ set renderedts [clock format $timestamp -format {%Y-%m-%d %H:%M:%S} -timezone $tz]
+ }
+ set textw .tabbar.r.content.text
+ $textw insert end "\[$renderedts\] "
+ linkinsert $textw $msgid 1
+ $textw insert end "\n$echoarea - $msgfrom ($msgfromaddr) to $msgto\n"
+ if {$replyto ne ""} {
+ $textw insert end "Replied to: "
+ linkinsert $textw "$replyto" 0
+ $textw insert end "\n"
+ }
+ $textw insert end "Subj: $subj\n$hdrline\n$msgbody\n$globalline\n\n"
+
+}
+
+proc tiix_viewecho {} {
+ global echodir msgdir linkcount tiix_echoname
+ global tiix_filter_num tiix_filter_regex tiix_filter_rev tiix_filter_tail
+ if {$tiix_echoname eq ""} {
+ errmsg "Please select an echo conference to read!"
+ return
+ }
+ set echofile [file join $echodir $tiix_echoname]
+ set msglist [split [readfile $echofile] "\n"]
+ set numitems $tiix_filter_num
+ # perform the element filtering
+ if {$numitems > 0} {
+ incr numitems -1
+ if {$tiix_filter_tail eq 1} {
+ set msglist [lrange $msglist end-$numitems end]
+ } else {
+ set msglist [lrange $msglist 0 $numitems]
+ }
+ }
+ if {$tiix_filter_rev eq 1} {
+ set msglist [lreverse $msglist]
+ }
+ set textw .tabbar.r.content.text
+ $textw configure -state normal
+ $textw delete 1.0 end
+ set linkcount 0
+ set linklist ""
+ foreach msgid $msglist { # iterate over the list after filtering
+ set msgid [string trim $msgid]
+ if {$msgid ne ""} {
+ set msgfile [file join $msgdir $msgid]
+ if {[file exists $msgfile]} {
+ set msgdata [readfile $msgfile]
+ set pass 1
+ if {$tiix_filter_regex ne {}} {
+ set pass [regexp -line -nocase -- $tiix_filter_regex $msgdata]
+ }
+ if {$pass eq 1} {tiix_formatmessage $msgdata $msgid}
+ }
+ }
+ }
+ $textw configure -state disabled
+}
+
+# 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 localdbdir
+ set prev_status $tiix_status
+ set tiix_status "Fetching echo contents..."
+ massfetch $echoname $localdbdir 0
+ set tiix_status $prev_status
+}
+
+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
+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 {
+ set echonames [lsort [glob -tails -directory $echodir -nocomplain -types f "*.*"]]
+ .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.tail -variable tiix_filter_tail -offvalue 0 -onvalue 1 -text "Tail"
+ttk::checkbutton .tabbar.r.addrframe.c.rev -variable tiix_filter_rev -offvalue 0 -onvalue 1 -text "Reverse"
+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.tail -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 "Filter regex"
+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 {
+ set echonames [lsort [glob -tails -directory $echodir -nocomplain -types f "*.*"]]
+ .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"
+ } 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
+
+
+# Custom keybindings
+
+# general keybinding switch
+
+bind . <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}
