rebol [
    title:      {vprint: print/logging management tool}
	version: 	1.3.2
	date: 		2008-12-11
	author:		"Maxim Olivier-Adlhoch"
	copyright:	"Copyright (c) 2002-2008 Maxim Olivier-Adlhoch"
	file:       %vprint.r
	license:    'mit
	purpose:	"programatically selectable, indented printing/tracing/logging/debugging engine."

	;-- REBOL.ORG header --
 	library: [
        level: 'intermediate
        platform: 'all
        type: [module]
        domain: [external-library debug file-handling testing]
        tested-under: [win view 2.7.5]
        license: 'MIT
        see also: none
    ]
    
	changes: {}
	History: {
		v1.2.2 - 8-May-2006/12:44:49 (MOA)
			-unified tag usage by adding print?() and indented-print()
			-updated v??()
			-added vprint() and related indented-prin()
	
		v1.2.3 - 2-Jun-2006/11:36:28 (MOA)
			-add log-file capapabilites to whole module
			-reworked some funcs to accomodate the logging.
			-fixed a few logging-related bugs.
	
		v1.2.4 - 6-Jun-2006/16:39:48 (MOA)
			-added vlogclear
			-von always sets verbose on, otherwise tags don't work anyways.
	
		v1.3.0 - 10-Jun-2006/18:17:36 (MOA)
	
		v1.3.1 - 2008-12-11/15:22:40 (max)
			-optimised exclude
			-one or two little tweaks (fixes?)

		v1.3.2 - 2008-12-11/15:29:29 (max)
			-license change to MIT
	}
	todo: {
		-include vask function in public distribution, which functions the same way as the other vprint
		 functions but instead causes a break in the code, by asking a question in the console.
		 
		 This function also responds to tags, so you can switch any breakpoints, programatically!
		 
		-create a view-enabled version of vask, which pops up a modal window, forcing you to click "ok" 
		 before app continues.
		 
	}
]



;; conditional lib execution, simulates C/C++ #ifndef 
do unless (value? 'lib-vprint) [[


;; declare lib
lib-vprint: true


lib-vprint-ctx: context [
;-------------------------------
;  VERBOSE PRINTING MANAGEMENT
;-------------------------------

;-------------------------------
; vprint mechanism is copyright (c) 2002-2006 Maxim Olivier-Adlhoch
; licensed commercially for the Railnet 2 project
;-------------------------------


;-------------------------------
;- VALUES
;-------------------------------
verbose:    false   ; display console messages
vtabs: []
ltabs: []

vtags: copy []			; setting this to a block of tags to print, allows vtags to function, making console messages very selective.
ntags: copy []			; setting this to a block of tags to ignore, prevents vtags to function, making console messages very selective.
log-vtags: copy []     ; selective logging selection
log-ntags: copy []     ; selective logging ignoring.
vconsole: none		; setting this to a block, means all console messages go here instead of in the console and can be spied on later !"

vlogfile: none

;-------------------------------
;- FUNCTIONS
;-------------------------------

;----------------
;-    MATCH-TAGS()
;----
match-tags: func [
	"return true if the specified tags match an expected template"
	template [block!]
	tags [block! none!]
	/local tag success
][
	success = False
	if tags [
		foreach tag template [
			if any [
				all [
					; match all the tags at once
					block? tag
					((intersect tag tags) = tag)
				]
				
				all [
					;word? tag
					found? find tags tag
				]
			][
				success: True
				break
			]
		]
	]
	success
]




;----------------
;-    PRINT?()
;----
print?: func [
	error
	always
	tags
][
	all [
		any [
			error
			all [
				any [verbose always] 
				not any [
					all [
						not empty? vtags
						not match-tags vtags tags
					]
					all [
						not empty? ntags
						match-tags ntags tags
					]
				]
			]
		]
	]	
]

;----------------
;-    LOG?()
;----
log?: func [
	error
	always
	tags
][
	either file? vlogfile [
		any [
			error
			all [
				any [verbose always] 
			]
		]
	][
		none
	]
]





;----------------
;-    INDENTED-PRINT()
;----
indented-print: func [
	data
	in
	out
	/log
	/local line do tabs
][
	tabs: either log [ltabs][vtabs]
	line: copy ""
	if out [remove tabs]
	append line tabs
	switch/default (type?/word data) [
		object! [append line mold first data]
		block! [append line rejoin data]
		string! [append line data]
		none! []
	][append line mold reduce data]
	
	if in [insert tabs "^-"]
	
	line: replace/all line "^/" join "^/" tabs
	
	
	either log [
		write/append vlogfile join line "^/" ; we must add the trailing new-line
	][
		either vconsole [
			append/only vconsole line
		][
			print line
		]
	]
	
]



;----------------
;-    INDENTED-PRIN()
;----
indented-prin: func [
	data
	/log
	/local line do tabs
][
	tabs: either log [ltabs][vtabs]
	line: copy ""
	switch/default (type?/word data) [
		object! [append line mold first data]
		block! [append line rejoin data]
		string! [append line data]
		none! []
	][append line mold reduce data]
	
	line: replace/all line "^/" join "^/" tabs 
	
	either log [
		write/append vlogfile line
	][
		either vconsole [
			append/only vconsole line 
		][
			prin line
		]
	]


]






;----------------
;-    VOFF()
;----
set 'voff func [/tags dark-tags  /log log-tags] [
	either any [tags log][
		if tags [
			
			vtags-ctrl dark-tags ntags vtags
		]
		if log [
			
			vtags-ctrl log-tags log-ntags log-vtags
		]
	][
		verbose: off
		if block? log-vtags [clear log-vtags]
		if block? vtags [clear vtags]
	]
]




;----------------
;-    VON()
;----
set 'von func [/tags lit-tags  /log log-tags] [
	verbose: on
	either any [ tags log ][
		if tags [
			vtags-ctrl lit-tags vtags ntags
		]
		if log [
			vtags-ctrl log-tags log-vtags log-ntags
		]
	][
		if block? log-ntags [clear log-ntags]
		if block? ntags [clear ntags]
	]
]



;----------------
;-    EXCLUDE()
;----
exlude: func [serieA serieB][
	remove-each item serieB [
		find serieA item 
	]
]



;----------------
;-    INCLUDE()
;----
include: func [serieA serieB][
	foreach item serieB [
		unless find serieA item [
			append/only serieA item
		]
	]
]



;----------------
;-    VTAGS-CTRL()
;----
vtags-ctrl: func [
	set
	tags
	antitags
][
	unless block? set [
		set: reduce [set]
	]
	if block? antitags [
		exclude antitags set
	]
	
	include tags set
]	



;----------------
;-    VIN()
;----
set 'vin func [
	txt
	/error
	/always
	/tags ftags [block!]
][
	if print? error always ftags [
		;vprint/in/always/tags join txt " [" ftags
		indented-print join txt " [" yes no
	]
	
	if log? error always ftags [
		indented-print/log join txt " [" yes no
	]
]




;----------------
;-    VOUT()
;----
set 'vout func [
	/error
	/always
	/tags ftags
	/return rdata ; use the supplied data as our return data, allows vout to be placed at end of a 
	              ; function and print itself outside inner content event if return value is a function.
][

	if print? error always ftags [
		indented-print "]" no yes
	]
	
	if log? error always ftags [
		indented-print/log "]" no yes
	]
	
	; this mimics print's functionality where not supplying return value will return unset!, causing an error in a func which expects a return value.
	either return [
		rdata
	][]
]





;----------------
;-    VPRINT()
;----
set 'vprint func [
	"verbose print"
	data
	/in "indents after printing"
	/out "un indents before printing. Use none so that nothing is printed"
	/error "like always, but adds stack trace"
	/always "always print, even if verbose is off"
	/tags ftags "only effective if one of the specified tags exist in vtags"
][
	if print? error always ftags [
		indented-print data in out
	]
	if log? error always ftags [
		indented-print/log data in out
	]
]



;----------------
;-    VPRIN()
;----
set 'vprin func [
	"verbose print"
	data
	/error "like always, but adds stack trace"
	/always "always print, even if verbose is off"
	/tags ftags "only effective if one of the specified tags exist in vtags"
][
	if print? error always ftags [
		indented-prin data
	]
	if log? error always ftags [
		indented-prin/log data
	]
]





;----------------
;-    VPROBE()
;----
set 'vprobe func [
	"verbose probe"
	data
	/in "indents after probing"
	/out "un indents before probing"
	/error "like always, but adds stack trace"
	/always "always print, even if verbose is off"
	/tags ftags "only effective if one of the specified tags exist in vtags"
	/part amount [integer!] "how much object do we want to display, should eventually support block of words"
	/local line
][
	unless part [
		amount: 500
	]
	
	switch/default (type?/word :data) [
		object! [
			line: rejoin [ mold first data "^/>>>" copy/part mold/all data amount "<<<"]
		] 
	][
		line: mold/all :data ; serialised values are explicit (better probe precision).
	]
	
	if print? error always ftags [
		indented-print line in out  ; part of indented-print
	]
			
	if log? error always ftags [
		indented-print/log line in out  ; part of indented-print
	]
			
	:data
]





;----------------
;-    V??()
;----
set 'v?? func [
    {Prints a variable name followed by its molded value. (for debugging) - (replaces REBOL mezzanine)}
    'name
	/error "like always, but adds stack trace"
	/always "always print, even if verbose is off"
	/tags ftags "only effective if one of the specified tags exist in vtags"
	/local value
][
	value: either word? :name [
		head insert tail form name reduce [": " mold name: get name]
	][
		mold :name
	]
		
	if print? error always ftags [
		indented-print value false false  ; in out
	]
	if log? error always ftags [
		indented-print/log value false false  ; in out
	]
		
	:name
]



;----------------
;-    VLOGCLEAR()
;----
set 'vlogclear func [][
	if all [file? vlogfile exists? vlogfile][
		; more effective than a delete, cause if the file is being traced or read by another tool,
		; a lock will be effective on the file.  In this case, files cannot be deleted or renamed.
		; but changing its content is still possible. So by clearing it we effectively remove the disk space and
		; reset it even if a file opened lock exists.
		write vlogfile ""
	]
]






;----------------
;-    VFLUSH()
;----
set 'vflush func [/disk logfile [file!]] [
	if block? vconsole [
		forall head vconsole [
			append first vconsole "^/"
		]
		either disk [
			write logfile rejoin head vconsole
		][
			print head vconsole
		]
		clear head vconsole
	]
]

; end lib
;print "loaded vprint library"


]]]