# use_embind.tcl
#   - GNU-Emacs like bindings for text and entry widgets
#   - start an external editor with Alt-e
#     (is taken from env(EDITOR)
#
# Copyright (c) 1994 R"udiger Franke
# All Rights Reserved.
# 
# Redistribution and use in any form, with or without modification, 
# is permitted, provided that the following conditions are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in other form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. All advertising materials mentioning features or use of this software
#    must display the following acknowledgement:
#       This product includes software developed by R"udiger Franke.
# 4. The name of the author may not be used to endorse or promote products
#    derived from this software without specific prior written permission.
# 
# THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
# OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
# IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
# INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
# NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
# THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
# (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
# THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

#
# global bindings
#
proc useEmacsBindings {} {

    #  an entry is created for supplying a widget's name after
    #  <Control-1> over that widget
    #
    if ![winfo exists .selectionEntry] {
      entry .selectionEntry
    }
    bind all <Control-1> {
      .selectionEntry delete 0 end
      .selectionEntry insert 0 [winfo containing %X %Y]
      .selectionEntry select from 0
      .selectionEntry select to end
    }

    # default bindings for entries (shortcuts from emacs)
    bind Entry <Enter> {focus %W}
    bind Entry <Leave> {focus [winfo toplevel %W]}
    bind Entry <Return> {focus [winfo toplevel %W]}

    bind Entry <Control-a> {%W icursor 0}
    bind Entry <Control-e> {%W icursor end}
    bind Entry <Control-b> {%W icursor [expr [%W index insert]-1]}
    bind Entry <Control-f> {%W icursor [expr [%W index insert]+1]}
    bind Entry <Key-Left> {%W icursor [expr [%W index insert]-1]}
    bind Entry <Key-Right> {%W icursor [expr [%W index insert]+1]}
    bind Entry <Control-d> {%W delete insert}
    bind Entry <Control-h> {%W delete [expr [%W index insert]-1]}
    bind Entry <Control-k> {
      .selectionEntry delete 0 end
      .selectionEntry insert 0 [%W get]
      %W delete insert end
      .selectionEntry select from 0
      .selectionEntry select to end
    }
    bind Entry <Control-w> {
      .selectionEntry delete 0 end
      .selectionEntry insert 0 [selection get]
      %W delete sel.first sel.last
      .selectionEntry select from 0
      .selectionEntry select to end
    }
    bind Entry <Control-y> {%W delete 0 end; %W insert 0 [selection get]}

    # default bindings for texts (shortcuts from emacs)

    bind Text <Enter> {focus %W}
    bind Text <Leave> {focus [winfo toplevel %W]}

    bind Text <Control-a> {%W mark set insert {insert linestart}}
    bind Text <Control-e> {%W mark set insert {insert lineend}}
    bind Text <Control-b> {
      %W mark set insert {insert - 1 char}
      %W yview -pickplace insert
    }
    bind Text <Control-f> {
      %W mark set insert {insert + 1 char}
      %W yview -pickplace insert
    }
    bind Text <Key-Left> {
      %W mark set insert {insert - 1 char}
      %W yview -pickplace insert
    }
    bind Text <Key-Right> {
      %W mark set insert {insert + 1 char}
      %W yview -pickplace insert
    }
    bind Text <Control-n> {
      %W mark set insert {insert + 1 line}
      %W yview -pickplace insert
    }
    bind Text <Control-p> {
      %W mark set insert {insert - 1 line}
      %W yview -pickplace insert
    }
    bind Text <Key-Down> {
      %W mark set insert {insert + 1 line}
      %W yview -pickplace insert
    }
    bind Text <Key-Up> {
      %W mark set insert {insert - 1 line}
      %W yview -pickplace insert
    }
    bind Text <Control-d> {%W delete insert}
    bind Text <Control-h> {%W delete {insert - 1 char}}
    bind Text <Control-k> {
      .selectionEntry delete 0 end
      .selectionEntry insert 0 [%W get insert {insert lineend}]
      %W delete insert {insert lineend}
      .selectionEntry select from 0
      .selectionEntry select to end
    }
    bind Text <Control-w> {
      .selectionEntry delete 0 end
      .selectionEntry insert 0 [%W get sel.first sel.last]
      %W delete sel.first sel.last
      .selectionEntry select from 0
      .selectionEntry select to end
    }
    bind Text <Control-y> {
      %W insert insert [selection get]
      %W yview -pickplace insert
    }

    bind Entry <Mod1-Key-e> {
      useExternalEditor \
        [%W get] \
        {%W delete 0 end; %W insert 0}
    }
    bind Text <Mod1-Key-e> {
      useExternalEditor \
        [%W get 0.0 end] \
        {%W delete 0.0 end; %W insert 0.0}
    }
    bind Entry <Mod2-Key-e> {
      useExternalEditor \
        [%W get] \
        {%W delete 0 end; %W insert 0}
    }
    bind Text <Mod2-Key-e> {
      useExternalEditor \
        [%W get 0.0 end] \
        {%W delete 0.0 end; %W insert 0.0}
    }
}

proc useExternalEditor {text readycmd} {

  # select external editor via environment

  global env

  if {![info exists env(EDITOR)]} {
    topmessage .tm USE "No environment EDITOR defined."
    return
  }
  set editor $env(EDITOR)

  # create and call a procedure for handling the request

  set id 1
  while {[info procs useExternalEditor$id] != {}} {
    incr id
  }

  proc useExternalEditor$id {id editor text readycmd} {

    # generate a temporary file with text

    set fname [use_tmpname]
    set fid [open $fname w]
    puts $fid $text
    close $fid

    # execute external editor

    eval [concat blt_bgexec result$id $editor $fname]
    tkwait variable result$id

    # backpropagate edited file

    set fid [open $fname r]
    set text [read $fid nonewline]
    close $fid
    exec rm $fname

    catch {eval [concat $readycmd \{$text\}]}

    # delete this procedure
  
    rename useExternalEditor$id {}
  }

  useExternalEditor$id $id $editor $text $readycmd
}
