Posted to tcl by hardkorebob at Fri Aug 07 17:59:10 GMT 2026view raw

  1.  
  2.  
  3. package require Tk
  4.  
  5. namespace eval Core {
  6. variable scriptfile [file normalize [info script]]
  7. variable plugindir [file join [file dirname $scriptfile] plugins]
  8.  
  9. variable current_buffer "scratch"
  10. variable buffer_list {}
  11. variable buffer_path [dict create] ;# buffer name -> absolute file path on disk
  12. variable buffer_from_path [dict create] ;# reverse: path -> buffer name
  13. variable buffer_widget [dict create] ;# buffer name -> internal widget id (buf1, buf2, ...)
  14. variable buffer_counter 0
  15. variable active_widget ""
  16. variable minibuffer_mode ""
  17. variable minibuffer_prompt ""
  18. variable plugin_state [dict create] ;# plugin name -> {file .. commands .. binds .. hooks .. modes}
  19. variable _reloading_plugin "" ;# name of the plugin currently being (re)sourced
  20.  
  21. # === Hook system ===
  22. variable hooks [dict create] ;# hookName -> list of scripts
  23.  
  24. # === Extensible minibuffer modes ===
  25. variable minibuffer_modes [dict create] ;# modeName -> handler command
  26. # Builtin modes are registered in Core::Init after procedures are defined
  27.  
  28. file mkdir $plugindir
  29. }
  30.  
  31. # ---- Hook API ----
  32. proc Core::AddHook {hookName script} {
  33. variable hooks
  34. dict lappend hooks $hookName $script
  35. }
  36.  
  37. proc Core::RunHook {hookName args} {
  38. variable hooks
  39. if {![dict exists $hooks $hookName]} return
  40. foreach script [dict get $hooks $hookName] {
  41. catch { uplevel #0 [list {*}$script {*}$args] }
  42. }
  43. }
  44.  
  45. proc Core::RunHookWithReturn {hookName args} {
  46. variable hooks
  47. if {![dict exists $hooks $hookName]} { return "" }
  48. foreach script [dict get $hooks $hookName] {
  49. if {[catch { uplevel #0 [list {*}$script {*}$args] } result]} continue
  50. if {$result ne "" && $result ne "continue"} {
  51. return $result
  52. }
  53. }
  54. return ""
  55. }
  56.  
  57. # ---- Extensible minibuffer modes API ----
  58. proc Core::RegisterMinibufferMode {mode handler} {
  59. variable minibuffer_modes
  60. dict set minibuffer_modes $mode $handler
  61. }
  62.  
  63. proc Core::UnregisterMinibufferMode {mode} {
  64. variable minibuffer_modes
  65. catch { dict unset minibuffer_modes $mode }
  66. }
  67.  
  68. # ---- Builtin minibuffer mode handlers ----
  69. proc Core::HandleEvalMode {input} {
  70. if {[catch {uplevel #0 $input} result]} {
  71. Core::Message "Error: $result"
  72. } else {
  73. Core::Message "=> $result"
  74. }
  75. }
  76.  
  77. proc Core::HandleFindFileMode {input} {
  78. Core::OpenFile [string trim $input]
  79. }
  80.  
  81. proc Core::HandleSwitchBufferMode {input} {
  82. set target [string trim $input]
  83. if {$target in $Core::buffer_list} {
  84. Core::SwitchToBuffer $target
  85. } else {
  86. Core::Message "No such buffer: $target"
  87. }
  88. }
  89.  
  90. proc Core::HandleSaveAsMode {filename} {
  91. set filename [string trim $filename]
  92. if {$filename eq ""} {
  93. Core::Message "Save cancelled"
  94. return
  95. }
  96. Core::SaveBufferToFile $filename
  97. }
  98.  
  99. # ---- UI Construction ----
  100. proc Core::BuildUI {} {
  101. wm title . "tclme"
  102.  
  103. # Global defaults flat, no borders
  104. option add *Background "#F5F5F5"
  105. option add *Foreground "#2C2C2C"
  106. option add *Font {Consolas 12}
  107. option add *borderWidth 0
  108. option add *relief flat
  109. option add *highlightThickness 0
  110.  
  111. # Workspace invisible background because buffers cover it,
  112. # but you can see it if no buffer is open (scratch appears).
  113. frame .workspace -bg "#F5F5F5"
  114. pack .workspace -fill both -expand true
  115.  
  116. # Thin separator line between workspace and status
  117. frame .separator1 -bg "#CCCCCC" -height 1
  118. pack .separator1 -fill x
  119.  
  120. # Status frame no border, just a background
  121. frame .status_frame -bg "#E0E0E0"
  122. pack .status_frame -fill x
  123. label .status -text " tclme " -anchor w \
  124. -bg "#E0E0E0" -fg "#555555" -font {Consolas 10 bold}
  125. pack .status -fill x
  126.  
  127. # Thin separator between status and minibuffer
  128. frame .separator2 -bg "#CCCCCC" -height 1
  129. pack .separator2 -fill x
  130.  
  131. # Minibuffer flat, no highlight border
  132. entry .minibuffer -bg "#F0F0F0" -fg "#2C2C2C" \
  133. -insertbackground "#2C2C2C" -bd 0
  134. pack .minibuffer -fill x
  135.  
  136. bind .minibuffer <Return> { Core::ExecuteMinibuffer }
  137. bind .minibuffer <Escape> { Core::CancelMinibuffer }
  138. bind .minibuffer <Control-g> { Core::CancelMinibuffer }
  139. }
  140.  
  141. # ---- Buffer management ----
  142. proc Core::SwitchToBuffer {name} {
  143. variable current_buffer
  144. variable buffer_list
  145. variable active_widget
  146. variable buffer_widget
  147. variable buffer_counter
  148.  
  149. if {[dict exists $buffer_widget $name]} {
  150. set wid [dict get $buffer_widget $name]
  151. } else {
  152. set wid "buf[incr buffer_counter]"
  153. dict set buffer_widget $name $wid
  154. }
  155.  
  156. set container ".workspace.$wid"
  157. set txt "$container.txt"
  158.  
  159. if {![winfo exists $container]} {
  160. frame $container -bg "#000000" -bd 0
  161.  
  162. text $txt -undo true -wrap word -padx 5 -pady 5 -highlightbackground "#000000" \
  163. -insertbackground "#000000" -bg "#EEEEEE" -fg "#000000" \
  164. -font {Consolas 12} -yscrollcommand "$container.vs set"
  165. scrollbar "$container.vs" -orient vertical -command "$txt yview" \
  166. -bg "#2d2d2d" -troughcolor "#1e1e1e"
  167.  
  168. pack "$container.vs" -side right -fill y
  169. pack $txt -side left -fill both -expand true
  170.  
  171. bindtags $txt [list $txt CoreText Text [winfo toplevel $txt] all]
  172.  
  173. bind $txt <<Modified>> { Core::RefreshStatus }
  174. bind $txt <KeyRelease> { Core::RefreshStatus }
  175. bind $txt <ButtonRelease-1> { Core::RefreshStatus }
  176.  
  177. lappend buffer_list $name
  178. }
  179.  
  180. foreach child [winfo children .workspace] { pack forget $child }
  181. pack $container -fill both -expand true
  182.  
  183. set current_buffer $name
  184. set active_widget $txt
  185. Core::RefreshStatus
  186. focus $txt
  187.  
  188. Core::RunHook switch-buffer-hook $name
  189. }
  190.  
  191. proc Core::FindBufferForPath {full} {
  192. variable buffer_from_path
  193. if {[dict exists $buffer_from_path $full]} {
  194. return [dict get $buffer_from_path $full]
  195. }
  196. return ""
  197. }
  198.  
  199. proc Core::KillBuffer {name} {
  200. variable buffer_list
  201. variable buffer_path
  202. variable buffer_from_path
  203. variable buffer_widget
  204. variable current_buffer
  205.  
  206. if {![dict exists $buffer_widget $name]} {
  207. Core::Message "No such buffer: $name"
  208. return
  209. }
  210.  
  211. set cancel [Core::RunHookWithReturn kill-buffer-hook $name]
  212. if {$cancel ne ""} {
  213. Core::Message "Kill cancelled: $cancel"
  214. return
  215. }
  216.  
  217. set wid [dict get $buffer_widget $name]
  218. set container ".workspace.$wid"
  219. set txt "$container.txt"
  220.  
  221. if {[$txt edit modified]} {
  222. set answer [tk_messageBox -type yesno -icon warning \
  223. -title "Unsaved changes" \
  224. -message "Buffer \"$name\" has unsaved changes. Kill?"]
  225. if {$answer ne "yes"} return
  226. }
  227.  
  228. if {[dict exists $buffer_path $name]} {
  229. set path [dict get $buffer_path $name]
  230. catch { dict unset buffer_from_path $path }
  231. }
  232.  
  233. set buffer_list [lsearch -all -inline -not -exact $buffer_list $name]
  234. catch { dict unset buffer_path $name }
  235. catch { dict unset buffer_widget $name }
  236.  
  237. if {$current_buffer eq $name} {
  238. if {[llength $buffer_list] > 0} {
  239. Core::SwitchToBuffer [lindex $buffer_list end]
  240. } else {
  241. Core::SwitchToBuffer "scratch"
  242. }
  243. }
  244.  
  245. after idle [list destroy $container]
  246. Core::Message "Killed buffer: $name"
  247. }
  248.  
  249. # ---- Status and message helpers ----
  250. proc Core::UpdateStatus {msg} { .status configure -text " $msg " }
  251.  
  252. proc Core::Message {msg} {
  253. .minibuffer delete 0 end
  254. .minibuffer insert 0 $msg
  255. }
  256.  
  257. proc Core::RefreshStatus {} {
  258. variable current_buffer
  259. variable active_widget
  260. variable buffer_path
  261.  
  262. if {$active_widget eq "" || ![winfo exists $active_widget]} { return }
  263.  
  264. set dirty [expr {[$active_widget edit modified] ? "*" : " "}]
  265. set pos [$active_widget index insert]
  266. set line [lindex [split $pos .] 0]
  267. set col [expr {[lindex [split $pos .] 1] + 1}]
  268.  
  269. set loc ""
  270. if {[dict exists $buffer_path $current_buffer]} {
  271. set loc " [dict get $buffer_path $current_buffer]"
  272. }
  273.  
  274. Core::UpdateStatus "${current_buffer}${dirty} Ln $line, Col $col${loc}"
  275.  
  276. set extra [Core::RunHookWithReturn status-line-hook $current_buffer]
  277. if {$extra ne ""} {
  278. .status configure -text " ${current_buffer}${dirty} Ln $line, Col $col${loc} $extra "
  279. }
  280. }
  281.  
  282. # ---- Minibuffer prompts ----
  283. proc Core::PromptMinibuffer {mode prompt} {
  284. variable minibuffer_mode
  285. variable minibuffer_prompt
  286. set minibuffer_mode $mode
  287. set minibuffer_prompt $prompt
  288. .minibuffer delete 0 end
  289. .minibuffer insert 0 $prompt
  290. focus .minibuffer
  291. .minibuffer icursor end
  292. }
  293.  
  294. proc Core::SetMinibufferMode {mode} {
  295. Core::PromptMinibuffer $mode "$mode: "
  296. }
  297.  
  298. # ---- Minibuffer handling ----
  299. proc Core::ExecuteMinibuffer {} {
  300. variable minibuffer_mode
  301. variable minibuffer_prompt
  302. variable active_widget
  303. variable minibuffer_modes
  304.  
  305. set input [.minibuffer get]
  306.  
  307. if {[string match {:*} $input] && $minibuffer_mode eq ""} {
  308. set cmd [string range $input 1 end]
  309. .minibuffer delete 0 end
  310. Core::RunExCommand [string trim $cmd]
  311. focus $active_widget
  312. return
  313. }
  314.  
  315. set mode $minibuffer_mode
  316. set arg $input
  317. if {$minibuffer_prompt ne "" && [string first $minibuffer_prompt $arg] == 0} {
  318. set arg [string range $arg [string length $minibuffer_prompt] end]
  319. }
  320. set minibuffer_mode ""
  321. set minibuffer_prompt ""
  322. .minibuffer delete 0 end
  323.  
  324. if {[dict exists $minibuffer_modes $mode]} {
  325. {*}[dict get $minibuffer_modes $mode] $arg
  326. }
  327.  
  328. focus $active_widget
  329. Core::RunHook minibuffer-execute-hook $mode $arg
  330. }
  331.  
  332. proc Core::CancelMinibuffer {} {
  333. variable minibuffer_mode
  334. variable minibuffer_prompt
  335. set minibuffer_mode ""
  336. set minibuffer_prompt ""
  337. .minibuffer delete 0 end
  338. if {[winfo exists $Core::active_widget]} {
  339. focus $Core::active_widget
  340. }
  341. }
  342.  
  343. # ---- Ex-command dispatcher ----
  344. proc Core::RunExCommand {cmd} {
  345. variable buffer_list
  346. variable current_buffer
  347.  
  348. set words [split $cmd]
  349. set verb [lindex $words 0]
  350. switch -- $verb {
  351. "e" - "edit" {
  352. Core::OpenFile [join [lrange $words 1 end]]
  353. }
  354. "w" - "write" {
  355. Core::SaveCurrentBuffer
  356. }
  357. "q" - "quit" {
  358. Core::Quit
  359. }
  360. "b" - "buffer" {
  361. set arg [join [lrange $words 1 end]]
  362. if {$arg eq ""} {
  363. # list buffers with 1â¬based indices
  364. set idx 0
  365. set lines {}
  366. foreach buf $buffer_list {
  367. incr idx
  368. lappend lines "$idx: $buf"
  369. }
  370. if {[llength $lines] == 0} {
  371. Core::Message "No buffers open"
  372. } else {
  373. Core::Message [join $lines " | "]
  374. }
  375. } elseif {[string is integer -strict $arg]} {
  376. set idx $arg
  377. if {$idx >= 1 && $idx <= [llength $buffer_list]} {
  378. Core::SwitchToBuffer [lindex $buffer_list [expr {$idx - 1}]]
  379. } else {
  380. Core::Message "Buffer index out of range (1â¬[llength $buffer_list])"
  381. }
  382. } else {
  383. # treat as exact name or substring (original behaviour)
  384. if {$arg in $buffer_list} {
  385. Core::SwitchToBuffer $arg
  386. } else {
  387. Core::Message "No such buffer: $arg"
  388. }
  389. }
  390. }
  391. "ls" {
  392. Core::Message "Buffers: [join $buffer_list {, }]"
  393. }
  394. "bd" - "kill" {
  395. set target [lindex $words 1]
  396. if {$target eq ""} { set target $current_buffer }
  397. Core::KillBuffer $target
  398. }
  399. "reload" {
  400. Core::ReloadPlugins [lindex $words 1]
  401. }
  402. "eval" {
  403. set code [join [lrange $words 1 end]]
  404. if {[catch {uplevel #0 $code} result]} {
  405. Core::Message "Error: $result"
  406. } else {
  407. Core::Message "=> $result"
  408. }
  409. }
  410. "help" {
  411. 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"
  412. }
  413. default {
  414. Core::Message "Unknown command: $verb (try :help)"
  415. }
  416. }
  417. }
  418.  
  419. # ---- Plugins ----
  420. proc Core::RegisterPlugin {name file} {
  421. variable plugin_state
  422. dict set plugin_state $name file $file
  423. }
  424.  
  425. proc Core::UnregisterPlugin {name} {
  426. variable plugin_state
  427. if {![dict exists $plugin_state $name]} return
  428.  
  429. if {[dict exists $plugin_state $name commands]} {
  430. foreach cmd [dict get $plugin_state $name commands] {
  431. catch { rename $cmd {} }
  432. }
  433. }
  434. if {[dict exists $plugin_state $name binds]} {
  435. foreach entry [dict get $plugin_state $name binds] {
  436. lassign $entry widget key script
  437. catch { bind $widget $key {} }
  438. }
  439. }
  440. if {[dict exists $plugin_state $name hooks]} {
  441. foreach entry [dict get $plugin_state $name hooks] {
  442. lassign $entry hookName script
  443. if {[dict exists $Core::hooks $hookName]} {
  444. set idx [lsearch -exact [dict get $Core::hooks $hookName] $script]
  445. if {$idx >= 0} {
  446. dict set Core::hooks $hookName [lreplace [dict get $Core::hooks $hookName] $idx $idx]
  447. }
  448. }
  449. }
  450. }
  451. if {[dict exists $plugin_state $name modes]} {
  452. foreach mode [dict get $plugin_state $name modes] {
  453. Core::UnregisterMinibufferMode $mode
  454. }
  455. }
  456. catch { dict unset plugin_state $name }
  457. }
  458.  
  459. proc Core::ReloadPlugins {{name ""}} {
  460. variable plugin_state
  461. variable plugindir
  462.  
  463. if {$name ne ""} {
  464. if {![dict exists $plugin_state $name]} {
  465. Core::Message "Plugin not registered: $name"
  466. return
  467. }
  468. Core::ReloadOnePlugin $name
  469. Core::Message "Reloaded plugin: $name"
  470. return
  471. }
  472.  
  473. set current_files [glob -nocomplain -directory $plugindir *.tcl]
  474. set current_names {}
  475. foreach f $current_files {
  476. lappend current_names [file rootname [file tail $f]]
  477. }
  478.  
  479. foreach name [dict keys $plugin_state] {
  480. if {$name ni $current_names} {
  481. Core::UnregisterPlugin $name
  482. }
  483. }
  484.  
  485. foreach f $current_files {
  486. set name [file rootname [file tail $f]]
  487. if {![dict exists $plugin_state $name]} {
  488. Core::RegisterPlugin $name $f
  489. if {[catch {Core::SourcePlugin $name $f} err]} {
  490. Core::Message "Error loading plugin $name: $err"
  491. }
  492. } else {
  493. dict set plugin_state $name file $f
  494. Core::ReloadOnePlugin $name
  495. }
  496. }
  497. Core::Message "Plugins reloaded."
  498. }
  499.  
  500. proc Core::ReloadOnePlugin {name} {
  501. variable plugin_state
  502. set file [dict get $plugin_state $name file]
  503.  
  504. if {[dict exists $plugin_state $name commands]} {
  505. foreach cmd [dict get $plugin_state $name commands] {
  506. catch { rename $cmd {} }
  507. }
  508. }
  509. if {[dict exists $plugin_state $name binds]} {
  510. foreach entry [dict get $plugin_state $name binds] {
  511. lassign $entry widget key script
  512. catch { bind $widget $key {} }
  513. }
  514. }
  515. if {[dict exists $plugin_state $name hooks]} {
  516. foreach entry [dict get $plugin_state $name hooks] {
  517. lassign $entry hookName script
  518. if {[dict exists $Core::hooks $hookName]} {
  519. set idx [lsearch -exact [dict get $Core::hooks $hookName] $script]
  520. if {$idx >= 0} {
  521. dict set Core::hooks $hookName [lreplace [dict get $Core::hooks $hookName] $idx $idx]
  522. }
  523. }
  524. }
  525. }
  526. if {[dict exists $plugin_state $name modes]} {
  527. foreach mode [dict get $plugin_state $name modes] {
  528. Core::UnregisterMinibufferMode $mode
  529. }
  530. }
  531. dict set plugin_state $name commands {}
  532. dict set plugin_state $name binds {}
  533. dict set plugin_state $name hooks {}
  534. dict set plugin_state $name modes {}
  535.  
  536. if {[catch {Core::SourcePlugin $name $file} err]} {
  537. Core::Message "Error loading plugin $name: $err"
  538. }
  539. }
  540.  
  541. # ---- Plugin API extensions ----
  542. proc Core::PluginAddCommand {cmd} {
  543. variable plugin_state
  544. variable _reloading_plugin
  545. if {$_reloading_plugin eq ""} return
  546. dict lappend plugin_state $_reloading_plugin commands $cmd
  547. }
  548.  
  549. proc Core::PluginBindKey {widget key script} {
  550. variable plugin_state
  551. variable _reloading_plugin
  552. if {$_reloading_plugin eq ""} return
  553. bind $widget $key "$script; break"
  554. dict lappend plugin_state $_reloading_plugin binds [list $widget $key $script]
  555. }
  556.  
  557. proc Core::PluginAddHook {hookName script} {
  558. variable plugin_state
  559. variable _reloading_plugin
  560. if {$_reloading_plugin eq ""} return
  561. dict lappend plugin_state $_reloading_plugin hooks [list $hookName $script]
  562. Core::AddHook $hookName $script
  563. }
  564.  
  565. proc Core::PluginAddMinibufferMode {mode handler} {
  566. variable plugin_state
  567. variable _reloading_plugin
  568. if {$_reloading_plugin eq ""} return
  569. dict lappend plugin_state $_reloading_plugin modes $mode
  570. Core::RegisterMinibufferMode $mode $handler
  571. }
  572.  
  573. proc Core::SourcePlugin {name file} {
  574. variable _reloading_plugin
  575. set _reloading_plugin $name
  576. try {
  577. uplevel #0 [list source $file]
  578. } finally {
  579. set _reloading_plugin ""
  580. }
  581. }
  582.  
  583. # ---- Plugin loading on startup ----
  584. proc Core::LoadPlugins {} {
  585. variable plugindir
  586. foreach file [lsort [glob -nocomplain -directory $plugindir *.tcl]] {
  587. set name [file rootname [file tail $file]]
  588. Core::RegisterPlugin $name $file
  589. if {[catch {Core::SourcePlugin $name $file} err]} {
  590. Core::Message "Error loading plugin $name: $err"
  591. }
  592. }
  593. }
  594.  
  595. # ---- File operations ----
  596. proc Core::OpenFile {filename} {
  597. variable buffer_path
  598. variable buffer_from_path
  599. variable active_widget
  600.  
  601. set filename [string trim $filename]
  602. if {$filename eq ""} return
  603. set full [file normalize $filename]
  604.  
  605. set existing [Core::FindBufferForPath $full]
  606. if {$existing ne ""} {
  607. Core::SwitchToBuffer $existing
  608. Core::Message "Switched to $existing"
  609. return
  610. }
  611.  
  612. set bname [file tail $full]
  613. if {[dict exists $buffer_path $bname]} {
  614. set n 2
  615. while {[dict exists $buffer_path "$bname<$n>"]} { incr n }
  616. set bname "$bname<$n>"
  617. }
  618.  
  619. Core::SwitchToBuffer $bname
  620. dict set buffer_path $bname $full
  621. dict set buffer_from_path $full $bname
  622.  
  623. if {![file exists $full]} {
  624. Core::Message "(New file) $filename"
  625. Core::RunHook find-file-hook $full
  626. return
  627. }
  628. if {[catch {
  629. set fp [open $full r]
  630. $active_widget delete 1.0 end
  631. $active_widget insert end [read $fp]
  632. close $fp
  633. $active_widget edit modified 0
  634. Core::Message "Read $filename"
  635. } err]} {
  636. Core::Message "Open error: $err"
  637. }
  638. Core::RefreshStatus
  639. Core::RunHook find-file-hook $full
  640. }
  641.  
  642. proc Core::SaveCurrentBuffer {} {
  643. variable current_buffer
  644. variable buffer_path
  645.  
  646. if {![dict exists $buffer_path $current_buffer]} {
  647. # No file associated prompt for save-as
  648. Core::PromptMinibuffer "save-as" "Save as (filename): "
  649. return
  650. }
  651.  
  652. set filename [dict get $buffer_path $current_buffer]
  653. Core::SaveBufferToFile $filename
  654. }
  655.  
  656. proc Core::SaveBufferToFile {filename} {
  657. variable current_buffer
  658. variable active_widget
  659. variable buffer_path
  660. variable buffer_from_path
  661.  
  662. set norm [file normalize $filename]
  663.  
  664. set cancel [Core::RunHookWithReturn before-save-hook $norm]
  665. if {$cancel ne ""} {
  666. Core::Message "Save cancelled: $cancel"
  667. return
  668. }
  669.  
  670. if {[catch {
  671. set fp [open $norm w]
  672. puts -nonewline $fp [$active_widget get 1.0 "end-1c"]
  673. close $fp
  674. $active_widget edit modified 0
  675.  
  676. # Update buffer-path mappings
  677. if {[dict exists $buffer_path $current_buffer]} {
  678. set old [dict get $buffer_path $current_buffer]
  679. if {$old ne $norm} {
  680. catch { dict unset buffer_from_path $old }
  681. }
  682. }
  683. dict set buffer_path $current_buffer $norm
  684. dict set buffer_from_path $norm $current_buffer
  685.  
  686. Core::Message "Wrote $norm"
  687. } err]} {
  688. Core::Message "Save error: $err"
  689. }
  690. Core::RefreshStatus
  691. Core::RunHook after-save-hook $norm
  692. }
  693.  
  694. proc Core::Quit {} {
  695. variable buffer_list
  696. variable buffer_widget
  697.  
  698. set cancel [Core::RunHookWithReturn before-quit-hook]
  699. if {$cancel ne ""} {
  700. Core::Message "Quit cancelled: $cancel"
  701. return
  702. }
  703.  
  704. set dirty {}
  705. foreach name $buffer_list {
  706. if {![dict exists $buffer_widget $name]} continue
  707. set wid [dict get $buffer_widget $name]
  708. set txt ".workspace.$wid.txt"
  709. if {[winfo exists $txt] && [$txt edit modified]} {
  710. lappend dirty $name
  711. }
  712. }
  713.  
  714. if {[llength $dirty] > 0} {
  715. set answer [tk_messageBox -type yesno -icon warning \
  716. -title "Unsaved changes" \
  717. -message "Unsaved changes in: [join $dirty {, }]\n\nQuit?"]
  718. if {$answer ne "yes"} return
  719. }
  720. exit 0
  721. }
  722.  
  723. # ---- Initialization ----
  724. proc Core::Init {} {
  725.  
  726. Core::RegisterMinibufferMode "eval" {Core::HandleEvalMode}
  727. Core::RegisterMinibufferMode "find-file" {Core::HandleFindFileMode}
  728. Core::RegisterMinibufferMode "switch-buffer" {Core::HandleSwitchBufferMode}
  729. Core::RegisterMinibufferMode "save-as" {Core::HandleSaveAsMode}
  730.  
  731. Core::BuildUI
  732.  
  733. bind CoreText <Control-g> { Core::CancelMinibuffer }
  734. bind CoreText <Control-x><Control-c> { Core::Quit }
  735. bind CoreText <Control-x><Control-r> { Core::ReloadPlugins }
  736. bind CoreText <Control-x><Control-s> { Core::SaveCurrentBuffer }
  737. bind CoreText <Control-x><Control-f> { Core::PromptMinibuffer "find-file" "Path: " }
  738. bind CoreText <Control-x><Control-e> { Core::PromptMinibuffer "eval" "Eval: " }
  739. bind CoreText <Control-x>b { Core::PromptMinibuffer "switch-buffer" "Switch to buffer: "; break }
  740. bind CoreText <Control-x>k { Core::KillBuffer $Core::current_buffer ; break}
  741. bind CoreText <Escape> {
  742. Core::CancelMinibuffer
  743. if {[winfo exists $Core::active_widget]} { focus $Core::active_widget }
  744. }
  745.  
  746. Core::SwitchToBuffer "scratch"
  747. Core::LoadPlugins
  748. focus $Core::active_widget
  749. }
  750.  
  751. # ---- Start ----
  752. Core::Init
  753.  

Add a comment

Please note that this site uses the meta tags nofollow,noindex for all pages that contain comments.
Items are closed for new comments after 1 week