' lserror.lss

Option Declare

' This module, both source code and documentation, is in the
' Public Domain, and comes with NO WARRANTY.
' See http://lserror.sourceforge.net for further information.

Public Sub rethrow
	If Err = 0 Then Exit Sub
	Error Err, formatError(Nothing, "", Getthreadinfo(10))
End Sub

Public Sub rethrowc(object As Variant)
	If Err = 0 Then Exit Sub
	Error Err, formatError(object, "", Getthreadinfo(10))
End Sub

Public Sub throw(id As Integer, message As String)
	If Err = 0 Then Exit Sub
	Error id, formatError(Nothing, message & Chr(10) & {Caused by error } & Err & {: }, Getthreadinfo(10))
End Sub

Public Sub throwc(object As Variant, id As Integer, message As String)
	If Err = 0 Then Exit Sub
	Error id, formatError(object, message & Chr(10) & {Caused by error } & Err & {: }, Getthreadinfo(10))
End Sub

Public Sub assert(Byval condition As Integer, message As String)
	If condition Then Exit Sub
	Stop
	Error 1000, formatError(Nothing, {Assertion failed: } & message, Getthreadinfo(10))
End Sub

Public Sub assertc(object As Variant, Byval condition As Integer, message As String)
	If condition Then Exit Sub
	Stop
	Error 1000, formatError(object, {Assertion failed: } & message, Getthreadinfo(10))
End Sub

Public Sub notify()
	notifyIntern Nothing, Getthreadinfo(10)
End Sub

Public Sub notifyc(object As Variant)
	notifyIntern object, Getthreadinfo(10)
End Sub

Private Function formatError(object As Variant, message As String, callproc As String) As String
	On Error Goto catch
	Dim session As New NotesSession, p As Integer, trace As String
	p = Instr(Error, {Caused by}) - 1
	If p < 0 Then p = Len(Error) + 1
	If Not object Is Nothing Then If Datatype(object) = 8 Then trace = "." & object Else trace = "." & Typename(object)
	trace = { at } & session.CurrentAgent.Name & trace & {.} & callproc & {:} & Erl
	formatError = Error
	If Instr(Error, trace) = 0 Then formatError = message & Left(Error, p - 1) & Chr(10) & trace & Mid(Error, p + 0)
	Exit Function
catch: Msgbox "Error " & Err & " in function formatError in line " & Erl & ": " & Error
	Exit Function
End Function

Private Sub notifyIntern(object As Variant, callproc As String)
	If Err = 0 Then Exit Sub
	On Error Goto catch
	Dim session As New NotesSession, errorLines As Variant, message As String
	message = formatError(object, "", callproc)
	errorLines = Split(message, Chr(10))
	Forall errorLine In errorLines
		If session.isOnServer Then Msgbox errorLine Else Print errorLine
	End Forall
	If Not session.isOnServer Then Msgbox message, 48, "Error " & Err
	Exit Sub
catch: Msgbox "Error " & Err & " in function notifyIntern in line " & Erl & ": " & Error
	Exit Sub
End Sub