Tcl Source Code

Artifact 7c7dff8c5956e643bbed8e2ff1c75dadf6fa538f:

Attachment "w macro.patch" to ticket [1034954fff] added by wildcard_25 2004-09-26 18:25:22.

---

diff -urd -x CVS src_tcl_orig\tools\man2help2.tcl src_tcl\tools\man2help2.tcl
--- src_tcl_orig\tools\man2help2.tcl	Thu Sep 23 23:49:40 2004
+++ src_tcl\tools\man2help2.tcl	Sun Sep 26 11:53:41 2004
@@ -39,7 +39,7 @@
 
 proc initGlobals {} {
     uplevel \#0 unset state
-    global state chars
+    global state chars twipsPerChar
 
     set state(paragraphPending) 0
     set state(breakPending) 0
@@ -63,6 +63,9 @@
     set state(sb) 0
     setTabs 0.5i
 
+# Approximate twips per character
+    set twipsPerChar 86.4
+
 # set up international character table
 
     array set chars {
@@ -586,9 +589,9 @@
 	    set relativeTo [expr {$state(leftMargin) \
 		    + ($state(offset) * $state(nestingLevel))}]
 	}
-	if {[regexp {^\w'(.*)'u$} $arg -> submatch]} {
-	    # Magic factor!
-	    set distance [expr {[string length $submatch] * 86.4}]
+        if { [string match {\\w*} $arg] } {
+            set arg [string range $arg 2 end]
+            set distance [macro2 w $arg]
 	} else {
 	    set distance [getTwips $arg]
 	}
@@ -705,11 +708,24 @@
 # error diagnostic.
 #
 # Arguments:
-# name -		The name of the macro (without the ".").
+# name -		The name of the macro (without the "\").
 # args -		Any additional arguments to the macro.
 
-proc macro2 {name args} {
-    puts stderr "Unknown macro: '$name [join $args " "]"
+proc macro2 {name arg} {
+    global twipsPerChar
+
+    switch -- $name {
+        w {
+            if { [regexp -- {^'(.*)'u$} $arg -> submatch] } {
+                return [expr { [string length $submatch] * $twipsPerChar }]
+            }
+            puts stderr "Bad \\w macro: \\$name $arg"
+        }
+        default {
+            puts stderr "Unknown macro: \\$name $arg"
+        }
+    }
+    return
 }
 
 
diff -urd -x CVS src_tcl_orig\tools\man2tcl.c src_tcl\tools\man2tcl.c
--- src_tcl_orig\tools\man2tcl.c	Mon Jan 12 14:49:17 2004
+++ src_tcl\tools\man2tcl.c	Sun Sep 26 10:27:34 2004
@@ -240,7 +240,21 @@
 	    QuoteText(p+1, (end-(p+1)));
 	} else {
 	    for (end = p+1;  (*end != 0) && !isspace(*end); end++) {
-		/* Empty loop body. */
+                if (*end == '\'')  {
+                    /*
+                     * The argument has internal quotes.
+                     */
+
+                    for (end = end+1; *end != '\''; end++) {
+                        if (*end == 0) {
+                            fprintf(stderr,
+                                "Unclosed quote in macro call on line %d.\n",
+                                lineNumber);
+                                    status = 1;
+                            break;
+                        }
+                    }
+		}
 	    }
 	    QuoteText(p, end-p);
 	}