home *** CD-ROM | disk | FTP | other *** search
/ Il CD di internet / CD.iso / SOURCE / AP / JED / JED097-1.TAR / jed / lib / site.sl < prev    next >
Encoding:
Text File  |  1994-12-12  |  32.2 KB  |  1,396 lines
  1. %_traceback = 1;
  2. % 
  3. %               Site specific initialiation file.
  4. % 
  5. % This file must be present in the JED_LIBRARY.  JED loads it first--- even
  6. % before reading command line arguments.  The command line arguments are then
  7. % passed to a hook declared in this file for further processing.
  8. % 
  9. % In addition to some hooks, this file declares some autoloads for various
  10. % functions and defines utility functions.  Any user specific stuff should be
  11. % placed in the jed.rc (.jedrc) user startup file.  Only put here what you
  12. % believe EVERY user on your system should get!
  13. % 
  14. % The best way to make changes in this file is to put all your changes in a
  15. % separate file, defaults.sl.  defaults.sl is NOT distributed with JED.  Code
  16. % at the edn of this file checks for the existence of `defaults.sl' and loads
  17. % it if found. Functions occuring in this file (site.sl) may be overloaded in
  18. % defaults.sl. Making changes this way also makes it easier to upgrade to
  19. % future JED versions.
  20. % 
  21.  
  22.  
  23. %!% A function to contat a directory with a filename.  Basically checks
  24. %!% for the final slash on the dir and adds on if necessary
  25. define dircat(dir, file)
  26. {
  27.    variable n = strlen(dir);
  28.    
  29. #ifdef MSDOS OS2
  30.    variable slash = "\\";
  31.    if (n)
  32.      {
  33.     if (strcmp(substr(dir, n, 1), slash)) dir = strcat(dir, slash);
  34.      }
  35.    strcat(dir, file);
  36. #endif
  37. #ifdef UNIX
  38.    variable slash = "/";
  39.    if (n)
  40.      {
  41.     if (strcmp(substr(dir, n, 1), slash)) dir = strcat(dir, slash);
  42.      }
  43.    strcat(dir, file);
  44. #endif
  45. #ifdef VMS
  46.    % convert a.dir;1 to [.a] first
  47.    variable f1, d1;
  48.    dir = extract_element(dir, 0, ';');
  49.    f1 = extract_element(dir, 1, ']');
  50.    if (strlen(f1)) f1 = strcat(".", extract_element(f1, 0, '.'));
  51.    d1 = extract_element(dir, 0, ']');
  52.    strcat(d1, f1);
  53.    if (':' != int(substr(dir, strlen(dir), 1))) strcat((), "]");
  54.    strcat ((), file);
  55. #endif
  56.    expand_filename(());
  57. }
  58.  
  59. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60. %     Global Variables
  61. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  62. variable Null_String = "";
  63.  
  64. %!% A Comma separated list of info directories to search.
  65. variable Info_Directory;
  66. variable Jed_Bin_Dir;
  67.  
  68.  
  69. %!% Prototype: Void strncat (String a, String b, ..., Integer n);
  70. %!% Returns concatenated string "abc..."
  71. define strncat (n)
  72. {
  73.    n--;
  74.    loop (n) strcat ();
  75. }
  76.  
  77.  
  78. %% Convert Unix- or OS/2- style path to comma-delimited list
  79. define path2list(path)
  80. {
  81. #ifdef VMS
  82.     path;
  83. #else
  84.     variable n, pathsep, a_path;
  85.  
  86. #ifdef UNIX
  87.     pathsep = ':';
  88. #else
  89.     pathsep = ';';
  90. #endif
  91.  
  92.     n = 0; Null_String; Null_String;
  93.     while (a_path = extract_element(path, n, pathsep), strlen(a_path))
  94.       {
  95.      strncat ((), (), a_path, 3);
  96.      % strcat((), strcat((), a_path));
  97.      ","; n++;
  98.       }
  99.     pop();
  100. #endif
  101. }
  102.  
  103. #ifdef VMS
  104.    Info_Directory = strcat(JED_ROOT, "[info]");
  105.    Jed_Bin_Dir = strcat(JED_ROOT, "[bin]");
  106. #else
  107.    Info_Directory = dircat(JED_ROOT, "info");
  108.    Jed_Bin_Dir = dircat(JED_ROOT, "bin");
  109. #endif
  110.  
  111. $1 = getenv("INFOPATH");
  112. if (strlen($1)) Info_Directory = path2list($1);
  113.   
  114. %!% Column to begin a C comment--- used by c_make_comment
  115. variable C_Comment_Column = 40;
  116.  
  117.  
  118. #ifdef UNIX
  119.  if (OUTPUT_RATE > 9600) OUTPUT_RATE = 0;   %% coming through a network?
  120. #endif
  121.  
  122. %%
  123. %% Some key definitions
  124. %%
  125. % These two are for compatability:
  126.   setkey("search_forward", "^Ff");
  127.   setkey("search_backward", "^Fb");
  128. #ifdef OS2
  129.    setkey("bob",  "^@\x84");
  130.    setkey("eob", "^@\x76");
  131.    setkey("skip_word", "^@\x74");  % C-left arrow
  132.    setkey("bskip_word", "^@\x73"); % C-right arrow
  133. #endif
  134.   setkey("skip_word", "^[^[[C");  %escape right arrow.
  135.   setkey("bskip_word", "^[^[[D");  %escape left arrow
  136.   setkey("upcase_word", "^[U");
  137.   setkey("downcase_word", "^[L");
  138.   setkey("capitalize_word", "^[C");
  139.   setkey("emacs_escape_x", "^[X");
  140.   setkey("undo", "^Xu");  %% Also ^_ but vtxxx have problems with it
  141.   setkey("transpose_lines", "^X^T");
  142.   setkey("help_prefix", "^H");
  143.   setkey("c_make_comment", "^[;");
  144.   setkey("indent_line_cmd", "^I");
  145.   setkey("insert_colon_cmd", ":");
  146.   setkey("newline_and_indent_cmd", "^M");
  147.   setkey("do_shell_cmd", "^[!");
  148.   setkey("find_tag", "^[.");
  149.   setkey("dabbrev", "\e/");
  150.   setkey("save_buffers", "^Xs");
  151.   setkey("whatpos", "^X?");
  152.   setkey("list_buffers", "^X^B");
  153.   setkey ("set_fill_column", "^Xf");
  154. #ifdef UNIX OS2
  155.   setkey("ispell", "^[$");
  156. #endif
  157. #ifndef MSDOS OS2
  158.   setkey("mail", "^Xm");
  159. #endif
  160.  
  161. %%
  162. %%  Autoloads
  163. %%
  164.  
  165.   autoload("find_binary_file",        "binary");
  166.   autoload("jed_easy_help",        "jedhelp");
  167.   autoload("query_replace_match",    "regexp");
  168.   autoload("re_search_forward",        "regexp");
  169.   autoload("re_search_backward",    "regexp");
  170.   autoload("c_make_comment",        "cmisc");
  171.   autoload("c_indent_line",        "indent");
  172.   autoload("c_colon_indent_line",    "indent");
  173.   autoload("dired",            "dired");
  174.   autoload("calendar",            "cal");
  175.   autoload("menu_main_cmds",        "menu");
  176.   autoload("trim_buffer",        "util");  %% trims excess lines and space
  177.   autoload("occur",            "util");  %% find all command
  178.   autoload("info_reader",        "info");
  179.   autoload("info_mode",            "info");
  180.   autoload("info_find_node",        "info");
  181.   autoload("list_buffers",        "buf");
  182.   autoload("append_region",        "buf");
  183.   autoload("write_region",        "buf");
  184.   autoload("recover_file",        "buf");
  185.   autoload("most_mode",            "most");
  186.   autoload("run_most",            "most");
  187.   autoload("compile",            "compile");
  188.   autoload("sort",            "sort");
  189.   autoload("untab",            "untab");
  190.   autoload("fortran_mode",        "fortran");
  191.   autoload("save_buffers",        "buf");
  192.   autoload("rot13",            "rot13");
  193.   autoload("search_forward",        "search");
  194.   autoload("search_backward",        "search");
  195.   autoload("replace_cmd",        "search");
  196.   autoload("replace_maybe_query",    "search");
  197.   autoload("replace_across_buffer_files","replace");
  198.   autoload("isearch_forward",        "isearch");
  199.   autoload("isearch_backward",        "isearch");
  200.   autoload("shell",            "shell");
  201.   autoload("mute_set_mute_keys",    "mutekeys");
  202. #ifndef UNIX OS2
  203.   autoload("shell_cmd",            "shell");
  204. #endif
  205.   autoload("do_shell_cmd",        "shell");
  206.   autoload("find_tag",            "ctags");
  207.   autoload("apropos",            "help");
  208.   autoload("expand_keystring",        "help");
  209.   autoload("describe_bindings",        "help");
  210.   autoload("describe_function",        "help");
  211.   autoload("describe_variable",        "help");
  212.   autoload("help_for_function",        "help");
  213.   autoload("where_is",            "help");
  214.   autoload("showkey",            "help");
  215.   autoload("describe_mode",        "help");
  216.   autoload("format_paragraph_hook",    "tmisc");
  217.   autoload("dabbrev",            "dabbrev");
  218.   autoload("tex_mode",            "tex");
  219.   autoload("bkmrk_goto_mark",           "bookmark");
  220.   autoload("bkmrk_set_mark",            "bookmark");
  221.  
  222. %%
  223. %% By default, tabs are every TAB columns (default 8).  Calling this function
  224. %% will allow the user to set the tabs arbitrarily and bind the TAB key
  225. %% appropriately.
  226.   autoload("edit_tab_stops",        "tabs");
  227.   autoload("tab_to_tab_stop",        "tabs");
  228.   autoload("append_string_to_file",    "misc");   
  229.   autoload("write_string_to_file",    "misc");   
  230.   autoload("make_tmp_buffer_name",    "misc");
  231.   autoload("abbrev_mode",        "abbrev");
  232.   autoload("set_abbrev_mode",        "abbrev");
  233.   autoload("save_abbrevs",        "abbrmisc");
  234.   autoload("define_abbreviation",    "abbrmisc");
  235.  
  236. #ifdef UNIX VMS
  237.   autoload("mail",            "mail");
  238.   autoload("mail_format_buffer",    "mail");
  239.   autoload("dcl_mode",            "dcl");
  240. #endif
  241.  
  242. #ifdef UNIX OS2
  243.   autoload("unix_man",            "man");
  244.   autoload("ispell",            "ispell");
  245. #endif
  246. #ifdef UNIX
  247.   autoload("rmail",            "rmail");
  248. #endif
  249.  
  250. #ifdef VMS
  251.   autoload("vms_help",            "vmshelp");
  252. #endif
  253.  
  254. % Utility functions
  255.  
  256. %!% Prototype: Void go_up (Integer n);
  257. %!% Move up 'n' lines.
  258. %!% See also: up, go_down
  259. define go_up() { () = up(); }
  260.  
  261. %!% Prototype: Void go_down (Integer n);
  262. %!% Move down 'n' lines.
  263. %!% See also: go_up, down
  264. define go_down() { () = down(); }
  265.  
  266. %!% Prototype: Void go_left (Integer n);
  267. %!% Move backward 'n' characters.
  268. %!% See also: left, go_right
  269. define go_left() { () = left();}
  270.  
  271. %!% Prototype: Void go_right (Integer n);
  272. %!% Move forward 'n' characters.
  273. %!% See also: right, go_left
  274. define go_right() { () = right();}
  275.  
  276. %% emacs-like escape-x function
  277. define emacs_escape_x()
  278. {
  279.    variable f = Null_String, i = 0;
  280.   
  281.    if (MINIBUFFER_ACTIVE)
  282.      {
  283.     call("evaluate_cmd");
  284.     return;
  285.      }
  286.    
  287.    forever
  288.      {
  289.     if (is_internal(f)) 
  290.       {
  291.          call(f);
  292.          return;
  293.       }
  294.     
  295.     if (is_defined(f))
  296.       {
  297.          eval(f);
  298.          return;
  299.       }
  300.     
  301.     if (i == 1) ungetkey(13);
  302.     ungetkey(' ');
  303.     ++i;
  304.     f = read_with_completion("M-x", Null_String, f, 'F')
  305.      } 
  306. }
  307.  
  308. define goto_line_cmd()
  309. {
  310.    read_mini("Goto line:", Null_String, Null_String);
  311.    goto_line(integer(()));
  312. }
  313.  
  314. define goto_column_cmd()
  315. {
  316.    read_mini("Goto Column:", Null_String, Null_String);
  317.    goto_column(integer(()));
  318. }
  319.  
  320. %!% Prototype: Void runhooks (String fun)
  321. %!% if S-Lang function 'fun' is defined, execute it.  It does nothing if 'fun'
  322. %!% does not exist.
  323. define runhooks(fun)
  324. {
  325.    if (is_defined (fun)) eval(fun);
  326. }
  327.  
  328. %!% Prototype: Void local_setkey (String fun, String key);
  329. %!% This function is like 'setkey' but unlike 'setkey' which operates on the
  330. %!% global keymap, 'local_setkey' operates on the current keymap which may or
  331. %!% may not be the global one.
  332. %!% See also: setkey, definekey, local_unsetkey
  333. define local_setkey(f, key)
  334. {
  335.    definekey(f, key, what_keymap());
  336. }
  337.  
  338. %!% Prototype: Void local_unsetkey (String key);
  339. %!% This function is like 'unsetkey' but unlike 'unsetkey' which unsets a key
  340. %!% from the global keymap, 'local_unsetkey' operates on the current keymap
  341. %!% which may or may not be the global one.
  342. %!% See also: unsetkey, undefinekey, local_setkey
  343. define local_unsetkey(key)
  344. {
  345.    undefinekey(key, what_keymap());
  346. }
  347.  
  348. %!% insert a character into a buffer.
  349. %!% This function should be called instead of 'insert' when it is desired to
  350. %!% insert a 1 character string.  Unlike 'insert', insert_char takes an integer
  351. %!% argument.  For example, 
  352. %!%    'x' insert_char
  353. %!% and 
  354. %!%    "x" insert
  355. %!% are functionally equivalent but insert_char is more memory efficient.
  356. define insert_char(ch) 
  357. { 
  358.    insert (char(ch));
  359. }
  360.  
  361.  
  362. %!% Prototype: Void newline (Void);
  363. %!% insert a newline in the buffer at point.
  364. %!% See also: insert, insert_char
  365. define newline () 
  366. { 
  367.    insert_char('\n');
  368. }
  369.  
  370.    
  371. %!% insert a single space into the buffer.
  372. define insert_single_space ()
  373. {
  374.    insert_char(' ');
  375. }
  376.  
  377. %!% Prototype: Integer looking_at_char (Integer ch);
  378. %!% This function returns non-zero if the character at the current editing
  379. %!% point is 'ch' otherwise it retuns zero.  This function performs a case 
  380. %!% sensitive comparison.
  381. define looking_at_char(ch)
  382. {
  383.    what_char() == ch;
  384. }
  385.  
  386.  
  387. %!% returns type of file.  e.g., /usr/a.b/file.c --> c
  388. define file_type(file)
  389. {
  390.    variable n;
  391.    file = extract_filename(file);
  392.    
  393.    n = is_substr(file, ".");
  394.    !if (n) return (Null_String);
  395.    
  396.    substr(file, n + 1, strlen(file));
  397. }
  398.  
  399.  
  400.  
  401. %;; scroll other window macros-- bind them yourself
  402. define next_wind_up()
  403. {
  404.    otherwindow();  call("page_up");
  405.    loop (nwindows() - 1) otherwindow();
  406. }
  407.  
  408. define next_wind_dn()
  409. {
  410.    otherwindow();  call("page_down");
  411.    loop (nwindows() - 1) otherwindow();
  412. }
  413.  
  414. %!% Mode dedicated to facilitate the editing of C language files.  Functions
  415. %!% that affect this mode include:
  416. %!%
  417. %!%   function:             default binding:
  418. %!%   brace_bra_cmd               {
  419. %!%   brace_ket_cmd               }
  420. %!%   newline_and_indent          RETURN
  421. %!%   indent_line_cmd             TAB
  422. %!%   goto_match                  ^\
  423. %!%   c_make_comment              ESC ;
  424. %!%
  425. %!%  Variables affecting indentation include:
  426. %!%
  427. %!%   C_INDENT
  428. %!%   C_BRACE
  429. %!%   C_Comment_Column  --- used by c_make_comment
  430. define c_mode()
  431. {
  432.    setmode("C", 2);
  433.    use_keymap("global");
  434.    runhooks("c_mode_hook");
  435. }
  436.  
  437. define slang_mode()
  438. {
  439.    setmode("SL", 2 | 8);
  440.    use_keymap("global");
  441.    runhooks("slang_mode_hook");
  442. }
  443.  
  444. %!%  Mode for indenting and wrapping text
  445. %!%  Functions that affect this mode include:
  446. %!%
  447. %!%    Function:                     Default Binding:
  448. %!%      indent_line_cmd                 TAB
  449. %!%      newline_and_indent_cmd          RETURN
  450. %!%      format_paragraph                ESC Q
  451. %!%      narrow_paragraph                ESC N
  452. %!%
  453. %!%  Variables include:
  454. %!%      WRAP_INDENTS, WRAP
  455. %!%      TAB, TAB_DEFAULT
  456. define text_mode()
  457. {
  458.    setmode("Text", 1);
  459.    use_keymap("global");
  460.    runhooks ("text_mode_hook");
  461. }
  462.  
  463. %!%  Generic mode not designed for anything in particular.
  464. %!%  See:  text_mode, c_mode
  465. define no_mode()
  466. {
  467.    setmode(Null_String, 0);
  468.    use_keymap("global");
  469. }
  470.  
  471. % Function prototypes
  472. % These 'functions' are only here to initialize function pointers.
  473. define _function_pop_0 (x) {0}
  474.  
  475. %!% called from mode_hook.  Returns 0 if it is desired that control return
  476. %!% to mode_hook or 1 if mode hook should exit after calling mode_hook_ptr
  477. variable mode_hook_pointer = &_function_pop_0;
  478.  
  479. variable Default_Mode = &text_mode;
  480.  
  481.  
  482.  
  483. % Emacs allows a mode definition on the first line of a file
  484. % -*- mode: MODENAME; VAR: VALUE; ... -*-
  485. % which can also include values of local variables 
  486.  
  487. %!% check first line for the simplest Emacs mode statement
  488. %!% -*- modename -*-
  489. define modeline_hook()
  490. {
  491.    variable mode = Null_String;
  492.    push_spot(); bob();
  493.    
  494.    if (looking_at("#!/")) mode = "sh";    % #!/bin/sh, #!/usr/local/bin/perl, ...
  495.        
  496.    push_mark (); narrow ();
  497.    if (re_fsearch ("-\\*- *\\([A-Za-z]+\\) *-\\*-"))
  498.      mode = strlow (regexp_nth_match (1));
  499.    
  500.    widen (); pop_spot ();        % restore place
  501.    
  502.    if ( strlen(mode) )
  503.      {
  504.     mode = strcat (mode, "_mode" );   
  505.     if ( is_defined(mode) )
  506.       {
  507.          eval (mode);
  508.          return 1;
  509.       }
  510.      }
  511.    0;
  512. }
  513.  
  514. variable Mode_List_Exts = "c,h,cc,cpp,sl,txt,doc,tex,f,for";
  515. variable Mode_List_Modes = "c,c,c,c,slang,text,text,tex,fortran,fortran";
  516.  
  517. #ifdef MSDOS OS2
  518. Mode_List_Exts = strcat (Mode_List_Exts, ",rc");     %  resource file
  519. Mode_List_Modes = strcat (Mode_List_Modes, ",c");
  520. #endif
  521.  
  522. #ifdef VMS UNIX
  523. Mode_List_Exts = strcat (Mode_List_Exts, ",com");     %  resource file
  524. Mode_List_Modes = strcat (Mode_List_Modes, ",dcl");
  525. #endif
  526.  
  527. #ifdef UNIX
  528. Mode_List_Exts = strcat (Mode_List_Exts, ",cshrc,tcshrc,login,profile");     %  resource file
  529. Mode_List_Modes = strcat (Mode_List_Modes, ",no,no,no,no");
  530. #endif
  531.  
  532.  
  533. %!% Prototype: Void add_mode_for_extension (String mode, String ext);
  534. %!% This function modifies Mode_List in such a way that when a file with 
  535. %!% filename extension `ext' is read in, function strcat (mode, "_mode")
  536. %!% will be called to set the mode.   That is, the first parameter 'mode' 
  537. %!% is the name of a mode without the '_mode' added to the end of it.
  538. define add_mode_for_extension (mode, ext)
  539. {
  540.    variable comma = ",";
  541.    
  542.    Mode_List_Modes = strncat (mode, comma, Mode_List_Modes, 3);
  543.    Mode_List_Exts = strncat (ext, comma, Mode_List_Exts, 3);
  544. }
  545.  
  546. %!% This is a hook called by find_file routines to set the mode
  547. %!% for the buffer. This function takes one parameter, the filename extension
  548. %!% and returns nothing.
  549. define mode_hook (ext)
  550. {
  551.    variable n, mode;
  552. #ifdef VMS
  553.    ext = extract_element(ext, 0, ';');
  554. #endif
  555.    
  556. #ifdef MSDOS OS2 VMS
  557.    ext = strlow (ext);
  558. #endif
  559.    
  560.    if (mode_hook_pointer(ext)) return;
  561.  
  562.    if (modeline_hook ()) return;
  563.    
  564.    n = is_list_element (Mode_List_Exts, ext, ',');
  565.    if (n)
  566.      {
  567.     n--;
  568.     mode = strcat (extract_element (Mode_List_Modes, n, ','), "_mode");
  569.     if (is_defined(mode)) 
  570.       {
  571.          eval (mode);
  572.          return;
  573.       }
  574.      }
  575.    Default_Mode ();
  576. }
  577.  
  578. define is_c_mode ()
  579. {
  580.    variable mode;
  581.    (, mode) = whatmode ();
  582.    mode & 2;
  583. }
  584.  
  585. define indent_line_cmd ()
  586. {
  587.    indent_line ();
  588.    if (is_c_mode) c_indent_line ();
  589. }
  590.  
  591. define insert_colon_cmd ()
  592. {
  593.    insert_char (':');
  594.    if (is_c_mode ())
  595.    {
  596.       () = c_colon_indent_line ();
  597.    }
  598. }
  599.  
  600.  
  601. define newline_and_indent_cmd ()
  602. {
  603.    % Note that the 'call' is necessary here so that exit_min is called
  604.    % if this is called from mini buffer at startup.
  605.    call ("newline");
  606.    indent_line_cmd ();
  607.    if (is_c_mode() and C_COMMENT_HINT) 
  608.      {
  609.     if (bolp ()) insert_single_space ();
  610.     insert ("* ");
  611.      }
  612. }
  613.  
  614.  
  615. %!% sets buf modified flag. If argument is 1, mark
  616. %!% buffer as modified.  If argument is 0, mark buffer as unchanged.
  617. define set_buffer_modified_flag(modif)
  618. {
  619.    getbuf_info();
  620.    if (modif) () | 1; else () & ~(1);
  621.    setbuf_info(());
  622. }
  623. %!%  returns non-zero if the buffer modified flag is set.  It returns zero
  624. %!%  if the buffer modified flag is not been set.  This works on the 
  625. %!%  current buffer.  See also 'set_buffer_modified_flag'.
  626. define buffer_modified ()
  627. {
  628.    variable flags;
  629.    (, , , flags) = getbuf_info ();
  630.    flags & 1;
  631. }
  632.  
  633. %!% set undo mode for buffer.  If argument is 1, undo is on.  0 turns it off
  634. define set_buffer_undo(modif)
  635. {
  636.    getbuf_info();
  637.    if (modif) () | 32; else () & ~(32);
  638.    setbuf_info(());
  639. }
  640.  
  641.  
  642. %!% Takes 1 parameter: 0 turn off readonly
  643. %!%                    1 turn on readonly
  644. define set_readonly(n)
  645. {
  646.    getbuf_info();
  647.    if (n) () | 8; else () & ~(8);
  648.    setbuf_info(());
  649. }
  650.  
  651. %!% Takes 1 parameter: 0 turn off overwrite
  652. %!%                    1 turn on overwrite
  653. define set_overwrite(n)
  654. {
  655.    getbuf_info();
  656.    if (n) () | 16; else () & ~(16);
  657.    setbuf_info(());
  658. }
  659.    
  660.  
  661. define toggle_crmode ()
  662. {
  663.    setbuf_info(getbuf_info() xor 0x400);
  664.    set_buffer_modified_flag (1);
  665. }
  666.  
  667. define toggle_readonly()
  668. {
  669.    setbuf_info(getbuf_info() xor 8);
  670. }
  671. define toggle_overwrite()
  672. {
  673.    setbuf_info(getbuf_info() xor 16);
  674. }
  675.  
  676. #ifdef MSDOS OS2
  677. setkey("toggle_overwrite", "^@R");     %/* insert key */
  678. #endif
  679.  
  680. define toggle_undo()
  681. {
  682.    setbuf_info(getbuf_info() xor 32);
  683. }
  684.  
  685. define double_line()
  686. {
  687.    POINT;
  688.    bol(); push_mark(); eol(); 
  689.    bufsubstr(); 
  690.    newline();
  691.    insert(());
  692.    =POINT;
  693. }
  694.  
  695. define transpose_lines()
  696. {
  697.    variable line;
  698.    bol(); push_mark(); push_mark(); eol(); 
  699.    line = bufsubstr();
  700.    go_right(1);
  701.    del_region();
  702.    go_up(1); bol();
  703.    insert(line);
  704.    newline();
  705.    go_down (1);                   %  goes to bol
  706. }
  707.  
  708.  
  709.  
  710.  
  711. %!% string to display at bottom of screen upon JED startup and when
  712. %!% user executes the help function.
  713. variable help_for_help_string;
  714.  
  715. help_for_help_string =
  716. #ifdef VMS
  717.  "^H -> Help:^H  Menu:?  Info:I  Apropos:A  Key:K  Where:W  Fnct:F  VMSHELP:M  Var:V";
  718. #endif
  719. #ifdef MSDOS
  720.  "^H -> Help:^H  Menu:?  Info:I  Apropos:A  Key:K  Where:W  Fnct:F  Var:V  Mem:M";
  721. #endif
  722. #ifdef UNIX OS2
  723.  "^H -> Help:^H  Menu:?  Info:I  Apropos:A  Key:K  Where:W  Fnct:F  Var:V  Man:M";
  724. #endif
  725.  
  726. % Load minibuffer routines now before any files are loaded.
  727. % This will reduce fragmentation on PC.
  728. !if (BATCH) () = evalfile("mini"); 
  729.  
  730.  
  731. %for compatability with older versions
  732. define read_file_from_mini(prompt)
  733. {
  734.    read_with_completion(prompt, Null_String, Null_String, 'f');
  735. }
  736.  
  737. %!% Search for FILE in directories specified by JED_LIBRARY returning
  738. %!% expanded pathname if found or the Null string otherwise.
  739. define expand_jedlib_file(f)
  740. {
  741.    variable n = 0, dir, file;
  742.    forever
  743.      {
  744.     dir = extract_element(JED_LIBRARY, n, ',');
  745.     !if (strlen(dir)) return (Null_String);
  746.     file = dircat(dir, f);
  747.     if (file_status(file) == 1) break;
  748.     ++n;
  749.    } 
  750.    file;
  751. }
  752.  
  753. %!% Prototype: String read_string_with_completion (prompt, dflt, list)
  754. %!% This function takes 3 String parameters and returns a String.  The
  755. %!% first parameter is used as the prompt, the second parameter is the 
  756. %!% default value to be returned and the third parameter is a list to be used
  757. %!% for completions.  This list is simply a comma separated list of strings.
  758. define read_string_with_completion (prompt, dflt, list)
  759. {
  760.    read_with_completion (list, prompt, dflt, Null_String, 's');
  761. }
  762.  
  763. %!% If non-zero, startup by asking user for a filename if one was
  764. %!% not specified on the command line.
  765. variable Startup_With_File = 0;
  766.  
  767. %% startup hook
  768. %!% Function that gets executed right before JED enters its main editing
  769. %!% loop.  This is for last minute modifications of data structures that
  770. %!% did not exist when startup files were loaded (e.g., minibuffer keymap)
  771. define jed_startup_hook()
  772. {
  773.    variable n, hlp, ok = 0, mini = "Mini_Map", file, do_message = 1;
  774.  
  775. #ifdef MSDOS OS2
  776.    definekey ("next_mini_command", "^@P", mini);
  777.    definekey ("prev_mini_command", "^@H", mini);
  778. #else
  779.    definekey ("next_mini_command", "^[[B", mini);
  780.    definekey ("prev_mini_command", "^[[A", mini);
  781. #endif
  782.  
  783.    definekey ("mini_exit_minibuffer", "^M", mini);
  784.    definekey ("exit_mini", "^[^M", mini);
  785.    
  786.    % turn on Abort character processing
  787.    IGNORE_USER_ABORT = 0;
  788.  
  789.    runhooks ("startup_hook");
  790.    
  791.    !if (strcmp(whatbuf(), "*scratch*") or buffer_modified())
  792.      {
  793.     ERROR_BLOCK 
  794.       {
  795.          erase_buffer ();
  796.          set_buffer_modified_flag (0);
  797.       }
  798.     
  799.     () = insert_file (expand_jedlib_file("cpright.hlp")); 
  800.     set_buffer_modified_flag (0);
  801.     bob();
  802.     file = Null_String;
  803.     if (Startup_With_File > 0)
  804.       {
  805.          forever 
  806.            {
  807.           file = read_file_from_mini ("Enter Filename:");
  808.           if (strlen(extract_filename(file))) break;
  809.            }
  810.       }
  811.     else !if (Startup_With_File)
  812.       {
  813.          message(help_for_help_string); do_message = 0;
  814.          update(1);
  815.          () = input_pending(600);
  816.       }
  817.     EXECUTE_ERROR_BLOCK;
  818.     if (strlen (file)) () = find_file(file);
  819.      }
  820.    
  821.    if (do_message) message(help_for_help_string);
  822. }
  823.  
  824.  
  825.  
  826. %!% display row and column information in minibuffer
  827. define whatpos ()
  828. {
  829.    variable max_lines;
  830.    
  831.    push_spot (); eob (); max_lines = whatline (); pop_spot ();
  832.    
  833.    message (Sprintf ("%s, Line %d of %d lines, Column %d",  
  834.              count_chars (), whatline(), max_lines, what_column (),
  835.              4));
  836. }
  837.  
  838.  
  839.  
  840. %!% find a file from JED_LIBRARY, returns number of lines read or 0 if not 
  841. %!% found.
  842. define find_jedlib_file(file)
  843. {
  844.    file = expand_jedlib_file(file);
  845.    !if (strlen(file)) return(0);
  846.    find_file(file);
  847. }
  848.  
  849.  
  850. %%
  851. %% help function
  852. %%
  853.  
  854. %!% name of the file to load when the help function is called.
  855. variable Help_File = "jed.hlp";   %% other modes will override this.
  856.  
  857. %!% Pop up a window containing a help file.  The help file that is read
  858. %!% in is given by the variable Help_File.
  859. define help()
  860. {
  861.    variable hlp = "*help*", buf, rows;
  862.     
  863.    !if (buffer_visible (hlp))
  864.      {
  865.     !if (strlen(Help_File)) Help_File = "generic.hlp";
  866.     Help_File = expand_jedlib_file(Help_File);
  867.     buf = whatbuf();
  868.     onewindow();
  869.     rows = window_info('r');
  870.     setbuf(hlp);
  871.     set_readonly(0);
  872.     erase_buffer();
  873.  
  874.     () = insert_file(Help_File);
  875.     pop2buf(hlp);
  876.     eob(); bskip_chars("\n");
  877.     rows = rows / 2 - (whatline() + 1);
  878.     bob();
  879.     set_buffer_modified_flag(0);
  880.     set_readonly(1);
  881.     pop2buf(buf);
  882.     loop (rows) enlargewin();
  883.      }
  884.    
  885.    update (1);
  886.    message(help_for_help_string);
  887. }
  888.  
  889. #ifdef VMS
  890. %% This resume hook is need for VMS when returning from spawn.
  891. %% In fact, it is NEEDED for certain JED functions on VMS so declare it.
  892. define resume_hook()
  893. {
  894.    variable file = getenv("JED_FILE_NAME");
  895.    !if (strlen(file)) return;
  896.    
  897.    !if (find_file(file)) error("File not found!");
  898. }
  899. #endif VMS
  900.  
  901.  
  902. %%file hooks
  903. %!% returns backup filename.  Arguments to function are dir and file.
  904. define make_backup_filename(dir, file)
  905. {
  906. #ifdef UNIX
  907.    strncat (dir, file, "~", 3);
  908. #endif
  909. #ifdef MSDOS OS2
  910.    variable type;
  911. #ifdef OS2
  912.    !if (IsHPFSFileSystem(dir)) {
  913. #endif
  914.  
  915.       % There are several things to worry about.  Here just break up the 
  916.       % filename and truncate type to 2 chars and paste it back.
  917.       % note that this takes a name like file.c and produces file.c~
  918.       % Also, note that if the type is empty as in 'file', it produces 
  919.       % 'file.~'
  920.  
  921.       type = file_type(file);
  922.       file = strncat (extract_element(file, 0, '.'), ".", substr(type, 1, 2), 3);
  923.       
  924.  
  925. #ifdef OS2
  926.    }
  927. #endif
  928.    strncat (dir, file, "~", 3);
  929. #endif  
  930. }
  931.  
  932.  
  933. %!% returns autosave filename.  Arguments to function are dir and file.
  934. define make_autosave_filename(dir, file)
  935. {
  936. #ifdef VMS
  937.    Sprintf ("%s_$%s;1", dir, file, 2);
  938. #endif
  939.    
  940. #ifdef UNIX
  941.    Sprintf ("%s#%s#", dir, file, 2);
  942. #endif
  943.    
  944. #ifdef MSDOS OS2
  945. #ifdef OS2
  946.    !if (IsHPFSFileSystem(dir)) 
  947.      {
  948. #endif
  949.     
  950.     variable type = file_type(file);
  951.     file = substr(extract_element(file, 0, '.'), 1, 7);
  952.     if (strlen(type)) file = strcat(file, ".");
  953.     file = strcat (file, type);
  954.  
  955. #ifdef OS2
  956.      }
  957. #endif
  958.    
  959.    strncat (dir, "#", file, 3);
  960. #endif
  961. }
  962.  
  963. %!% breaks a filespec into dir filename--- 
  964. %!% this routine returns dir and filename such that a simple strcat will
  965. %!% suffice to put them together again.  For example, on unix, /a/b/c
  966. %!% returns /a/b/ and c
  967. define parse_filename(fn)
  968. {
  969.    variable f, dir, n;
  970.       
  971.    f = extract_filename(fn);
  972.    n = strlen(fn) - strlen(f);
  973.    dir = substr(fn, 1, n);
  974.    dir; f;
  975. }
  976.  
  977.  
  978. define set_buffer_no_backup ()
  979. {
  980.    setbuf_info (getbuf_info() | 0x100);
  981. }
  982. define set_buffer_no_autosave ()
  983. {
  984.    setbuf_info (getbuf_info() & ~(0x2));
  985. }
  986.  
  987. variable No_Backups = 0;
  988.  
  989. %!% called AFTER a file is read in to a buffer.  FILENAME is on the stack.
  990. define find_file_hook(file)
  991. {
  992.    variable dir, a, f, m;
  993.    (dir, f) = parse_filename(file); 
  994.  
  995. #ifndef VMS
  996.    if (file_status(dir) != 2)
  997.      {
  998.     error (Sprintf("Directory %s is invalid!", dir, 1));
  999.      }
  1000. #endif
  1001.    
  1002.    if (No_Backups) set_buffer_no_backup ();
  1003.    a = make_autosave_filename(dir, f);
  1004.    if (file_time_compare(a, file) > 0) 
  1005.      {
  1006.     m = "Autosave file is newer. Use ESC-X recover_file.";
  1007.     flush(m);
  1008.         () = input_pending(10); 
  1009.     message(m);
  1010.      }
  1011.    runhooks ("user_find_file_hook");
  1012. }
  1013.  
  1014. %
  1015. % completions  -- everything here must be predefined
  1016. % I just push the strings onto the stack and loop 'add_completion' over them
  1017. %
  1018.   $0 = _stkdepth();
  1019.  
  1020. . "toggle_undo" "calendar" "trim_buffer" "abbrev_mode"
  1021. . "define_abbreviation" "save_abbrevs"
  1022. . "occur" "append_region" "write_region" "replace_across_buffer_files"
  1023. . "recover_file" "compile" "sort" "untab" "fortran_mode" "save_buffers"
  1024. . "isearch_forward" "isearch_backward" "shell"
  1025. . "edit_tab_stops" "c_mode" "toggle_crmode"
  1026. . "text_mode" "no_mode" "goto_line_cmd" "goto_column_cmd" "describe_mode"
  1027. . "evalbuffer" "open_rect" "kill_rect" "insert_rect" "copy_rect" "blank_rect"
  1028. . "dired" "re_search_forward" "re_search_backward" "query_replace_match"
  1029. . "describe_bindings"  "search_backward" "search_forward" "replace_cmd"
  1030. .  "find_binary_file"
  1031. #ifndef MSDOS OS2
  1032. .  "mail" 
  1033. #endif
  1034. #ifdef UNIX OS2
  1035. . "ispell"
  1036. #endif
  1037.  
  1038. loop (_stkdepth - $0) add_completion(());
  1039.  
  1040.  
  1041. %!% Prototype: String buffer_filename ();
  1042. %!% Returns the name of the file associated with the current buffer.  If 
  1043. %!% there is none associated with it, the empty string is returned.
  1044. define buffer_filename ()
  1045. {
  1046.    variable file, dir;
  1047.    (file, dir, , ) = getbuf_info();
  1048.    !if (strlen (file)) dir = Null_String;
  1049.    strcat (dir, file);
  1050. }
  1051.  
  1052.  
  1053. % save buffer if necessary
  1054. define save_buffer()
  1055. {
  1056.    variable flags, dir, file;
  1057.    (file, , , flags) = getbuf_info();
  1058.  
  1059.    !if (flags & 1) return (message("Buffer not modified."));
  1060.    if (strlen(file))
  1061.      {
  1062.     () = write_buffer(buffer_filename ()); 
  1063.      }
  1064.    else call ("save_buffers");
  1065. } add_completion("save_buffer");
  1066.  
  1067. define insert_buffer()
  1068. {
  1069.    read_with_completion("Insert Buffer:", Null_String, Null_String, 'b');
  1070.    push_spot();
  1071.    ERROR_BLOCK {pop_spot()}
  1072.    insbuf(());
  1073.    EXECUTE_ERROR_BLOCK;
  1074. }  add_completion("insert_buffer");
  1075.  
  1076. variable Global_Top_Status_Line = " *** To activate menus, press `Ctrl-H ?'.  For help, press `Ctrl-H' twice. ***";
  1077. () = set_top_status_line (Global_Top_Status_Line); 
  1078. define help_prefix()
  1079. {
  1080.    variable c;
  1081.    
  1082.    !if (input_pending(20)) flush (help_for_help_string);
  1083.    c = int (strup(char(getkey())));
  1084.    switch (c)
  1085.      { case  8 : help }
  1086.      { case  'A' : apropos }
  1087.      { case  'I' : info_mode}
  1088.      { case  '?' : menu_main_cmds}
  1089.      { case  'F' : describe_function}
  1090.      { case  'V' : describe_variable}
  1091.      { case  'W' : where_is}
  1092.      { case  'C' or case ('K', c) : showkey}
  1093.      { case  'M' :
  1094. #ifdef UNIX OS2
  1095.     unix_man();
  1096. #else 
  1097. #ifdef VMS
  1098.     vms_help ();
  1099. #endif
  1100. #endif
  1101. #ifdef MSDOS
  1102.     call("coreleft");
  1103. #endif
  1104.      }
  1105.      { pop(); beep(); }
  1106. }
  1107.  
  1108. %%
  1109. %%  word movement definitions.  Since these vary according to editors,
  1110. %%  they are S-Lang routines.
  1111. %%
  1112.  
  1113. define skip_word ()
  1114. {
  1115.   while (skip_non_word_chars(), eolp()) 
  1116.     {
  1117.       if (1 != right(1)) break;
  1118.     }
  1119.    skip_word_chars();
  1120. }
  1121.  
  1122. define bskip_word()
  1123. {
  1124.    while (bskip_non_word_chars(), bolp())
  1125.      {
  1126.     !if (left(1)) break;
  1127.      }
  1128.    bskip_word_chars();
  1129. }
  1130.  
  1131. define delete_word()
  1132. {
  1133.    push_mark(); skip_word(); del_region();
  1134. }
  1135.  
  1136. define bdelete_word ()
  1137. {  
  1138.    push_mark(); bskip_word(); del_region();
  1139. }
  1140.  
  1141. define xform_word(x)
  1142. {
  1143.    skip_non_word_chars();
  1144.    push_mark(); skip_word(); 
  1145.    xform_region(x);
  1146. }
  1147.  
  1148. define capitalize_word()
  1149. {
  1150.    xform_word('c');
  1151. }
  1152.  
  1153. define upcase_word()
  1154. {
  1155.    xform_word('u');
  1156. }
  1157.  
  1158. define downcase_word()
  1159. {
  1160.    xform_word('d');
  1161. }
  1162.  
  1163. define smart_set_mark_cmd ()
  1164. {
  1165.    if (markp()) pop_mark(0); else call("set_mark_cmd");
  1166. }
  1167.  
  1168. define flush_input()
  1169. {
  1170.      while (input_pending(0)) () = getkey();
  1171. }
  1172.  
  1173. %!% Prototype Void buffer_format_in_columns();
  1174. %!% takes a buffer consisting of a sigle column of items and converts the
  1175. %!% buffer to a multi-column format.
  1176. define buffer_format_in_columns()
  1177. {
  1178.    push_spot();
  1179.    bob();
  1180.    forever 
  1181.      {
  1182.     _for (0,4,1) 
  1183.       {
  1184.          goto_column(() * 14 + 1);
  1185.          if (eolp())
  1186.            {
  1187.           if (eobp()) 
  1188.             {
  1189.                pop_spot();
  1190.                return;
  1191.             }
  1192.           insert_single_space;
  1193.           del();
  1194.            }
  1195.       } 
  1196.     !if (down(1)) break;
  1197.     % bol (); % this is a side effect of going down
  1198.      }
  1199.    pop_spot();
  1200. }
  1201.  
  1202. define delete_line()
  1203. {
  1204.    bol(); push_mark(); eol(); go_right(1); del_region();
  1205. }
  1206.  
  1207.  
  1208. define set_fill_column ()
  1209. {
  1210.    push_spot(); 
  1211.    eol();
  1212.    WRAP = what_column ();
  1213.    pop_spot();
  1214.    message (Sprintf("WRAP column at %d.", WRAP, 1));
  1215. }
  1216.  
  1217. define rename_buffer(name)
  1218. {
  1219.    variable flags = getbuf_info(); pop(); setbuf_info(name, flags);
  1220. }
  1221.  
  1222. define info ()
  1223. {
  1224.    info_mode ();
  1225.    definekey("exit_jed",        "Q",  "Infomap");
  1226.    definekey("exit_jed",        "q",  "Infomap");
  1227. }
  1228.  
  1229. define make_tmp_file(base)
  1230. {
  1231.    variable pid = getpid(), file, n = 1000;
  1232.    while (n)
  1233.      {
  1234.     file = strcat(base, string(pid));
  1235.     !if (file_status(file)) return (file);
  1236.     pid++;
  1237.      }
  1238.    error ("Unable to create a tmp file!");
  1239. }
  1240.  
  1241.  
  1242. define goto_top_of_window ()
  1243. {
  1244.    go_up (window_line () - 1);
  1245. }
  1246.  
  1247. define goto_bottom_of_window ()
  1248. {
  1249.    go_down (window_info ('r') - window_line ());
  1250. }
  1251.  
  1252.  
  1253. %!% called from main in JED executable.
  1254. define command_line_hook()
  1255. {
  1256.    variable n, i, file, depth, jedrc, home, next_file;
  1257.    variable script_file = Null_String;
  1258.    jedrc = "jed.rc";
  1259.   
  1260. #ifdef UNIX
  1261.    jedrc = ".jedrc";
  1262. #endif
  1263.    
  1264.    home = getenv("JED_HOME");
  1265. #ifdef VMS
  1266. %% allows JED_HOME: to be search list---
  1267. %% thanks to SYSTEM@VACMZB.chemie.Uni-Mainz.DE for suggestion
  1268.    if (strlen(home)) home = "JED_HOME:";
  1269. #endif
  1270.    !if (strlen(home))
  1271.      {
  1272.     home = getenv("HOME");
  1273. #ifdef VMS
  1274.     home = "SYS$LOGIN:";
  1275. #endif
  1276.      } 
  1277.    jedrc = dircat(home, jedrc);
  1278.    
  1279.    n = MAIN_ARGC;
  1280.    
  1281.    --n;  %% argv[0], here it is not used.
  1282. %
  1283. %  If batch then first argument is not used so start at second
  1284. %  Also, n is the number of effective command line parameters so reduce it.
  1285. %
  1286.    
  1287.    if (BATCH) {    --n; 2; } else 1;  =i;
  1288. %
  1289. % if first argument is -n then do NOT load init file
  1290. %
  1291.    % stuff left on stack for if 
  1292.    if (n) strcmp (command_line_arg(i), "-n"); else 1;
  1293.    if (())
  1294.      {
  1295.     depth = _stkdepth;
  1296.     if (file_status(jedrc) == 1) jedrc; else "jed.rc";
  1297.     () = evalfile(()); 
  1298.     if ( _stkdepth != depth)
  1299.       {
  1300.          flush(strcat ("Excess junk left on stack by ", jedrc));
  1301.          () = input_pending(10);
  1302.       }
  1303.  
  1304.     loop (_stkdepth - depth) pop();
  1305.      }
  1306.    else if (n) ++i;
  1307.    
  1308.    n = MAIN_ARGC - i;   
  1309.    
  1310.    !if (n) return;
  1311.    
  1312. %
  1313. % Is JED to emulate most?
  1314. %
  1315.    !if (strcmp(command_line_arg(i), "-most"))
  1316.      {
  1317.     run_most (i + 1);
  1318.     return;
  1319.      }
  1320.       
  1321.    while (n > 0)
  1322.      {
  1323.     file = command_line_arg(i);
  1324.     --n; ++i;
  1325.     if (n) next_file = command_line_arg(i);
  1326.     switch(file)
  1327.       {case "-f" and n : eval(next_file)}
  1328.       {case "-g" and n : goto_line(integer(next_file))}
  1329.       {case "-s" and n : 
  1330.          () = fsearch(next_file); 
  1331.          save_search_string(next_file);
  1332.       }
  1333.       {case "-l" and n : () = evalfile(next_file); }
  1334.       {case "-i" and n : () = insert_file(next_file);}
  1335.       {case "-2" : splitwindow(); ++n; --i;}
  1336.       {case "-tmp":
  1337.          set_buffer_no_backup ();
  1338.          set_buffer_no_autosave ();
  1339.          ++n; --i;
  1340.       }
  1341.       {() = find_file(());  ++n; --i;}
  1342.     
  1343.     --n; ++i;
  1344.      }
  1345.    
  1346.    if (strlen(script_file)) () = evalfile(script_file);
  1347. }
  1348. %!% Prototype: Void deln (Integer n);
  1349. %!% delete the next 'n' characters.
  1350. define deln (n)
  1351. {
  1352.    push_mark (); go_right(n); del_region ();
  1353. }
  1354.  
  1355. define insert_spaces (n) 
  1356. {
  1357.    loop (n) insert_single_space ();
  1358. }
  1359.  
  1360. define blooking_at (str)
  1361. {
  1362.    variable n = strlen (str);
  1363.    
  1364.    EXIT_BLOCK 
  1365.      {
  1366.     pop_spot ();
  1367.      }
  1368.    
  1369.    push_spot ();
  1370.  
  1371.    if (n != left(n)) return 0;
  1372.    return looking_at (str);
  1373. }
  1374.  
  1375. define exchange_point_and_mark ()
  1376. {
  1377.    call ("exchange");
  1378. }
  1379.  
  1380.     
  1381.    
  1382. % This fixes some bug in OS2 dealing with 'dir' issued non-interactively.
  1383. #ifdef OS2
  1384.    if (strlen(getenv("DIRCMD"))) putenv("DIRCMD=/ogn");
  1385. #endif
  1386.  
  1387. () = evalfile ("os.sl"); 
  1388.  
  1389. %
  1390. %  This code fragment looks for the existence of "defaults.sl" and loads
  1391. %  it.  This file IS NOT distributed with JED.
  1392. %
  1393.  
  1394. if (strlen(expand_jedlib_file("defaults.sl"))) () = evalfile("defaults");
  1395.  
  1396.