#!/usr/bin/wish

## PARAMETERS
## ----------


set BOOK_FILE        "~/.books"
set ORGANIZER_GIFS   "~/data/organizer"
set EDITOR_FONTS { 
        {"Courier S"  "courier 10 roman"}
        {"Courier M"  "courier 14 roman"}
        {"Courier L"  "courier 18 roman"}
        {"Arial S"  "arial 10 roman"}
        {"Arial M"  "arial 14 roman"}
        {"Arial L"  "arial 18 roman"}
        {"Times S"  "times 10 roman"}
        {"Times M"  "times 14 roman"}
        {"Times L"  "times 18 roman"}
        {"Misc Small" "-misc-fixed-*-*-*-*-14-*-*-*-*-*-*-*"}
        {"Misc Medium" "-misc-fixed-*-*-*-*-16-*-*-*-*-*-*-*"}
        {"Misc Large" "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"}
        {"Adobe Small" "-adobe-*-*-r-*-*-14-*-*-*-*-*-*-*"}
        {"Adobe Medium" "-adobe-*-*-r-*-*-16-*-*-*-*-*-*-*"}
        {"Adobe Large" "-adobe-*-*-r-*-*-20-*-*-*-*-*-*-*"}
		{"Schumacher" "-schumacher-clean-bold-r-normal--15-150-75-75-c-90-iso8859-1"}
  }		
set EDITOR_FONT "times 14 roman"

## --------------------------------------------------------------------------


# ROTINAS
# ---------------------------------------------

# varias
# -----------

set spaces_str "                           "

proc spaces n {
 global spaces_str 
 return [string range $spaces_str 1 $n]
}

# Imagens
# -----------

set img(0) " "
set img_dir " "

proc load_images lst {
  global img img_dir
  foreach l $lst {
     image create photo img([lindex $l 0]) -file $img_dir/[lindex $l 1]
  }
}

# Janela de Input
# ---------------

set input_data ""

proc {InputButton} {cancel} {
 global input_data
 
 if {$cancel} {  
    set input_data "" 
 } else {  
    set input_data [.in.f.e get] 
 }
}

proc GetInputData msg  {
   global input_data 
   
   toplevel .in
   wm title .in "Input"
   frame .in.f    -height 68 -width 150
   label .in.f.l  -borderwidth 1 -text $msg
   entry .in.f.e  -background #aedede 
   button .in.ok_but   -padx 9 -pady 3 -text OK \
     -command {set input_data [.in.f.e get]; destroy .in}
   button .in.canc_but -padx 9 -pady 3 -text Cancel \
     -command {set input_data ""; destroy .in}
   bind   .in.f.e  <Return> {set input_data [.in.f.e get]; destroy .in}
   bind   .in.f.e  <Escape> {set input_data ""; destroy .in}

   pack .in.f   -fill both -ipadx 10 -ipady 10
   pack .in.f.l -side left -padx 5
   pack .in.f.e -side left -fill x -expand 1 -padx 5
   pack .in.ok_but -side right -padx 5
   pack .in.canc_but -side right -padx 5

   focus .in.f.e
   wm deiconify .in
   tkwait visibility .in
   grab set .in
   tkwait window .in
}

 
# TOOLBAR
# ----------- 

proc toolbar {name lst} {
  global img
  frame $name
  set n 0
  foreach l $lst {
    set t [lindex $l 0]
	switch $t {
	  i {button $name.$n -image img([lindex $l 1]) -command [lindex $l 2]}
	  m {menubutton $name.$n -image img([lindex $l 1]) \
	     -menu $name.$n.[lindex $l 2] }
    }
	pack $name.$n -side left
    incr n
  }
  pack $name
}


# MAKE_MENU
# ---------------

proc make_menu {name lst tearoff} {
  menu $name -tearoff $tearoff
  foreach l $lst {
    set t [lindex $l 0]
	switch $t {
	  s {$name add separator} 
	  i {$name add command -label [lindex $l 1] -command [lindex $l 2]}
	  m {$name add cascade -menu $name.[lindex $l 2] -label [lindex $l 1]}
    }
  }	 
}     
	 
	 
##
## RUIED - EDITOR
## --------------

global red_b        # base widget
global red_file     # file in editor
global red_modified # 1 if mofidied
global red_writable # 1 if file is writable
global red_error    # Error message. = "" if ok

set red_fonts $EDITOR_FONTS
set red_font  $EDITOR_FONT

proc red_chg_fnt n {
  global red_fonts red_b
  $red_b.f.t configure -font [lindex [lindex $red_fonts $n] 1]
}

proc red_create data {
  global red_b red_file red_modified red_fonts red_writable red_font
  
  set red_b $data
  toplevel $red_b
  frame $red_b.mbar
  menubutton $red_b.mbar.mb -text Fonts -menu $red_b.mbar.mb.m -indicatoron true
  label $red_b.mbar.l
  button $red_b.mbar.b1 -text "Reload File" -command "red_reload"
  button $red_b.mbar.b2 -text "Save" -command "red_save"

  menu $red_b.mbar.mb.m
  set n 0
  foreach l $red_fonts {
    $red_b.mbar.mb.m add command -label [lindex $l 0]  \
	  -command "red_chg_fnt $n"
	incr n  
  }	

  frame $red_b.f -relief sunken
  scrollbar $red_b.f.xsb \
    -borderwidth 1 -command "$red_b.f.t xview" -orient horiz \
    -width 10 
  scrollbar $red_b.f.ysb \
    -borderwidth 1 -command "$red_b.f.t yview" -orient vert \
	-width 10
  text  $red_b.f.t \
    -font $red_font -height 25 -width 80 -wrap none \
    -xscrollcommand "$red_b.f.xsb set" \
    -yscrollcommand "$red_b.f.ysb set" 

  pack $red_b.mbar -side top -fill x
  pack $red_b.mbar.mb \
       $red_b.mbar.b1 \
       $red_b.mbar.b2 \
	   $red_b.mbar.l  -side left

    
  pack $red_b.f -expand 1 -fill both
  pack $red_b.f.xsb -side bottom -fill x
  pack $red_b.f.ysb -side right -fill y
  pack $red_b.f.t -expand 1 -fill both

  set red_writable 0	
  set red_file ""
  set red_modified 0
  red_state E
}         


proc red_open fname {
  global red_b red_file red_modified
  global red_error red_writable
  
  # Verificar se ficheiro existe
  if ![file exists $fname] {
     set red_error "file no found"
	 return 1
  }

  
  # Ler o ficheiro
  set red_writable 1
  $red_b.f.t delete 1.0 end

  set tmp [open $fname r]
  $red_b.f.t insert end [read $tmp]
  $red_b.f.t delete {end - 1 lines} end 
  close $tmp
  set red_file $fname
  set red_modified 0
  	 
  # Verificar se e WRITABLE e tomar accoes conforme
  set red_writable [file writable $fname]
  if $red_writable { 
    red_state O
    $red_b.mbar.b1 configure -state normal
    $red_b.mbar.b2 configure -state normal
  } else {
    red_state R
    $red_b.mbar.b1 configure -state disabled
    $red_b.mbar.b2 configure -state disabled
  }
}


proc red_reload {} {
  global red_file
  red_open $red_file
}
  

proc red_save {} {
  global red_b red_modified red_file red_writable
  
  # Chech if save can be done
  if { $red_file == "" || !$red_modified || !$red_writable } return
	   
  # Save it
  set page_file [open $red_file w]
  puts -nonewline $page_file [$red_b.f.t get 1.0 end]
  close $page_file
  set red_modified 0
  red_state S
}


proc red_state n {
  global red_b
  
  switch $n {
    E {$red_b.mbar.l configure -text "Empty" -foreground #DD0050 }
    O {$red_b.mbar.l configure -text "File on Disk" -foreground #0600AA }
    R {$red_b.mbar.l configure -text "Read Only" -foreground #FF0000 }
    S {$red_b.mbar.l configure -text "Just Saved" -foreground #0000FA }
    M {$red_b.mbar.l configure -text "< Modified >" -foreground #FF0509 }
  }	
}   

proc red_title data {
  global red_b
  wm title $red_b $data
}


##### MAIN

proc ruied {cmd data} {
 switch $cmd {
   create  { red_create $data }
   open    { red_open $data }
   save    { red_save }
   title   { red_title $data }
  } 
}	 
	 
	 
	 
	 
	 
	 
	 
	 
	 
	 


## Variaveis Globais

set book_lst {}
set book_cnt 0
set book_fg  0 
set book_tit ""
set book_dir ""
set book_sec ""
set book_pag ""

## Modulos

proc OpenBook no {
  global book_lst book_tit book_dir book_sec book_pag book_fg
  incr no -1

  set e [lindex $book_lst $no]
  set book_tit [lindex $e 0]
  set book_dir [lindex $e 1]
  set book_sec ""
  set book_pag ""
  wm title . $book_tit
  OpenSection
  set book_fg 1
}
 
#------------------------------------------------

proc ReadBookList {} {
 global book_lst book_cnt BOOK_FILE mnu_b
 
 set fid [open $BOOK_FILE r]
 set books_cnt 0
 set l [gets $fid]
 while {! [eof $fid]} {
   if {$l == "-"} {
      set entry [list s]
   } else {
      incr book_cnt
      set x [split $l =]
	  set y [list [lindex $x 0] [lindex $x 1]]
	  lappend book_lst $y
      set entry [list i [lindex $x 0]  "OpenBook $book_cnt"]
   }
   set mnu_b [linsert $mnu_b end $entry]
   set l [gets $fid]
 }
}
 
#------------------------------------------------

proc EditBookList {} {
  global BOOK_FILE
  
  ruied open $BOOK_FILE
  ruied title "Book List"
}

#------------------------------------------------

proc ReloadBookList {} {
  global book_lst book_cnt mnu_b
  
  set book_lst {}
  set book_cnt 0
  set mnu_b {}  
  ReadBookList
  destroy .bar1.0.mnu_b
  make_menu .bar1.0.mnu_b $mnu_b 1
}

#------------------------------------------------

proc gen_filename {} {
  global book_dir book_sec book_pag
  return $book_dir$book_sec$book_pag
}  

#------------------------------------------------

proc PreOpenPage {w y} {
  global book_sec book_pag book_fg

  if !$book_fg return
  set i [$w nearest $y]
  if {$i == -1} return
  $w activate $i
  set book_pag /[$w get active]
  ruied save if_changed
  ruied open [gen_filename]
  ruied title [string trimleft $book_pag /]
}

#------------------------------------------------

proc PreOpenSection {w y} {
  global book_sec book_fg

  if !$book_fg return
  set i [$w nearest $y]
  if {$i == -1} return
  $w activate $i
  set tmp [$w get active]
  set book_sec "$book_sec/$tmp"
  OpenSection
}

#------------------------------------------------

proc OpenSection {} {
  global book_dir book_sec
  global sec pag

  $sec.lb delete 0 end
  $pag.lb delete 0 end

  ## search for files
  set file_list [glob -nocomplain "$book_dir$book_sec/*"]
  set file_list [lsort -ascii $file_list]
  set no_files  [llength $file_list]

  for {set n 0} {$n < $no_files} {incr n} {
    set tmp [lindex $file_list $n]
    if [file isdirectory $tmp] {
	  $sec.lb insert end [file tail $tmp]
	} else { 
	  $pag.lb insert end [file tail $tmp]
	} 
  }

  set n 0
  set lab ""
  set l [split $book_sec /]
  foreach e $l {
    if {$l != ""} {set lab "$lab\n[spaces $n]$e"}
	incr n
	incr n
  }
  set lab [string trimleft $lab "\n"]
  .pos.l configure -text $lab
}

#------------------------------------------------

proc Index {} {
  global book_sec book_fg
  
  if !$book_fg return
  set book_sec ""
  OpenSection
}

#------------------------------------------------

proc Up {} {
  global book_sec book_fg
  
  if !$book_fg return
  
  if {$book_sec == ""} return
  set tmp [file split $book_sec]
  set sz [llength $tmp]
  set sz [expr $sz - 1]
  set book_sec ""
  for {set n 1} {$n < $sz} {incr n} {
    set book_sec $book_sec/[lindex $tmp $n]
  }
  OpenSection
}

#------------------------------------------------

proc Hide {} {
 wm iconify  .
 wm iconify  .editor
 wm deiconify .hide
}

#------------------------------------------------

proc UnHide {} {
 wm withdraw   .hide
 wm deiconify  .
 wm deiconify  .editor
}

#------------------------------------------------

proc About {} {
 destroy  .about
 toplevel .about
 wm title .about "About Organizer"
 label .about.label -text \
    "\nORGANIZER 1.0\n\nhttp://www.geocities.com/SiliconValley/6333/organizer\
\n\nRui Anastacio (ranastacio@mail.telepac.pt)\nFev 1999\n" \
    -borderwidth 0
 frame  .about.l -height 3 -borderwidth 2 -relief raised -background black
 button .about.ok -text "Ok" -command { destroy .about }
 
 pack   .about.label -padx 6 
 pack   .about.l -side top -fill both -pady 5 -padx 5
 pack   .about.ok -side top -pady 4
}

#------------------------------------------------

# --------
# PAGE OPS
# --------

proc AddPage {} {
  global input_data book_dir book_sec book_fg
  
  if !$book_fg return

  GetInputData "Enter Page Name: "
  if {$input_data == ""} return
  set fname "$book_dir$book_sec/$input_data"

  # Test if page exists
  if [file exists $fname] {
    tk_messageBox -type ok -icon error -title Error -parent . \
      -message "Page Exists. Delete it first"
	return
  }	  
    
  # Create the page
  if [catch "open \"$fname\" w" tmp]  {
    tk_messageBox -type ok -icon error -title Error -parent . \
      -message "Unabble to Create Page:\n  $input_data"
    return
  }
  close $tmp
  OpenSection
}


#------------------------------------------------

proc RenamePage {} {
  global input_data book_dir book_sec book_pag book_fg
  
  if !$book_fg return
  
  set fname [gen_filename]
  GetInputData "Enter New Name for: $book_pag: "
  if {$input_data == ""} return
  set newname "$book_dir$book_sec/$input_data"
  
  ## rename page
  if [catch "file rename \"$fname\" \"$newname\"" tmp]  {
    tk_messageBox -type ok -icon error -title Error -parent . \
	  -message "Unabble to Rename Page\nProbably Exists"
  return  
  }

  OpenSection
  set book_pag $input_data
}
#------------------------------------------------

proc DeletePage {} {
  global input_data book_dir book_sec book_pag book_fg
  
  if !$book_fg return

  set fname [gen_filename]
  set tmp [tk_messageBox -type yesno -icon question -title Confirm -parent . \
     -message "Really Delete Page $book_pag ? "]
  if {$tmp == "no"} return

  ## remove page
  if [catch "file delete \"$fname\"" tmp]  {
    tk_messageBox -type ok -icon error -title Error -parent . \
	  -message "Unabble to remove page"
    return  
  }
  OpenSection
}

#------------------------------------------------

# -----------
# SECTION OPS
# -----------


proc AddSection {} {
  global input_data book_dir book_sec book_fg
  
  if !$book_fg return
   
  GetInputData "Enter Section Name: "
  if {$input_data == ""} return
  set fname "$book_dir$book_sec/$input_data"
 
  ## create the section
  if [catch "file mkdir \"$fname\"" tmp]  {
    tk_messageBox -type ok -icon error -title Error -parent . \
	  -message "Unabble to Create Section\nProbably Exists"
    return
  }
  OpenSection
}

#------------------------------------------------

proc RenameSection {} {
  global input_data book_dir book_sec book_fg
  
  if !$book_fg return
  
  set fname   "$book_dir$book_sec"  
  GetInputData "Enter New Name: "
  if {$input_data == ""} return
  
  set p [string last / $book_sec]
  if {$p == -1} return
  
  set newname "$book_dir[string range $book_sec 0 $p]$input_data"
 
  ## rename page
  if [catch "file rename \"$fname\" \"$newname\"" tmp]  {
    tk_messageBox -type ok -icon error -title Error -parent . \
	  -message "Unabble to Rename Section\nProbably exists"
  return  
  }
  set book_sec [string range $book_sec 0 $p]$input_data
  OpenSection
}

#------------------------------------------------

proc DeleteSection {} {
  global input_data book_dir book_sec book_fg
  
  if !$book_fg return

  set fname "$book_dir$book_sec"
  set tmp [tk_messageBox -type yesno -icon question -title Confirm -parent . \
     -message "Are you shure you want to remove section:\n $fname"]
  if {$tmp == "no"} return
  
  ## remove section
  if [catch "file delete -force \"$fname\"" tmp]  {
    tk_messageBox -type ok -icon error -title Error -parent . \
	  -message "Unabble to Delete Section"
  return  
  }
  Up
}








set img_dir $ORGANIZER_GIFS
set icons { {books   books.gif} 
            {ops     ops.gif} 
            {hide    hide.gif} 
            {info    info.gif} 
			{standby standby.gif}
          }

set mnu_b { }

set mnu_o { {i "Page: Add New"        AddPage}
            {i "Page: Rename Current" RenamePage}
            {i "Page: Delete current" DeletePage}
			{s}
            {i "Section: Add New"       AddSection}
			{i "Section: Rename Curent" RenameSection}
			{i "Section: Delete Curent" DeleteSection}
			{s}
            {i "Edit book list"   EditBookList}
			{i "Reload book list" ReloadBookList}
		   }

set mnu_h { {i "About Organizer" About}
            {s}
			{i Quit "red_save; exit"}
		   }

set tb1 { {m books mnu_b}
          {m ops   mnu_o}
          {i hide  Hide }
          {m info  mnu_h}
	     }
		 
###
### MAIN
###		

ReadBookList
load_images $icons
wm title . "Organizer"

toolbar .bar1 $tb1
make_menu .bar1.0.mnu_b $mnu_b 1
make_menu .bar1.1.mnu_o $mnu_o 1
make_menu .bar1.3.mnu_h $mnu_h 0

frame .bar2
button .bar2.index -text " Index " -foreground blue -command Index -borderwidth 0
button .bar2.up -text " Up " -foreground blue -command Up -borderwidth 0
pack .bar2 -fill x
pack .bar2.index -side left -fill x
pack .bar2.up   -side right -fill x

frame .pos
label .pos.l -text "no book" -font "arial 12" -justify left
pack .pos -side top -fill x
pack .pos.l -side left

#---------------
set base ""

frame $base.b   -height 300 -width 150
frame $base.b.t 
frame $base.b.b 
frame $base.b.h -background #0000FF -borderwidth 2 -relief raised

bind $base.b.h <B1-Motion> \
  { set root [split %W .]
    set nb [ llength $root ]
    incr nb -1
    set root [ lreplace $root $nb $nb ]
    set root [ join $root . ]
    set height [ winfo height $root ].0
    set val [ expr (%Y - [winfo rooty $root]) / $height ]
    if { $val >= 0 && $val <= 1.0 } {
        place $root.t -relheight $val
        place $root.h -rely $val
        place $root.b -relheight [ expr 1.0 - $val ]
    }
  }
  
pack  $base.b  -in . -anchor center -expand 1 -fill both -side top 
place $base.b.t \
        -x 0 -y 0 -relwidth 1 -height -1 -relheight 0.3 -anchor nw \
        -bordermode ignore 
place $base.b.b \
        -x 0 -y 0 -rely 1 -relwidth 1 -height -1 -relheight 0.7 -anchor sw \
        -bordermode ignore 
place $base.b.h \
        -x 0 -relx 0.9 -y 0 -rely 0.3 -width 10 -height 10 -anchor e \
        -bordermode ignore 

global sec pag
set sec .b.t
set pag .b.b

listbox $sec.lb -yscrollcommand {$sec.ysb set}
scrollbar $sec.ysb \
        -borderwidth 1 -command {$sec.lb yview} -orient vert \
        -width 10
pack $sec.ysb -side right -fill y
pack $sec.lb -fill both -expand 1

listbox $pag.lb -yscrollcommand {$pag.ysb set} 
scrollbar $pag.ysb \
        -borderwidth 1 -command {$pag.lb yview} -orient vert \
        -width 10
pack $pag.ysb -side right -fill y
pack $pag.lb -fill both -expand 1


bind $sec.lb <ButtonPress-1> {PreOpenSection %W %y}
bind $pag.lb <ButtonPress-1> {PreOpenPage %W %y}

toplevel .hide -class Toplevel
wm transient .hide .
button .hide.b -image img(standby) -command UnHide
pack   .hide.b
wm withdraw .hide

ruied create .editor
rename .editor.f.t  .editor.f.t_hand

proc .editor.f.t {command args} {
  global red_modified red_writable

  if { $command == "insert" || $command == "delete" } {
    if !$red_writable return
	 
	if !$red_modified {
	    set red_modified 1
        red_state M
	 }
  }
  return [eval .editor.f.t_hand $command $args]
}			
