tclme


package require Tk

namespace eval Core {
    variable scriptfile [file normalize [info script]]
    variable plugindir  [file join [file dirname $scriptfile] plugins]

    variable current_buffer   "scratch"
    variable buffer_list      {}
    variable buffer_path      [dict create]   ;# buffer name -> absolute file path on disk
    variable buffer_from_path [dict create]   ;# reverse: path -> buffer name
    variable buffer_widget    [dict create]   ;# buffer name -> internal widget id (buf1, buf2, ...)
    variable buffer_counter   0
    variable active_widget    ""
    variable minibuffer_mode   ""
    variable minibuffer_prompt ""
    variable plugin_state      [dict create]  ;# plugin name -> {file .. commands .. binds .. hooks .. modes}
    variable _reloading_plugin ""             ;# name of the plugin currently being (re)sourced

    # === Hook system ===
    variable hooks            [dict create]   ;# hookName -> list of scripts

    # === Extensible minibuffer modes ===
    variable minibuffer_modes [dict create]   ;# modeName -> handler command
    # Builtin modes are registered in Core::Init after procedures are defined

    file mkdir $plugindir
}

# ---- Hook API ----
proc Core::AddHook {hookName script} {
    variable hooks
    dict lappend hooks $hookName $script
}

proc Core::RunHook {hookName args} {
    variable hooks
    if {![dict exists $hooks $hookName]} return
    foreach script [dict get $hooks $hookName] {
        catch { uplevel #0 [list {*}$script {*}$args] }
    }
}

proc Core::RunHookWithReturn {hookName args} {
    variable hooks
    if {![dict exists $hooks $hookName]} { return "" }
    foreach script [dict get $hooks $hookName] {
        if {[catch { uplevel #0 [list {*}$script {*}$args] } result]} continue
        if {$result ne "" && $result ne "continue"} {
            return $result
        }
    }
    return ""
}

# ---- Extensible minibuffer modes API ----
proc Core::RegisterMinibufferMode {mode handler} {
    variable minibuffer_modes
    dict set minibuffer_modes $mode $handler
}

proc Core::UnregisterMinibufferMode {mode} {
    variable minibuffer_modes
    catch { dict unset minibuffer_modes $mode }
}

# ---- Builtin minibuffer mode handlers ----
proc Core::HandleEvalMode {input} {
    if {[catch {uplevel #0 $input} result]} {
        Core::Message "Error: $result"
    } else {
        Core::Message "=> $result"
    }
}

proc Core::HandleFindFileMode {input} {
    Core::OpenFile [string trim $input]
}

proc Core::HandleSwitchBufferMode {input} {
    set target [string trim $input]
    if {$target in $Core::buffer_list} {
        Core::SwitchToBuffer $target
    } else {
        Core::Message "No such buffer: $target"
    }
}

proc Core::HandleSaveAsMode {filename} {
    set filename [string trim $filename]
    if {$filename eq ""} {
        Core::Message "Save cancelled"
        return
    }
    Core::SaveBufferToFile $filename
}

# ---- UI Construction ----
proc Core::BuildUI {} {
    wm title . "tclme"

    # Global defaults  flat, no borders
    option add *Background      "#F5F5F5"
    option add *Foreground      "#2C2C2C"
    option add *Font            {Consolas 12}
    option add *borderWidth     0
    option add *relief          flat
    option add *highlightThickness 0

    # Workspace invisible background because buffers cover it,
    # but you can see it if no buffer is open (scratch appears).
    frame .workspace -bg "#F5F5F5"
    pack .workspace -fill both -expand true

    # Thin separator line between workspace and status
    frame .separator1 -bg "#CCCCCC" -height 1
    pack .separator1 -fill x

    # Status frame no border, just a background
    frame .status_frame -bg "#E0E0E0"
    pack .status_frame -fill x
    label .status -text " tclme " -anchor w \
        -bg "#E0E0E0" -fg "#555555" -font {Consolas 10 bold}
    pack .status -fill x

    # Thin separator between status and minibuffer
    frame .separator2 -bg "#CCCCCC" -height 1
    pack .separator2 -fill x

    # Minibuffer flat, no highlight border
    entry .minibuffer -bg "#F0F0F0" -fg "#2C2C2C" \
        -insertbackground "#2C2C2C" -bd 0
    pack .minibuffer -fill x

    bind .minibuffer <Return>       { Core::ExecuteMinibuffer }
    bind .minibuffer <Escape>       { Core::CancelMinibuffer }
    bind .minibuffer <Control-g>    { Core::CancelMinibuffer }
}

# ---- Buffer management ----
proc Core::SwitchToBuffer {name} {
    variable current_buffer
    variable buffer_list
    variable active_widget
    variable buffer_widget
    variable buffer_counter

    if {[dict exists $buffer_widget $name]} {
        set wid [dict get $buffer_widget $name]
    } else {
        set wid "buf[incr buffer_counter]"
        dict set buffer_widget $name $wid
    }

    set container ".workspace.$wid"
    set txt "$container.txt"

    if {![winfo exists $container]} {
        frame $container -bg "#000000" -bd 0

        text $txt -undo true -wrap word -padx 5 -pady 5 -highlightbackground "#000000" \
            -insertbackground "#000000" -bg "#EEEEEE" -fg "#000000" \
            -font {Consolas 12} -yscrollcommand "$container.vs set"
        scrollbar "$container.vs" -orient vertical -command "$txt yview" \
            -bg "#2d2d2d" -troughcolor "#1e1e1e"

        pack "$container.vs" -side right -fill y
        pack $txt -side left -fill both -expand true

        bindtags $txt [list $txt CoreText Text [winfo toplevel $txt] all]

        bind $txt <<Modified>>       { Core::RefreshStatus }
        bind $txt <KeyRelease>       { Core::RefreshStatus }
        bind $txt <ButtonRelease-1>  { Core::RefreshStatus }

        lappend buffer_list $name
    }

    foreach child [winfo children .workspace] { pack forget $child }
    pack $container -fill both -expand true

    set current_buffer $name
    set active_widget $txt
    Core::RefreshStatus
    focus $txt

    Core::RunHook switch-buffer-hook $name
}

proc Core::FindBufferForPath {full} {
    variable buffer_from_path
    if {[dict exists $buffer_from_path $full]} {
        return [dict get $buffer_from_path $full]
    }
    return ""
}

proc Core::KillBuffer {name} {
    variable buffer_list
    variable buffer_path
    variable buffer_from_path
    variable buffer_widget
    variable current_buffer

    if {![dict exists $buffer_widget $name]} {
        Core::Message "No such buffer: $name"
        return
    }

    set cancel [Core::RunHookWithReturn kill-buffer-hook $name]
    if {$cancel ne ""} {
        Core::Message "Kill cancelled: $cancel"
        return
    }

    set wid [dict get $buffer_widget $name]
    set container ".workspace.$wid"
    set txt "$container.txt"

    if {[$txt edit modified]} {
        set answer [tk_messageBox -type yesno -icon warning \
            -title "Unsaved changes" \
            -message "Buffer \"$name\" has unsaved changes. Kill?"]
        if {$answer ne "yes"} return
    }

    if {[dict exists $buffer_path $name]} {
        set path [dict get $buffer_path $name]
        catch { dict unset buffer_from_path $path }
    }

    set buffer_list [lsearch -all -inline -not -exact $buffer_list $name]
    catch { dict unset buffer_path $name }
    catch { dict unset buffer_widget $name }

    if {$current_buffer eq $name} {
        if {[llength $buffer_list] > 0} {
            Core::SwitchToBuffer [lindex $buffer_list end]
        } else {
            Core::SwitchToBuffer "scratch"
        }
    }

    after idle [list destroy $container]
    Core::Message "Killed buffer: $name"
}

# ---- Status and message helpers ----
proc Core::UpdateStatus {msg} { .status configure -text " $msg " }

proc Core::Message {msg} {
    .minibuffer delete 0 end
    .minibuffer insert 0 $msg
}

proc Core::RefreshStatus {} {
    variable current_buffer
    variable active_widget
    variable buffer_path

    if {$active_widget eq "" || ![winfo exists $active_widget]} { return }

    set dirty [expr {[$active_widget edit modified] ? "*" : " "}]
    set pos [$active_widget index insert]
    set line [lindex [split $pos .] 0]
    set col  [expr {[lindex [split $pos .] 1] + 1}]

    set loc ""
    if {[dict exists $buffer_path $current_buffer]} {
        set loc "   [dict get $buffer_path $current_buffer]"
    }

    Core::UpdateStatus "${current_buffer}${dirty}  Ln $line, Col $col${loc}"

    set extra [Core::RunHookWithReturn status-line-hook $current_buffer]
    if {$extra ne ""} {
        .status configure -text " ${current_buffer}${dirty}  Ln $line, Col $col${loc}  $extra "
    }
}

# ---- Minibuffer prompts ----
proc Core::PromptMinibuffer {mode prompt} {
    variable minibuffer_mode
    variable minibuffer_prompt
    set minibuffer_mode $mode
    set minibuffer_prompt $prompt
    .minibuffer delete 0 end
    .minibuffer insert 0 $prompt
    focus .minibuffer
    .minibuffer icursor end
}

proc Core::SetMinibufferMode {mode} {
    Core::PromptMinibuffer $mode "$mode: "
}

# ---- Minibuffer handling ----
proc Core::ExecuteMinibuffer {} {
    variable minibuffer_mode
    variable minibuffer_prompt
    variable active_widget
    variable minibuffer_modes

    set input [.minibuffer get]

    if {[string match {:*} $input] && $minibuffer_mode eq ""} {
        set cmd [string range $input 1 end]
        .minibuffer delete 0 end
        Core::RunExCommand [string trim $cmd]
        focus $active_widget
        return
    }

    set mode $minibuffer_mode
    set arg  $input
    if {$minibuffer_prompt ne "" && [string first $minibuffer_prompt $arg] == 0} {
        set arg [string range $arg [string length $minibuffer_prompt] end]
    }
    set minibuffer_mode ""
    set minibuffer_prompt ""
    .minibuffer delete 0 end

    if {[dict exists $minibuffer_modes $mode]} {
        {*}[dict get $minibuffer_modes $mode] $arg
    }

    focus $active_widget
    Core::RunHook minibuffer-execute-hook $mode $arg
}

proc Core::CancelMinibuffer {} {
    variable minibuffer_mode
    variable minibuffer_prompt
    set minibuffer_mode ""
    set minibuffer_prompt ""
    .minibuffer delete 0 end
    if {[winfo exists $Core::active_widget]} {
        focus $Core::active_widget
    }
}

# ---- Ex-command dispatcher ----
proc Core::RunExCommand {cmd} {
    variable buffer_list
    variable current_buffer

    set words [split $cmd]
    set verb [lindex $words 0]
    switch -- $verb {
        "e" - "edit" {
            Core::OpenFile [join [lrange $words 1 end]]
        }
        "w" - "write" {
            Core::SaveCurrentBuffer
        }
        "q" - "quit" {
            Core::Quit
        }
        "b" - "buffer" {
            set arg [join [lrange $words 1 end]]
            if {$arg eq ""} {
                # list buffers with 1â¬based indices
                set idx 0
                set lines {}
                foreach buf $buffer_list {
                    incr idx
                    lappend lines "$idx: $buf"
                }
                if {[llength $lines] == 0} {
                    Core::Message "No buffers open"
                } else {
                    Core::Message [join $lines " | "]
                }
            } elseif {[string is integer -strict $arg]} {
                set idx $arg
                if {$idx >= 1 && $idx <= [llength $buffer_list]} {
                    Core::SwitchToBuffer [lindex $buffer_list [expr {$idx - 1}]]
                } else {
                    Core::Message "Buffer index out of range (1â¬[llength $buffer_list])"
                }
            } else {
                # treat as exact name or substring (original behaviour)
                if {$arg in $buffer_list} {
                    Core::SwitchToBuffer $arg
                } else {
                    Core::Message "No such buffer: $arg"
                }
            }
        }
        "ls" {
            Core::Message "Buffers: [join $buffer_list {, }]"
        }
        "bd" - "kill" {
            set target [lindex $words 1]
            if {$target eq ""} { set target $current_buffer }
            Core::KillBuffer $target
        }
        "reload" {
            Core::ReloadPlugins [lindex $words 1]
        }
        "eval" {
            set code [join [lrange $words 1 end]]
            if {[catch {uplevel #0 $code} result]} {
                Core::Message "Error: $result"
            } else {
                Core::Message "=> $result"
            }
        }
        "help" {
            Core::Message ":e :w :q :b[#|name] :ls :bd\[name\] :reload\[plugin\] :eval  |  C-x C-s/C-f/C-e/b/k, C-x C-r"
        }
        default {
            Core::Message "Unknown command: $verb  (try :help)"
        }
    }
}

# ---- Plugins ----
proc Core::RegisterPlugin {name file} {
    variable plugin_state
    dict set plugin_state $name file $file
}

proc Core::UnregisterPlugin {name} {
    variable plugin_state
    if {![dict exists $plugin_state $name]} return

    if {[dict exists $plugin_state $name commands]} {
        foreach cmd [dict get $plugin_state $name commands] {
            catch { rename $cmd {} }
        }
    }
    if {[dict exists $plugin_state $name binds]} {
        foreach entry [dict get $plugin_state $name binds] {
            lassign $entry widget key script
            catch { bind $widget $key {} }
        }
    }
    if {[dict exists $plugin_state $name hooks]} {
        foreach entry [dict get $plugin_state $name hooks] {
            lassign $entry hookName script
            if {[dict exists $Core::hooks $hookName]} {
                set idx [lsearch -exact [dict get $Core::hooks $hookName] $script]
                if {$idx >= 0} {
                    dict set Core::hooks $hookName [lreplace [dict get $Core::hooks $hookName] $idx $idx]
                }
            }
        }
    }
    if {[dict exists $plugin_state $name modes]} {
        foreach mode [dict get $plugin_state $name modes] {
            Core::UnregisterMinibufferMode $mode
        }
    }
    catch { dict unset plugin_state $name }
}

proc Core::ReloadPlugins {{name ""}} {
    variable plugin_state
    variable plugindir

    if {$name ne ""} {
        if {![dict exists $plugin_state $name]} {
            Core::Message "Plugin not registered: $name"
            return
        }
        Core::ReloadOnePlugin $name
        Core::Message "Reloaded plugin: $name"
        return
    }

    set current_files [glob -nocomplain -directory $plugindir *.tcl]
    set current_names {}
    foreach f $current_files {
        lappend current_names [file rootname [file tail $f]]
    }

    foreach name [dict keys $plugin_state] {
        if {$name ni $current_names} {
            Core::UnregisterPlugin $name
        }
    }

    foreach f $current_files {
        set name [file rootname [file tail $f]]
        if {![dict exists $plugin_state $name]} {
            Core::RegisterPlugin $name $f
            if {[catch {Core::SourcePlugin $name $f} err]} {
                Core::Message "Error loading plugin $name: $err"
            }
        } else {
            dict set plugin_state $name file $f
            Core::ReloadOnePlugin $name
        }
    }
    Core::Message "Plugins reloaded."
}

proc Core::ReloadOnePlugin {name} {
    variable plugin_state
    set file [dict get $plugin_state $name file]

    if {[dict exists $plugin_state $name commands]} {
        foreach cmd [dict get $plugin_state $name commands] {
            catch { rename $cmd {} }
        }
    }
    if {[dict exists $plugin_state $name binds]} {
        foreach entry [dict get $plugin_state $name binds] {
            lassign $entry widget key script
            catch { bind $widget $key {} }
        }
    }
    if {[dict exists $plugin_state $name hooks]} {
        foreach entry [dict get $plugin_state $name hooks] {
            lassign $entry hookName script
            if {[dict exists $Core::hooks $hookName]} {
                set idx [lsearch -exact [dict get $Core::hooks $hookName] $script]
                if {$idx >= 0} {
                    dict set Core::hooks $hookName [lreplace [dict get $Core::hooks $hookName] $idx $idx]
                }
            }
        }
    }
    if {[dict exists $plugin_state $name modes]} {
        foreach mode [dict get $plugin_state $name modes] {
            Core::UnregisterMinibufferMode $mode
        }
    }
    dict set plugin_state $name commands {}
    dict set plugin_state $name binds    {}
    dict set plugin_state $name hooks    {}
    dict set plugin_state $name modes    {}

    if {[catch {Core::SourcePlugin $name $file} err]} {
        Core::Message "Error loading plugin $name: $err"
    }
}

# ---- Plugin API extensions ----
proc Core::PluginAddCommand {cmd} {
    variable plugin_state
    variable _reloading_plugin
    if {$_reloading_plugin eq ""} return
    dict lappend plugin_state $_reloading_plugin commands $cmd
}

proc Core::PluginBindKey {widget key script} {
    variable plugin_state
    variable _reloading_plugin
    if {$_reloading_plugin eq ""} return
    bind $widget $key "$script; break"
    dict lappend plugin_state $_reloading_plugin binds [list $widget $key $script]
}

proc Core::PluginAddHook {hookName script} {
    variable plugin_state
    variable _reloading_plugin
    if {$_reloading_plugin eq ""} return
    dict lappend plugin_state $_reloading_plugin hooks [list $hookName $script]
    Core::AddHook $hookName $script
}

proc Core::PluginAddMinibufferMode {mode handler} {
    variable plugin_state
    variable _reloading_plugin
    if {$_reloading_plugin eq ""} return
    dict lappend plugin_state $_reloading_plugin modes $mode
    Core::RegisterMinibufferMode $mode $handler
}

proc Core::SourcePlugin {name file} {
    variable _reloading_plugin
    set _reloading_plugin $name
    try {
        uplevel #0 [list source $file]
    } finally {
        set _reloading_plugin ""
    }
}

# ---- Plugin loading on startup ----
proc Core::LoadPlugins {} {
    variable plugindir
    foreach file [lsort [glob -nocomplain -directory $plugindir *.tcl]] {
        set name [file rootname [file tail $file]]
        Core::RegisterPlugin $name $file
        if {[catch {Core::SourcePlugin $name $file} err]} {
            Core::Message "Error loading plugin $name: $err"
        }
    }
}

# ---- File operations ----
proc Core::OpenFile {filename} {
    variable buffer_path
    variable buffer_from_path
    variable active_widget

    set filename [string trim $filename]
    if {$filename eq ""} return
    set full [file normalize $filename]

    set existing [Core::FindBufferForPath $full]
    if {$existing ne ""} {
        Core::SwitchToBuffer $existing
        Core::Message "Switched to $existing"
        return
    }

    set bname [file tail $full]
    if {[dict exists $buffer_path $bname]} {
        set n 2
        while {[dict exists $buffer_path "$bname<$n>"]} { incr n }
        set bname "$bname<$n>"
    }

    Core::SwitchToBuffer $bname
    dict set buffer_path $bname $full
    dict set buffer_from_path $full $bname

    if {![file exists $full]} {
        Core::Message "(New file) $filename"
        Core::RunHook find-file-hook $full
        return
    }
    if {[catch {
        set fp [open $full r]
        $active_widget delete 1.0 end
        $active_widget insert end [read $fp]
        close $fp
        $active_widget edit modified 0
        Core::Message "Read $filename"
    } err]} {
        Core::Message "Open error: $err"
    }
    Core::RefreshStatus
    Core::RunHook find-file-hook $full
}

proc Core::SaveCurrentBuffer {} {
    variable current_buffer
    variable buffer_path

    if {![dict exists $buffer_path $current_buffer]} {
        # No file associated prompt for save-as
        Core::PromptMinibuffer "save-as" "Save as (filename): "
        return
    }

    set filename [dict get $buffer_path $current_buffer]
    Core::SaveBufferToFile $filename
}

proc Core::SaveBufferToFile {filename} {
    variable current_buffer
    variable active_widget
    variable buffer_path
    variable buffer_from_path

    set norm [file normalize $filename]

    set cancel [Core::RunHookWithReturn before-save-hook $norm]
    if {$cancel ne ""} {
        Core::Message "Save cancelled: $cancel"
        return
    }

    if {[catch {
        set fp [open $norm w]
        puts -nonewline $fp [$active_widget get 1.0 "end-1c"]
        close $fp
        $active_widget edit modified 0

        # Update buffer-path mappings
        if {[dict exists $buffer_path $current_buffer]} {
            set old [dict get $buffer_path $current_buffer]
            if {$old ne $norm} {
                catch { dict unset buffer_from_path $old }
            }
        }
        dict set buffer_path $current_buffer $norm
        dict set buffer_from_path $norm $current_buffer

        Core::Message "Wrote $norm"
    } err]} {
        Core::Message "Save error: $err"
    }
    Core::RefreshStatus
    Core::RunHook after-save-hook $norm
}

proc Core::Quit {} {
    variable buffer_list
    variable buffer_widget

    set cancel [Core::RunHookWithReturn before-quit-hook]
    if {$cancel ne ""} {
        Core::Message "Quit cancelled: $cancel"
        return
    }

    set dirty {}
    foreach name $buffer_list {
        if {![dict exists $buffer_widget $name]} continue
        set wid [dict get $buffer_widget $name]
        set txt ".workspace.$wid.txt"
        if {[winfo exists $txt] && [$txt edit modified]} {
            lappend dirty $name
        }
    }

    if {[llength $dirty] > 0} {
        set answer [tk_messageBox -type yesno -icon warning \
            -title "Unsaved changes" \
            -message "Unsaved changes in: [join $dirty {, }]\n\nQuit?"]
        if {$answer ne "yes"} return
    }
    exit 0
}

# ---- Initialization ----
proc Core::Init {} {

    Core::RegisterMinibufferMode "eval"          {Core::HandleEvalMode}
    Core::RegisterMinibufferMode "find-file"     {Core::HandleFindFileMode}
    Core::RegisterMinibufferMode "switch-buffer" {Core::HandleSwitchBufferMode}
    Core::RegisterMinibufferMode "save-as"       {Core::HandleSaveAsMode}

    Core::BuildUI

    bind CoreText <Control-g>              { Core::CancelMinibuffer }
    bind CoreText <Control-x><Control-c>   { Core::Quit }
    bind CoreText <Control-x><Control-r>   { Core::ReloadPlugins }
    bind CoreText <Control-x><Control-s>   { Core::SaveCurrentBuffer }
    bind CoreText <Control-x><Control-f>   { Core::PromptMinibuffer "find-file" "Path: " }
    bind CoreText <Control-x><Control-e>   { Core::PromptMinibuffer "eval" "Eval: " }
    bind CoreText <Control-x>b             { Core::PromptMinibuffer "switch-buffer" "Switch to buffer: "; break }
    bind CoreText <Control-x>k             { Core::KillBuffer $Core::current_buffer ; break}
    bind CoreText <Escape> {
        Core::CancelMinibuffer
        if {[winfo exists $Core::active_widget]} { focus $Core::active_widget }
    }

    Core::SwitchToBuffer "scratch"
    Core::LoadPlugins
    focus $Core::active_widget
}

# ---- Start ----
Core::Init