Version 6 of ddeexec

Updated 2005-03-26 03:59:13

The windows shell uses the ddeexec registry key to try and open file type using a running dde service. You can specify both application and topic and the command (in dde parlance - the item) to be called.

The following is a sample application that runs a dde server and associates with files with a .z_t extension. You can open a file in this application by running either 'wish dde-edit.tcl <filename>' or once you have run 'wish dde-edit.tcl -install' to setup the file association - you can just do 'start xyzzy.z_t' and the Windows Shell will open the file in your tcl app for you.


 # 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.7 2005-03-26 07:00:29 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
     }
 }


[L1 ] [L2 ] [L3 ] [L4 ] [L5 ] [L6 ] [L7 ]