procedure fred$set_mark
   LOCAL mark_num;                    ! Next mark number (STRING)

   mark_num := fred$get_next_mark_num;
   EXECUTE ("MARK_" + mark_num + " := MARK(reverse)");

   MESSAGE ("Mark #" + mark_num + " set...");
   fred$x_mark_count := fred$x_mark_count + 1;
   fred$remove_mark_keys;
ENDPROCEDURE;
           

PROCEDURE fred$goto_mark
   LOCAL mark_num,                    ! Next mark number (STRING)
   	mark_buffer,
        buffer_name;
                        
   mark_num := READ_LINE ("Mark #: ");
   if fred$is_digit(mark_num) = 0 then
      MESSAGE ("MUST enter a number...");
      RETURN (0);
   endif;

   fred$is_mark (mark_num);

   MESSAGE ("Going to Mark #" + mark_num);
 
   EXECUTE ('fred$mark_buffer := GET_INFO (mark_'+mark_num+',"buffer")');
   buffer_name := GET_INFO (fred$mark_buffer,"name");
   fred$map_to_current_window (buffer_name);
   EXECUTE ("POSITION (MARK_" + mark_num +")");

   fred$remove_mark_keys;

ENDPROCEDURE;



PROCEDURE fred$is_mark (mark_num)
   LOCAL loc;
                      
   if mark_num = "1" then      
      loc := INDEX (fred$x_marks,mark_num); 
   else
      loc := INDEX (fred$x_marks," "+mark_num); 
   endif;

   if loc = 0 then
      MESSAGE ("Mark #" + mark_num + " does not exist...");
      ABORT;
   endif;

ENDPROCEDURE;


PROCEDURE fred$delete_mark
   LOCAL len,
	loc1,
	loc2,
	mark_num;                    ! Next mark number (STRING)

   len := LENGTH (fred$x_marks);
   mark_num := READ_LINE ("Mark # to delete: ");
   if fred$is_digit(mark_num) = 0 then
      MESSAGE ("MUST enter a number...");
      RETURN (0);
   endif;
                             
   fred$is_mark (mark_num);

   loc1 := INDEX (fred$x_marks," "+mark_num);
   if (loc1 = 0) then
      if (mark_num <> "1") then
         RETURN (FALSE);
      endif;
   endif;             
          
   loc2 := fred$search_for (" ",loc1+1,FORWARD);
   fred$x_marks := SUBSTR (fred$x_marks,1,loc1) + "X" + 
				SUBSTR (fred$x_marks,loc2,len);
   EXECUTE ("DELETE (MARK_" + mark_num + ")");
   MESSAGE ("Deleted Mark #" + mark_num);
               
   fred$x_mark_count := fred$x_mark_count - 1;
   fred$remove_mark_keys;
ENDPROCEDURE;


       
PROCEDURE fred$search_for(strval,sloc,direction)
   LOCAL cnt, incre, char;

   cnt := sloc;
   if (direction = FORWARD) then
      incre := 1;
   else
      incre := -1;    
   endif;

   len := LENGTH (fred$x_marks);

   loop
      char := SUBSTR (fred$x_marks,cnt,1);
      exitif (char = strval);
      if cnt <= 0 then           ! Special case (beginning of FRED$X_MARKS)
         RETURN (2);
      endif;
      cnt := cnt + incre;
   endloop;
   RETURN (cnt);         
ENDPROCEDURE;


PROCEDURE fred$get_next_mark_num
   LOCAL mark_num,              	! Next mark number (STRING)
      	len, x_loc, sloc;

   len := LENGTH (fred$x_marks);	! Find the end of the string
   if (len = 1) then                                 
      fred$x_marks := " 1 ";
      RETURN ("1");
   endif;

   x_loc := INDEX (fred$x_marks,"X");	! Find a deleted mark first...

   if (x_loc = 0) then			! No deleted marks
      if len = 3 then	
         sloc := 2;     		! First pass thru
      else  
         sloc := fred$search_for (" ",len-1,REVERSE) + 1;
      endif;
      mark_num := STR( INT (SUBSTR (fred$x_marks,sloc,len-sloc)) + 1);
      fred$x_marks := SUBSTR (fred$x_marks,1,len-1) + " " + mark_num + " ";
   else					! Use deleted marker number
      sloc := fred$search_for (" ",x_loc-2,REVERSE) + 1;

      mark_num := STR (INT (SUBSTR (fred$x_marks,sloc,x_loc-1-sloc)) +1);

      fred$x_marks := SUBSTR (fred$x_marks,1,x_loc-1) + mark_num +
		SUBSTR (fred$x_marks,x_loc+1,len);
   endif;

   RETURN (mark_num);
  
ENDPROCEDURE;



PROCEDURE fred$show_marks
   LOCAL this_buffer, 
	 buffer_name,
	 pad_char,
	 xxx;

   MAP (info_window,show_buffer);
   SET (status_line, info_window, reverse,
     		" Show buffer          MARKS currently set...");
   POSITION (BEGINNING_OF (show_buffer));
   ERASE (CURRENT_BUFFER);
   SPLIT_LINE;
   COPY_TEXT ("    Mark #     Col#           Buffer Name");
   SPLIT_LINE;
   if (fred$x_marks = " ") then
      SPLIT_LINE;              
      COPY_TEXT ("     No MARKS are currently set...");
   else
      count := 0;
      loop                                                             
         exitif (count = fred$x_mark_count);
         count := count + 1;                                                   
         mark_num := STR (count);                         
         EXECUTE ('fred$mark_buffer := GET_INFO (mark_' + 
						mark_num +
					  	',"buffer")');
         buffer_name := GET_INFO (fred$mark_buffer,"name"); 
         EXECUTE ('fred$x_marker_column := GET_INFO (mark_' + 
				 		mark_num + 
						',"offset_column")');
         SPLIT_LINE;
	 if (fred$x_marker_column < 10) then
	    pad_char := "  ";
	 else
  	    if (fred$x_marker_column < 100) then
	       pad_char := " ";
	    else
	       pad_char := "";
	    endif;
	 endif;

         COPY_TEXT ("       " + mark_num + 
		    "        " + pad_char + STR(fred$x_marker_column) + 
		    "       " + buffer_name);
      endloop;
      POSITION (BEGINNING_OF (CURRENT_BUFFER));
      MOVE_VERTICAL (+2);
   endif;

   UPDATE (info_window);
   loop        
      xxx := READ_LINE ("Enter <CR> to continue...");
      exitif (xxx = "") and (LAST_KEY = RET_KEY);
!      EXECUTE (LOOKUP_KEY (LAST_KEY,program));
!      UPDATE (CURRENT_WINDOW);
   endloop;
   UNMAP (info_window);
   fred$remove_mark_keys;

ENDPROCEDURE;                       

PROCEDURE fred$set_mark_keys
   ADD_KEY_MAP (eve$x_key_map_list, eve$kt_first, fred$x_mark_keys);
   MESSAGE ("MARK function keys enabled...");
ENDPROCEDURE;

PROCEDURE fred$remove_mark_keys
   REMOVE_KEY_MAP (eve$x_key_map_list, fred$x_mark_keys, ALL);
!   MESSAGE ("MARK function keys disabled...");
ENDPROCEDURE;
   

PROCEDURE tpu$local_init

   fred$x_marks := " ";	   		! Initialize to a blank
   fred$x_mark_count := 0; 		! Initialize to zero
   fred$mark_buffer := eve$kt_null;
   fred$x_marker_column := eve$kt_null;
   if (fred$test_for_key_map("fred$mark_keys") = 0) then
      fred$x_mark_keys := CREATE_KEY_MAP ("fred$mark_keys");
      DEFINE_KEY ("fred$set_mark", e2, " set_mark",      	! Insert key
		fred$x_mark_keys);
      DEFINE_KEY ("fred$delete_mark", e3, " delete_mark",  ! Remove key
		fred$x_mark_keys);
      DEFINE_KEY ("fred$goto_mark", e1, " goto_mark",      ! Find key
		fred$x_mark_keys);
      DEFINE_KEY ("fred$show_marks", e4, " show_marks",    ! Select key
		fred$x_mark_keys);
   else
      fred$x_mark_keys := "fred$mark_keys";
   endif;

ENDPROCEDURE;