From 55fc68056d2a4a22d1a0bbc1ac86e71ed8111e66 Mon Sep 17 00:00:00 2001 From: No Time To Play Date: Fri, 6 Jan 2023 08:41:23 +0000 Subject: [PATCH] Add version 1.1 --- NEWS.md | 12 + README.md | 32 ++- toyed.tcl | 651 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 693 insertions(+), 2 deletions(-) create mode 100644 NEWS.md create mode 100644 toyed.tcl diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..5609292 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,12 @@ +# Toyed project news + +## [1.1] - 2023-01-06 + +### Added + +* Prefix Lines feature +* minimal documentation + +## [1.0] - 2022-12-27 + +Initial release diff --git a/README.md b/README.md index caf3804..63336be 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,31 @@ -# toyed +# About ToyEd -A toy text editor in Tcl/Tk for educational purposes. \ No newline at end of file +"A toy text editor in Tcl/Tk for educational purposes." + +ToyEd is a toy text editor made for fun and learning. It's not meant for serious use, but rather to be studied and built upon. + +ToyEd is written in 650 lines of Tcl/Tk (see below), but has many expected features: + +- GUI controls +- keyboard operation +- line and word count +- formatting functions +- display options + +ToyEd is open source under the MIT license. See source code: + +As of 6 January 2023, the code seems to work right, but hasn't really been tested. Please back up your data. + +The user interface should be fairly obvious. + +## System requirements + +Running ToyEd from source requires Tcl/Tk 8.5 or newer, with Tcllib and Tklib. Both are available on most Linux distributions, or else from the tcl-lang.org website. + +Recommended screen resolution: 800x600. + +## Credits and support + +ToyEd was born from the experience of developing Scrunch Edit TT, and reuses most code from it. + +You can usually find me on IRC, in the #ctrl-c channel of tilde.chat, or else as @notimetoplay on the elekk.xyz Mastodon instance. Would love to hear from you. diff --git a/toyed.tcl b/toyed.tcl new file mode 100644 index 0000000..d6fc556 --- /dev/null +++ b/toyed.tcl @@ -0,0 +1,651 @@ +#!/usr/bin/env tclsh +# +# ToyEd: a toy text editor for educational purposes in Tcl/Tk. +# Copyright 2022 Felix Pleșoianu +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to deal +# in the Software without restriction, including without limitation the rights +# to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +# copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +# OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +# THE SOFTWARE. + +package require Tcl 8.5 +package require Tk 8.5 +package require try + +package require getstring +namespace import getstring::* + +set about_text "A toy text editor\nVersion 1.1 (6 Jan 2023)\nMIT License" +set credits_text "Made by No Time To Play\nbased on knowledge\nfrom TkDocs.com" +set site_link "https://ctrl-c.club/~nttp/toys/toyed/" + +set file_types { + {"All files" ".*"} + {"Text files" ".txt"} + {"Markdown files" ".md"} +} + +set file_name "" +set search_term "" +set _word_wrap 1 + +namespace eval font_size { + variable minimum 6 + variable default 11 + variable maximum 16 + + namespace export increase decrease reset + namespace ensemble create + + variable current $default + + proc increase {widget {family "Courier"}} { + variable current + variable maximum + if {$current < $maximum} { + incr current + } + $widget configure -font "$family $current" + } + + proc decrease {widget {family "Courier"}} { + variable current + variable minimum + if {$current > $minimum} { + incr current -1 + } + $widget configure -font "$family $current" + } + + proc reset {widget {family "Courier"}} { + variable current + variable default + set current $default + $widget configure -font "$family $current" + } +} + +namespace eval tk_util { + proc pack_scrolled widget { + set parent [winfo parent $widget] + if {$parent == "."} { + set scroll .scroll + } else { + set scroll $parent.scroll + } + ttk::scrollbar $scroll -orient "vertical" \ + -command "$widget yview" + pack $widget -side "left" -fill "both" -expand 1 + $widget configure -yscrollcommand "$scroll set" + pack $scroll -side "right" -fill y + } + + proc load_text {widget content} { + $widget delete 1.0 end + $widget insert end $content + $widget edit reset + $widget edit modified 0 + } + + proc text_selection widget { + if {[llength [$widget tag ranges sel]] > 0} { + return [$widget get sel.first sel.last] + } else { + return "" + } + } + + proc paste_content widget { + if {[llength [$widget tag ranges sel]] > 0} { + $widget delete sel.first sel.last + } + tk_textPaste $widget + } + + proc select_all widget { + $widget tag remove sel 1.0 end + $widget tag add sel 1.0 end + } + + proc highlight_text {widget content {start "1.0"}} { + set idx [$widget search -nocase $content $start] + if {$idx ne ""} { + set len [string length $content] + set pos "$idx +$len chars" + $widget tag remove "sel" "1.0" "end" + $widget tag add "sel" $idx $pos + $widget mark set "insert" $pos + $widget see "insert" + focus $widget + } + return $idx + } + + proc open_line widget { + $widget insert "insert +0 chars" "\n" + $widget mark set "insert" "insert -1 chars" + } + + proc word_wrap widget { + if {[$widget cget -wrap] eq "word"} { + $widget configure -wrap "none" + } else { + $widget configure -wrap "word" + } + } + + proc full_screen window { + if {[wm attributes $window -fullscreen]} { + wm attributes $window -fullscreen 0 + } else { + wm attributes $window -fullscreen 1 + } + } +} + +wm title . "ToyEd" +option add *tearOff 0 +. configure -padx 4 + +if {[tk windowingsystem] == "x11"} { + ttk::style theme use "clam" +} + +pack [ttk::frame .toolbar] -side top -pady 4 + +ttk::frame .status +ttk::label .status.line -relief sunken -textvar status +ttk::sizegrip .status.grip + +pack .status -side bottom -fill x -pady 4 +pack .status.line -side left -fill x -expand 1 +pack .status.grip -side right -anchor s + +text .editor -width 80 -height 24 -wrap "word" -undo 1 +font_size::reset .editor +tk_util::pack_scrolled .editor + +ttk::button .toolbar.new -text "New" -width 8 -under 0 -command do_new +ttk::button .toolbar.bOpen -text "Open" -width 8 -under 0 -command do_open +ttk::button .toolbar.save -text "Save" -width 8 -under 0 -command do_save + +ttk::separator .toolbar.sep1 -orient vertical + +ttk::button .toolbar.reload -text "Reload" -width 8 -under 0 -command do_reload +ttk::button .toolbar.stats -text "Stats" -width 8 -under 1 -command show_stats + +ttk::separator .toolbar.sep2 -orient vertical + +ttk::button .toolbar.find -text "Find" -width 8 -under 0 -command do_find +ttk::button .toolbar.again -text "Again" -width 8 -under 1 -command find_again + +pack .toolbar.new -side left +pack .toolbar.bOpen -side left +pack .toolbar.save -side left + +pack .toolbar.sep1 -side left -padx 4 -pady 4 -fill y + +pack .toolbar.reload -side left +pack .toolbar.stats -side left + +pack .toolbar.sep2 -side left -padx 4 -pady 4 -fill y + +pack .toolbar.find -side left +pack .toolbar.again -side left + +. configure -menu [menu .menubar] + +set m [menu .menubar.mFile] +$m add command -label "New" -command do_new -under 0 -accel "Ctrl-N" +$m add command -label "Open..." -command do_open -under 0 -accel "Ctrl-O" +$m add command -label "Save" -command do_save -under 0 -accel "Ctrl-S" +$m add separator +$m add command -label "Save as..." -command do_save_as -under 5 +$m add command -label "Reload" -command do_reload -under 0 -accel "Ctrl-R" +$m add command -label "Statistics" -command show_stats -under 1 -accel "Ctrl-T" +$m add separator +$m add command -label "Quit" -command do_quit -under 0 -accel "Ctrl-Q" +.menubar add cascade -menu .menubar.mFile -label "File" -underline 0 + +set m [menu .menubar.edit] +$m add command -label "Undo" -command {.editor edit undo} \ + -underline 0 -accelerator "Ctrl-Z" +$m add command -label "Redo" -command {.editor edit redo} \ + -underline 0 -accelerator "Ctrl-Y" +$m add separator +$m add command -label "Cut" -command {tk_textCut .editor} \ + -underline 0 -accelerator "Ctrl-X" +$m add command -label "Copy" -command {tk_textCopy .editor} \ + -underline 1 -accelerator "Ctrl-C" +$m add command -label "Paste" -command {tk_util::paste_content .editor} \ + -underline 0 -accelerator "Ctrl-V" +$m add separator +$m add command -label "Select all" -under 7 -accel "Ctrl-A" \ + -command {tk_util::select_all .editor; break} +$m add command -label "Find..." -command do_find -under 0 -accel "Ctrl-F" +$m add command -label "Again" -command find_again -under 1 -accel "Ctrl-G" +.menubar add cascade -menu .menubar.edit -label "Edit" -underline 0 + +set m [menu .menubar.mFormat] +$m add command -label "Join lines" -command join_lines -under 0 -accel "Alt-J" +$m add command -label "Open line" -under 0 -accel "Alt-O" \ + -command {tk_util::open_line .editor} +$m add separator +$m add command -label "Lower case" -command lower_case -under 0 -accel "Alt-L" +$m add command -label "Title case" -command title_case -under 1 -accel "Alt-T" +$m add command -label "Upper case" -command upper_case -under 0 -accel "Alt-U" +$m add separator +$m add command -label "Prefix lines..." -command prefix_lines \ + -under 0 -accel "Alt-P" +.menubar add cascade -menu .menubar.mFormat -label "Format" -underline 3 + +set m [menu .menubar.view] +$m add checkbutton -label "Word wrap" -under 0 -var _word_wrap \ + -command {tk_util::word_wrap .editor} +$m add separator +$m add command -label "Bigger font" -under 0 -accel "Ctrl +" \ + -command {font_size incr .editor} +$m add command -label "Smaller font" -under 0 -accel "Ctrl -" \ + -command {font_size decr .editor} +$m add command -label "Reset font" -under 0 -accel "Ctrl-0" \ + -command {font_size reset .editor} +$m add separator +if {[llength [info commands "console"]] > 0} { + $m add command -label "Console" -command {console show} \ + -underline 5 -accelerator "Ctrl-L" +} +$m add checkbutton -label "Full screen" -command {tk_util::full_screen .} \ + -underline 10 -accelerator "F11" -var _full_screen +.menubar add cascade -menu .menubar.view -label "View" -underline 0 + +set m [menu .menubar.help] +$m add command -label "About" -command {alert $about_text} -under 0 +$m add command -label "Credits" -command {alert $credits_text} -under 0 +$m add command -label "Website" -command {open_in_app $site_link} -under 0 +.menubar add cascade -menu .menubar.help -label "Help" -underline 0 + +wm protocol . WM_DELETE_WINDOW do_quit +bind .editor <> show_modified + +bind . do_new +bind . do_open +bind . do_save +bind . do_reload +bind . show_stats +bind . do_quit + +bind . do_new +bind . do_open +bind . do_save +bind . do_reload +bind . show_stats +bind . do_quit + +# Undo, cut and copy are already bound to their usual keys by default. +# Many bindings here have to override broken defaults. + +bind .editor {.editor edit redo} +bind .editor {tk_util::paste_content .editor; break} +bind .editor {tk_util::select_all .editor; break} +bind . do_find +bind . find_again + +bind .editor {.editor edit redo} +bind .editor {tk_util::paste_content .editor; break} +bind .editor {tk_util::select_all .editor; break} +bind . do_find +bind . find_again + +bind Text {} +bind .editor join_lines +bind .editor {tk_util::open_line .editor; break} +bind .editor {lower_case; break} +bind .editor {title_case; break} +bind .editor upper_case +bind .editor prefix_lines + +bind . {font_size::increase .editor} +bind . {font_size::decrease .editor} +bind . {font_size::reset .editor} + +bind . {font_size::increase .editor} +bind . {font_size::decrease .editor} +bind . {font_size::reset .editor} + +bind . {tk_util::full_screen .} + +if {[llength [info commands "console"]] > 0} { + bind . {console show} + bind . {console show} +} + +proc show_modified {} { + global status + if {[.editor edit modified]} { + set status "(modified)" + } +} + +proc do_new {} { + global status file_name + + if {[.editor edit modified]} { + set answer [tk_messageBox -parent . \ + -type "yesno" -icon "question" \ + -title "ToyEd" \ + -message "New file?" \ + -detail "File is unsaved.\nStart another?"] + if {!$answer} { + set status "New file canceled." + return + } + } + wm title . "ToyEd" + set file_name "" + .editor delete "1.0" "end" + .editor edit reset + .editor edit modified 0 + set status [clock format [clock seconds]] +} + +proc do_open {} { + global status file_types file_name + + if {[.editor edit modified]} { + set answer [tk_messageBox -parent . \ + -type "yesno" -icon "question" \ + -title "ToyEd" \ + -message "Open another file?" \ + -detail "File is unsaved.\nOpen another?"] + if {!$answer} { + set status "Opening canceled." + return + } + } + set choice [tk_getOpenFile -parent . \ + -title "Open existing file" \ + -initialdir [file_dir $file_name] \ + -filetypes $file_types] + if {[string length $choice] == 0} { + set status "Opening canceled." + } elseif {![file isfile $choice]} { + tk_messageBox -parent . \ + -type "ok" -icon "error" \ + -title "ToyEd" \ + -message "Error opening file" \ + -detail "File not found: $choice" + } elseif {[load_file $choice]} { + set file_name $choice + } +} + +proc load_file full_path { + global status + + set fn [file tail $full_path] + try { + set f [open $full_path] + tk_util::load_text .editor [read $f] + set status "Opened $fn" + wm title . "$fn | ToyEd" + return 1 + } on error e { + tk_messageBox -parent . \ + -type "ok" -icon "error" \ + -title "ToyEd" \ + -message "Error opening file" \ + -detail $e + return 0 + } finally { + close $f + } +} + +proc file_dir name { + if {$name ne ""} { + return [file dirname $name] + } else { + return [pwd] + } +} + +proc do_save {} { + global file_name + if {$file_name eq ""} { + do_save_as + } else { + save_file $file_name + } +} + +proc do_save_as {} { + global file_name file_types status + + set choice [tk_getSaveFile -parent . \ + -title "Save file as..." \ + -initialdir [file_dir $file_name] \ + -filetypes $file_types] + if {[string length $choice] == 0} { + set status "Save canceled." + } elseif {[save_file $choice]} { + set file_name $choice + } +} + +proc save_file full_path { + global status + + set fn [file tail $full_path] + set data [.editor get "1.0" "end"] + set data [string trimright $data "\n"] + try { + set f [open $full_path "w"] + puts -nonewline $f "$data\n" + flush $f + set status "Saved $fn" + wm title . "$fn | ToyEd" + return 1 + } on error e { + tk_messageBox -parent . \ + -type "ok" -icon "error" \ + -title "ToyEd" \ + -message "Error saving file" \ + -detail $e + return 0 + } finally { + close $f + } +} + +proc do_reload {} { + global file_name status + if {$file_name eq ""} { + tk_messageBox -parent . \ + -type "ok" -icon "warning" \ + -title "ToyEd" \ + -message "Can't reload." \ + -detail "The file was never saved." + } else { + set answer [tk_messageBox -parent . \ + -type "yesno" -icon "question" \ + -title "ToyEd" \ + -message "Reload file?" \ + -detail "Reload last save?"] + if {$answer eq "yes"} { + load_file $file_name + } else { + set status "Reloading canceled." + } + } +} + +proc show_stats {} { + set data [tk_util::text_selection .editor] + if {$data eq ""} { + set data [.editor get "1.0" "end"] + set msg "File statistics" + } else { + set msg "Selection stats" + } + set clean [string trimright $data "\n"] + set lines [llength [split $clean "\n"]] + set words [regexp -all {\S+} $data] + set chars [string length $data] + set stats "Lines: $lines\nWords: $words\nCharacters: $chars" + tk_messageBox -parent . \ + -type "ok" -icon "info" -title "ToyEd" \ + -message $msg -detail $stats +} + +proc do_quit {} { + if {[.editor edit modified]} { + set answer [tk_messageBox -parent . \ + -type "yesno" -icon "question" \ + -title "ToyEd" \ + -message "Quit ToyEd?" \ + -detail "File is unsaved.\nQuit anyway?"] + } else { + set answer "yes" + } + if {$answer eq "yes"} { + destroy . + } +} + +proc do_find {} { + global search_term status + set term [tk_util::text_selection .editor] + set ret [tk_getString .gs answer "Search pattern:" \ + -title "Find" -entryoptions "-textvar search_term"] + if {!$ret} { + set status "Search canceled." + return + } + set search_term $answer; # Possibly redundant + step_search +} + +proc find_again {} { + global search_term status + if {$search_term eq ""} { + do_find + } else { + step_search + } +} + +proc step_search {} { + global search_term status + set res [tk_util::highlight_text .editor $search_term "insert"] + if {$res eq ""} { + set search_term "" + set status "Nothing found." + } +} + +proc join_lines {} { + global status + set t [tk_util::text_selection .editor] + if {[string length $t] > 0} { + set t [string map {"\n" " "} $t] + .editor replace sel.first sel.last $t + } else { + set status "Nothing selected." + } +} + +proc lower_case {} { + global status + set t [tk_util::text_selection .editor] + if {[string length $t] > 0} { + .editor replace sel.first sel.last [string tolower $t] + } else { + set status "Nothing selected." + } +} + +proc title_case {} { + global status + set sel [tk_util::text_selection .editor] + if {[string length $sel] > 0} { + .editor replace sel.first sel.last [string totitle $sel] + } else { + set status "Nothing selected." + } +} + +proc upper_case {} { + global status + set sel [tk_util::text_selection .editor] + if {[string length $sel] > 0} { + .editor replace sel.first sel.last [string toupper $sel] + } else { + set status "Nothing selected." + } +} + +proc prefix_lines {} { + global status + set sel [tk_util::text_selection .editor] + if {$sel eq ""} { + set status "Nothing selected." + return + } + set ret [tk_getString .gs answer "Prefix selected lines with:"] + if {!$ret} { + set status "Search canceled." + return + } + set lines [split $sel "\n"] + set result [list] + foreach l $lines { + lappend result $answer$l + } + .editor replace sel.first sel.last [join $result "\n"] +} + +proc alert message { + tk_messageBox -parent . \ + -type "ok" -icon "info" \ + -title "ToyEd" \ + -message $message +} + +proc open_in_app link { + global status + if {[auto_execok "xdg-open"] ne ""} { + catch {exec "xdg-open" $link &} + } elseif {[auto_execok "open"] ne ""} { + catch {exec "open" $link &} + } elseif {[auto_execok "start"] ne ""} { + catch {exec "start" $link &} + } else { + set status "Can't open website." + } +} + +set status [clock format [clock seconds]] + +if {[llength $argv] > 0} { + set fn [lindex $argv 0] + if {![file exists $fn]} { + set file_name [file normalize $fn] + set fn [file tail $file_name] + wm title . "$fn | ToyEd" + } elseif {[load_file $fn]} { + set file_name [file normalize $fn] + } +}