# mkbook5 -
# create a book with index window on the left, the links of which
# choose chapters to view in the book window on the right,
# first this file is sourced in to setup the frames to view the book in
# then the tcl-tagged content of the book and its index is inserted
#---------------------------------------------------------------------------
# set up frames and text widgets
set thefont [font create -family Times -size 12]
option add *Text.selectBackground yellow
option add *Text.selectForeground black
#----------------------------------------------------------------------
# make a menu bar:
frame .mbar -borderwidth 1 -relief raised
pack .mbar -fill x
menubutton .mbar.books -text "Books" -menu .mbar.books.m
pack .mbar.books -side left
menu .mbar.books.m
.mbar.books.m add command -label "Vintage Balzac" -command {source book5.txt}
.mbar.books.m add command -label "Exit" -command exit
menubutton .mbar.bookmarks -text "Notes" -menu .mbar.bookmarks.m
pack .mbar.bookmarks -side left
menu .mbar.bookmarks.m
.mbar.bookmarks.m add command -label "Review Notes" \
-command {review_notes}
.mbar.bookmarks.m add command -label "Take Notes" \
-command {take_notes 0 0}
menubutton .mbar.help -text "Help" -menu .mbar.help.m
pack .mbar.help -side right
menu .mbar.help.m
.mbar.help.m add command -label "About" -command {
tk_messageBox -default ok -icon info -message \
"The Cauldron Notetaker" \
-parent . -title "About Cauldron" -type ok
}
#---------------------------------------------------------------------------
# setup book and index frames
frame .book
pack .book -side right -fill both -expand true
set t [text .book.t -font $thefont -wrap word -width 60 -height 25\
-setgrid true -yscrollcommand ".book.sy set"]
scrollbar .book.sy -orient vert -command ".book.t yview"
pack .book.sy -side right -fill y
pack .book.t -side left -fill both -expand true
frame .index
pack .index -side left
text .index.t -font $thefont -wrap word -width 25 -height 25\
-setgrid true -yscrollcommand ".index.sy set"
scrollbar .index.sy -orient vert -command ".index.t yview"
pack .index.sy -side right -fill y
pack .index.t -side left
#--------------------------------------------------------------------------------
# utilities for notes:
proc note {title keywords notes paragraph_tag selection context} {
global note
set note($title) [list $keywords $notes $paragraph_tag $selection $context]
}
proc open_notes {notefilename} {
global note
if {[array exists note]} {
unset note
}
array set note {}
set notefile [open $notefilename r]
set contents [read -nonewline $notefile]
eval "$contents"
close $notefile
}
#------------------------------------------------------------------------
# widget for reviewing notes:
proc highlight_selection {title keywords notes paragraph_tag selection context} {
global tclbook_directory
# typical paragraph tag: p_file_1
set whole ""
set file ""
regexp {p_(.*?)_\d+} $paragraph_tag whole file
append file ".txt"
show_file .book.t $file
.book.t tag delete sel2
# get start position for text widget search
set range [.book.t tag ranges $paragraph_tag]
if {[llength $range] == 0} {
puts "ERROR: Paragraph tag not found in file: $paragraph_tag"
return
}
set paragraph_start [lindex $range 0]
# create a regex pattern from the selection text
set pattern [string trim $selection]
regsub -all {[ ]+} $pattern { } pattern
regsub -all " " $pattern "\\s+" pattern
set start [.book.t search -count cnt -nocase -regexp -- $pattern $paragraph_start end]
if {$cnt != 0} {
.book.t see $paragraph_start
.book.t tag add sel2 $start "$start +$cnt chars"
.book.t tag configure sel2 -background yellow
}
# tag the selection text for the note and make the text background yellow,
# make this highlighting persist while the pop-up notetaking widget
# has focus
}
proc BindYview { lists args } {
foreach l $lists {
eval {$l yview} $args
}
}
# use the title selected in the listbox to read notes into text box
proc get_notes {} {
global note
.review.cmd delete 1.0 end
foreach i [.review.key curselection] {
set title [.review.key get $i]
set info $note($title)
set notes [lindex $info 1]
regsub -all {\n\n} $notes {@} notes
regsub -all {\n} $notes {} notes
regsub -all {@} $notes "\n\n" notes
#puts "title: $title\n"
#puts "note(title): $note($title)\n"
#puts "notes: $notes\n"
.review.cmd insert end $notes
# highlight selection in yellow
set keywords [lindex $info 0]
set paragraph_id [lindex $info 2]
set selection [lindex $info 3]
set context [lindex $info 4]
highlight_selection $title $keywords $notes $paragraph_id $selection $context
}
}
# create a widget for reading and reviewing notes
proc review_notes {} {
global note
# Set a class used for resource specifications
toplevel .review -class Review
wm title .review "Review Notes"
# Default relief
option add *Review*Entry.relief sunken startup
option add *Review*Listbox.relief sunken startup
# Default Listbox sizes
option add *Review*key.width 30 startup
option add *Review*cmd.width 40 startup
option add *Review*Listbox.height 5 startup
# A listbox index of titles with scrollbar and
# a text widget with notes selected by a title
scrollbar .review.s -orient vertical \
-command [list BindYview [list .review.key .review.cmd]]
listbox .review.key \
-yscrollcommand [list .review.s set] \
-exportselection false
#-width 30
text .review.cmd -wrap word
#-width 40
#-yscrollcommand [list .review.s set]
pack .review.s -side left -fill y
pack .review.key .review.cmd -side left \
-fill both -expand true
# Initialize the listbox index
.review.key delete 0 end
set keys [array names note]
foreach key $keys {
.review.key insert end $key
}
# initialize the text widget with notes
set first [.review.key get 0]
set notes [lindex $note($first) 1]
regsub -all {\n\n} $notes {@} notes
regsub -all {\n} $notes {} notes
regsub -all {@} $notes "\n\n" notes
.review.cmd insert end $notes
# selecting in titles results, uses title as a key into the array to get a value
# this value is inserted into the text widget
bind .review.key {get_notes}
bind .review {.book.t tag delete sel2}
}
#--------------------------------------------------------------------------------
# setup popup notetaking menu:
proc get_enclosing_paragraph {mark} {
set tags [.book.t tag names $mark]
set index [lsearch -regexp $tags "p_"]
set item [lindex $tags $index]
if {$item == -1} {
return ""
} else {
return $item
}
}
proc write_notes {} {
global notefilename
# extract the notes the user just entered
set title [.n.meta.title get]
set keywords [.n.meta.keywords get]
set notes [.n.notes.text get 1.0 end]
# test for selection
set selection ""
set mark "1.0"
if {[llength [.book.t tag ranges sel]] == 0} {
set mark [.book.t index "insert"]
set selection ""
} else {
set mark [.book.t index sel.first]
set selection [.book.t get sel.first sel.last]
}
set paragraph_tag [get_enclosing_paragraph $mark]
set context [.book.t get "$mark linestart" "$mark lineend"]
# open notes file in append mode
set notefile [open $notefilename a]
# add note to array holding notes
note $title $keywords $notes $paragraph_tag $selection $context
# append notes to notes file
puts $notefile "\nnote {$title} \\"
puts $notefile "{$keywords} \\"
puts $notefile "{$notes} \\"
puts $notefile "{$paragraph_tag} \\"
puts $notefile "{$selection} \\"
puts $notefile "{$context}"
close $notefile
destroy .n
}
proc take_notes {x y} {
toplevel .n
wm geometry .n "300x200+$x+$y"
wm title .n "Notes"
wm group .n .
frame .n.meta
label .n.meta.ltitle -text "Title:"
entry .n.meta.title
label .n.meta.lkeywords -text "Keywords:"
entry .n.meta.keywords
button .n.meta.finished -text "Write" -command write_notes
grid .n.meta.ltitle -row 0 -column 0 -sticky e
grid .n.meta.title -row 0 -column 1 -sticky ew
grid .n.meta.finished -row 0 -column 2 -rowspan 3 -sticky nsew
grid .n.meta.lkeywords -row 2 -column 0 -sticky e
grid .n.meta.keywords -row 2 -column 1 -sticky ew
grid columnconfigure .n.meta 1 -weight 1
frame .n.notes
scrollbar .n.notes.sbar -command { .n.notes.text yview}
text .n.notes.text -yscrollcommand { .n.notes.sbar set}
pack .n.notes.sbar -side right -fill y
pack .n.notes.text -side left -expand yes -fill both
pack .n.meta -fill x -padx 4 -pady 4
pack .n.notes -expand yes -fill both -padx 4 -pady 4
bind .n.meta.title {focus .n.meta.keywords}
bind .n.meta.keywords {focus .n.notes.text}
bind .n.meta.title {focus .n.meta.keywords}
bind .n.meta.keywords {focus .n.notes.text}
}
# activates pop-up note-taking widget
bind .book.t {
take_notes %X %Y
}
# the following two bindings tag the selected text and make the background yellow
# so that this highlighting will persist while the pop-up notetaking widget
# has focus:
bind .book.t {
if {[lsearch -exact [.book.t tag names] {sel2}] != -1} {
.book.t tag delete sel2
}
}
bind .book.t {
if {[llength [.book.t tag ranges sel]] > 0} {
.book.t tag add sel2 sel.first sel.last
.book.t tag configure sel2 -background yellow
}
}
#--------------------------------------------------------------------------------
# read a plain text file of paragraphs into a text widget
# skip blank lines until first non-blank
#
# initialize accumulated lines with empty list
# read lines until end-of-file
# if blank-line
# if number of accumulated lines > 0
# format accumulated lines into paragraph
# write out paragraph
# initialize accumulated lines with empty list
# else
# add line to accumulated lines
proc write_paragraph {widget para_name para_id} {
upvar $para_name para
set para [join $para " "]
# (note: the following line causes weird scrolling behavior, workaround?)
append para "\n\n"
set para_insert ""
append para_insert $widget " insert end {" $para "} {" $para_id "}"
#puts "para_insert: $para_insert\n"
eval "$para_insert"
}
proc show_file {widget bookname} {
set whole ""
set prefix ""
regexp {(.+?)\..+?} $bookname whole prefix
set bookfile [open $bookname r]
$widget configure -wrap word
$widget delete 1.0 end
set acum {}
set i 0
foreach line [split [read $bookfile] \n] {
set trimmed [string trim $line]
if {[string length $trimmed] > 0} {
#puts "non-blank line"
lappend acum $trimmed
} else {
#puts "blank line"
if {[llength $acum] > 0} {
incr i
set para_id [join [list p_ $prefix _ $i] ""]
puts "para_id: $para_id\n"
write_paragraph $widget acum $para_id
}
set acum {}
}
}
close $bookfile
}
#--------------------------------------------------------------------------------
# setup commands for reading text into widgets:
bind .index.t break
.book.t tag configure "heading" -spacing1 0.1i -spacing3 5 \
-font -*-helvetica-bold-r-normal--*-120-*
.index.t tag configure "heading" -spacing1 0.1i -spacing3 5 \
-font -*-helvetica-bold-r-normal--*-120-*
.book.t tag configure "body" -lmargin1 0.2i
proc heading {widget mesg} {
$widget insert end $mesg heading
}
proc body {widget mesg} {
$widget insert end $mesg body
}
set linkNum 0
proc link {widget mesg linkCode} {
global linkNum
set tag "link[incr linkNum]"
$widget insert end $mesg [list body $tag]
$widget tag configure $tag -foreground red -underline 1
$widget tag bind $tag \
"$widget tag configure $tag -foreground blue"
$widget tag bind $tag \
"$widget tag configure $tag -foreground red"
$widget tag bind $tag \
"$linkCode"
}
(
geocities.com/soho/square) (
geocities.com/soho)