Generate -errorcode values to go with errors. Generate messages and postscript

using Tcl_Obj API, not the string result API.

1 files changed, 18 insertions, 9 deletions

diff --git a/library/comdlg.tcl b/library/comdlg.tcl
index 39d27d3..f89754c 100644
--- a/library/comdlg.tcl
+++ b/library/comdlg.tcl
@@ -40,7 +40,8 @@ proc tclParseConfigSpec {w specs flags argList} {
     #
     foreach spec $specs {
 	if {[llength $spec] < 4} {
-	    error "\"spec\" should contain 5 or 4 elements"
+	    return -code error -errorcode {TK VALUE CONFIG_SPEC} \
+		"\"spec\" should contain 5 or 4 elements"
 	}
 	set cmdsw [lindex $spec 0]
 	set cmd($cmdsw) ""
@@ -53,9 +54,11 @@ proc tclParseConfigSpec {w specs flags argList} {
     if {[llength $argList] & 1} {
 	set cmdsw [lindex $argList end]
 	if {![info exists cmd($cmdsw)]} {
-	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
+	    return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \
+		"bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
 	}
-	error "value for \"$cmdsw\" missing"
+	return -code error -errorcode {TK VALUE_MISSING} \
+	    "value for \"$cmdsw\" missing"
     }
 
     # 2: set the default values
@@ -68,7 +71,8 @@ proc tclParseConfigSpec {w specs flags argList} {
     #
     foreach {cmdsw value} $argList {
 	if {![info exists cmd($cmdsw)]} {
-	    error "bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
+	    return -code error -errorcode [list TK LOOKUP OPTION $cmdsw] \
+		"bad option \"$cmdsw\": must be [tclListValidFlags cmd]"
 	}
 	set data($cmdsw) $value
     }
@@ -120,7 +124,8 @@ proc tclListValidFlags {v} {
 proc ::tk::FocusGroup_Create {t} {
     variable ::tk::Priv
     if {[winfo toplevel $t] ne $t} {
-	error "$t is not a toplevel window"
+	return -code error -errorcode [list TK LOOKUP TOPLEVEL $t] \
+	    "$t is not a toplevel window"
     }
     if {![info exists Priv(fg,$t)]} {
 	set Priv(fg,$t) 1
@@ -140,7 +145,8 @@ proc ::tk::FocusGroup_BindIn {t w cmd} {
     variable FocusIn
     variable ::tk::Priv
     if {![info exists Priv(fg,$t)]} {
-	error "focus group \"$t\" doesn't exist"
+	return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \
+	    "focus group \"$t\" doesn't exist"
     }
     set FocusIn($t,$w) $cmd
 }
@@ -156,7 +162,8 @@ proc ::tk::FocusGroup_BindOut {t w cmd} {
     variable FocusOut
     variable ::tk::Priv
     if {![info exists Priv(fg,$t)]} {
-	error "focus group \"$t\" doesn't exist"
+	return -code error -errorcode [list TK LOOKUP FOCUS_GROUP $t] \
+	    "focus group \"$t\" doesn't exist"
     }
     set FocusOut($t,$w) $cmd
 }
@@ -255,7 +262,8 @@ proc ::tk::FocusGroup_Out {t w detail} {
 proc ::tk::FDGetFileTypes {string} {
     foreach t $string {
 	if {[llength $t] < 2 || [llength $t] > 3} {
-	    error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
+	    return -code error -errorcode {TK VALUE FILE_TYPE} \
+		"bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
 	}
 	lappend fileTypes([lindex $t 0]) {*}[lindex $t 1]
     }
@@ -274,7 +282,8 @@ proc ::tk::FDGetFileTypes {string} {
 	# empty.
 	foreach macType [lindex $t 2] {
 	    if {[string length $macType] != 4} {
-		error "bad Macintosh file type \"$macType\""
+		return -code error -errorcode {TK VALUE MAC_TYPE} \
+		    "bad Macintosh file type \"$macType\""
 	    }
 	}