#!/usr/local/bin/wish4.0
# jhotlist - a tool for manipulating Mosaic hotlists
#
######################################################################
# Copyright 1992-1995 by Jay Sekora.  This file may be freely        #
# distributed, modified or unmodified, for any purpose, provided     #
# that this copyright notice is retained verbatim in all copies and  #
# no attempt is made to obscure the authorship of this file.  If you #
# distribute any modified versions, I ask, but do not require, that  #
# you clearly mark any changes you make as such and that you provide #
# your users with instructions for getting the original sources.     #
######################################################################
## begin boiler_header

if {[info exists env(JSTOOLS_LIB)]} {
  set jstools_library $env(JSTOOLS_LIB)
} else {
  set jstools_library /usr/local/lib/jstools
}

# add the jstools library to the library search path:

set auto_path [concat [list $jstools_library] $auto_path]

# check for ~/.tk and prepend it to the auto_path if it exists.
# that way the user can override and customise the jstools libraries.

if {[file isdirectory ~/.tk]} then {
  set auto_path [concat [list [glob ~/.tk]] $auto_path]
}

## end boiler_header

######################################################################

global NAME			;# user's login name
global HOME			;# user's home directory

global J_PREFS JHOTLIST_PREFS	;# user preferences
global HOTLISTS			;# array of hotlists.
				;# each is a list of url/title pairs
set HOTLISTS(0) 0		;# make sure it exists
global CUR			;# current hotlist name
set CUR "Default"		;# start in default hotlist

global DEST			;# hotlist to copy to (so it can be default)
set DEST {}

j:jstools_init jhotlist		;# prefs, libraries, bindings...

########################################################################

proc jhotlist:read {hotlist} {
  global HOTLISTS CUR HOME
  
  set HOTLISTS($hotlist) {}	;# clear old entries
  cd $HOME
  set filename ".mosaic-hotlist-[string tolower $hotlist]"
  
  set hlfile [open $filename {RDWR CREAT}]
  set format [gets $hlfile]
  if {"x$format" == "x"} {
    j:alert -text [eval [j:ldb warning_no_file]]
  }
  if {"x$format" != "xncsa-xmosaic-hotlist-format-1"} {
    j:alert -text [eval [j:ldb warning_unrecog_fmt]]
  }
  
  set hlname [gets $hlfile]
  
  while {1} {
    set url [gets $hlfile]	;# actually, has other info as well
    if {"x$url" == "x"} {
      break
    }
    set title [gets $hlfile]
    lappend HOTLISTS($hotlist) [list $url $title]
  }
  close $hlfile
}

########################################################################

proc jhotlist:write {hotlist} {
  global HOTLISTS CUR HOME
  
  cd $HOME
  set filename ".mosaic-hotlist-[string tolower $hotlist]"
  
  set hlfile [open $filename {WRONLY CREAT TRUNC}]
  puts $hlfile "ncsa-xmosaic-hotlist-format-1"
  puts $hlfile $hotlist
  
  foreach pair $HOTLISTS($hotlist) {
    set url_stuff [lindex $pair 0]
    set title [lindex $pair 1]
    
    puts $hlfile $url_stuff
    puts $hlfile $title
  }
  
  close $hlfile
}

######################################################################

proc jhotlist:write_html {} {
  global HOTLISTS CUR HOME
  
  set hotlist $CUR
  
  set filename [j:fs -prompt "Save HTML to"]
  if {"x$filename" == "x"} {
    return 0
  }
  
  set html [open $filename {WRONLY CREAT TRUNC}]
  
  puts $html "<html>\n<header>"
  puts $html "<h1>Hotlist `$hotlist'</h1>"
  puts $html "</header>\n\n<body>"
  puts $html "<hr><i>[j:ldb html_automatic]</i><hr>"
  puts $html "\n<ul>"
  
  foreach pair $HOTLISTS($hotlist) {
    set url_stuff [lindex $pair 0]
    set url [lindex $url_stuff 0]
    set title [lindex $pair 1]
    
    # need to do better...
    regsub -all -- {[<>&]} $title "###" title
    
    puts $html "  <li><a"
    puts $html "  href=\"$url\">"
    puts $html "  $title</a>"
  }
  
  puts $html "</ul>"
  puts $html "</body>"
  
  close $html
  
  return 0
}

########################################################################

proc jhotlist:load_all {} {
  global JHOTLIST_PREFS
  foreach hotlist $JHOTLIST_PREFS(hotlists) {
    jhotlist:read $hotlist
  }
}

########################################################################

proc jhotlist:save_all {} {
  global JHOTLIST_PREFS
  foreach hotlist $JHOTLIST_PREFS(hotlists) {
    jhotlist:write $hotlist
  }
}

########################################################################

proc jhotlist:add_hotlist {} {
  global JHOTLIST_PREFS HOTLISTS
  
  set new_hotlist [j:prompt \
    -text [j:ldb prompt:new_name] \
    -title [j:ldb title:name]]
  if {"x$new_hotlist" == "x"} {
    return 1
  }
  
  if {[lsearch -exact $JHOTLIST_PREFS(hotlists) $new_hotlist] != -1} {
    j:alert -text [j:ldb notice:already_loaded]
    return 1
  }
  
  lappend JHOTLIST_PREFS(hotlists) $new_hotlist
  set HOTLISTS($new_hotlist) {}
  jhotlist:read $new_hotlist
  return 0
}

########################################################################

proc jhotlist:mklist {w args} {
  global J_PREFS JHOTLIST_PREFS
  
  frame $w
  scrollbar $w.sb -relief flat -command "$w.lb yview"
  listbox $w.lb -borderwidth 0 -yscroll "$w.sb set" -exportselection false
  jhotlist:configure_list $w.lb
  j:tk3 {
    tk_listboxSingleSelect $w.lb
  }
  j:tk4 {
    $w.lb configure -selectmode single
  }
  
  pack $w.sb [j:rule $w] -side $J_PREFS(scrollbarside) -fill y
  pack $w.lb -side $J_PREFS(scrollbarside) -fill both -expand yes

  eval [list $w config] $args
  return $w
}

######################################################################
# proc jhotlist:configure_list - apply prefs to listbox
######################################################################

proc jhotlist:configure_list {w} {
  global JHOTLIST_PREFS
  
  j:configure_font $w $JHOTLIST_PREFS(listfont)
  
  if [catch {
    $w configure \
      -geometry $JHOTLIST_PREFS(listwidth)x$JHOTLIST_PREFS(listheight)
  }] {
    $w configure \
      -width $JHOTLIST_PREFS(listwidth) \
      -height $JHOTLIST_PREFS(listheight)
  }    
}

######################################################################

proc jhotlist:hotlist_menu {w menubutton menu} {
  global JHOTLIST_PREFS
  
  $menu delete 0 last
  foreach hotlist $JHOTLIST_PREFS(hotlists) {
    $menu add command -label $hotlist -command "
      set CUR $hotlist
      $menubutton configure -text $hotlist
      jhotlist:fill $w
    "
  }
  $menu add separator
  $menu add command -label [j:ldb cmd:add] -command "
    jhotlist:add_hotlist
    jhotlist:hotlist_menu $w $menubutton $menu
  "
  $w.chooser.mb.m add command -label [j:ldb cmd:remove] -command "
    jhotlist:remove_hotlist
    jhotlist:hotlist_menu $w $menubutton $menu
  "
}

########################################################################

proc jhotlist:mkmain {w} {
  global URLS
  global TITLES
  set URLS(A) 0
  set TITLES(A) 0
  global HOTLISTS CUR
  global JHOTLIST_PREFS J_PREFS
  
  toplevel $w
  
  global FOO; label $w.foo -textvariable FOO; pack $w.foo -fill x
  
  frame $w.chooser -relief flat
  label $w.chooser.l -relief flat -text [j:ldb label:hotlist]
  menubutton $w.chooser.mb -relief raised -width 20 -anchor c \
    -menu $w.chooser.mb.m -text $CUR
  
  pack $w.chooser.l $w.chooser.mb -side left
  
  menu $w.chooser.mb.m
  jhotlist:hotlist_menu $w $w.chooser.mb $w.chooser.mb.m
  
  j:variable_entry $w.url \
    -labelwidth 8 -entrywidth 65 -label [j:ldb label:url] \
    -variable URLS($w)
  j:variable_entry $w.title \
    -labelwidth 8 -entrywidth 65 -label [j:ldb label:title] \
    -variable TITLES($w)
  j:buttonbar $w.paircmds -default change -buttons [format {
    {
      change
      cmd:change
      {
        jhotlist:change %s
      }
    } {
      copy
      cmd:copy
      {
        jhotlist:copy %s
      }
    } {
      move
      cmd:move
      {
        jhotlist:move %s
      }
    } {
      delete
      cmd:delete
      {
        jhotlist:delete %s
      }
    } {
      view
      cmd:view
      {
        exec Mosaic $url &
      }
    } {
      prefs
      cmd:prefs
      {
        jhotlist:cmd:hotlist_prefs
      }
    } {
      quit
      cmd:quit
      {
        exit 0
      }
    }
  } $w $w $w $w]
  
  jhotlist:mklist $w.hl -borderwidth 0
  
  j:buttonbar $w.listcmds -buttons [format {
    {
      sort
      cmd:sort
      {
        jhotlist:sort %s
      }
    } {
      save
      cmd:save
      {
        jhotlist:save_all
      }
    } {
      reload
      cmd:reload
      {
        jhotlist:load_all
        jhotlist:fill %s
      }
    } {
      html
      cmd:html
      {
        jhotlist:write_html
      }
    }
  } $w $w $w]
  
  # following is a bit tricky: we know the url-title pairs are in the
  # listbox in the same order they are in HOTLISTS($CUR), so we can
  # extract the full info from HOTLISTS($CUR) even though it's not
  # in a nice list format in the listbox.
  
  bind $w.hl.lb <ButtonRelease-1> {
    set pair [lindex $HOTLISTS($CUR) [%W nearest %y]]
    set url [lindex [lindex $pair 0] 0]
    set title [lindex $pair 1]
    set URLS([winfo parent [winfo parent %W]]) $url ;# ACK! ICK!
    set TITLES([winfo parent [winfo parent %W]]) $title ;# ACK! ICK!
  }
  
  pack \
    [j:filler $w] \
    $w.chooser \
    [j:filler $w]
  pack \
    [j:rule $w] \
    [j:filler $w] \
    $w.url \
    $w.title \
    $w.paircmds \
    [j:rule $w] \
    -fill x
  pack $w.hl -fill both -expand yes
  pack \
    [j:rule $w] \
    $w.listcmds \
    -fill x
  
  j:tab_ring $w.url.e $w.title.e
  j:default_button $w.paircmds.change $w.url.e $w.title.e
  
  wm minsize $w 100 100
  wm maxsize $w [winfo screenwidth $w] [winfo screenheight $w]
  
  focus $w.title.e
  catch {focus default $w.title.e}	;# caught for Tk 4.0
}

########################################################################

proc jhotlist:change {w} {
  global HOTLISTS CUR J_PREFS JHOTLIST_PREFS URLS TITLES
  
  set url [string trim $URLS($w)]
  set title [string trim $TITLES($w)]
  
  if {"x$url" == "x"} {
    j:alert -text [j:ldb notice:missing_url]
    return 1
  }
  if {[string match "*\[\n\r\t \]*" $url]} {
    j:alert -text [j:ldb notice:url_space]
    return 1
  }
  if {"x$title" == "x"} {
    j:alert -text [j:ldb notice:missing_title]
    return 1
  }
  if {[string match "*\[\n\r\]*" $title]} {
    j:alert -text [j:ldb notice:title_newline]
    return 1
  }
  set index [$w.hl.lb curselection]
  
  # get the old date-and-time information
  set old_url_info [lindex [lindex $HOTLISTS($CUR) $index] 0]
  regsub -- {^[^ ] *} $old_url_info {} old_url_info ;# sd do error checking
  set old_url_info "$url $old_url_info"
  
  set new_pair [list $old_url_info $title]
  
  set HOTLISTS($CUR) \
    [lreplace $HOTLISTS($CUR) $index $index $new_pair]
  
  jhotlist:fill $w
  $w.hl.lb select from $index
}

########################################################################

proc jhotlist:copy {w} {
  #
  # BOGUS - need to output header if the file is new
  #
  global HOTLISTS CUR J_PREFS JHOTLIST_PREFS URLS TITLES
  
  set hotlist [jhotlist:select -prompt [j:ldb prompt:copy_to]]
  
  if {"x$hotlist" == "x"} {
    return 0
  }
  
  jhotlist:copy_to $hotlist $w
  ### TEMPORARY
  jhotlist:fill $w
}

########################################################################

proc jhotlist:move {w} {
  #
  # BOGUS - need to output header if the file is new
  #
  global HOTLISTS CUR J_PREFS JHOTLIST_PREFS URLS TITLES
  
  set hotlist [jhotlist:select -prompt [j:ldb prompt:move_to]]
  
  if {"x$hotlist" == "x"} {
    return 0
  }
  
  jhotlist:copy_to $hotlist $w
  jhotlist:delete $w
}

########################################################################

proc jhotlist:copy_to {hotlist w} {
  global HOTLISTS CUR J_PREFS JHOTLIST_PREFS URLS TITLES
  
  set index [$w.hl.lb curselection]
  
  # get the old date-and-time information
  set pair [lindex $HOTLISTS($CUR) $index]
  
  set url_and_time [lindex $pair 0]
  set title [lindex $pair 1]
  
  set pair [list $url_and_time $title]
  lappend HOTLISTS($hotlist) $pair
}

########################################################################

proc jhotlist:select { args } {
  j:parse_args [list \
    [list prompt [j:ldb prompt:choose]] \
    [list title [j:ldb title:selector]] \
  ]
  
  global CUR J_PREFS JHOTLIST_PREFS
  global j_hl
  set J_PREFS(0) 1
  if {[lsearch [array names J_PREFS] {scrollbarside}] == -1} {
    set J_PREFS(scrollbarside) right ;# make sure it's defined
  }
  set hotlist ""
  set j_hl(result) $hotlist
  
  set old_focus [focus]		;# so we can restore original focus
  
  if [winfo exists .hs] {
    destroy .hs
  }
  
  toplevel .hs
  wm title .hs $title
  wm minsize .hs 10 10
  
  label .hs.prompt -anchor w -text $prompt
  frame .hs.list
  listbox .hs.list.lb -yscroll ".hs.list.sb set" -geometry 20x10 \
    -exportselection false
  tk_listboxSingleSelect .hs.list.lb
  scrollbar .hs.list.sb -relief flat -command ".hs.list.lb yview"
  
  j:buttonbar .hs.b -default ok -buttons {
    {
      ok
      OK
      {
        if [catch {
          set j_hl(result) [.hs.list.lb get [.hs.list.lb curselection]]
        }] {
          set j_hl(result) ""
        }
        destroy .hs
      }
    } {
      cancel
      Cancel
      {
        set j_hl(result) ""
        destroy .hs
      }
    }
  }
  
  pack .hs.list.sb [j:rule .hs.list] .hs.list.lb \
    -side $J_PREFS(scrollbarside) -fill y
  
  pack \
    .hs.prompt \
    [j:rule .hs] \
    .hs.list \
    [j:rule .hs] \
    .hs.b \
    -side top -fill x
  
  j:dialogue .hs		;# position in centre of screen
  
  focus .hs
  bind .hs.list.lb <Double-Button-1> {
    .hs.b.ok invoke
  }
  
  j:default_button .hs.b.ok .hs
  j:cancel_button .hs.b.cancel .hs
  
  foreach hotlist $JHOTLIST_PREFS(hotlists) {
    .hs.list.lb insert end $hotlist
  }
  
  tkwait window .hs
  focus $old_focus
  return $j_hl(result)
}

########################################################################

proc jhotlist:delete {w} {
  global HOTLISTS CUR J_PREFS JHOTLIST_PREFS URLS TITLES
  
  set index [$w.hl.lb curselection]
  
  set HOTLISTS($CUR) \
    [lreplace $HOTLISTS($CUR) $index $index] ;# with nothing
  
  jhotlist:fill $w
}


########################################################################

proc jhotlist:pair_compare {a b} {
  set title_a [string tolower [lindex $a 1]]
  set title_b [string tolower [lindex $b 1]]
  return [string compare $title_a $title_b]
}

proc jhotlist:sort {w} {
  global HOTLISTS CUR J_PREFS JHOTLIST_PREFS URLS TITLES
  
  set HOTLISTS($CUR) \
    [lsort -command jhotlist:pair_compare $HOTLISTS($CUR)]
  
  jhotlist:fill $w
}

########################################################################

proc jhotlist:fill {w} {
  global HOTLISTS CUR
  
  # save current scroll value (to prevent jumping to top):
  set oldyview [lindex [$w.hl.sb get] 2]
  
  $w.hl.lb delete 0 end
  foreach pair $HOTLISTS($CUR) {
    set url [lindex [lindex $pair 0] 0]
    set title [lindex $pair 1]
    $w.hl.lb insert end "$title---$url"
  }
  
  # restore old scroll value (to prevent jumping to top):
  $w.hl.lb yview $oldyview
  
  global FOO; set FOO [llength $HOTLISTS($CUR)]
}

######################################################################
# jhotlist:cmd:hotlist_prefs - hotlist preference panel
######################################################################

proc jhotlist:cmd:hotlist_prefs {} {
  global JHOTLIST_PREFS
  
  set w .hl_prefs
  toplevel $w
  wm title $w [j:ldb title:prefs]
  frame $w.size
  label $w.size.wl -text [j:ldb pref:width]
  entry $w.size.we -relief sunken -width 3 \
    -textvariable JHOTLIST_PREFS(listwidth)
  label $w.size.hl -text [j:ldb pref:height]
  entry $w.size.he -relief sunken -width 3 \
    -textvariable JHOTLIST_PREFS(listheight)
  
  j:variable_entry $w.defaulthl \
    -label [j:ldb pref:defaulthl] \
    -variable JHOTLIST_PREFS(defaulthotlist)
  
  j:variable_entry $w.hotlists \
    -label [j:ldb pref:hotlists] \
    -variable JHOTLIST_PREFS(hotlists)
  
  ####################################################################
  frame $w.font
  frame $w.font.top
  label $w.font.top.l -text [j:ldb pref:font]
  button $w.font.top.default -text [j:ldb pref:def_font] -command {
    set JHOTLIST_PREFS(listfont) {default}
  }
  button $w.font.top.choose -text [j:ldb pref:choose_font] -command {
    set JHOTLIST_PREFS(listfont) [j:prompt_font]
  }
  frame $w.font.bot
  entry $w.font.bot.e -relief sunken -width 50 \
    -textvariable JHOTLIST_PREFS(listfont)
  
  pack $w.font.top.l -side left
  pack $w.font.top.choose -side right -padx 10 -pady 5
  pack $w.font.top.default -side right -pady 5
  pack $w.font.bot.e -side left -padx 10 -pady 5
  pack $w.font.top $w.font.bot -side top -expand yes -fill x
  ####################################################################
  
  j:buttonbar $w.b -default save -buttons [format {
    { 
      save Save {
        jhotlist:configure_list .main.hl.lb
        j:write_prefs -array JHOTLIST_PREFS -file jhotlist-defaults
        destroy %s
      }
    } {
      cancel Cancel {
        jhotlist:configure_list .main.hl.lb
        destroy %s
      }
    }
  } $w $w]
  
  pack $w.size.wl $w.size.we [j:filler $w.size] $w.size.hl $w.size.he \
    -in $w.size -side left

  pack \
    [j:filler $w] \
    $w.size \
    [j:filler $w] \
    [j:rule $w] \
    [j:filler $w] \
    $w.defaulthl \
    [j:filler $w] \
    $w.hotlists \
    [j:filler $w] \
    [j:rule $w] \
    $w.font \
    [j:rule $w] \
    $w.b \
    -in $w -side top -fill x

  j:dialogue $w		;# position in centre of screen

  focus $w
  j:default_button $w.b.save \
    $w.size.we $w.size.he $w $w.defaulthl.e $w.hotlists.e $w.font.bot.e
  j:tab_ring \
    $w.size.we $w.size.he $w.defaulthl.e $w.hotlists.e $w.font.bot.e
  bind $w <Key-Tab> "focus $w.size.we"
}

########################################################################

# read in user's .tk/jhotlistrc.tcl and .tk/jmore-defaults
#
j:source_config jhotlist.tcl	# just source the file, if any
j:read_prefs -array JHOTLIST_PREFS -file jhotlist-defaults {
  {listfont default}
  {listwidth 80}
  {listheight 30}
  {defaulthotlist Default}
  {hotlists {Default People Sites}}
}

wm withdraw .

cd $HOME
set CUR $JHOTLIST_PREFS(defaulthotlist)

if {$argc > 0} {
  if {$argc > 1} {
    puts stderr "[j:ldb label:usage] [file tail $argv0] \[<hotlist>\]"
    exit 1
  } else {
    set CUR [lindex $argv 0]
  }
}

foreach hotlist $JHOTLIST_PREFS(hotlists) {
  set HOTLISTS($hotlist) {}
}

jhotlist:mkmain .main
jhotlist:load_all
jhotlist:fill .main

tkwait window .main
exit 0


