Posted to tcl by iobates at Thu Aug 20 12:52:55 GMT 2026view pretty

#!/usr/bin/env tclsh

package require Tk
package require sqlite3

sqlite3 db /home/devuan/db/zote.db

db eval {CREATE TABLE IF NOT EXISTS zotes(note_title text, note_id integer, note_content_part integer, content text)}
db eval {CREATE TABLE IF NOT EXISTS links(prim integer, second integer)}  

proc every {ms cmd} {
        {*}$cmd
        after $ms [list after idle [namespace code [info level 0]]]
}

wm title . "Zote"
set frm [ttk::frame .f -padding "2 2 5 5"]
grid $frm -column 0 -row 0 -sticky nsew
set quit [ttk::button .f.qbtn -width 1 -text "X" -command {exit}]
grid $quit -column 2 -row 1 -sticky ns
set lbl [ttk::label .f.lbl -text "Welcome to Zotes"]
grid $lbl -column 1 -row 1 -sticky ns

set txtfield [text .f.cnvs]
grid $txtfield -column 1 -row 3 -sticky ns

set get [ttk::button .f.gbtn -text "Save Text" -command {save}]
grid $get -column 1 -row 4 -sticky ns

set charlbl [ttk::label .f.chlbl -textvariable chars]
grid $charlbl -column 2 -row 5 -sticky ns

set titlelbl [ttk::entry .f.tintry -textvariable title]
grid $titlelbl -column 1 -row 2 -sticky ns

proc save {} {
    set txt ""
    puts $::title
    set txt [$::txtfield get 1.0 end]
    puts [tags]
}

proc tags {} {
    set start [$::txtfield search -regexp -all {!} 0.0]
    global name
    puts [llength $start]
    for {set i 0} {$i < [llength $start]} {incr i} {
	set end [regexp {!([a-zA-Z]+)} [$::txtfield get [lindex $start $i] end] m word]
	set length [string length $word]
	set name $word
	set end_pos [expr [lindex $start $i] + 0.$length + 0.1]
	$::txtfield tag add link$word [lindex $start $i] $end_pos
	$::txtfield tag bind link$word <1> {set name [$::txtfield tag cget link$name get] puts $name}
    }
}



proc characters {} {
    set words [$::txtfield get 0.0 end]
    set ::chars [expr [string length $words] - 1]
}

every 100 characters

Comments

Posted by schelte at Thu Aug 20 13:15:32 GMT 2026 [text] [code]

Change line 53 to: $::txtfield tag bind link$word <1> [list printlink %W link$name] Then create a proc printlink {t link} {puts [$t tag cget $link get]}