;dBRIEF Engine - v3.10
;Copyright (c) 1991 - Global Technologies Corporation
;ALL RIGHTS RESERVED
#include "dbrief.h"
(macro dbrief
	(
		(message "%s Programmers Core Enabled." dbr_version)
		(register_macro 1 "_switch_buffer")
		(return 1)
	)
)
;***
;* main routine
;***
(macro _init
	(
		(int		temp_int
					_prg_smart
					_obk_smart
					library_buffer
					library_window
					curr_indent_line
					curr_indent_col
					dbr_current_buffer
					dbr_current_window
					dbr_text_flag
					dbr_curr_line
					dbr_return_flag
					dbr_dialect
					dbr_default_dialect
					dbr_indent_level
					dbr_proc_indent
					dbr_auto_indent
					dbr_comment_tab
					dbr_comment_lines
					dbr_set_ext
					dbr_auto_header
					dbr_template
					dbr_graphics
					dbr_apx_file_id
		)
		(string  temp_str
					dbr_library
					apx_menu_event
		)
		(global  temp_int
					temp_str
					_prg_smart
					_obk_smart
					library_buffer
					library_window
					curr_indent_line
					curr_indent_col
					dbr_current_buffer
					dbr_current_window
					dbr_text_flag
					dbr_curr_line
					dbr_return_flag
					dbr_dialect
					dbr_default_dialect
					dbr_indent_level
					dbr_proc_indent
					dbr_auto_indent
					dbr_comment_tab
					dbr_comment_lines
					dbr_set_ext
					dbr_auto_header
					dbr_template
					dbr_graphics
					dbr_library
					dbr_apx_file_id
					apx_menu_event
		)
		;*** Default Settings
		(= dbr_auto_indent 1)			;*** auto indent ON=1, OFF=0
		(= dbr_auto_header 1)			;*** auto header ON=1, OFF=0
		(= dbr_set_ext 1)					;*** auto default extension ON=1, OFF=0
		(= dbr_template 1)				;*** template editing ON=1, OFF=0
		(= dbr_dialect 12)					;*** dialect code
		(= dbr_graphics 1)				;*** graphics mode 1-Normal, 2-Double, 3-Combination, 4-Special
		(= dbr_comment_tab 50)			;*** comment tab column
		(= dbr_library "/brief/library.src")  ;*** sourceview library
		(= dbr_comment_lines 1)			;*** conditional comment line numbers 1=ON, 0=OFF
		(= dbr_proc_indent 1)			;*** procedure/function indenting ON=1, OFF=0
		(= dbr_default_dialect dbr_dialect)
		(assign_to_key "<f10>" "function_f10")
		(keyboard_push)
		(assign_to_key "<Enter>" "_enter")
		(assign_to_key "<Tab>" "slide_in")
		(assign_to_key "<Shift-Tab>" "slide_out")
		(assign_to_key "<Space>" "_prg_template")
		(assign_to_key "<Ctrl-O>" "_implode_object_window")
		(assign_to_key "<Ctrl-G>" "scan routines")
		(assign_to_key "<Ctrl-H>" "head")
		(assign_to_key "<Ctrl-F>" "_ctrl_f")
		(assign_to_key "<Ctrl-V>" "vers")
		(assign_to_key "<Ctrl-S>" "scan prev")
		(assign_to_key "<Ctrl-X>" "nothing")
		(assign_to_key "<Ctrl-f7>" "_same_line_comment")
		(assign_to_key "<Ctrl-f8>" "sv")
		(assign_to_key "<Ctrl-f9>" "_execute_option_one")
		(assign_to_key "<Ctrl-f10>" "expa")
		(assign_to_key "<Shift-f3>" "rein")
		(assign_to_key "<Shift-f7>" "comm")
		(assign_to_key "<Shift-f8>" "set")
		(assign_to_key "<Alt-f3>" "disp stru")
		(assign_to_key "<Alt-f4>" "print")
		(assign_to_key "<Alt-=>" "_alt_equals_sign")
		(assign_to_key "<Alt-y>" "tag")
		(assign_to_key "<Alt-O>" "nothing")
		(assign_to_key "<Alt-E>" "nothing")
		(assign_to_key "<Alt-X>" "nothing")
		(assign_to_key "<Alt-N>" "nothing")
		(assign_to_key "<Alt-B>" "nothing")
		(assign_to_key "<Alt-minus>" "nothing")
		(assign_to_key "<Alt-Up>" "_alt_up")
		(assign_to_key "<Ctrl-minus>" "nothing")
		(assign_to_key "<Ctrl-A>" "nothing")
		(assign_to_key "<Ctrl-E>" "nothing")
		(= _obk_smart (inq_keyboard))
		(keyboard_pop 1)
		(keyboard_push)
		(assign_to_key "<Enter>" "_enter")
		(assign_to_key "<Tab>" "slide_in")
		(assign_to_key "<Shift-Tab>" "slide_out")
		(assign_to_key "<Space>" "_prg_template")
		(assign_to_key "<Ctrl-A>" "apx")
		(assign_to_key "<Ctrl-C>" "coor")
		(assign_to_key "<Ctrl-E>" "_select_apx_program")
		(assign_to_key "<Ctrl-O>" "_explode_object_window")
		(assign_to_key "<Ctrl-G>" "scan routines")
		(assign_to_key "<Ctrl-H>" "head")
		(assign_to_key "<Ctrl-F>" "_ctrl_f")
		(assign_to_key "<Ctrl-S>" "scan prev")
		(assign_to_key "<Ctrl-V>" "vers")
		(assign_to_key "<Shift-f1>" "assi")
		(assign_to_key "<Shift-f2>" "dbhe")
		(assign_to_key "<Shift-f3>" "rein")
		(assign_to_key "<Shift-f4>" "pre")
		(assign_to_key "<Shift-f7>" "comm")
		(assign_to_key "<Shift-f8>" "set")
		(assign_to_key "<Ctrl-f7>" "_same_line_comment")
		(assign_to_key "<Ctrl-f8>" "sv")
		(assign_to_key "<Ctrl-f9>" "_execute_option_one")
		(assign_to_key "<Ctrl-f10>" "expa")
		(assign_to_key "<Ctrl-Up>" "_display_procedure")
		(assign_to_key "<Ctrl-Down>" "_list_uses")
		(assign_to_key "<Alt-f3>" "disp stru")
		(assign_to_key "<Alt-f4>" "print")
		(assign_to_key "<Alt-f9>" "revi")
		(assign_to_key "<Alt-=>" "_alt_equals_sign")
		(assign_to_key "<Alt-y>" "tag")
		(assign_to_key "<Alt-Up>" "_alt_up")
		(= _prg_smart (inq_keyboard))
		(keyboard_pop 1)
		(set_msg_level 3)
		(autoload "apx"			"apx"
										"_select_apx_program"
										"_open_apx_file"
										"_create_apx_file"
										"_display_apx_file"
										"_apx_scan_menu"
										"_scan_apx_programs_r"
										"_scan_apx_programs_p"
										"_scan_apx_programs_f"
										"_scan_apx_programs_t"
		)
		(autoload "assist"		"assi"
										"dbhe"
										"inte"
										"_execute_option_one"
		)
		(autoload "crossref"		"_find_constant"
		)
		(autoload "comment"		"comm"
										"unco"
										"_comment_block"
										"_uncomment_block"
										"_same_line_comment"
										"_remove_same_line_comments"
		)
		(autoload "display"		"disp"
										"_display_graphics_mode"
										"_display_dialect"
										"_status"
										"_display_procedure"
										"_seek_keyword"
		)
		(autoload "graphics"		"draw"
										"nodr"
										"_frame"
										"_cursor"
		)
		(autoload "generate"		"_create_routine_from_block"
										"stor"
										"scat"
										"gath"
										"init"
										"coor"
										"_substitute_window_coordinates"
										"_reverse_window_coordinates"
		)
		(autoload "header"		"head"
										"revi"
										"_pro_header"
										"_procedure_header"
		)
		(autoload "indenter"		"rein"
										"_prg_indent"
                             	"_last_character"
		)
		(autoload "library"		"sv"
										"libr"
										"_process_library_call"
										"_sv"
		)
		(autoload "macrolib"		"_date_time"
										"_pad_right"
										"_replicate"
										"_display_popup_message"
										"_pause_for_seconds"
										"_menu_lines"
										"_invalid_key"
										"_get_directory"
										"_number_lines"
										"_number_bytes"
										"_pick_menu"
										"_parse_child"
		)
		(autoload "optimize"		"opti"
										"_tab_support"
		)
		(autoload "object"		"_explode_object_window"
										"_implode_object_window"
		)
		(autoload "preproc"		"pre"
		)
		(autoload "scanner"		"scan"
										"tag"
										"unta"
										"_scan_source"
										"repl"
		)
		(autoload "setcmds"		"setu"
										"set"
										"_switch_dialect"
		)
		(autoload "source"		"_print_source"
		)
		(autoload "template"		"expa"
										"_prg_template"
										"_evaluate_expansion_table"
										"_parse_and_expand"
										"_command_insert"
										"_function_insert"
		)
		(autoload					(_get_dialect_info dbr_dialect 2)
										"_continuation_character"
										"_comment_character"
										"_write_enable"
										"_beg_of_rout_scan"
										"_beg_of_proc_scan"
										"_beg_of_func_scan"
										"_end_of_rout_syntax"
										"_execute_command"
										"_dialect_table"
										"_backdenting_conditionals"
										"_do_case_syntax"
										"_do_while_syntax"
										"_adjust_indent_level"
										"_indent_shift"
										"_command_table"
										"_function_table"
										"_set_table"
										"_comment_conditionals"
										"_uncomment_conditionals"
										"memv"
										"@"
										"_complete_conditional"
										"_cond_insert"
										"_insert_graphics"
										"_frame_component"
										"_structure"
										"_generate_fields"
										"_structure_build"
										"writ"
		)
		(set_msg_level 0)
		(if dbr_apx_autoload
			(
				(string  file_name)
				(int		file_match)
				(file_pattern "*.apx")
				(if (&& (find_file file_name)(! (inq_kbd_char)))
					(
						(message "Loading %s into memory..." (upper file_name))
						(_open_apx_file file_name)
						;uncomment the next line if you want to start the apx menu upon loading brief
						;(apx)
						(= file_match 1)
					)
				)
				(message "")
				(keyboard_flush)
				(if (! file_match)
					(_display_popup_message "No APX available!" (upper file_name) 1)
				)
			)
		)
	)
)
;***
;* replacement for F10, performs a lower case on first token and also parses to 4 characters
;***
(macro function_f10
	(
		(string		_command_string
						_command_word
						_command_token
						_command_parameters
		)
		(if (get_parm 0 _command_string "Command+: ")
			(
				(if (index _command_string " ")
					(
						(= _command_word (ltrim (trim (substr _command_string 1 (index _command_string " ")))))
						(= _command_token (lower (ltrim (trim (substr _command_string 1 (index _command_string " "))))))
						(= _command_parameters (ltrim (trim (substr _command_string (index _command_string " ")))))
					)
				;else
					(
						(= _command_word (ltrim (trim _command_string)))
						(= _command_token (lower _command_word))
						(= _command_parameters "")
					)
				)
				(if (> (strlen _command_token) 4)
					(= _command_token (substr _command_token 1 4))
				)
				(switch (upper _command_token)
					"DEL"
						(if (&& (exist _command_parameters)(execute_macro (lower _command_string)))
							(message "%s has been deleted." (upper _command_parameters))
						;else
							(
								(beep)
								(if (! (exist _command_parameters))
									(error "%s doesn't exist!" (upper _command_parameters))
								;else
									(error "Cannot delete %s!" (upper _command_parameters))
								)
							)
						)
					"PRIN"
						(execute_macro "print")
					"VERS"
						(if (== (upper _command_string) "VERSION")
							(message "BRIEF v%d.%d - (c) 1990 by SDC Partners II, L.P." (/ (version) 100)(% (version) 100))
						;else
							(execute_macro "vers")
						)
					"CD"
						(
							(if (strlen _command_parameters)
								(execute_macro (lower _command_string))
							)
							(getwd NULL _command_string)
							(message "%s" _command_string)
						)
					"A:"  NULL
					"B:"  NULL
					"C:"  NULL
					"D:"  NULL
					"E:"  NULL
					"F:"
						(
							(execute_macro (+ "cd " _command_string))
							(getwd NULL _command_string)
							(message "%s" _command_string)
						)
					NULL
						(if (inq_macro _command_word)
							(execute_macro _command_string)
						;else
							(if (inq_macro (lower _command_word))
								(execute_macro (+ (+ (lower _command_word) " ") _command_parameters))
							;else
								(if (inq_macro _command_token)
									(execute_macro (+ (+ _command_token " ") _command_parameters))
								;else
									(execute_macro _command_string)
								)
							)
						)
				)
			)
		)
	)
)
;***
;* Replacement for <enter>
;***
(macro _enter
	(
		(if (== dbr_auto_indent 1)
			(_prg_indent)
		;else
			(self_insert)
		)
	)
)
;***
;* load indenting keyboard for normal dBASE prg's
;***
(macro _refresh_dialect
	(
		(int				forced_dialect
		)
		(get_parm 0 forced_dialect)
		(if (!= dbr_dialect forced_dialect)
			(_switch_dialect dbr_dialect forced_dialect 0)
		)
	)
)
(macro _switch_buffer
	(
		(if dbr_auto_switch_buffer
			(
				(string			extension
				)
				(inq_names NULL extension NULL)
				(switch extension
					"prs"
						(_refresh_dialect 4)
					"pgm"
						(_refresh_dialect 7)
					"sc"
						(_refresh_dialect 9)
					"cmd"
						(_refresh_dialect 10)
					"sql"
						(_refresh_dialect 11)
					NULL
						(_refresh_dialect dbr_default_dialect)
				)
			)
		)
	)
)
(macro .prg_smart_first
	(
		(extern			.prg
							default
		)
		(int				dialect_number
							apx_temp_buffer
							apx_temp_file
		)
		(string			full_name
							extension
							_support_type
		)
		(inq_names full_name extension NULL)
		(if (&& (== (inq_message)(+ dbr_version " Programmers Core Enabled."))(== extension "obk"))
			(
				(_display_popup_message "dBRIEF cannot edit a file with an OBK extension!" "" 1)
				(exit "y")
			)
		)
		(if (&& (!= extension "")(index "PRG~PGM~CMD~SC ~PRE~PRS~TEM~TLB~FMT~SQL~COD~H  ~FH ~CH " (upper (_pad_right extension 3))))
			(
				(if (inq_macro (+ "." extension))
					(execute_macro (+ "." extension))
				;else
					(if (inq_macro ".prg")
						(.prg)
					;else
						(default)
					)
				)
				(= dbr_indent_level (distance_to_tab))
				(if (< dbr_indent_level 1)
					(= dbr_indent_level dbr_indent_default)
				)
				(if dbr_auto_switch_buffer
					(_switch_buffer)
				)
				(message "%s Support Enabled [indent=%d]" (_get_dialect_info dbr_dialect 1) dbr_indent_level)
				(use_local_keyboard _prg_smart)
				(if (&& (! (exist full_name))(== dbr_auto_header 1))
					(_pro_header "proghead.cfg")
				)
			)
		;else
			(
				(= apx_temp_buffer (inq_buffer))
				(if (&& (== extension "")(== dbr_set_ext 1))
					(
						(if (index full_name ".")
							(= full_name (substr full_name 1 (- (index full_name ".") 1)))
						;else
							(+= full_name ".")
						)
						(+= full_name (lower (_get_dialect_info dbr_dialect 3)))
						(set_msg_level 0)
						(edit_file full_name)
						(delete_buffer apx_temp_buffer)
					)
				;else
					(if (== extension "apx")
						(
							(edit_file "~apx~.~")
							(= apx_temp_file (inq_buffer))
							(delete_buffer apx_temp_buffer)
							(if (exist full_name)
								(_open_apx_file full_name)
							;else
								(if (== 0 (_create_apx_file (upper full_name)))
									(exit "y")
								)
							)
							(if (!= dbr_apx_file_id 0)
								(if (== (_select_apx_program) 1)
									(delete_buffer apx_temp_file)
								)
							)
						)
					)
				)
			)
		)
		(return "")
	)
)
(macro .obk
	(
		(if (inq_macro ".prg")
			(.prg)
		;else
			(default)
		)
		(use_local_keyboard _obk_smart)
	)
)
(macro vers
	(_display_popup_message "%s - (c)1990 by Global Technologies" dbr_version 0)
)
;***
;* replacement macros
;***
(replacement edit_file
	(
		(int				file_match
		)
		(string			file_extension
		)
		(if (|| (== (inq_called) "")(== (inq_called) "_create_apx_program"))
			(
				(string			file_name
									file_path
									prompt_str
				)
				(if (== dbr_set_ext 0)
					(sprintf prompt_str "File [No default]: ")
				;else
					(sprintf prompt_str "File [%s-%s def]: " (_get_dialect_info dbr_dialect 1) (_get_dialect_info dbr_dialect 3))
				)
				(if (get_parm 0 file_name prompt_str)
					(if (index (upper file_name) ".APX")
						(if (exist file_name)
							(
								(_open_apx_file file_name)
								(apx)
							)
						;else
							(if (_create_apx_file (upper file_name))
								(apx)
							)
						)
					;else
						(
							(if (|| (index file_name "..")(== (substr file_name 1 1) "\\"))
								(= file_path (substr file_name 1 (rindex file_name "\\")))
							;else
								(if (index file_name ":\\")
									(= file_path (substr file_name 1 (rindex file_name "\\")))
								;else
									(= file_path (substr file_name 1 (rindex file_name ":")))
								)
							)
							(if (|| (|| (index file_name ".")(== (_get_dialect_info dbr_dialect 3) "NONE")) (== dbr_set_ext 0))
								(if (index file_name "*")
									(
										(file_pattern file_name)
										(while (&& (find_file file_name)(! (inq_kbd_char)))
											(
												(message "Loading %s into memory..." (upper (+ file_path file_name)))
												(edit_file (+ file_path file_name))
												(= file_match 1)
											)
										)
										(message "")
										(keyboard_flush)
										(if (! file_match)
											(_display_popup_message "No files found matching %s wildcard!" (upper file_name) 1)
										)
									)
								;else
									(
										(= file_extension (substr file_name (index file_name ".")))
										(if (!= ".OBK" (upper file_extension))
											(return (edit_file file_name))
										;else
											(
												(_display_popup_message "dBRIEF cannot edit a file with an OBK extension!" "" 1)
												(return -1)
											)
										)
									)
								)
							;else
								(return (edit_file (+ (trim file_name) (+ "." (_get_dialect_info dbr_dialect 3)))))
							)
						)
					)
				)
			)
		;else
			(return (edit_file))
		)
	)
)
(replacement read_file
	(
		(if (== (inq_called) "")
			(
				(string			file_name
				)
				(if (== dbr_set_ext 0)
					(sprintf temp_str "File [No default]: ")
				;else
					(sprintf temp_str "File [%s default]: " (_get_dialect_info dbr_dialect 3))
				)
				(if (get_parm 0 file_name temp_str)
					(if (|| (|| (index file_name ".")(== (_get_dialect_info dbr_dialect 3) "NONE")) (== dbr_set_ext 0))
						(return (read_file file_name))
					;else
						(return (read_file (+ (trim file_name) (+ "." (_get_dialect_info dbr_dialect 3)))))
					)
				)
			)
		;else
			(return (read_file))
		)
	)
)
(replacement print
	(
		(if (|| (== (inq_called) "")(== (inq_called) "assist"))
			(
				(if (inq_marked)
					(return (print))
				;else
					(
						(inq_names temp_str NULL NULL)
						(if (get_parm 0 temp_str "File name to print: " NULL temp_str)
							(
								(if (index (upper temp_str) ".DBF")
									(_structure NULL (substr temp_str 1 (- (index temp_str ".") 1)) "P")
								;else
									(_print_source temp_str)
								)
							)
						)
					)
				)
			)
		;else
			(return (print))
		)
	)
)
(macro _ctrl_f
	(
		(if (inq_marked)
			(
				(if (== (inq_marked) 2)
					(_frame)
				;else
					(writ)
				)
			)
		;else
			(insert "~frame~")
		)
	)
)
(macro _alt_equals_sign
	(
		(if (== (inq_marked) 2)
			(_substitute_window_coordinates)
		;else
			(if (== (_reverse_window_coordinates) 0)
				(_process_library_call)
			)
		)
	)
)
(macro _case_insert
	(
		(string		insert_string
		)
		(int			reposition_cursor
						relational_move
						character_case
		)
		(get_parm 0 insert_string)
		(get_parm 1 reposition_cursor)
		(get_parm 2 relational_move)
		(get_parm 3 character_case)
		(if reposition_cursor
			(move_abs curr_indent_line curr_indent_col)
		)
		(move_rel 0 (* -1 relational_move))
		(delete_to_eol)
		(if (|| (& (inq_kbd_flags) 0x43) character_case)
			(insert insert_string)
		;else
			(insert (lower insert_string))
		)
		(if reposition_cursor
			(move_abs 0 curr_indent_col)
		)
	)
)
;***
;* dialect manager macros
;***
(macro _get_dialect_info
	(
		(int			dialect
						info_type
		)
		(get_parm 0 dialect)
		(get_parm 1 info_type)
		(switch info_type
			1
				;*** return the dialect name
				(switch dialect
					1
						(return "Clipper Summer '87")
					2
						(return "Force")
					3
						(return "dBASE III Plus")
					4
						(return "dBASE IV")
					5
						(return "FoxBASE+")
					6
						(return "FoxPro")
					7
						(return "Vulcan")
					8
						(return "dbXL/Quicksilver")
					9
						(return "Paradox")
					10
						(return "R:BASE")
					11
						(return "Oracle")
					12
						(return "Clipper 5.0")
					)
			2
				;*** return the dialect macro
				(switch dialect
					1		NULL
					12
						(return "clipper")
					2
						(return "force")
					3		NULL
					4
						(return "dbase")
					5		NULL
					6
						(return "foxpro")
					7
						(return "vulcan")
					8
						(return "dbxl")
					9
						(return "paradox")
					10
						(return "rbase")
					11
						(return "oracle")
					)
			3
				;*** return the dialect extension
				(switch dialect
					1  NULL
					2  NULL
					3  NULL
					4  NULL
					5  NULL
					6	NULL
					8  NULL
					12 NULL
					13
						(return dbr_def_file_ext)
					7
						(return "PGM")
					9
						(return "SC")
					10
						(return "CMD")
					11
						(return "SQL")
				)
			4
				;*** return the executable name
				(switch dialect
					1  NULL
					12
						(return "clipper ")
					2
						(return "force ")
					3
						(return "dbase ")
					4
						(return "dbase /t ")
					5
						(return "foxplus ")
					6
						(return "foxpro ")
					7
						(return "vulcan ")
					8
						(return "dbxl ")
					9
						(return "paradox ")
					10
						(return "rbase ")
					11
						(return "oracle")
				)
			5
				;*** return whether it's a compiler or interpreter
				(switch dialect
					1  NULL
					2  NULL
					12
						(return 1)
					3  NULL
					4  NULL
					5  NULL
					6  NULL
					7  NULL
					8  NULL
					9  NULL
					10 NULL
					11
						(return 0)
				)
			6
				;*** return whether there is display structure support
				(switch dialect
					1  NULL
					2  NULL
					3  NULL
					4  NULL
					5  NULL
					6  NULL
					8  NULL
					9  NULL
					12
						(return 1)
					7  NULL
					10 NULL
					11
						(return 0)
				)
		)
	)
)
(macro _list_uses
	(
		(int row1
			  col1
			  row2
			  col2
		)
		(string word)
		(if (inq_marked row1 col1 row2 col2)
			(
				(raise_anchor)
				(if (== row1 row2)
					(
						(move_rel 0 (- (- col1 col2) 1))
						(= word (read (+ (- col2 col1) 1)))
					)
				;else
					(_display_popup_message "Invalid mark for scan operation!" "" 1)
				)
			)
		;else
			(
				(inq_position row1 col1)
				(search_fwd "[ \t\x0c\n]\\c[~ \t\x0c\n]" 1 1)
				(inq_position row2 col2)
				(move_abs row1 col1)
				(if (== row1 row2)
					(= word (trim (read (- col2 col1))))
				;else
					(
						(end_of_line)
						(inq_position row2 col2)
						(move_abs row1 col1)
						(= word (trim (read (- col2 col1))))
					)
				)
				(move_abs row1 col1)
			)
		)
		(if (strlen word)
			(
				(int _temp_reg)
				(extern _reg_exp)
				(= _temp_reg _reg_exp)
				(= _reg_exp 0)
				(scan word)
				(= _reg_exp _temp_reg)
			)
		)
	)
)
(macro _alt_up
	(_find_constant)
)
