7 files changed, 84 insertions(+), 11 deletions(-)

M README.md
M bin/spdx-gen.tcl
M src/plugins.tcl
M src/spdx/lib.tcl
M src/threads.tcl
M src/ui/main.tcl
M testplugin/manifest.tcl

@@ 21,5 21,7 @@ Current feature plans:
 - Attachments with UI integration
 - GUI object upload management(dctc+bot)
 - Functional scrollback
+- Managed Group Chats
+- Integrated Federation
 
 [code docs](https://man.amehut.dev/~aleteoryx/tclircc/)

@@ 1,5 1,6 @@
 #!/bin/env tclsh
 # script to convert the spdx db to a dict
+# FIXME: parallelize?
 
 package require http
 package require json

@@ 4,6 4,12 @@
 # [description]
 
 package require sha256
+package require html
+package require htmlparse
+if {[info procs ::spdx::*] == {}} {
+  global path
+  source [file join $path "spdx/lib.tcl"]
+}
 
 # plugin manifest format:
 # tcl script that must set the following variables at a minimum:


@@ 104,6 110,47 @@ namespace eval plugins {
     if {[llength $v1] > [llength $v2]} { return 1 }
     return -1
   }
+  
+  # TODO: parse markdown to html, parse plaintext <links> to html
+  proc format_license {license dir} {
+    switch -glob -- $license {
+      spdx:* {
+        set license [string range $license 5 end]
+        if ![spdx::exists $license] {
+          return "<b>License:</b> <i>Unknown (invalid SPDX code \"[html::html_entities $license\"])</i>"
+        }
+        set license_name [spdx::get_name $license]
+        set license_uri [spdx::get_spdx_uri $license]
+        set license [spdx::get_text $license]
+      }
+      file:* {
+        set license [string range $license 5 end]
+        set license_name [file tail [file rootname $license]]
+        set license_path [file join $dir [string trim [file normalize /$license] /]]
+        set license_uri "file://$license_path"
+        if [catch {
+          set fd [open $license_path r]
+          set license [read $fd]
+          close $fd
+          unset fd
+        }] {
+          set license_path [html::html_entities $license_path]
+          return "<b>License:</b> <i>Unreadable (couldn't load file \"<a href=\"$license_uri\">$license_path</a>\")</i>"
+        }
+      }
+      * {
+        set license_name custom
+        set license_uri {}
+      }
+    }
+
+    set license [html::html_entities $license]
+    regsub -all {&lt;((?:https?|ftps?|gopher|gemini|spartan|file)://(?:(?!&gt;).)+)&gt;} $license {<a href="\1">\1</a>} license
+    regsub -all {&lt;([^@]+@(?:(?!&gt;)[^@])+?)&gt;} $license {<a href="mailto:\1">\1</a>} license
+    set license_name [html::html_entities $license_name]
+    set license_uri [html::html_entities $license_uri]
+    return "<b>License:</b> <i><a href=\"$license_uri\">$license_name</a></i>\n\n$license"
+  }
 
   proc enroll_interp {tid iid} {}
 


@@ 111,6 158,7 @@ namespace eval plugins {
     variable log
     variable manifest_reader
 
+    set dir [file normalize $dir]
     ${log}::info "attempting to load plugin from \"$dir\"..."
 
     set mf_path [file join $dir manifest.tcl]


@@ 189,7 237,7 @@ namespace eval plugins {
         WHERE slug = $pl_slug
           AND namespace = $pl_namespace}]
 
-#    load_license manifest
+    dict set manifest license [format_license [dict get $manifest license] $dir]
 
     if ![llength $stored] {
       tailcall int_load_new $skip_prompt $manifest $dir


@@ 212,7 260,7 @@ namespace eval plugins {
       set dir [list $dir]
       t::exec tclircc::ui {
         set manifest %manifest
-        tk_messageBox -type yesno \
+        prompt -type yesno \
           -title "Plugin Installation" \
           -icon "question" \
           -message "Do you want to install \"[dict get $manifest name]\"?" \


@@ 251,7 299,7 @@ namespace eval plugins {
       set dir [list $dir]
       t::exec tclircc::ui {
         set manifest %manifest
-        tk_messageBox -type yesno \
+        prompt -type yesno \
           -title "Plugin Tampering Detected!" \
           -icon "warning" \
           -message "\"[dict get $manifest name]\" ([dict get $manifest qslug]) has been edited since last load!" \


@@ 282,7 330,7 @@ namespace eval plugins {
       set dir [list $dir]
       t::exec tclircc::ui {
         set manifest %manifest
-        tk_messageBox -type yesno \
+        prompt -type yesno \
           -title "Plugin Update" \
           -icon "question" \
           -message "Do you want to update \"[dict get $manifest name]\"?" \

@@ 4,7 4,7 @@
 # [description]
 
 namespace eval spdx {
-  set log [logger::init spdx]
+  variable log [logger::init spdx]
 
   variable db
 


@@ 50,10 50,10 @@ namespace eval spdx {
     ::spdx::load
     dict get [set db($id)] text
   }
-  proc get_spdx_url {id} {
+  proc get_spdx_uri {id} {
     variable db
     ::spdx::load
-    dict get [set db($id)] spdx_url
+    dict get [set db($id)] spdx_uri
   }
   proc get_see_also {id} {
     variable db

@@ 23,6 23,23 @@ namespace eval threads {
         variable log
         parray t::ns
       }
+      proc util_regsub_prep {data} {
+        set first -1
+        while {[set first [string first \\ $data $first+1]] != -1} {
+          if {[string index $data $first+1] ni {0 1 2 3 4 5 6 7 8 9}} {
+            continue
+          }
+          set data [string replace $data $first $first \\\\]
+          incr first
+        }
+        set first -1
+        while {[set first [string first & $data $first+1]] != -1} {
+          set data [string replace $data $first $first {\&}]
+          incr first
+        }
+        
+        return $data
+      }
       proc util_pctsub {script} {
         set new_script {}
         set idx 0


@@ 61,9 78,10 @@ namespace eval threads {
             set script [concat [list set result $result] ";" %followup]
             thread::send -async [t::ns %self] $script
           }
-          regsub %self $realscript [list $self] realscript
-          regsub %followup $realscript [list $followup] realscript
-          regsub %script $realscript [list $script] script
+          regsub %self $realscript [util_regsub_prep [list $self]] realscript
+          regsub %followup $realscript [util_regsub_prep [list $followup]] realscript
+          regsub %script $realscript [util_regsub_prep [list $script]] realscript
+          set script $realscript
         }
 
         thread::send -async [set ns($name)] $script

@@ 69,6 69,10 @@ proc mk_toplevel {varname {takefocus 0}} {
   tab_update $window
 }
 
+proc prompt {args} {
+  uplevel tk_messageBox $args
+}
+
 ${log}::debug "ui init done!"
 
 #***

@@ 4,4 4,4 @@ set namespace "aleteoryx"
 set version {0 0}
 
 set authors {Aleteoryx <alyx@aleteoryx.me>}
-set license spdx:WTFPL
+set license {i hate you <https://example.com> by <amity@aleteoryx.me> < > &}