#!/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 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 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 tiix_status "Fetching echo contents..."
  massfetch $echoname $localdbdir 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
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

# 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 keybindings

# 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}