# dde-edit.tcl - Copyright (C) 2003 Pat Thoyts <[email protected]>
#
# Illustrate launching tcl applications via dde. This code requires a DDE
# package that implements TIP 120 - such as the one in Tcl 8.5a0
#
# $Id: 8940,v 1.9 2006-01-25 07:00:30 jcw Exp $
 
package require dde 1.2.4
 
namespace eval ::DdeEdit {
     variable uid
     if {![info exists uid]} {set uid 0}
     variable dialogs
     variable console 0
}
 
# -------------------------------------------------------------------------
# Description:
#  Begin the dde service.
#
proc ::DdeEdit::DdeEdit {args} {
     dde servername -handler [namespace origin DdeHandler] DdeEdit
 
     menu .menu
     menu .menu.file -tearoff 0
     .menu add cascade -label "File" -underline 0 -menu .menu.file
     .menu.file add checkbutton -label "Console" -underline 0 \
         -command [namespace origin ShowConsole] \
         -variable [namespace current]::console
     .menu.file add command -label "Exit" -underline 1 -accel "Ctrl-W" \
         -command {destroy .}
     bind . <Control-w> {destroy .}
 
     . configure -menu .menu
 
     set t [text .t -yscrollcommand {.s set}]
     set s [scrollbar .s -command [list $t yview]]
     $t insert end $args
 
     grid $t $s -sticky news
     grid columnconfigure . 0 -weight 1
     grid rowconfigure . 0 -weight 1
     
     tkwait window .
}
 
# -------------------------------------------------------------------------
# We expect to receive commands in fairly standard DDE style.
# eg: Open("<filename>"), etc.
# If it doesn't match up - reject it.
#
proc ::DdeEdit::DdeHandler {cmd} {
     set bits [split $cmd ()]
     switch -exact -- [set verb [lindex $bits 0]] {
         Open { return [DdeHandleOpen [lindex $bits 1]] }
         Run  { return [DdeHandleRun [lindex $bits 1]] }
         Exit { return [DdehandleExit] }
         default {
             return -code error "invalid dde command:\
                 \"$verb\" must be one of Open, Run or Exit."
         }
     }
     return
}
 
proc ::DdeEdit::DdeHandleOpen {filename} {
     set filename [string trim $filename "\""]
     if {![file readable $filename]} {
         return -code error "file \"$filename\" is not readable: \
 [llength $filename]\
     [llength [lindex $filename 0]]"
     }
     set f [open $filename r]
     set d [read $f]
     close $f
     ShowDialog $d
}
 
proc ::DdeEdit::DdeHandleExit {} {
     after 100 {destroy .}
}
 
# -------------------------------------------------------------------------
# Description:
#  Show a simple dialog without locking up the application.
#  DDE calls need to return within a reasonable amount of time or the calling
#  application raises an error - this means we cannot use tk_messageBox here.
#
proc ::DdeEdit::ShowDialog {text} {
     variable uid
     variable dialogs
 
     set dlg [toplevel .t[incr uid]]
     set m [menu ${dlg}.menu -tearoff 0]
     $dlg configure -menu $m
     $m add cascade -label "File" -underline 0 -menu [menu $m.file]
     $m.file add command -label "Exit" -underline 1 -accel Ctrl-W \
         -command [list destroy $dlg]
     
     bind $dlg <Control-w> [list destroy $dlg]
 
     set t [text $dlg.t -yscrollcommand [list $dlg.s set]]
     set s [scrollbar $dlg.s -command [list $t yview]]
 
     $t insert end $text
     
     grid $t $s -sticky news
     grid columnconfigure $dlg 0 -weight 1
     grid rowconfigure $dlg 0 -weight 1
 
     lappend dialogs $dlg
}
 
# -------------------------------------------------------------------------
# Description:
#  Pop the nth element off a list. Used in options processing.
#
proc ::DdeEdit::Pop {varname {nth 0}} {
     upvar $varname args
     set r [lindex $args $nth]
     set args [lreplace $args $nth $nth]
     return $r
}
 
# -------------------------------------------------------------------------
# Description:
#  Toggle display of the Tk console.
#
proc ::DdeEdit::ShowConsole {} {
     variable console
     if {$console == 0} {
         console hide
     } else {
         console show
     }
}
 
# -------------------------------------------------------------------------
# Description:
#  Called to register the ".z_t" file suffix with Windows.
#
proc ::DdeEdit::install {} {
     package require registry
     set HKCR HKEY_CLASSES_ROOT
     registry set "$HKCR\\.z_t" {} z_tfile
     registry set $HKCR\\z_tfile {} "DDE Test File"
     registry set $HKCR\\z_tfile\\shell {} {}
     registry set $HKCR\\z_tfile\\shell\\&Open {} "&Open"
     registry set $HKCR\\z_tfile\\shell\\&Open\\ddeexec {} "Open(\"%1\")"
     registry set $HKCR\\z_tfile\\shell\\&Open\\ddeexec\\application {} "TclEval"
     registry set $HKCR\\z_tfile\\shell\\&Open\\ddeexec\\topic {} "DdeEdit"
     registry set $HKCR\\z_tfile\\shell\\&Open\\command {} \
         "[file nativename [info nameofexecutable]]\
            [file nativename [file normalize [info script]]] \"%1\""
}
 
# -------------------------------------------------------------------------
 
if {$tcl_interactive} {
     puts "loaded"
} else {
     if {[llength $argv] == 1 && [string match "-install" [lindex $argv 0]]} {
         ::DdeEdit::install
         puts "install done"
         exit 0
     }
 
     # See if we already have a running app.
     package require Tk
     if {[dde services TclEval DdeEdit] != {}} {
         wm withdraw .
         set filename [file normalize [lindex $argv 0]]
         dde eval DdeEdit "Open(\"$filename\")"
         exit 0
     } else {
         eval DdeEdit::DdeEdit $argv
     }
}