;**********************************************************************
; tag.m
;
; Goto macro or function by matching supplied tag in "tags_b" file.
;
; $Revision:   1.0  $
;   $Author:   spage  $
;     $Date:   11 Nov 1991 22:10:00  $
;
;**********************************************************************
;
;	To use this,
;		o	Copy tag.m and tag.cm to your \brief\macros directory
;		o	If you don't have a "\penpoint\sdk\inc" or a 
;			"\penpoint\sdk\utils", modify "/penpoint/sdk/inc/" and
;			"/penpoint/sdk/util/tags/tags_b" in this file to point to
;			your include directory and utilities directory.
;		o	Make sure you have an up to date copy of "tags_b" in
;			\penpoint\sdk\util\tags.
;		o	In BRIEF, edit the file your_initials.m in \brief\macros, for
;			example ssp.m.  This file is created by BRIEF's setup program.
;			In it you should find a macro called "YOUR_INITIALS".
;			After the line  ";**	Put your changes here." add the following:
;					(autoload "tag" "tag")
;					(assign_to_key "<Ctrl-H>" "tag")
;		o	Press <Alt-F10> to recompile your_initials.m.
;		o	Exit and restart BRIEF.
;
;	To look up a tag, either
;		o	Position the cursor at its beginning of the name and
;			press <Ctrl-H> (Control and the "H" key simultaneously).
;		o	Type <F10>tag thing_name.
;	The macro leaves bookmark 9 at the original location, so you can type
;		<Alt-J>9 to return to it.
;
;	FIXME: better error handling
;
;**********************************************************************

;*********************************
;**  support routines for reading word under cursor.
;!!  Should be able to use Brief's internal Word macros, but they're
;!!  too unstructured.
(macro _init
  (
	(string $c_sep_str $c_quoted_sep_str)
	(global $c_sep_str $c_quoted_sep_str)

	(= $c_sep_str " \t\n()[]{},.:;\"'+-=*\\/|!&<>#")
	(= $c_quoted_sep_str " \t\n()\\[\\]{},.;\"'+\\-=*\\\\/|!&<>#")
	(autoload "search" ".c_previous_word")
  )
)

; If cursor on part of a word, move to beginning of word
; Returns 0 if not on part of word when called, non-zero otherwise
(macro $start_of_word
  (
		(string peek)
		(extern .c_previous_word)

		(if (index $c_sep_str (read 1))
			(return 0)					; Started on separator
		)
		(prev_char)						; Peek at previous char
		(= peek (read 1))
		(next_char)
		(if (index $c_sep_str peek)
			(return 1)					; Separator => started at word start
		)
		(return (.c_previous_word))
  )
)

; If cursor on part of a word, move to end of word
; Returns 0 if not on part of word when called, non-zero otherwise
(macro $end_of_word
  (
		(string peek)
		(extern $extend_word)

		(if (index $c_sep_str (read 1))
			(return 0)					; Started on separator
		)
		(next_char)						; Peek at next char
		(= peek (read 1))
		(prev_char)
		(if (index $c_sep_str peek)
			(return 1)					; Separator => started at word end
		)
		(return ($extend_word))
  )
)

(macro $extend_word
  (
		(int	ret_val)

		(save_position)

		(next_char)
		(if (index $c_sep_str (read 1))
			(next_char)
		)
		(= ret_val (search_fwd (+ (+ (+ (+
					"[~ " $c_quoted_sep_str)			; NOT Separator
					"][ ") $c_quoted_sep_str) "]")		; Separator)
		))
		(restore_position (! ret_val))
		(return ret_val)
  )
)

(macro $read_selection
  (
	(int		start_line 
		  		start_col
				end_line
				end_col
				temp_int
	)
	(string		$sel_str prompt)

	(if (inq_marked)
	  (
		(save_position)
		(inq_position end_line end_col)
		(swap_anchor)
		(inq_position start_line start_col)
		(raise_anchor)
		;**
		;**		If the starting line is after the ending line, swap
		;**	the variables.
		;**
		(if (above start_line end_line)
		  (
			(= temp_int start_line)
			(= start_line end_line)
			(= end_line temp_int)
		  )
		)
		;**
		;**		Move to the upper left corner of the block (assuming
		;**	that the ending column is greater than the starting column.
		;**
		(if (> start_col end_col)
		  (
			;**
			;**	If the starting column is greater then the ending col,
			;**	swap the two.
			;**
			(= temp_int start_col)
			(= start_col end_col)
			(= end_col temp_int)
		  )
		)
		(move_abs start_line start_col)
		(= $sel_str (read (+ (- end_col start_col) 1)))
	  )
	  ;else
	  (
		(if (== 0 (get_parm 0 prompt)) (= prompt "Enter a 'selection': "))
		(get_parm NULL $sel_str prompt)
	  )
	)
	(return $sel_str)
  )
)

;*********************************
;**  Tag routine itself.
(macro tag
(
	(string
		tag_name
		pattern
		file
		extension
		f_pat
	)
	(int
		old_buf
		new_buf
	)
	
	(= old_buf (inq_buffer))
	; Next line is optional: drop a bookmark at current location.
	(drop_bookmark 9 "y")
	(if (== (get_parm 0 tag_name) 0)
	  (
		(if (inq_marked) (raise_anchor) (drop_anchor 1))
		($start_of_word)
		(drop_anchor 1)
		($end_of_word)
		(= tag_name ($read_selection "tag: "))
		(raise_anchor)
	  )
	)
	(if (!= tag_name "")
;	(if (&& (!= (get_parm 0 tag_name "tag: ") 0)(!= tag_name ""))
	  (
		(sprintf pattern "<%s[\\t]" tag_name)
		(if (exist "/penpoint/sdk/util/tags/tags_b")
		  (
	 		(= new_buf (create_buffer "Tags" "/penpoint/sdk/util/tags/tags_b" 1))
			(set_buffer new_buf)
			(top_of_buffer)
			(if (> (search_fwd pattern) 0)
			  (
				(beginning_of_line)
		   		(get_token)								;** skip tag name
				(= file (get_token))
				(if (!= (substr file 1 1) "/")
				  ;** if not 
				  (
					(= file (+ "/penpoint/sdk/inc/" file))
				  )
				)
														;** next token is reference file
				(if (exist file)
				  (
					(= pattern (get_token))				;** next is pattern (or line #)
					(set_buffer old_buf)
					(delete_buffer new_buf)				;** get rid of "Tags" file
					(edit_file file)					;** edit the reference file
					;** ?? The next few lines try to read in a macro appropriate
					;**    for the reference file.  Won't this happen automatically??
					(inq_names NULL extension NULL)
					(set_msg_level 3)
					(execute_macro (+ "." extension))	;** macro for file type
					(set_msg_level 0)
	
					(= f_pat (substr pattern 1 1))
					(if (isdigit f_pat)					;** pattern is either...
					  (
						(move_abs (atoi pattern) 1)	;** ... a line number
					  )
					;else  ; pattern isn't numeric
					  (
						(top_of_buffer)
						(search_fwd pattern 0)			;** ... or a pattern (no RE!)
					  )
					)  ; pattern is numeric
					;** !! Should check for status returned by both of these.
					;**    and inform user of errors.
	
					(execute_macro "center_line")
				  )
				;else ; file doesn't exist
				  (
					(message "Tags to missing %s file." file)
					(set_buffer old_buf)
					(delete_buffer new_buf)
				  )
				)  ; file exists
			  )
			;else  ; didn't find tag
			  (
				(message "%s not in tags file" tag_name)
				(set_buffer old_buf)
				(delete_buffer new_buf)
			  )
			) ; end of if tag found
		  )
		;else  ; tags file doesn't exist
		  (
			(message "Missing /penpoint/sdk/util/tags/tags_b file.")
		  )
		) ; end of tags file exist
	  )
	;else  ; tag_name blank
	  (
		(message "")
	  )
	)  ; tag_name blank
  )
)

;*********************************
;**  support routines for parsing tag entries.
(macro isdigit
(
	(string chr)
	(if (get_parm 0 chr)
	(
		(if (&& (>= chr "0")(<= chr "9"))
		(
			(returns 1)
		)
		;else
		(
			(returns 0)
		))
	)
	;else
	(
		(returns 0)
	))
))

(macro get_token
(
	(string
		token
		char
	)
	
	(= token "")
	(while (== (index "\t\n" (= char (read 1))) 0)
	(
		(+= token char)
		(next_char)
	))
	(returns token)
	(next_char)
))

