#!/usr/local/bin/wish -f # Simple Tk script to create a button that has the current selection. # Click on the button to terminate the program. # # The first line below creates the button, and the second line # asks the packer to shrink-wrap the application's main window # around the button. proc watch { number name } { set short_name [ string range $name 0 30 ] button .$number -text $short_name -command "send_paste $number" # Need to improve this appearance-wise pack .$number -fill x } proc del_paste { number } { global paste # Cheezy but it works catch { unset paste($number) } catch { destroy .$number } } proc getSelect {} { set is_select "foo" # Don't get any thing if we own the selection set sel_other [ catch { selection own } sel_owner ] while { $sel_owner == ".basic.t" } { update idletasks update after 100 set sel_other [ catch { selection own } sel_owner ] #puts stdout "Stuck with $sel_owner" ; } set sel_ready [ catch { selection get STRING } results ] while { $sel_ready != 0 || [string length $results ] < 3 } { after 100 set sel_ready [ catch { selection get STRING } results ] # When waiting for xterms and emacs we get stuck here # puts stdout "Waiting on sel_ready: $results:" # grabbing does not work .... update idletasks # If we get a signal here while emacs has the selection # it causes all emacs windows to dissappear, but emacs is # still running.... ARGHHH.... } #puts stdout "Getting $results from $sel_owner" ; set is_select $results return $is_select } proc wait_new_select {} { global tselect set tnew [ getSelect ] if { [string compare $tselect $tnew ] == 0 } { after 1000 wait_new_select } else { set tselect $tnew } } proc save_paste {} { global paste global paste_file set PASTE [ open $paste_file w ] # What should the format be ???? # we need a magic separator set sep "MAGIC-SEP-STRING-XXX-777" foreach paste_val [array names paste] { puts $PASTE "$sep\n$paste($paste_val)" # puts stdout "$sep\n$paste($paste_val)" } close $PASTE } proc read_paste {} { global paste global paste_file # Magic Separator is always the first line catch { set PASTE [ open $paste_file r ] } if [ info exists PASTE ] { set eof [ gets $PASTE sep ] set i 1 set eof [ gets $PASTE tmp ] # puts stdout $sep # puts stdout $tmp while { $eof > -1 } { if { [string compare $tmp $sep ] != 0 } { lappend foo $tmp } else { set paste($i) [ join $foo "\n" ] incr i set foo "" } set eof [ gets $PASTE tmp ] #puts stdout $tmp #puts stdout $foo } set paste($i) [ join $foo "\n" ] #puts stdout $paste($i) close $PASTE } } proc change_paste { number window } { global paste set paste($number) [ $window.t get 0.0 end ] catch { watch $number $paste($number) } } proc show_help {} { global w set w .help catch {destroy $w} toplevel $w set help_text "This application is designed to provide a history for the X11 paste buffer. It attempts to automagically remember the paste and store it in a menu item. Unfortunately, it only works automagically with rxvt. Most other programs require that you move the mouse into the paste menu window to save the current paste. The main window supports three buttons, QUIT, HELP, SAVE. QUIT quits the entire application. HELP brings up this window. SAVE stores the current list of paste items into the file .bartrc. Clicking any of other buttons in the main window does two things. One, it sets the current paste to the contents of that button. Two it brings up the paste in a paste buffer window. The contents of the Paste buffer can be edited in this window. You will need to explictly press the UPDATE button to change the contents of the paste buffer. CLEAR deletes the current paste. OK closes the window." # dpos $w wm title $w "Paste Help" wm iconname $w "PasteHelp" text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true -height 10 -width 40 -font fixed -wrap word scrollbar $w.s -relief flat -command "$w.t yview" frame $w.buttons pack $w.buttons -side bottom -expand yes -fill x button $w.buttons.ok -text OK -command "destroy $w" pack $w.buttons.ok -side left -expand yes -fill x pack $w.s -side right -fill y pack $w.t -expand yes -fill both $w.t insert 0.0 "$help_text" bind $w "focus $w.t" } proc send_paste { number} { global paste global w set w .basic catch {destroy $w} toplevel $w # dpos $w wm title $w "Paste Buffer" wm iconname $w "Paste" text $w.t -relief raised -bd 2 -yscrollcommand "$w.s set" -setgrid true -height 10 -width 40 -font fixed -wrap none scrollbar $w.s -relief flat -command "$w.t yview" frame $w.buttons pack $w.buttons -side bottom -expand yes -fill x button $w.buttons.ok -text OK -command "destroy $w" button $w.buttons.clear -text CLEAR -command "del_paste $number" button $w.buttons.update -text UPDATE -command " change_paste $number $w " pack $w.buttons.ok $w.buttons.clear $w.buttons.update -side left -expand yes -fill x pack $w.s -side right -fill y pack $w.t -expand yes -fill both $w.t insert 0.0 "$paste($number)" $w.t mark set insert 0.0 bind $w "focus $w.t" $w.t tag add sel 0.0 end } # Maybe add some global controls here proc global_control { } { # Show quit /save /help in the first menubar frame .buttons pack .buttons -side bottom -expand yes -fill x button .buttons.quit -text QUIT -command {destroy . ; exit } button .buttons.save -text SAVE -command { save_paste } button .buttons.help -text HELP -command { show_help } pack .buttons.quit .buttons.help .buttons.save -side left -expand yes -fill x } set paste_file "~/.bartrc" global_control set i 1 set paste($i) "" read_paste foreach p [ array names paste ] { watch $i $paste($p) incr i } set tselect [ getSelect ] set tnew tselect update update idletasks while { 0 == 0 } { wait_new_select tkwait variable tselect update idletasks update incr i 1 set paste($i) $tselect watch $i $tselect }