%_traceback = 1;
% 
% 		      Site specific initialiation file.
% 
% This file must be present in the JED_LIBRARY.  JED loads it first--- even
% before reading command line arguments.  The command line arguments are then
% passed to a hook declared in this file for further processing.
% 
% In addition to some hooks, this file declares some autoloads for various
% functions and defines utility functions.  Any user specific stuff should be
% placed in the jed.rc (.jedrc) user startup file.  Only put here what you
% believe EVERY user on your system should get!
% 
% The best way to make changes in this file is to put all your changes in a
% separate file, defaults.sl.  defaults.sl is NOT distributed with JED.  Code
% at the edn of this file checks for the existence of `defaults.sl' and loads
% it if found. Functions occuring in this file (site.sl) may be overloaded in
% defaults.sl. Making changes this way also makes it easier to upgrade to
% future JED versions.
% 


%!% A function to contat a directory with a filename.  Basically checks
%!% for the final slash on the dir and adds on if necessary
define dircat(dir, file)
{
   variable n = strlen(dir);
   
#ifdef MSDOS OS2
   variable slash = "\\";
   if (n)
     {
	if (strcmp(substr(dir, n, 1), slash)) dir = strcat(dir, slash);
     }
   strcat(dir, file);
#endif
#ifdef UNIX
   variable slash = "/";
   if (n)
     {
	if (strcmp(substr(dir, n, 1), slash)) dir = strcat(dir, slash);
     }
   strcat(dir, file);
#endif
#ifdef VMS
   % convert a.dir;1 to [.a] first
   variable f1, d1;
   dir = extract_element(dir, 0, ';');
   f1 = extract_element(dir, 1, ']');
   if (strlen(f1)) f1 = strcat(".", extract_element(f1, 0, '.'));
   d1 = extract_element(dir, 0, ']');
   strcat(d1, f1);
   if (':' != int(substr(dir, strlen(dir), 1))) strcat((), "]");
   strcat ((), file);
#endif
   expand_filename(());
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%     Global Variables
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
variable Null_String = "";

%!% A Comma separated list of info directories to search.
variable Info_Directory;
variable Jed_Bin_Dir;



%% Convert Unix- or OS/2- style path to comma-delimited list
define path2list(path)
{
#ifdef VMS
    path;
#else
    variable n, pathsep, a_path;
 
#ifdef UNIX
    pathsep = ':';
#else
    pathsep = ';';
#endif
 
    n = 0; Null_String; Null_String;
    while (a_path = extract_element(path, n, pathsep), strlen(a_path))
      {
 	strcat((), strcat((), a_path));
 	","; n++;
      }
    pop();
#endif
}

#ifdef VMS
   Info_Directory = strcat(JED_ROOT, "[info]");
   Jed_Bin_Dir = strcat(JED_ROOT, "[bin]");
#else
   Info_Directory = dircat(JED_ROOT, "info");
   Jed_Bin_Dir = dircat(JED_ROOT, "bin");
#endif
 
$1 = getenv("INFOPATH");
if (strlen($1)) Info_Directory = path2list($1);
  
%!% Column to begin a C comment--- used by c_make_comment
variable C_Comment_Column = 40;


#ifdef UNIX
 if (OUTPUT_RATE > 3000) OUTPUT_RATE = 0;   %% coming through a network?
#endif

%%
%% Some key definitions
%%
% These two are for compatability:
  setkey("search_forward", "^Ff");
  setkey("search_backward", "^Fb");
#ifdef OS2
   setkey("bob",  "^@\x84");
   setkey("eob", "^@\x76");
   setkey("skip_word", "^@\x74");  % C-left arrow
   setkey("bskip_word", "^@\x73"); % C-right arrow
#endif
  setkey("skip_word", "^[^[[C");  %escape right arrow.
  setkey("bskip_word", "^[^[[D");  %escape left arrow
  setkey("upcase_word", "^[U");
  setkey("downcase_word", "^[L");
  setkey("capitalize_word", "^[C");
  setkey("emacs_escape_x", "^[X");
  setkey("undo", "^Xu");  %% Also ^_ but vtxxx have problems with it
  setkey("transpose_lines", "^X^T");
  setkey("help_prefix", "^H");
  setkey("c_make_comment", "^[;");
  setkey("indent_line_cmd", "^I");
  setkey("insert_colon_cmd", ":");
  setkey("newline_and_indent_cmd", "^M");
  setkey("do_shell_cmd", "^[!");
  setkey("find_tag", "^[.");
  setkey("save_buffers", "^Xs");
  setkey("whatpos", "^X?");
  setkey("list_buffers", "^X^B");
  setkey ("set_fill_column", "^Xf");
#ifdef UNIX OS2
  setkey("ispell", "^[$");
#endif
#ifndef MSDOS OS2
  setkey("mail", "^Xm");
#endif

%%
%%  Autoloads
%%

  autoload("find_binary_file",		"binary");
#ifdef VMS
  autoload("dcl",			"dcl");
#endif
  autoload("jed_easy_help",		"jedhelp");
  autoload("query_replace_match",	"regexp");
  autoload("re_search_forward",		"regexp");
  autoload("re_search_backward",	"regexp");
  autoload("c_make_comment",		"cmisc");
  autoload("c_indent_line",		"indent");
  autoload("c_colon_indent_line",	"indent");
  autoload("dired",			"dired");
  autoload("calendar",			"cal");
  autoload("menu_main_cmds",		"menu");
  autoload("trim_buffer",		"util");  %% trims excess lines and space
  autoload("occur",			"util");  %% find all command
  autoload("info_mode",			"info");
  autoload("list_buffers",		"buf");
  autoload("append_region",		"buf");
  autoload("write_region",		"buf");
  autoload("recover_file",		"buf");
  autoload("most_mode",			"most");
  autoload("run_most",			"most");
  autoload("compile",			"compile");
  autoload("sort",			"sort");
  autoload("untab",			"untab");
  autoload("fortran",			"fortran");
  autoload("save_buffers",		"buf");
  autoload("rot13",			"rot13");
  autoload("search_forward",		"search");
  autoload("search_backward",		"search");
  autoload("replace_cmd",		"search");
  autoload("isearch_forward",		"isearch");
  autoload("isearch_backward",		"isearch");
  autoload("shell",			"shell");
#ifndef UNIX OS2
  autoload("shell_cmd",			"shell");
#endif
  autoload("do_shell_cmd",		"shell");
  autoload("find_tag",			"ctags");
  autoload("apropos",			"help");
  autoload("expand_keystring",		"help");
  autoload("describe_bindings",		"help");
  autoload("describe_function",		"help");
  autoload("describe_variable",		"help");
  autoload("help_for_function",		"help");
  autoload("where_is",			"help");
  autoload("showkey",			"help");
  autoload("describe_mode",		"help");
  autoload("format_paragraph_hook",	"tmisc");
  autoload("tex_mode",			"tex");

%%
%% By default, tabs are every TAB columns (default 8).  Calling this function
%% will allow the user to set the tabs arbitrarily and bind the TAB key
%% appropriately.
  autoload("edit_tab_stops",		"tabs");
  autoload("tab_to_tab_stop",		"tabs");
     
#ifdef UNIX VMS
  autoload("mail",			"mail");
  autoload("mail_format_buffer",	"mail");
#endif

#ifdef UNIX OS2
  autoload("unix_man",			"man");
  autoload("ispell",			"ispell");
#endif
#ifdef UNIX
  autoload("rmail",			"rmail");
  autoload("dcl",			"dcl");
#endif 
#ifdef VMS
  autoload("vms_help",			"vmshelp");
#endif

% Utility functions

define go_up(n) { pop(up(n)); }
define go_down(n) { pop(down(n));}
define go_left(n) { pop(left(n));}
define go_right(n) { pop(right(n));}

%% emacs-like escape-x function
define emacs_escape_x()
{
   variable f = Null_String, i = 0;
  
   if (MINIBUFFER_ACTIVE)
     {
	call("evaluate_cmd");
	return;
     }
   
   forever
     {
	if (is_internal(f)) 
	  {
	     call(f);
	     return;
	  }
	
	if (is_defined(f))
	  {
	     eval(f);
	     return;
	  }
	
	if (i == 1) ungetkey(13);
	ungetkey(9);
	++i;
	f = read_with_completion("M-x", Null_String, f, 'F')
     } 
}

define goto_line_cmd()
{
   read_mini("Goto line:", Null_String, Null_String);
   goto_line(integer(()));
}

define goto_column_cmd()
{
   read_mini("Goto Column:", Null_String, Null_String);
   goto_column(integer(()));
}

%% A useful hooks function---
%% There is a builtin one in slang as well that is called from C code
define runhooks(fun)
{
   if (is_defined (fun)) eval(fun);
}

%% useful functions for use in user hooks--- operate on current keymap
define local_setkey(f, key)
{
   definekey(f, key, what_keymap());
}

define local_unsetkey(key)
{
   undefinekey(key, what_keymap());
}

%!% insert a character into a buffer.
%!% This function should be called instead of 'insert' when it is desired to
%!% insert a 1 character string.  Unlike 'insert', insert_char takes an integer
%!% argument.  For example, 
%!%    'x' insert_char
%!% and 
%!%    "x" insert
%!% are functionally equivalent but insert_char is more memory efficient.
define insert_char(ch) 
{ 
   insert (char(ch));
}


%!%   insert a newline in buffer
define newline () 
{ 
   insert_char(10);
}

   
%!% insert a single space into the buffer.
define insert_single_space ()
{
   insert_char(' ');
}


define looking_at_char(ch)   % case sensitive
{
   what_char() == ch;
}


%!% returns type of file.  e.g., /usr/a.b/file.c --> c
define file_type(file)
{
   variable n;
   file = extract_filename(file);
   
   n = is_substr(file, ".");
   !if (n) return (Null_String);
   
   substr(file, n + 1, strlen(file));
}



%;; scroll other window macros-- bind them yourself
define next_wind_up()
{
   otherwindow();  call("page_up");
   loop (nwindows() - 1) otherwindow();
}

define next_wind_dn()
{
   otherwindow();  call("page_down");
   loop (nwindows() - 1) otherwindow();
}

%!% Mode dedicated to facilitate the editing of C language files.  Functions
%!% that affect this mode include:
%!%
%!%   function:             default binding:
%!%   brace_bra_cmd               {
%!%   brace_ket_cmd               }
%!%   newline_and_indent          RETURN
%!%   indent_line_cmd             TAB
%!%   goto_match                  ^\
%!%   c_make_comment              ESC ;
%!%
%!%  Variables affecting indentation include:
%!%
%!%   C_INDENT
%!%   C_BRACE
%!%   C_Comment_Column  --- used by c_make_comment
define c_mode()
{
   setmode("C", 2);
   use_keymap("global");
}

define slang_mode()
{
   setmode("SL", 2 | 8);
   use_keymap("global");
}

%!%  Mode for indenting and wrapping text
%!%  Functions that affect this mode include:
%!%
%!%    Function:                     Default Binding:
%!%      indent_line_cmd                 TAB
%!%      newline_and_indent_cmd          RETURN
%!%      format_paragraph                ESC Q
%!%      narrow_paragraph                ESC N
%!%
%!%  Variables include:
%!%      WRAP_INDENTS, WRAP
%!%      TAB, TAB_DEFAULT
define text_mode()
{
   setmode("Text", 1);
   use_keymap("global");
}

%!%  Generic mode not designed for anything in particular.
%!%  See:  text_mode, c_mode
define no_mode()
{
   setmode(Null_String, 0);
   use_keymap("global");
}

% Function prototypes
% These 'functions' are only here to initialize function pointers.
define _function_pop_0 (x) {0}

%!% called from mode_hook.  Returns 0 if it is desired that control return
%!% to mode_hook or 1 if mode hook should exit after calling mode_hook_ptr
variable mode_hook_pointer = &_function_pop_0;

variable Default_Mode = &text_mode;

%!% This is a hook called by find_file routines to set the mode
%!% for the buffer. This function takes one parameter, the filename extension
%!% and returns nothing.
define mode_hook(ext)
{
   variable file;
   if (mode_hook_pointer(ext)) return;
   switch(ext)
     {not (strcmp((), "c")) : c_mode}
     {not (strcmp((), "h")) : c_mode}
     {not (strcmp((), "tex")) : tex_mode}
     {not (strcmp((), "txt")) : text_mode}
     {not (strcmp((), "doc")) : text_mode}
     {not (strcmp((), "f")) : fortran }
     {not (strcmp((), "for")) : fortran }
     {not (strcmp((), "dat")) : no_mode }
     {not (strcmp((), "sl")) : slang_mode }
     {not (strcmp((), "rc")) :
	no_mode ();
	(file,,,) = getbuf_info ();
	!if (strcmp(file,"jed.rc")) slang_mode ();
     }
#ifdef UNIX
     {not (strcmp((), "jedrc")) : c_mode } 
     {not (strcmp((), "cshrc")) : no_mode } 
     {not (strcmp((), "tcshrc")) : no_mode }
     {not (strcmp((), "login")) : no_mode } 
     {not (strcmp((), "profile")) : no_mode }
#endif
#ifndef MSDOS OS2
     {not (strcmp((), "com")) : dcl}
#endif
     {not (strcmp((), "ci")) : c_mode}
     {pop(); Default_Mode ();} %%  default
}

define is_c_mode ()
{
   variable mode;
   (, mode) = whatmode ();
   mode & 2;
}

define indent_line_cmd ()
{
   indent_line ();
   if (is_c_mode) c_indent_line ();
}

define insert_colon_cmd ()
{
   insert_char (':');
   if (is_c_mode ()) indent_line_cmd ();
}


define newline_and_indent_cmd ()
{
   % Note that the 'call' is necessary here so that exit_min is called
   % if this is called from mini buffer at startup.
   call ("newline");
   indent_line_cmd ();
   if (is_c_mode() and C_COMMENT_HINT) insert ("* ");
}


%!% sets buf modified flag. If argument is 1, mark
%!% buffer as modified.  If argument is 0, mark buffer as unchanged.
define set_buffer_modified_flag(modif)
{
   getbuf_info();
   if (modif) () | 1; else () & ~(1);
   setbuf_info(());
}
%!%  returns non-zero if the buffer modified flag is set.  It returns zero
%!%  if the buffer modified flag is not been set.  This works on the 
%!%  current buffer.  See also 'set_buffer_modified_flag'.
define buffer_modified ()
{
   variable flags;
   (, , , flags) = getbuf_info ();
   flags & 1;
}

%!% set undo mode for buffer.  If argument is 1, undo is on.  0 turns it off
define set_buffer_undo(modif)
{
   getbuf_info();
   if (modif) () | 32; else () & ~(32);
   setbuf_info(());
}


%!% Takes 1 parameter: 0 turn off readonly
%!%                    1 turn on readonly
define set_readonly(n)
{
   getbuf_info();
   if (n) () | 8; else () & ~(8);
   setbuf_info(());
}

%!% Takes 1 parameter: 0 turn off overwrite
%!%                    1 turn on overwrite
define set_overwrite(n)
{
   getbuf_info();
   if (n) () | 16; else () & ~(16);
   setbuf_info(());
}

define toggle_readonly()
{
   setbuf_info(getbuf_info() xor 8);
}
define toggle_overwrite()
{
   setbuf_info(getbuf_info() xor 16);
}

#ifdef MSDOS OS2
setkey("toggle_overwrite", "^@R");     %/* insert key */
#endif

define toggle_undo()
{
   setbuf_info(getbuf_info() xor 32);
}

define double_line()
{
   POINT;
   bol(); push_mark(); eol(); 
   bufsubstr(); 
   newline();
   insert(());
   =POINT;
}

define transpose_lines()
{
   variable line;
   bol(); push_mark(); push_mark(); eol(); 
   line = bufsubstr();
   go_right(1);
   del_region();
   go_up(1); bol();
   insert(line);
   newline();
   go_down(1);
   bol();
}




%!% string to display at bottom of screen upon JED startup and when
%!% user executes the help function.
variable help_for_help_string;

help_for_help_string =
#ifdef VMS
 "^H -> Help:^H  Menu:?  Info:I  Apropos:A  Key:C  Where:W  Fnct:F  VMSHELP:M  Var:V";
#endif
#ifdef MSDOS
 "^H -> Help:^H  Menu:?  Info:I  Apropos:A  Key:C  Where:W  Fnct:F  Var:V  Mem:M";
#endif
#ifdef UNIX OS2
 "^H -> Help:^H  Menu:?  Info:I  Apropos:A  Key:C  Where:W  Fnct:F  Var:V  Man:M";
#endif

% Load minibuffer routines now before any files are loaded.
% This will reduce fragmentation on PC.
!if (BATCH) {evalfile("mini"); pop();}


%for compatability with older versions
define read_file_from_mini(prompt)
{
   read_with_completion(prompt, Null_String, Null_String, 'f');
}


%!% If non-zero, startup by asking user for a filename if one was
%!% not specified on the command line.
variable Startup_With_File = 0;

%% startup hook
%!% Function that gets executed right before JED enters its main editing
%!% loop.  This is for last minute modifications of data structures that
%!% did not exist when startup files were loaded (e.g., minibuffer keymap)
define  jed_startup_hook()
{
   variable n, hlp, ok = 0, mini = "Mini_Map", file;

#ifdef MSDOS OS2
   definekey ("next_mini_command", "^@P", mini);
   definekey ("prev_mini_command", "^@H", mini);
#else
   definekey ("next_mini_command", "^[[B", mini);
   definekey ("prev_mini_command", "^[[A", mini);
#endif

   definekey ("mini_exit_minibuffer", "^M", mini);
   definekey ("exit_mini", "^[^M", mini);
   
   % turn on Abort character processing
   IGNORE_USER_ABORT = 0;
  
   if (Startup_With_File and not (strcmp (whatbuf(), "*scratch*")))
     {
	forever 
	  {
	     file = read_file_from_mini ("Enter Filename:");
	     if (strlen(extract_filename(file))) break;
	  }
	find_file(file); pop();
     }
   message(help_for_help_string);
}


%!% display row and column information in minibuffer
define whatpos ()
{
   strcat(count_chars(), ", Line ");
   strcat( (), string(whatline()));
   strcat( (), " of ");
   push_spot(); eob(); 
   strcat( (), string(whatline()));
   pop_spot();
   strcat( (), " lines, Column ");
   strcat( (), string(what_column()));
   message( () );
}


%!% Search for FILE in directories specified by JED_LIBRARY returning
%!% expanded pathname if found or the Null string otherwise.
define expand_jedlib_file(f)
{
   variable n = 0, dir, file;
   forever
     {
	dir = extract_element(JED_LIBRARY, n, ',');
	!if (strlen(dir)) return (Null_String);
	file = dircat(dir, f);
	if (file_status(file) == 1) break;
	++n;
   } 
   file;
}

%!% find a file from JED_LIBRARY, returns number of lines read or 0 if not 
%!% found.
define find_jedlib_file(file)
{
   file = expand_jedlib_file(file);
   !if (strlen(file)) return(0);
   find_file(file);
}


%%
%% help function
%%

%!% name of the file to load when the help function is called.
variable Help_File = "jed.hlp";   %% other modes will override this.

%!% Pop up a window containing a help file.  The help file that is read
%!% in is given by the variable Help_File.
define help()
{
   variable hlp = "*help*", file, buf, rows;
    
   !if (buffer_visible (hlp))
     {
	Help_File = expand_jedlib_file(Help_File);
	!if (strlen(Help_File)) error ("No help file available.");
	buf = whatbuf();
	onewindow();
	rows = window_info('r');
	file = Help_File;
	setbuf(hlp);
	set_readonly(0);
	erase_buffer();

	insert_file(Help_File); pop();
	pop2buf(hlp);
	eob(); bskip_chars("\n");
	rows = rows / 2 - (whatline() + 1);
	bob();
	set_buffer_modified_flag(0);
	set_readonly(1);
	pop2buf(buf);
	loop (rows) enlargewin();
     }
   
   message(help_for_help_string);
}

#ifdef VMS
%% This resume hook is need for VMS when returning from spawn.
%% In fact, it is NEEDED for certain JED functions on VMS so declare it.
define resume_hook()
{
   variable file = getenv("JED_FILE_NAME");
   !if (strlen(file)) return;
   
   !if (find_file(file)) error("File not found!");
}
#endif VMS


%%file hooks
%!% returns backup filename.  Arguments to function are dir and file.
define make_backup_filename(dir, file)
{
#ifdef UNIX
   strcat (strcat (dir, file), "~");
#endif
#ifdef MSDOS OS2
   variable type;
#ifdef OS2
   !if (IsHPFSFileSystem(dir)) {
#endif

      % There are several things to worry about.  Here just break up the 
      % filename and truncate type to 2 chars and paste it back.
      % note that this takes a name like file.c and produces file.c~
      % Also, note that if the type is empty as in 'file', it produces 
      % 'file.~'

      type = file_type(file);
      file = strcat (strcat (extract_element(file, 0, '.'), "."),
		     substr(type, 1, 2));

#ifdef OS2
   }
#endif
   strcat (strcat (dir, file), "~");
#endif  
}


%!% returns autosave filename.  Arguments to function are dir and file.
define make_autosave_filename(dir, file)
{
#ifdef VMS
   file = strcat (strcat ("_$", file), ";1");
   strcat (dir, file);
#endif
#ifdef UNIX
   variable p = "#";
   strcat (dir, strcat (strcat (p, file), p));
#endif
#ifdef MSDOS OS2
#ifdef OS2
   !if (IsHPFSFileSystem(dir)) {
#endif
      variable type = file_type(file);
      file = substr(extract_element(file, 0, '.'), 1, 7);
      if (strlen(type)) file = strcat(file, ".");
      file = strcat (file, type);
#ifdef OS2
   }
#endif
   
   strcat (dir, strcat ("#", file));
#endif
}

%!% breaks a filespec into dir filename--- 
%!% this routine returns dir and filename such that a simple strcat will
%!% suffice to put them together again.  For example, on unix, /a/b/c
%!% returns /a/b/ and c
define parse_filename(fn)
{
   variable f, dir, n;
      
   f = extract_filename(fn);
   n = strlen(fn) - strlen(f);
   dir = substr(fn, 1, n);
   dir; f;
}
 
%!% called AFTER a file is read in to a buffer.  FILENAME is on the stack.
define find_file_hook(file)
{
   variable dir, a, f, m;
   (dir, f) = parse_filename(file); 
   
   a = make_autosave_filename(dir, f);
   if (file_time_compare(a, file) > 0) 
     {
	m = "Autosave file is newer. Use ESC-X recover_file.";
	flush(m);
        input_pending(10); pop();
	message(m);
     } 
}

%
% completions  -- everything here must be predefined
% I just push the strings onto the stack and loop 'add_completion' over them
%
  $0 = _stkdepth();

. "toggle_overwrite" "toggle_readonly" "toggle_undo" "calendar" "trim_buffer"
. "occur" "info_mode" "list_buffers" "append_region" "write_region"
. "recover_file" "compile" "sort" "untab" "fortran" "save_buffers" "rot13"
. "isearch_forward" "isearch_backward" "shell" "apropos" "describe_function"
. "describe_variable" "where_is" "showkey" "edit_tab_stops" "c_mode"
. "text_mode" "no_mode" "goto_line_cmd" "goto_column_cmd" "describe_mode"
. "evalbuffer" "open_rect" "kill_rect" "insert_rect" "copy_rect" "blank_rect"
. "dired" "re_search_forward" "re_search_backward" "query_replace_match"
. "describe_bindings"  "search_backward" "search_forward" "replace_cmd"
.  "find_binary_file"
#ifndef MSDOS OS2
.  "mail" 
#endif
#ifdef UNIX OS2
. "ispell"		
#endif

loop (_stkdepth - $0) add_completion(());


% save buffer if necessary
define save_buffer()
{
   variable flags, dir, file;
   (file, dir, , flags) = getbuf_info();

   !if (flags & 1) return (message("Buffer not modified."));
   if (strlen(file))
     {
	write_buffer(dircat(dir, file)); pop();
     }
   else call ("save_buffers");
} add_completion("save_buffer");

define insert_buffer()
{
   read_with_completion("Insert Buffer:", Null_String, Null_String, 'b');
   push_spot();
   ERROR_BLOCK {pop_spot()}
   insbuf(());
   EXECUTE_ERROR_BLOCK;
}  add_completion("insert_buffer");


define help_prefix()
{
   variable c;
   
   !if (input_pending(20)) flush (help_for_help_string);
   c = int (strup(char(getkey())));
   switch (c)
     { () == 8 : help }
     { () == 'A' : apropos }
     { () == 'I' : info_mode}
     { () == '?' : menu_main_cmds}
     { () == 'F' : describe_function}
     { () == 'V' : describe_variable}
     { () == 'W' : where_is}
     { () == 'C' : showkey}
     { () == 'M' :
#ifdef UNIX OS2
	unix_man();
#else 
#ifdef VMS
	vms_help ();
#endif
#endif
#ifdef MSDOS
	call("coreleft");
#endif
     }
     { pop(); beep(); }
}

%%
%%  word movement definitions.  Since these vary according to editors,
%%  they are S-Lang routines.
%%

define skip_word ()
{
  while (skip_non_word_chars(), eolp()) 
    {
      if (1 != right(1)) break;
    }
   skip_word_chars();
}

define bskip_word()
{
   while (bskip_non_word_chars(), bolp())
     {
	!if (left(1)) break;
     }
   bskip_word_chars();
}

define delete_word()
{
   push_mark(); skip_word(); del_region();
}

define xform_word(x)
{
   skip_non_word_chars();
   push_mark(); skip_word(); 
   xform_region(x);
}

define capitalize_word()
{
   xform_word('c');
}

define upcase_word()
{
   xform_word('u');
}

define downcase_word()
{
   xform_word('d');
}

define smart_set_mark_cmd ()
{
   if (markp()) pop_mark(0); else call("set_mark_cmd");
}

define flush_input()
{
     while (input_pending(0)) pop(getkey());
}

%!% Prototype Void buffer_format_in_columns();
%!% takes a buffer consisting of a sigle column of items and converts the
%!% buffer to a multi-column format.
define buffer_format_in_columns()
{
   push_spot();
   bob();
   forever 
     {
	_for (0,4,1) 
	  {
	     goto_column(() * 14 + 1);
	     if (eolp())
	       {
		  if (eobp()) 
		    {
		       pop_spot();
		       return;
		    }
		  insert_single_space;
		  del();
	       }
	  } 
	!if (down(1)) break;
	bol();
     }
   pop_spot();
}

define delete_line()
{
   bol(); push_mark(); eol(); go_right(1); del_region();
}


define set_fill_column ()
{
   push_spot(); 
   eol();
   WRAP = what_column ();
   pop_spot();
   message (Sprintf("WRAP column at %d.", WRAP, 1));
}

define rename_buffer(name)
{
   variable flags = getbuf_info(); pop(); setbuf_info(name, flags);
}

define info ()
{
   info_mode ();
   definekey("exit_jed",		"Q",  "Infomap");
   definekey("exit_jed",		"q",  "Infomap");
}

define make_tmp_file(base)
{
   variable pid = getpid(), file, n = 1000;
   while (n)
     {
	file = strcat(base, string(pid));
	!if (file_status(file)) return (file);
	pid++;
     }
   error ("Unable to create a tmp file!");
}


define set_buffer_no_backup ()
{
   setbuf_info (getbuf_info() | 0x100);
}
define set_buffer_no_autosave ()
{
   setbuf_info (getbuf_info() & ~(0x2));
}

define goto_top_of_window ()
{
   go_up (window_line () - 1);
}

define goto_bottom_of_window ()
{
   go_down (window_info ('r') - window_line ());
}


%!% called from main in JED executable.
define command_line_hook()
{
   variable n, i, file, depth, jedrc, home, next_file;
   variable script_file = Null_String;
   jedrc = "jed.rc";
  
#ifdef UNIX
   jedrc = ".jedrc";
#endif
   
   home = getenv("JED_HOME");
#ifdef VMS
%% allows JED_HOME: to be search list---
%% thanks to SYSTEM@VACMZB.chemie.Uni-Mainz.DE for suggestion
   if (strlen(home)) home = "JED_HOME:";
#endif
   !if (strlen(home))
     {
	home = getenv("HOME");
#ifdef VMS
	home = "SYS$LOGIN:";
#endif
     } 
   jedrc = dircat(home, jedrc);
   
   n = MAIN_ARGC;
   
   --n;  %% argv[0], here it is not used.
%
%  If batch then first argument is not used so start at second
%  Also, n is the number of effective command line parameters so reduce it.
%
   
   if (BATCH) {	--n; 2; } else 1;  =i;
%
% if first argument is -n then do NOT load init file
%
   % stuff left on stack for if 
   if (n) strcmp (command_line_arg(i), "-n"); else 1;
   if (())
     {
	depth = _stkdepth;
	if (file_status(jedrc) == 1) jedrc; else "jed.rc";
	evalfile(()); pop();
	if ( _stkdepth != depth)
	  {
	     flush(strcat ("Excess junk left on stack by ", jedrc));
	     pop(input_pending(10));
	  }

	loop (_stkdepth - depth) pop();
     }
   else if (n) ++i;
   
   n = MAIN_ARGC - i;
   !if (n) return;
   
   if (BATCH == 2)
     {
	% last command line argument is a script.  eval it.
	script_file = command_line_arg (n + 1);
	n--;
     }
   
%
% Is JED to emulate most?
%
   !if (strcmp(command_line_arg(i), "-most"))
     {
	run_most (i + 1);
	return;
     }
   
   while (n > 0)
     {
	file = command_line_arg(i);
	--n; ++i;
	if (n) next_file = command_line_arg(i);
	switch(file)
	  {not(strcmp ((), "-f")) and n : eval(next_file)}
	  {not(strcmp ((), "-g")) and n : goto_line(integer(next_file))}
	  {not(strcmp ((), "-s")) and n : 
	     fsearch(next_file); pop();
	     save_search_string(next_file);
	  }
	  {not(strcmp ((), "-l")) and n : evalfile(next_file); pop();}
	  {not(strcmp ((), "-i")) and n : insert_file(next_file); pop();}
	  {not(strcmp ((), "-2")) : splitwindow(); ++n; --i;}
	  {not(strcmp ((), "-tmp")):
	     set_buffer_no_backup ();
	     set_buffer_no_autosave ();
	     ++n; --i;
	  }
	  {find_file(()); pop(); ++n; --i;}
	
	--n; ++i;
     }
   
   if (strlen(script_file)) pop(evalfile(script_file));
}
%!% Prototype: Void deln (Integer n);
%!% delete the next 'n' characters.
define deln (n)
{
   push_mark (); go_right(n); del_region ();
}

define insert_spaces (n) 
{
   loop (n) insert_single_space ();
}


% This fixes some bug in OS2 dealing with 'dir' issued non-interactively.
#ifdef OS2
   if (strlen(getenv("DIRCMD"))) putenv("DIRCMD=/ogn");
#endif

evalfile ("os.sl"); pop();

%
%  This code fragment looks for the existence of "defaults.sl" and loads
%  it.  This file IS NOT distributed with JED.
%

if (strlen(expand_jedlib_file("defaults.sl"))) pop(evalfile("defaults"));

