* win/makefile.vc: Improved the win build system.
authorpatthoyts <patthoyts>
Mon, 22 Nov 2004 23:48:47 +0000 (23:48 +0000)
committerpatthoyts <patthoyts>
Mon, 22 Nov 2004 23:48:47 +0000 (23:48 +0000)
* demos/*: Added a few sample applications, demos of broadcast,
multicast and normal operation.
* tools/mpexpand.tcl: Added app for generating documentation.

12 files changed:
ChangeLog
demos/broadcast.tcl [new file with mode: 0644]
demos/multicast.tcl [new file with mode: 0644]
demos/udpcat.tcl [new file with mode: 0644]
doc/manpage.css [new file with mode: 0644]
doc/udp.man
doc/udp.n
generic/udp_tcl.c
tools/mpexpand.tcl [new file with mode: 0644]
win/makefile.vc
win/rules.vc
win/tcludp.rc

index 690a7bed8d8740ec34b8ff5a96eea36d748f0819..c1ec4b83ab3e739d614ff4015ea42cb34d729f6c 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,10 @@
 2004-11-22  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
+       * win/makefile.vc: Improved the win build system.
+       * demos/*: Added a few sample applications, demos of broadcast, 
+       multicast and normal operation.
+       * tools/mpexpand.tcl: Added app for generating documentation.
+
        * generic/udp_tcl.h: Done some testing with multicast and have
        * generic/udp_tcl.c: rationalised the fconfigure/udp_conf interfaces
        a bit better. The -ttl option will set the multicast ttl if the
diff --git a/demos/broadcast.tcl b/demos/broadcast.tcl
new file mode 100644 (file)
index 0000000..dc9a430
--- /dev/null
@@ -0,0 +1,38 @@
+# multicast.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+#
+# Demonstrate the use of broadcast UDP sockets.
+#
+# You can send to ths using netcat:
+#  echo HELLO | nc -u 192.168.255.255 7772
+#
+# $Id$
+
+package require udp 1.0.6
+
+proc udpEvent {chan} {
+    set data [read $chan]
+    set peer [fconfigure $chan -peer]
+    puts "$peer [string length $data] '$data'"
+    if {[string match "QUIT*" $data]} {
+        close $chan
+        set ::forever 1
+    }
+    return
+}
+
+# Select a subnet and the port number.
+set subnet 192.168.255.255
+set port   7772
+
+# Create a listening socket and configure for sending too.
+set s [udp_open $port]
+fconfigure $s -buffering none -blocking 0
+fconfigure $s -broadcast 1 -remote [list $subnet $port]
+fileevent $s readable [list udpEvent $s]
+
+# Announce our presence and run
+puts -nonewline $s "hello, world"
+set forever 0
+vwait ::forever
+
+exit
diff --git a/demos/multicast.tcl b/demos/multicast.tcl
new file mode 100644 (file)
index 0000000..ff4414d
--- /dev/null
@@ -0,0 +1,38 @@
+# multicast.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+#
+# Demonstrate the use of IPv4 multicast UDP sockets.
+#
+# You can send to ths using netcat:
+#  echo HELLO | nc -u 224.5.1.21 7771
+#
+# $Id$
+
+package require udp 1.0.6
+
+proc udpEvent {chan} {
+    set data [read $chan]
+    set peer [fconfigure $chan -peer]
+    puts "$peer [string length $data] '$data'"
+    if {[string match "QUIT*" $data]} {
+        close $chan
+        set ::forever 1
+    }
+    return
+}
+
+# Select a multicast group and the port number.
+set group 224.5.1.21
+set port  7771
+
+# Create a listening socket and configure for sending too.
+set s [udp_open $port]
+fconfigure $s -buffering none -blocking 0
+fconfigure $s -mcastadd $group -remote [list $group $port]
+fileevent $s readable [list udpEvent $s]
+
+# Announce our presence and run
+puts -nonewline $s "hello, world"
+set forever 0
+vwait ::forever
+
+exit
diff --git a/demos/udpcat.tcl b/demos/udpcat.tcl
new file mode 100644 (file)
index 0000000..6cdec6e
--- /dev/null
@@ -0,0 +1,64 @@
+# udpsend.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sf.net>
+#
+# Demo application - cat data from stdin via a UDP socket.
+#
+# $Id$
+
+package require udp 1.0.6
+
+proc Event {sock} {
+    global forever
+    set pkt [read $sock]
+    set peer [fconfigure $sock -peer]
+    puts "Received [string length $pkt] from $peer\n$pkt"
+    set forever 1
+    return
+}
+
+proc Send {host port {msg {}}} {
+    set s [udp_open]
+    fconfigure $s -blocking 0 -buffering none -translation binary \
+        -remote [list $host $port]
+    fileevent $s readable [list Event $s]
+    if {$msg == {}} {
+        fcopy stdin $s
+    } else {
+        puts -nonewline $s $msg
+    }
+
+    after 2000
+    close $s
+}
+
+proc Listen {port} {
+    set s [udp_open $port]
+    fconfigure $s -blocking 0 -buffering none -translation binary
+    fileevent $s readable [list Event $s]
+    return $s
+}
+
+# -------------------------------------------------------------------------
+# Runtime
+# udpsend listen -port N -blocking 0
+# udpsend send host port message
+# -------------------------------------------------------------------------
+set forever 0
+
+if {! $tcl_interactive} {
+    switch -exact -- [set cmd [lindex $argv 0]] {
+        send {
+            eval [list Send] [lrange $argv 1 end]
+        }
+        listen {
+            set s [Listen [lindex $argv 1]]
+            vwait ::forever
+            close $s
+        }
+        default {
+            puts "usage: udpcat send host port ?message?\
+                \n       udpcat listen port"
+        }
+    }
+}
+
+
diff --git a/doc/manpage.css b/doc/manpage.css
new file mode 100644 (file)
index 0000000..8a4cfbd
--- /dev/null
@@ -0,0 +1,218 @@
+/*
+ * $Id$
+ * Author:     Joe English, <jenglish@flightab.com>
+ * Created:    26 Jun 2000
+ * Description:        CSS stylesheet for TCL man pages
+ */
+
+HTML {
+    background:        #FFFFFF;
+    color:             black;
+}
+
+BODY {
+    background:        #FFFFFF;
+    color:             black;
+}
+
+DIV.body {
+    margin-left:       10%;
+    margin-right:      10%;
+}
+DIV.header,DIV.footer {
+    width:             100%;
+    margin-left:       0%;
+    margin-right:      0%;
+}
+
+DIV.body H1,DIV.body H2 {
+    margin-left:       -5%;
+}
+
+/* Navigation material: */
+
+DIV.navbar {
+    width:             100%;
+    margin-top:                5pt;
+    margin-bottom:     5pt;
+    margin-left:       0%;
+    margin-right:      0%;
+    padding-top:       5pt;
+    padding-bottom:    5pt;
+    background:                #DDDDDD;
+    color:             black;
+    border:            1px solid black;
+    text-align:                center;
+    font-size:         small;
+    font-family:       sans-serif;
+}
+
+P.navaid {
+    text-align:        center;
+}
+.navaid {
+    font-size:         small;
+    font-family:       sans-serif;
+}
+
+P.notice {
+    text-align:        center;
+    font-size:         small;
+    font-family:       sans-serif;
+    font-style:        italic;
+    color:             red;
+}
+
+A.navaid:link          { color: green;         background: transparent; }
+A.navaid:visited       { color: green;         background: transparent; }
+A.navaid:active        { color: yellow;        background: transparent; }
+
+/* For most anchors, we should leave colors up to the user's preferences. */
+/*--
+A:link                 { color: blue;          background: transparent; }
+A:visited      { color: purple;        background: transparent; }
+A:active       { color: red;           background: transparent; }
+--*/
+
+H1, H2, H3, H4 {
+    margin-top:        1em;
+    font-family:       sans-serif;
+    font-size:         large;
+    color:             #005A9C;
+    background:        transparent;
+    text-align:                left;
+}
+
+H1.title {
+    text-align: center;
+}
+
+UL,OL {
+    margin-right: 0em;
+    margin-top: 3pt;
+    margin-bottom: 3pt;
+}
+UL LI {
+    list-style: disc;
+}
+OL LI {
+    list-style: decimal;
+}
+
+DT {
+       padding-top:    1ex;
+}
+
+DL.toc {
+    font:      normal 12pt/16pt sans-serif;
+    margin-left: 10%;
+}
+
+UL.toc,UL.toc UL, UL.toc UL UL {
+    font:      normal 12pt/14pt sans-serif;
+    list-style:        none;
+}
+LI.tocentry,LI.tocheading {
+    list-style:        none;
+    margin-left:       0em;
+    text-indent:       0em;
+    padding:           0em;
+}
+
+.tocheading {
+    font-family:       sans-serif;
+    font-weight:       bold;
+    color:             #005A9C;
+    background:        transparent;
+}
+
+PRE {
+    display:           block;
+    font-family:       monospace;
+    white-space:       pre;
+    margin:            0%;
+    padding-top:       0.5ex;
+    padding-bottom:    0.5ex;
+    padding-left:      1ex;
+    padding-right:     1ex;
+    width:             100%;
+}
+PRE.syntax {
+    color:             black;
+    background:        #80ffff;
+    border:            1px solid black;
+    font-family:       serif;
+}
+PRE.example {
+    color:             black;
+    background:        #f5dcb3;
+    border:            1px solid black;
+}
+
+PRE.sample {
+    color:             black;
+    background:        #f5dcb3;
+    border:            1px solid black;
+}
+
+DIV.arglist {
+    border:            1px solid black;
+    width:             100%;
+}
+TH, THEAD TR, TR.heading {
+    color:             #005A9C;
+    background:                #DDDDDD;
+    text-align:                center;
+    font-family:       sans-serif;
+    font-weight:       bold;
+}
+TR.syntax {
+    color:             black;
+    background:                #80ffff;
+}
+TR.desc {
+    color:             black;
+    background:                #f5dcb3;
+}
+
+/* TR.row[01] are used to get alternately colored table rows. 
+ * Could probably choose better colors here...
+ */
+TR.row0 {
+    color:             black;
+    background:                #efffef;
+}
+
+TR.row1 {
+    color:             black;
+    background:                #efefff;
+}
+
+/* Workaround for Netscape bugs:
+ * Netscape doesn't seem to compute table widths properly.
+ * unless they're wrapped inside a DIV.  (Additionally,
+ * it appears to require a non-zero border-width.)
+ */
+DIV.table {
+    border-width:      1px;
+    border-color:      white;
+    width:             100%;
+}
+DIV.menu {     /* Wrapper for TABLE class="menu" */
+    margin-top:                10px;
+    margin-bottom:     10px;
+    border:            thin solid #005A9C;
+    width:             100%;
+    margin-left:       5%;
+}
+
+VAR {
+    font-style: italic;
+}
+
+/* For debugging: highlight unrecognized elements: */
+.unrecognized {
+    color: red; background: green;
+}
+
+/* EOF */
index 00bd583b95fb515bdbe5cd3a40042fa9849dba75..21efc711861b82cb434acc6b96aca35bdfe2397f 100644 (file)
@@ -3,7 +3,7 @@
           script from tcllib: mpexpand nroff udp.man udp.n
                               mpexpand html  udp.man udp.html
 }]
-[manpage_begin udp n 1.0.5]
+[manpage_begin udp n 1.0.6]
 [copyright {1999-2000 Columbia University; all rights reserved}]
 [moddesc {Tcl UDP extension}]
 [titledesc {Create UDP sockets in Tcl}]
 [require udp 1.0]
 [description]
 
-This package provides support for using UDP through Tcl.
+This package provides support for using UDP through Tcl. The package provides
+a new channel type and attempts to permit the use of packet oriented UDP
+over stream oriented Tcl channels. The package defined three commands but
+[cmd udp_conf] should be considered depreciated in favour of the standard
+Tcl command [cmd fconfigure].
 
 [section "COMMANDS"]
 
@@ -30,7 +34,7 @@ if required.
 for packets written to this [arg "sock"]. You must call this command before
 writing data to the UDP socket.
 
-[call [cmd "udp_conf"] [arg "sock"] [arg [opt -myport]] [arg [opt -remote]] [arg [opt -peer]]]
+[call [cmd "udp_conf"] [arg "sock"] [arg [opt -myport]] [arg [opt -remote]] [arg [opt -peer]] [arg [opt "-broadcast bool"]] [arg [opt "-ttl count"]]]
 
 In addition to being used to configure the remote host, the [cmd "udp_conf"]
 command is used to obtain information about the UDP socket.
@@ -48,13 +52,31 @@ Returns the remote hostname and port number as set using
 Returns the remote hostname and port number for the packet most recently
 received by this socket.
 
+[lst_item "[arg -broadcast\ [opt boolean]]"]
+UDP packets can listen and send on the broadcast address. For some systems 
+a flag must be set on the socket to use broadcast. 
+With no argument this option will return the broadcast setting. With a 
+boolean argument the setting can be modified.
+
+[lst_item "[arg -ttl\ [opt count]]"]
+
+The time-to-live is given as the number of router hops the packet may do. For
+multicast packets this is important in specifying the distribution of the
+packet. The system default for multicast is 1 which restricts the packet 
+to the local subnet. To permit packets to pass routers, you must increase the
+ttl. A value of 31 should keep it within a site, while 255 is global.
+
+
 [list_end]
 
 [nl]
-[call [cmd "udp_conf"] [opt "[arg -mcastadd] [arg -mcastdrop]"]\
-     [arg groupaddr]]
+[call [cmd "udp_conf"] [opt "[arg -mcastadd] groupaddr"]]
+[call [cmd "udp_conf"] [opt "[arg -mcastdrop] groupaddr"]]
 
-FIX ME
+[package tcludp] sockets can support IPv4 multicast operations. To recieve
+multicast packets the application has to notify the operating system that
+it should join a particular multicast group. These are specified as addresses
+in the range 224.0.0.0 to 239.255.255.255. 
 
 [call [cmd "udp_peek"] [arg "sock"] [opt [arg "buffersize"]]]
 
@@ -69,7 +91,7 @@ This function is not available on windows.
 # Send data to a remote UDP socket
 proc udp_puts {host port} {
     set s [udp_open]
-    udp_conf $s $host $port
+    fconfigure $s -remote [list $host $port]
     puts $s "Hello, World"
     close $f
 }
@@ -81,7 +103,7 @@ package require udp
 
 proc udpEventHandler {sock} {
     set pkt [read $sock]
-    set peer [udp_conf $sock -peer]
+    set peer [fconfigure $sock -peer]
     puts "$peer: [string length $pkt] {$pkt}"
     return
 }
@@ -90,7 +112,7 @@ proc udp_listen {port} {
     set srv [udp_open $port]
     fconfigure $srv -buffering none -translation binary
     fileevent $srv readable [list ::udpEventHandler $srv]
-    puts "Listening on udp port: [udp_conf $srv -myport]"
+    puts "Listening on udp port: [fconfigure $srv -myport]"
     return $srv
 }
 
@@ -99,6 +121,31 @@ vwait forever
 close $sock
 }]
 
+[example {
+# A multicast demo.
+proc udpEvent {chan} {
+    set data [read $chan]
+    set peer [fconfigure $chan -peer]
+    puts "$peer [string length $data] '$data'"
+    if {[string match "QUIT*" $data]} {
+        close $chan
+        set ::forever 1
+    }
+    return
+}
+
+set group 224.5.1.21
+set port  7771
+set s [udp_open $port]
+fconfigure $s -buffering none -blocking 0
+fconfigure $s -mcastadd $group -remote [list $group $port]
+fileevent $s readable [list udpEvent $s]
+puts -nonewline $s "hello, world"
+set ::forever 0
+vwait ::forever
+exit
+}]
+
 [section "HISTORY"]
 
 Some of the code in this extension is copied from Michael Miller's tcludp
index 10d260dd1d65d933dd89abbdb89f76551e7c0aea..d1b2599b3568e45fc4cf4125c9f6145bd9a3ed2c 100644 (file)
--- a/doc/udp.n
+++ b/doc/udp.n
@@ -8,7 +8,7 @@
 '\"                               mpexpand html  udp.man udp.html
 '\"
 .so man.macros
-.TH "udp" n 1.0.5  "Tcl UDP extension"
+.TH "udp" n 1.0.6  "Tcl UDP extension"
 .BS
 .SH "NAME"
 udp \- Create UDP sockets in Tcl
@@ -17,33 +17,39 @@ package require \fBTcl  8.0\fR
 .sp
 package require \fBudp  1.0\fR
 .sp
-\fBudp_open\fR ?\fIport\fR?\fR
+\fBudp_open\fR ?\fIport\fR?
 .sp
-\fBudp_conf\fR \fIsock\fR \fIhost\fR \fIport\fR\fR
+\fBudp_conf\fR \fIsock\fR \fIhost\fR \fIport\fR
 .sp
-\fBudp_conf\fR \fIsock\fR \fI?-myport?\fR \fI?-remote?\fR \fI?-peer?\fR\fR
+\fBudp_conf\fR \fIsock\fR \fI?-myport?\fR \fI?-remote?\fR \fI?-peer?\fR \fI?-broadcast bool?\fR \fI?-ttl count?\fR
 .sp
-\fBudp_conf\fR ?\fI-mcastadd\fR \fI-mcastdrop\fR? \fIgroupaddr\fR\fR
+\fBudp_conf\fR ?\fI-mcastadd\fR groupaddr?
 .sp
-\fBudp_peek\fR \fIsock\fR ?\fIbuffersize\fR?\fR
+\fBudp_conf\fR ?\fI-mcastdrop\fR groupaddr?
+.sp
+\fBudp_peek\fR \fIsock\fR ?\fIbuffersize\fR?
 .sp
 .BE
 .SH "DESCRIPTION"
-This package provides support for using UDP through Tcl.
+This package provides support for using UDP through Tcl. The package provides
+a new channel type and attempts to permit the use of packet oriented UDP
+over stream oriented Tcl channels. The package defined three commands but
+\fBudp_conf\fR should be considered depreciated in favour of the standard
+Tcl command \fBfconfigure\fR.
 .SH "COMMANDS"
 .TP
-\fBudp_open\fR ?\fIport\fR?\fR
+\fBudp_open\fR ?\fIport\fR?
 \fBudp_open\fR will open a UDP socket. If \fIport\fR is specified the UDP
 socket will be opened on that port. Otherwise the system will choose a port
 and the user can use the \fBudp_conf\fR command to obtain the port number
 if required.
 .TP
-\fBudp_conf\fR \fIsock\fR \fIhost\fR \fIport\fR\fR
+\fBudp_conf\fR \fIsock\fR \fIhost\fR \fIport\fR
 \fBudp_conf\fR in this configuration is used to specify the remote destination
 for packets written to this \fIsock\fR. You must call this command before
 writing data to the UDP socket.
 .TP
-\fBudp_conf\fR \fIsock\fR \fI?-myport?\fR \fI?-remote?\fR \fI?-peer?\fR\fR
+\fBudp_conf\fR \fIsock\fR \fI?-myport?\fR \fI?-remote?\fR \fI?-peer?\fR \fI?-broadcast bool?\fR \fI?-ttl count?\fR
 In addition to being used to configure the remote host, the \fBudp_conf\fR
 command is used to obtain information about the UDP socket.
 .RS
@@ -58,13 +64,31 @@ Returns the remote hostname and port number as set using
 \fI-peer\fR
 Returns the remote hostname and port number for the packet most recently
 received by this socket.
+.TP
+\fI-broadcast ?boolean?\fR
+UDP packets can listen and send on the broadcast address. For some systems
+a flag must be set on the socket to use broadcast.
+With no argument this option will return the broadcast setting. With a
+boolean argument the setting can be modified.
+.TP
+\fI-ttl ?count?\fR
+The time-to-live is given as the number of router hops the packet may do. For
+multicast packets this is important in specifying the distribution of the
+packet. The system default for multicast is 1 which restricts the packet
+to the local subnet. To permit packets to pass routers, you must increase the
+ttl. A value of 31 should keep it within a site, while 255 is global.
 .RE
 .sp
 .TP
-\fBudp_conf\fR ?\fI-mcastadd\fR \fI-mcastdrop\fR? \fIgroupaddr\fR\fR
-FIX ME
+\fBudp_conf\fR ?\fI-mcastadd\fR groupaddr?
 .TP
-\fBudp_peek\fR \fIsock\fR ?\fIbuffersize\fR?\fR
+\fBudp_conf\fR ?\fI-mcastdrop\fR groupaddr?
+\fBtcludp\fR sockets can support IPv4 multicast operations. To recieve
+multicast packets the application has to notify the operating system that
+it should join a particular multicast group. These are specified as addresses
+in the range 224.0.0.0 to 239.255.255.255.
+.TP
+\fBudp_peek\fR \fIsock\fR ?\fIbuffersize\fR?
 Examine a packet without removing it from the buffer.
 This function is not available on windows.
 .SH "EXAMPLES"
@@ -73,7 +97,7 @@ This function is not available on windows.
 # Send data to a remote UDP socket
 proc udp_puts {host port} {
     set s [udp_open]
-    udp_conf $s $host $port
+    fconfigure $s -remote [list $host $port]
     puts $s "Hello, World"
     close $f
 }
@@ -84,7 +108,7 @@ package require udp
 
 proc udpEventHandler {sock} {
     set pkt [read $sock]
-    set peer [udp_conf $sock -peer]
+    set peer [fconfigure $sock -peer]
     puts "$peer: [string length $pkt] {$pkt}"
     return
 }
@@ -93,7 +117,7 @@ proc udp_listen {port} {
     set srv [udp_open $port]
     fconfigure $srv -buffering none -translation binary
     fileevent $srv readable [list ::udpEventHandler $srv]
-    puts "Listening on udp port: [udp_conf $srv -myport]"
+    puts "Listening on udp port: [fconfigure $srv -myport]"
     return $srv
 }
 
@@ -101,6 +125,30 @@ set sock [udp_listen 53530]
 vwait forever
 close $sock
 .fi
+.nf
+# A multicast demo.
+proc udpEvent {chan} {
+    set data [read $chan]
+    set peer [fconfigure $chan -peer]
+    puts "$peer [string length $data] '$data'"
+    if {[string match "QUIT*" $data]} {
+        close $chan
+        set ::forever 1
+    }
+    return
+}
+
+set group 224.5.1.21
+set port  7771
+set s [udp_open $port]
+fconfigure $s -buffering none -blocking 0
+fconfigure $s -mcastadd $group -remote [list $group $port]
+fileevent $s readable [list udpEvent $s]
+puts -nonewline $s "hello, world"
+set ::forever 0
+vwait ::forever
+exit
+.fi
 .SH "HISTORY"
 Some of the code in this extension is copied from Michael Miller's tcludp
 package. (http://www.neosoft.com/tcl/ftparchive/sorted/comm/tcludp-1.0/)
index e04a24430631c4d223db26d7e96317861b0f2111..63a6ccf7e1620c3e0a1ed305c32c7189e0a5cdba 100644 (file)
@@ -1155,18 +1155,22 @@ UdpMulticast(ClientData instanceData, Tcl_Interp *interp,
        int ndx = LSearch(statePtr->groupsObj, grp);
        if (ndx != -1) {
            Tcl_Obj *old, *ptr;
+            int dup = 0;
            old = ptr = statePtr->groupsObj;
            statePtr->multicast--;
-           if (Tcl_IsShared(ptr)) {
+           if ((dup = Tcl_IsShared(ptr))) {
                ptr = Tcl_DuplicateObj(ptr);
            }
            Tcl_ListObjReplace(interp, ptr, ndx, 1, 0, NULL);
-           statePtr->groupsObj = ptr;
-           Tcl_IncrRefCount(ptr);
-           Tcl_DecrRefCount(old);
+            if (dup) {
+               statePtr->groupsObj = ptr;
+               Tcl_IncrRefCount(ptr);
+               Tcl_DecrRefCount(old);
+            }
        }
     }
-    Tcl_SetObjResult(interp, statePtr->groupsObj);
+    if (interp != NULL)
+        Tcl_SetObjResult(interp, statePtr->groupsObj);
     return TCL_OK;
 }
 \f
diff --git a/tools/mpexpand.tcl b/tools/mpexpand.tcl
new file mode 100644 (file)
index 0000000..4c0ff65
--- /dev/null
@@ -0,0 +1,165 @@
+#!/bin/sh
+# -*- tcl -*- \
+exec tclsh "$0" ${1+"$@"}
+
+lappend auto_path [file dirname [file dirname [info script]]]
+
+if 0 {
+    puts auto_path=\n\t[join $auto_path \n\t]
+    catch {puts tcl_pkgPath=\n\t[join $tcl_pkgPath \n\t]}
+    catch {puts tcl_libPath=\n\t[join $tcl_libPath \n\t]}
+
+    puts [package require doctools]
+    exit
+}
+
+package require doctools
+
+
+
+# ---------------------------------------------------------------------
+#  1. Handle command line options, input and output
+#  2. Initialize a doctools object.
+#  3. Run the input through the object.
+#  4. Write output.
+# ---------------------------------------------------------------------
+
+proc usage {{exitstate 1}} {
+    global argv0
+    puts "Usage: $argv0\
+           ?-h|--help|-help|-??\
+           ?-help-fmt|--help-fmt?\
+           ?-module module?\
+           ?-deprecated?\
+           ?-copyright text?\
+           format in|- ?out|-?"
+    exit $exitstate
+}
+
+# ---------------------------------------------------------------------
+
+proc fmthelp {} {
+    # Tcllib FR #527029: short reference of formatting commands.
+
+    global argv0
+    puts "$argv0 [doctools::help]"
+    exit 0
+}
+
+# ---------------------------------------------------------------------
+# 1. Handle command line options, input and output
+
+proc cmdline {} {
+    global argv0 argv format in out extmodule deprecated copyright
+
+    set copyright ""
+    set extmodule ""
+    set deprecated 0
+
+    while {[string match -* [set opt [lindex $argv 0]]]} {
+       switch -exact -- $opt {
+           -module {
+               set extmodule [lindex $argv 1]
+               set argv [lrange $argv 2 end]
+               continue
+           }
+           -copyright {
+               set copyright [lindex $argv 1]
+               set argv [lrange $argv 2 end]
+               continue
+           }
+           -deprecated {
+               set deprecated 1
+               set argv [lrange $argv 1 end]
+           }
+           -help - -h - --help - -? {
+               # Tcllib FR #527029
+               usage 0
+           }
+           -help-fmt - --help-fmt {
+               # Tcllib FR #527029
+               fmthelp
+           }
+           default {
+               # Unknown option
+               usage
+           }
+       }
+    }
+
+    if {[llength $argv] < 3} {
+       usage
+    }
+    foreach {format in out} $argv break
+
+    if {$format == {} || $in == {}} {
+       usage
+    }
+    if {$out == {}} {set out -}
+    return $format
+}
+
+# ---------------------------------------------------------------------
+#  3. Read input. Also providing the namespace with file information.
+
+proc get_input {} {
+    global in
+    if {[string equal $in -]} {
+       return [read stdin]
+    } else {
+       set if [open $in r]
+       set text [read $if]
+       close $if
+       return $text
+    }
+}
+
+# ---------------------------------------------------------------------
+# 4. Write output.
+
+proc write_out {text} {
+    global out
+    if {[string equal $out -]} {
+       puts -nonewline stdout $text
+    } else {
+       set of [open $out w]
+       puts -nonewline $of $text
+       close $of
+    }
+}
+
+
+# ---------------------------------------------------------------------
+# Get it all together
+
+proc main {} {
+    global format deprecated extmodule in copyright
+
+    #if {[catch {}
+       cmdline
+
+       ::doctools::new dt -format $format -deprecated $deprecated -file $in
+       if {$extmodule != {}} {
+           dt configure -module $extmodule
+       }
+       if {$copyright != {}} {
+           dt configure -copyright $copyright
+       }
+
+       write_out [dt format [get_input]]
+
+       set warnings [dt warnings]
+       if {[llength $warnings] > 0} {
+           puts stderr [join $warnings \n]
+       }
+
+       #{} msg]} {}
+       #puts stderr "Execution error: $msg"
+    #{}
+    return
+}
+
+
+# ---------------------------------------------------------------------
+main
+exit
index e909bd9888c33973e32f298c6d4972d274a6fdb8..2e91178f6bae0585ef36e92baa04e6a8ec322e71 100644 (file)
@@ -21,7 +21,7 @@
 # RCS: @(#)$Id$
 #-------------------------------------------------------------------------
 
-!if "$(MSVCDIR)" == ""
+!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCToolkitInstallDir)
 MSG = ^
 You will need to run vcvars32.bat from Developer Studio, first, to setup^
 the environment.  Jump to this line to read the new instructions.
@@ -164,6 +164,9 @@ DLLOBJS = \
        $(TMP_DIR)\udp_tcl.obj \
        $(TMP_DIR)\tcludp.res
 
+PRJDOCS = \
+       $(OUT_DIR)\udp.html
+
 #-------------------------------------------------------------------------
 # Target names and paths ( shouldn't need changing )
 #-------------------------------------------------------------------------
@@ -179,25 +182,23 @@ PRJSTUBLIBNAME    = $(STUBPREFIX)$(VERSION).lib
 PRJSTUBLIB     = $(OUT_DIR)\$(PRJSTUBLIBNAME)
 
 ### Make sure we use backslash only.
-LIB_INSTALL_DIR                = $(_INSTALLDIR)\lib
-BIN_INSTALL_DIR                = $(_INSTALLDIR)\bin
-DOC_INSTALL_DIR                = $(_INSTALLDIR)\doc
-SCRIPT_INSTALL_DIR     = $(_INSTALLDIR)\lib\$(PROJECT)$(DOTVERSION)
-INCLUDE_INSTALL_DIR    = $(_INSTALLDIR)\include
+PRJ_INSTALL_DIR         = $(_INSTALLDIR)\$(PROJECT)$(DOTVERSION)
+BIN_INSTALL_DIR                = $(PRJ_INSTALL_DIR)
+DOC_INSTALL_DIR                = $(PRJ_INSTALL_DIR)
+SCRIPT_INSTALL_DIR     = $(PRJ_INSTALL_DIR)
+DEMO_INSTALL_DIR       = $(PRJ_INSTALL_DIR)\demos
+INCLUDE_INSTALL_DIR    = $(_TCLDIR)\include
+LIB_INSTALL_DIR                = $(_TCLDIR)\lib
 
 ### The following paths CANNOT have spaces in them.
 GENERICDIR     = $(ROOT)\generic
 WINDIR         = $(ROOT)\win
 LIBDIR          = $(ROOT)\library
 DOCDIR         = $(ROOT)\doc
+DEMODIR                = $(ROOT)\demos
 TOOLSDIR       = $(ROOT)\tools
 COMPATDIR      = $(ROOT)\compat
 
-### Find a tclsh for testing and installation.
-!if !exist("$(TCLSH)")
-TCLSH           = $(BIN_INSTALL_DIR)\tclsh$(TCL_VERSION).exe
-!endif
-
 #---------------------------------------------------------------------
 # Compile flags
 #---------------------------------------------------------------------
@@ -211,9 +212,9 @@ cdebug      =
 !endif
 !else if "$(MACHINE)" == "IA64"
 ### Warnings are too many, can't support warnings into errors.
-cdebug = -Z7 -Od
+cdebug = -Z7 -Od -GZ
 !else
-cdebug = -Z7 -WX -Od
+cdebug = -Z7 -WX -Od -GZ
 !endif
 
 ### Declarations common to all compiler options
@@ -294,17 +295,31 @@ TESTFLAGS = -file $(TESTPAT)
 
 all:       setup $(PROJECT)
 $(PROJECT): setup $(PRJLIB)
-install:    install-binaries install-libraries install-docs
+doc:        setup $(PRJDOCS)
+install:    install-binaries install-libraries install-docs install-demos
 
 
-test: setup $(PROJECT)
-       set TCL_LIBRARY=$(ROOT)/library
+# Tests need to ensure we load the right dll file we
+# have to handle the output differently on Win9x.
+#
 !if "$(OS)" == "Windows_NT"  || "$(MSVCDIR)" == "IDE"
-       $(TCLSH) "$(ROOT)/tests/all.tcl" $(TESTFLAGS)
+test: setup $(PROJECT)
+        $(TCLSH) <<
+load $(PRJLIB:\=/)
+cd "$(ROOT)/tests"
+set argv "$(TESTFLAGS)"
+source all.tcl
+<<
 !else
-       @echo Please wait while the tests are collected...
-       $(TCLSH) "$(ROOT)/tests/all.tcl" $(TESTFLAGS) > tests.log
-       type tests.log | more
+test: setup $(PROJECT)
+        echo Please wait while the test results are collected
+        $(TCLSH) << >tests.log
+load $(PRJLIB:\=/)
+cd "$(ROOT)/tests"
+set argv "$(TESTFLAGS)"
+source all.tcl
+<<
+        type tests.log | more
 !endif
 
 setup:
@@ -341,6 +356,9 @@ $<
 
 {$(WINDIR)}.rc{$(TMP_DIR)}.res:
        $(rc32) -fo $@ -r -i "$(GENERICDIR)" -D__WIN32__ \
+               -DCOMMAVERSION=$(DOTVERSION:.=,),0 \
+               -DDOTVERSION=\"$(DOTVERSION)\" \
+               -DVERSION=\"$(VERSION)$(SUFX)\" \
 !if $(DEBUG)
        -d DEBUG \
 !endif
@@ -352,8 +370,19 @@ $<
 !endif
        $<
 
+DOC2HTML = $(TCLSH) "$(TOOLSDIR)\mpexpand.tcl" html
+
+{$(DOCDIR)}.man{$(OUT_DIR)}.html:
+       $(DOC2HTML) $< $@
+        @$(TCLSH) <<
+set name $(@:\=/)
+set f [open $$name r]; set d [read $$f]; close $$f
+set d [regsub {</head>} $$d {<link rel="stylesheet" href="manpage.css" type="text/css"></head>}]
+set f [open $$name w]; puts -nonewline $$f $$d; close $$f
+<<
+
 .SUFFIXES:
-.SUFFIXES:.c .rc
+.SUFFIXES:.c .rc .man
 
 #---------------------------------------------------------------------
 # Installation. (EDIT)
@@ -364,17 +393,32 @@ $<
 #---------------------------------------------------------------------
 
 install-binaries:
-       @echo Installing to '$(SCRIPT_INSTALL_DIR)'
-       @if not exist $(SCRIPT_INSTALL_DIR)\nul mkdir $(SCRIPT_INSTALL_DIR)
-       $(CPY) $(PRJLIB) $(SCRIPT_INSTALL_DIR)
+       @echo Installing binaries to '$(SCRIPT_INSTALL_DIR)'
+       @if not exist $(SCRIPT_INSTALL_DIR)\nul mkdir "$(SCRIPT_INSTALL_DIR)"
+       @$(CPY) $(PRJLIB) "$(SCRIPT_INSTALL_DIR)" >NUL
 
 install-libraries:
-       @echo Installing to '$(SCRIPT_INSTALL_DIR)'
-       @if exist $(LIBDIR)\nul $(CPY) $(LIBDIR)\*.tcl $(SCRIPT_INSTALL_DIR)
-       @cd $(SCRIPT_INSTALL_DIR)
-       @echo pkg_mkIndex -verbose . | $(TCLSH)
+       @echo Installing libraries to '$(SCRIPT_INSTALL_DIR)'
+#      @$(CPY) $(LIBDIR)\*.tcl "$(SCRIPT_INSTALL_DIR)" >NUL
+       @type << >"$(SCRIPT_INSTALL_DIR)\pkgIndex.tcl"
+# Handcrafted pkgIndex for tcludp.
+if {[info exists ::tcl_platform(debug)]} {
+    package ifneeded $(PROJECT) $(DOTVERSION) [list load [file join $$dir $(PROJECT)$(VERSION)g.$(EXT)]]
+} else {
+    package ifneeded $(PROJECT) $(DOTVERSION) [list load [file join $$dir $(PROJECT)$(VERSION).$(EXT)]]
+}
+<<
+
+install-docs: $(PRJDOCS)
+       @echo Installing documentation to '$(DOC_INSTALL_DIR)'
+       @if not exist $(DOC_INSTALL_DIR)\NUL mkdir "$(DOC_INSTALL_DIR)"
+       @$(CPY) "$(DOCDIR)\manpage.css" "$(DOC_INSTALL_DIR)\" >NUL
+       @for %i in ($(PRJDOCS)) do @$(CPY) %i "$(DOC_INSTALL_DIR)\" > NUL
 
-install-docs:
+install-demos:
+       @echo Installing demos to '$(DEMO_INSTALL_DIR)'
+       @if not exist $(DEMO_INSTALL_DIR)\nul mkdir "$(DEMO_INSTALL_DIR)"
+       @$(CPY) $(DEMODIR)\*.tcl "$(DEMO_INSTALL_DIR)" >NUL
 
 #---------------------------------------------------------------------
 # Clean up
@@ -382,6 +426,7 @@ install-docs:
 
 clean:
        @if exist $(TMP_DIR)\nul $(RMDIR) $(TMP_DIR)
+       @if exist $(WINDIR)\version.vc del $(WINDIR)\version.vc
 
 realclean: clean
        @if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
index cd2402779623a4b3247df1c9b15e9ab91ef7cc46..ba4b828441050c206caf9282846e71a87c1a5ca8 100644 (file)
@@ -29,7 +29,7 @@ rc32          = $(RC)   # built-in default.
 ### Assume the normal default.
 _INSTALLDIR    = C:\Program Files\Tcl
 !else
-### Fix the path seperators.
+### Fix the path separators.
 _INSTALLDIR    = $(INSTALLDIR:/=\)
 !endif
 
@@ -310,12 +310,17 @@ OPTDEFINES        = $(OPTDEFINES) -DTCL_CFG_DO64BIT
 
 !if "$(PROJECT)" != "tcl"
 
-!if !defined(TCLDIR)
+# If INSTALLDIR set to tcl root dir then reset to the lib dir.
 !if exist("$(_INSTALLDIR)\include\tcl.h")
+_INSTALLDIR=$(_INSTALLDIR)\lib
+!endif
+
+!if !defined(TCLDIR)
+!if exist("$(_INSTALLDIR)\..\include\tcl.h")
 TCLINSTALL     = 1
-_TCLDIR                = $(_INSTALLDIR)
-_TCL_H          = $(_INSTALLDIR)\include\tcl.h
-TCLDIR          = $(_INSTALLDIR)
+_TCLDIR                = $(_INSTALLDIR)\..
+_TCL_H          = $(_INSTALLDIR)\..\include\tcl.h
+TCLDIR          = $(_INSTALLDIR)\..
 !else
 MSG=^
 Failed to find tcl.h.  Set the TCLDIR macro.
@@ -325,14 +330,15 @@ Failed to find tcl.h.  Set the TCLDIR macro.
 _TCLDIR        = $(TCLDIR:/=\)
 !if exist("$(_TCLDIR)\include\tcl.h")
 TCLINSTALL     = 1
+_TCL_H          = $(_TCLDIR)\include\tcl.h
 !elseif exist("$(_TCLDIR)\generic\tcl.h")
 TCLINSTALL     = 0
+_TCL_H          = $(_TCLDIR)\generic\tcl.h
 !else
 MSG =^
 Failed to find tcl.h.  The TCLDIR macro does not appear correct.
 !error $(MSG)
 !endif
-_TCL_H          = $(_TCLDIR)\generic\tcl.h
 !endif
 
 !if [nmakehlp -v $(_TCL_H) ""] == 0
@@ -343,24 +349,16 @@ TCL_VERSION       = $(TCL_DOTVERSION:.=)
 !endif
 
 !if $(TCLINSTALL)
-TCLSH          = "$(_INSTALLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
-TCLSTUBLIB     = "$(_INSTALLDIR)\lib\tclstub$(TCL_VERSION).lib"
-TCLIMPLIB      = "$(_INSTALLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
-TCL_LIBRARY    = $(_INSTALLDIR)\lib
-TCLREGLIB      = "$(_INSTALLDIR)\lib\tclreg11$(SUFX:t=).lib"
-TCLDDELIB      = "$(_INSTALLDIR)\lib\tcldde12$(SUFX:t=).lib"
-COFFBASE       = \must\have\tcl\sources\to\build\this\target
-TCLTOOLSDIR    = \must\have\tcl\sources\to\build\this\target
-TCL_INCLUDES    = -I"$(_INSTALLDIR)\include"
+TCLSH          = "$(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe"
+TCLSTUBLIB     = "$(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib"
+TCLIMPLIB      = "$(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib"
+TCL_LIBRARY    = $(_TCLDIR)\lib
+TCL_INCLUDES    = -I"$(_TCLDIR)\include"
 !else
 TCLSH          = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe"
 TCLSTUBLIB     = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib"
 TCLIMPLIB      = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib"
 TCL_LIBRARY    = $(_TCLDIR)\library
-TCLREGLIB      = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg11$(SUFX:t=).lib"
-TCLDDELIB      = "$(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde12$(SUFX:t=).lib"
-COFFBASE       = "$(_TCLDIR)\win\coffbase.txt"
-TCLTOOLSDIR    = $(_TCLDIR)\tools
 TCL_INCLUDES   = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
 !endif
 
@@ -373,11 +371,16 @@ TCL_INCLUDES      = -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
 !if "$(PROJECT)" != "tcl" && "$(PROJECT)" != "tk"
 
 !if !defined(TKDIR)
-!if exist("$(_INSTALLDIR)\include\tk.h")
+!if exist("$(_INSTALLDIR)\..\include\tk.h")
+TKINSTALL      = 1
+_TKDIR         = $(_INSTALLDIR)\..
+_TK_H          = $(_TKDIR)\include\tk.h
+TKDIR          = $(_TKDIR)
+!elseif exist("$(_TCLDIR)\include\tk.h")
 TKINSTALL      = 1
-_TKDIR         = $(_INSTALLDIR)
-_TK_H          = $(_INSTALLDIR)\include\tk.h
-TKDIR          = $(_INSTALLDIR)
+_TKDIR         = $(_TCLDIR)
+_TK_H          = $(_TKDIR)\include\tk.h
+TKDIR          = $(_TKDIR)
 !else
 MSG =^
 Failed to find tk.h. Set the TKDIR macro.
@@ -387,14 +390,15 @@ Failed to find tk.h. Set the TKDIR macro.
 _TKDIR = $(TKDIR:/=\)
 !if exist("$(_TKDIR)\include\tk.h")
 TKINSTALL      = 1
+_TK_H          = $(_TKDIR)\include\tk.h
 !elseif exist("$(_TKDIR)\generic\tk.h")
 TKINSTALL      = 0
+_TK_H          = $(_TKDIR)\generic\tk.h
 !else
 MSG =^
 Failed to find tk.h. The TKDIR macro does not appear correct.
 !error $(MSG)
 !endif
-_TK_H          = $(_TKDIR)\generic\tk.h
 !endif
 
 !if [nmakehlp -v $(_TCL_H) $(_TK_H)] == 0
@@ -405,10 +409,10 @@ TK_VERSION        = $(TK_DOTVERSION:.=)
 !endif
 
 !if $(TKINSTALL)
-WISH           = "$(_INSTALLDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
-TKSTUBLIB      = "$(_INSTALLDIR)\lib\tkstub$(TK_VERSION).lib"
-TKIMPLIB       = "$(_INSTALLDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
-TK_INCLUDES     = -I"$(_INSTALLDIR)\include"
+WISH           = "$(_TKDIR)\bin\wish$(TK_VERSION)$(SUFX).exe"
+TKSTUBLIB      = "$(_TKDIR)\lib\tkstub$(TK_VERSION).lib"
+TKIMPLIB       = "$(_TKDIR)\lib\tk$(TK_VERSION)$(SUFX).lib"
+TK_INCLUDES     = -I"$(_TKDIR)\include"
 !else
 WISH           = "$(_TKDIR)\win\$(BUILDDIRTOP)\wish$(TCL_VERSION)$(SUFX).exe"
 TKSTUBLIB      = "$(_TKDIR)\win\$(BUILDDIRTOP)\tkstub$(TCL_VERSION).lib"
index fb16bf5b2c0cfb2740f5afc7abdfdb0ac838aff1..40d5abf7e40e0f74fd53bdb90bc83237cc87ca19 100644 (file)
@@ -8,8 +8,8 @@
 LANGUAGE 0x9, 0x1      /* LANG_ENGLISH, SUBLANG_DEFAULT */
 
 VS_VERSION_INFO VERSIONINFO
- FILEVERSION    1,0,6,0
- PRODUCTVERSION 1,0,6,0
+ FILEVERSION    COMMAVERSION
+ PRODUCTVERSION COMMAVERSION
  FILEFLAGSMASK         0x3fL
 #ifdef DEBUG
  FILEFLAGS     VS_FF_DEBUG
@@ -24,12 +24,12 @@ BEGIN
     BEGIN
         BLOCK "040904b0" /* LANG_ENGLISH/SUBLANG_ENGLISH_US, Unicode CP */
         BEGIN
-            VALUE "FileDescription", "Tcl UDP extension\0"
-            VALUE "OriginalFilename", "udp106.dll\0"
-            VALUE "FileVersion", "1.0.6.0\0"
-            VALUE "LegalCopyright", "Copyright \251 1999-2000 Columbia University; all rights reserved\0"
-            VALUE "ProductName", "TclUDP\0"
-            VALUE "ProductVersion", "1.0.6.0\0"
+            VALUE "FileDescription", "Tcl UDP " DOTVERSION " for Windows\0"
+            VALUE "OriginalFilename", "udp" VERSION ".dll\0"
+            VALUE "FileVersion",      DOTVERSION "\0"
+            VALUE "LegalCopyright",   "Copyright \251 1999-2000 Columbia University; all rights reserved\0"
+            VALUE "ProductName",      "TclUDP " DOTVERSION " for Windows\0"
+            VALUE "ProductVersion",   DOTVERSION "\0"
         END                
     END
     BLOCK "VarFileInfo"