memory.pli

net plug source code

# NetPlug
# simple plugin that remembers a host/port list
# (c) 1996 Laurent demailly <[e-mail]>
#
# $Id: memory.pli,v 1.1 1996/06/24 19:42:36 dl Exp $
#
# $Log: memory.pli,v $
# Revision 1.1  1996/06/24 19:42:36  dl
# Initial revision
#
#

global memory_fname memory_list

set memory_fname  "$dotdir/memory.data";
set memory_list {}
catch {
  set f [open $memory_fname]
  set memory_list [read $f];
  close $f
}

# the plugin proc:
proc memory {onoff} {
  global memory_list
  catch {destroy .memory}
  if {$onoff} {
    set w .memory
    toplevel $w
    wm title $w "NetPlug Memory plugin";
  
    frame $w.frame -borderwidth .1c
    pack $w.frame -side top -expand yes -fill both
  
    scrollbar $w.frame.scroll -command "$w.frame.list yview"
    listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12
    pack $w.frame.scroll -side right -fill y
    pack $w.frame.list -side left -expand 1 -fill both
    eval $w.frame.list insert 0 $memory_list ;
    $w.frame.list insert 0 "   ***NEW ENTRY***";
    bind $w.frame.list <Double-1>  memory_dbl;
    bind $w.frame.list <Delete>    memory_del;
    bind $w.frame.list <BackSpace> memory_del;
    bind $w.frame.list <Return>     memory_dbl;
    focus $w.frame.list;
    $w.frame.list selection set 0
    $w.frame.list activate 0
  }
}
  
proc memory_del {} {
   set w .memory;
   set cs [$w.frame.list curselection];
   if {[string compare "" $cs]} {
     if {$cs==0} {
       debug 0 "Illegal delete of new entry element (0) !";
     } else {
       set val [$w.frame.list get $cs];
       debug 0 "Deleting $cs : $val";
       $w.frame.list delete $cs;
       incr cs -1;
       $w.frame.list selection set $cs
       $w.frame.list activate $cs
       memory_save
     }
   } else {
     debug 0 "Empty selection for memory del!";
   }
}

proc memory_save {} {
# save
  global memory_fname memory_list;
  set w .memory.frame.list;
  if {[catch {
               set f [open $memory_fname w];
	       set memory_list [$w get 1 end];
	       puts $f $memory_list; 
	       close $f
	     } res]} {
    puts stderr "ERROR saving memory list : $res";
  } else {
    debug 0 "memory saved ok in $memory_fname";
  }
}

proc mementry_dialog {title} {
  global memval memres;
  set nw ".memdiag";
  catch {destroy $nw} 
  toplevel $nw
#   wm transient $nw .memory
  wm title $nw $title;
  frame $nw.f1
  label $nw.f1.l -text "host port";
  entry $nw.f1.e -textvariable memval -relief sunken;
  pack $nw.f1.l $nw.f1.e -side left -fill x -expand 1 \
    -ipadx 1m -padx 1m -pady 1m;
  frame $nw.f2;
  button $nw.f2.bok -text "Ok" -command "set memres 1";
  button $nw.f2.bcancel -text "Cancel" -command "set memres 0";
  bind $nw.f1.e <Return> "$nw.f2.bok invoke";
  pack $nw.f2.bok $nw.f2.bcancel -side left -fill x -expand 1 \
    -ipadx 1m -padx 1m -pady 1m;
  pack $nw.f1 $nw.f2 -fill both -expand 1 -padx 1m -pady 1m;
  update;
  grab set $nw;
  focus $nw.f1.e;
  tkwait variable memres;
  grab release $nw;
  destroy $nw;
  list $memres $memval;
}

proc memory_dbl {} {
  set w .memory.frame.list;
  set cs [$w curselection];
  if {[string compare "" $cs]} {
    set what [$w get $cs];
  } else {
    debug 0 "memory: no selection...";
    return;
  }
  if {$cs!=0} {
    debug 1 "memory 2 '$what'";
    global host port;
    set host [lindex $what 0];
    set port [lindex $what 1];
    Invoke ;
  } else {
    debug 1 "memory 2 new";
    set r [mementry_dialog "New Entry"];
    if {[lindex $r 0]} {
      set val [lindex $r 1];
      lappend memory_list $val;
      $w insert end $val;
      memory_save;
    }
  }
}


list "Memory ..." memory;