% -*- mode: slang; mode: fold -*-

%{{{ licence, presentation

%% po_mode.sl -- an Emacs-like Jed editing mode for 
%% Gettext portable object files (*.po)
%% 
%% License: http://www.fsf.org/copyleft/gpl.html
%% Author : Morten Bo Johansen <mbj@spamcop.net>
%%
%% Thanks to Paul Boekholt for some general hints relating to S-Lang
%% scripting and to Günter Milde for including it in the jed-extra
%% package in Debian.
%%
%% Tested with Jed 0.99.19 on Linux, compiled against slang 2.2
%% Superficially tested with emulations, cua, edt, emacs, ide, jed and
%% wordstar. You must edit several functions to make it usable on
%% non-Unix systems.
%%
%% Copy this file and po_mode.hlp to a directory in your jed library path,
%% e.g. /usr/share/jed/lib. For initialization, either use make_ini()
%% (from jedmodes.sf.net/mode/make_ini/) or copy the content of the
%% INITIALIZATION block to your .jedrc.
%%
%% For the rest, please refer to the po_mode.hlp file for the ins and outs
%% of this mode. There is some rather important information therein, so you
%% should read it ;-). If you copied it to the same place as this file, it
%% should be available in po_mode by typing '?'.

%}}}
%{{{ debian initialization block

#<INITIALIZATION>
autoload ("po_mode", "po_mode");
add_mode_for_extension ("po", "po");
add_mode_for_extension ("po", "pot");
#</INITIALIZATION>

%}}}

%{{{ modules/autoloads

import ("pcre");
autoload ("most_exit_most", "most");
autoload ("grep", "grep.sl");

%}}}
%{{{ user customization variables

%% Your name as translator
custom_variable ("Translator", "Your Name");

%% Your personal email address
custom_variable ("Translator_Email", "Your Email-address");

%% Your language - use English adjective, e.g. "German", "Danish" etc.
custom_variable ("Language", "Your Language");

%% The two-letter code for your language.
%% See http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes
custom_variable ("LangCode", "");

%% The two-letter code for your country.
%% See http://en.wikipedia.org/wiki/ISO_3166-1_alpha-2
custom_variable ("CountryCode", "");

%% Your language - use English adjective, e.g. "German", "Danish" etc.
custom_variable ("Language", "Your Language");

%% Email address of your language team
custom_variable ("Team_Email", "<LL@Li.org>");

%% Your language team
custom_variable ("Language_Team",  "$Language $Team_Email"$);

% Default character encoding of po-file. utf-8, iso-8859-1, etc
custom_variable ("Encoding", "utf-8");

%% Path to directory where source archives are usually kept
custom_variable ("SrcBaseDir", expand_filename ("~/src"));

%% Language pair for machine translation system, Apertium
%% E.g. "en-es" will use the English-to-Spanish pair.
custom_variable ("Apertium_Langs", "");

%% Your chosen spell checker. Use "aspell" or "hunspell" (recomended)
custom_variable ("Spell_Prg", "aspell");

%% po-files in languages that you want to compare your translations
%% with. A comma-separated string of iso language codes as listed in 
%% http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes. Change the
%% codes below to your liking. This example will compare with Swedish,
%% Norwegian Bokmål, German, French and Dutch.
custom_variable ("Compare_With_Languages", "sv,nb,de,fr,nl");

%% Path to your translation compendium file
custom_variable ("Compendium", expand_filename ("~/.compendium_pomode"));

%% Whether or not to look up translations at Microsoft's language portal
custom_variable ("Use_Microsoft_Wordlist", 1);

%}}}
%{{{ private variables

private variable 
  Mode = "PO",
  Buf = "",
  Edit_Mode = "Po_Edit",
  Edit_Buf = "*Translate*",
  Msgid_Buf = "Msgid",
  Po_Comment_Buf = "*Edit User Comment*",
  Po_Tmpfile = make_tmp_file ("/tmp/po_tmpfile"),
  gettext_err_msg = "/tmp/gettext_err_msg",
  Msgids = Array_Type,
  Msgstrs = Array_Type,
  Obsolete = Array_Type,
  Po_Dir = Null_String,
  Last_Edited = Null_String,
  Msgstr_Copy = Null_String,
  Entry = Assoc_Type[String_Type, ""],
  CompHash = Assoc_Type[String_Type, ""],
  CompHash_Fuzzy = Assoc_Type[String_Type, ""],
  Trans_Hash = Assoc_Type[String_Type, ""],
  Po_Buf = whatbuf (),
  Entry_No = 0,
  Multi_Line = 0,
  Gettext_Wrap = 0,
  Msgid_Has_End_Newline = 0,
  Msgid_Has_Beg_Newline = 0,
  Translation_Status = 0,
  StrsLists_Exists = 0,
  Trans_Hash_Exists = 0,
  Compendium_Is_Hashed = 0,
  Wrap = 72;

%}}}
%{{{ buffer local variables
%% Make all count variables local to the buffer
private define count (type)
{
   switch (type)
     { case "t": get_blocal_var ("translated"); }
     { case "u": get_blocal_var ("untranslated"); }
     { case "f": get_blocal_var ("fuzzy"); }
     { case "o": get_blocal_var ("obsolete"); }
     { case "t+": set_blocal_var 
          (get_blocal_var ("translated") + 1, "translated"); }
     { case "t-": set_blocal_var 
          (get_blocal_var ("translated") - 1, "translated"); }
     { case "u+": set_blocal_var 
          (get_blocal_var ("untranslated") + 1, "untranslated"); }
     { case "u-": set_blocal_var 
          (get_blocal_var ("untranslated") - 1, "untranslated"); }
     { case "f+": set_blocal_var 
          (get_blocal_var ("fuzzy") + 1, "fuzzy"); }
     { case "f-": set_blocal_var 
          (get_blocal_var ("fuzzy") - 1, "fuzzy"); }
     { case "o+": set_blocal_var 
          (get_blocal_var ("obsolete") + 1, "obsolete"); }
     { case "o-": set_blocal_var 
          (get_blocal_var ("obsolete") - 1, "obsolete"); }
}

%}}}
%{{{ dfa syntax and colors

#ifdef HAS_DFA_SYNTAX
% %%% DFA_CACHE_BEGIN %%%
create_syntax_table (Mode);
private define setup_dfa_callback (Mode)
{
   custom_color ("tokens", get_color ("keyword")); % msgstr, msgid keywords
   custom_color ("flagcomment", get_color ("comment")); % e.g. fuzzy flag comment
   custom_color ("usercomment", get_color ("string")); % translators note to entry
   custom_color ("begblank", get_color ("number"), exch ()); % whitespace at beg/end of line
   custom_color ("endblank", get_color ("number"), exch ()); % whitespace at beg/end of line
   custom_color ("srccomment", get_color ("number")); % source reference comments
   custom_color ("extrcomment", get_color ("comment")); % developer's notes to translator
   custom_color ("ctxcomment", get_color ("comment")); % context comments
   custom_color ("lbreak", get_color ("bold")); % newline literals "\n"
   custom_color ("pyvar", get_color ("string"));
   custom_color ("pyvar1", get_color ("string"));
   custom_color ("format_specifier", get_color ("string")); % "%d" "%s" "%f"

   dfa_enable_highlight_cache ("po.dfa", Mode);
   dfa_define_highlight_rule ("^msg(id_?p?l?u?r?a?l?|str)", "tokens", Mode);
   dfa_define_highlight_rule ("^#, .*", "flagcomment", Mode);
   dfa_define_highlight_rule ("^\" +", "begblank", Mode);
   dfa_define_highlight_rule ("[ \t]+\\\\?n?\"$", "endblank", Mode);
   dfa_define_highlight_rule ("\\\\n", "lbreak", Mode);
   dfa_define_highlight_rule ("^#: .*$", "srccomment", Mode); % src
   dfa_define_highlight_rule ("^msgctxt.*$", "extrcomment", Mode);
   dfa_define_highlight_rule ("^#\\| .*$", "ctxcomment", Mode);
   dfa_define_highlight_rule ("^#\\. ?.*$", "extrcomment", Mode);
   dfa_define_highlight_rule ("^# .*$", "usercomment", Mode);
   dfa_define_highlight_rule ("%\\([0-9A-Za-z_]+\\)", "pyvar", Mode);
   dfa_define_highlight_rule ("{.*}", "pyvar1", Mode);
   dfa_define_highlight_rule ("%[bBcdfFls]+", "format_specifier", Mode);
   dfa_build_highlight_table (Mode);
   enable_dfa_syntax_for_mode (Mode);
}
dfa_set_init_callback (&setup_dfa_callback, Mode);
%%% DFA_CACHE_END %%%
#endif

%}}}
%{{{ delimitation, navigation

private define find_entry_delim_beg ()
{
   if (eolp () && bolp () && not eobp () || bobp ())
     return;
   ifnot (bol_bsearch ("\n"))
     bob ();
}

private define find_entry_delim_end ()
{
   find_entry_delim_beg ();
   go_down_1 ();
   ifnot (bol_fsearch ("\n"))
     eob ();
}

%% Determine if an entry is untranslated. Thanks to Günter Milde for
%% suggesting this.
private define is_untranslated ()
{
   push_spot ();
   ((down (1)) && (not looking_at ("\"")) && (up (1)) && (blooking_at (" \"\"")));
   pop_spot ();
}

private define is_translated ()
{
   not is_untranslated ();
}

private define is_fuzzy ()
{
   push_spot ();
   find_entry_delim_beg ();
   push_mark ();
   () = bol_fsearch ("msgid");
   variable str = bufsubstr ();
   ((is_substr (str, "#, fuzzy")) && (not (is_substr (str, "#~ "))));
   pop_spot ();
}

private define mark_entry ()
{
   find_entry_delim_beg ();
   ifnot (bobp ())
     go_right_1 ();
   push_visible_mark ();
   find_entry_delim_end ();
   ifnot (eobp)
     go_left_1 ();
}

private define get_current_entry_number ()
{
   variable i = 0;
   push_spot ();
   find_entry_delim_end ();
   while (bol_bsearch ("msgid "))
     i++;
   pop_spot ();
   return i;
}

private define find_msgstr_keyword ()
{
   bol ();
   
   if (looking_at ("#~"))
     throw UsageError, "obsolete entry";
   
   if (eolp () && bolp () || bobp ())
     {
        ifnot (bol_fsearch ("msgstr"))
          {
             () = bol_bsearch ("msgstr");
          }
        return;
     }
   if (re_looking_at ("^\""))
     {
        () = bol_bsearch ("msgid");
     }
   do
     {
        if (looking_at ("msgstr"))
          return;
        if (looking_at ("msgid "))
          { 
             () = bol_fsearch ("msgstr");
             return;
          }
        if (looking_at ("msgid_plural"))
          { 
             () = bol_fsearch ("msgstr[1]");
             return;
          }
     }
   while (down (1));
}

private define find_msgid_keyword ()
{
   find_msgstr_keyword ();
   if ((looking_at ("msgstr ")) || (looking_at ("msgstr[0]")))
     () = bol_bsearch ("msgid ");
   else
     () = bol_bsearch ("msgid_plural");
}

private define mark_msgid ()
{
   find_msgid_keyword ();
   push_mark ();
   go_right_1 ();
   () = bol_fsearch ("msg");
   go_left_1 ();
}

private define mark_msgstr ()
{
   find_msgstr_keyword (); push_mark (); go_down_1 ();

   do
     {
        if ((looking_at ("\n")) || (looking_at ("msgstr")))
          break;
     }
   while (down (1));
   
   go_left_1 ();
}

%% Mark a word and return it
private define po_mark_word ()
{
   variable word = "";
   
   define_word ("-A-Za-zÀ-ÿ");
   push_spot ();
   bskip_word_chars ();
   push_mark ();
   skip_word_chars ();
   if (__argv[0] == "del")
     bufsubstr_delete ();
   else
     bufsubstr ();
   pop_spot ();
}

private define entry_as_str ()
{
. push_spot mark_entry bufsubstr pop_spot
}

private define msgid_as_str ()
{
. push_spot mark_msgid bufsubstr pop_spot
}

private define msgstr_as_str ()
{
. push_spot mark_msgstr bufsubstr pop_spot
}

define show_current_entry_number ()
{
   variable n = get_current_entry_number ();
   
   flush ("# $n"$);
}

define po_next_entry ()
{
   find_msgid_keyword ();
   go_right_1 ();
   () = re_fsearch ("^msgid_?");
}

define po_previous_entry ()
{
   push_mark (); find_entry_delim_beg ();
   if (bol_bsearch ("msgid"))
     return pop_mark_0 ();
   pop_mark_1 ();
}

define top_justify_entry ()
{
   find_entry_delim_beg (); go_right_1 (); recenter (1);
}

define goto_entry (n)
{
   if (n < 0)
     { 
        n = read_mini ("Go to entry number:", "", "");
        n = integer (n);
     }
   
   if (n > get_blocal_var ("total_entries"))
     throw UsageError, "no such entry";

   bob ();

   loop (n)
     {
        () = bol_fsearch ("msgid ");
        eol ();
     }

   bol ();
} 

%% Goto next or previous translated or untranslated message
define find_msgstr (dir, status)
{
   variable search_fun, move, translated;
   
   if (status > 0)
     translated = &is_translated ();
   else translated = &is_untranslated ();
   
   if (dir < 0) 
     {
        search_fun = &bol_bsearch ();
        move = &go_left_1 ();
     }
   else
     { 
        search_fun = &bol_fsearch ();
        move = &go_right_1 ();
     }
   
   push_mark ();
   @move ();
   while (@search_fun ("msgstr")) 
          {
             if (@translated ())
               { 
                  if (status > 0)
                    {
                       if (is_fuzzy ())
                         {
                            @move ();
                            continue;
                         }
                    }
                  return pop_mark_0 ();
               }
             @move ();
          }
   flush ("no matches beyond this point");
   return pop_mark_1 ();
}

%% Find the previous entry with fuzzy flag.
define bfind_fuzzy ()
{
   find_entry_delim_beg ();
   
   while (bol_bsearch ("#, fuzzy"))
     {
        push_spot ();
        go_down_1 ();
        if (looking_at ("#~"))
          {
             pop_spot ();
             continue;
          }
        return pop_spot ();
     }
   flush ("no fuzzy entries above this point");
}

define find_fuzzy ()
{
   push_mark ();
   while (bol_fsearch ("#, fuzzy"))
     {
        go_down_1 ();
        if (looking_at ("#~"))
          { 
             pop_mark_0;
             continue;
          }
        else return pop_mark_0;
     }
   flush ("wrapping search around buffer ...");
   bob ();
   ifnot (bol_fsearch ("#, fuzzy"))
     {
        flush ("no fuzzy entries");
        pop_mark_1;
     }
   pop_mark_0;
}

define find_obsolete ()
{
   push_mark ();
   while (fsearch ("#~ msgid "))
     {
        () = bol_fsearch ("#~ msgstr ");
        return pop_mark (0);
     }
   flush ("wrapping search around buffer ...");
   bob ();
   ifnot (fsearch ("#~ msgid "))
     { 
        flush ("no obsolete entries");
        pop_mark_1 ();
     }
   pop_mark_0 ();
}

%% Go to next entry that is either fuzzy or untranslated
define any_next_unfinished ()
{
   push_mark ();
   go_right_1 ();
   while (bol_fsearch ("msgstr"))
     { 
        if ((is_untranslated ()) || (is_fuzzy ()))
          return pop_mark_0 ();
        else
          go_right_1 ();
     }
   flush ("wrapping search around buffer ...");
   bob ();
   while (bol_fsearch ("msgstr"))
     { 
        if ((is_untranslated ()) || (is_fuzzy ()))
          return pop_mark_0 ();
        else
          go_right_1 ();
     }
   flush ("no unfinished entries below this point");
   pop_mark_1 ();
}

define find_translator_comment ()
{
   push_mark ();
   find_entry_delim_end ();
   while (bol_fsearch ("# "))
     {
        () = bol_fsearch ("msgid");
        return pop_mark (0);
     }
   flush ("wrapping search around buffer");
   bob ();
   while (bol_fsearch ("# "))
     {
        () = bol_fsearch ("msgid");
        return pop_mark (0);
     }
   pop_mark (1);
   flush ("no more translator comments");
}

%}}}
%{{{ statistics

%% The status line that shows the counts for translated, untranslated, fuzzy
%% and obsolete entries
define set_po_status_line ()
{
   variable t, u, f, o, s, n, p, mode;
   
   ifnot ("PO" == get_mode_name ())
     return;

   if (get_blocal_var ("View_Limit", 1))
     return;
   
   t = count ("t"); u = count ("u"); f = count ("f"); o = count ("o");
   n = t + f + u;
   if (n == 0) n = 1;
   p = Sprintf ("(%S%s) ", (t*100)/n, "%%",  2);
   s = Sprintf ("%dt/%du/%df/%do", t, u, f, o, 4);
   set_status_line (" %b " + p + s + "  (%m%a%n%o)  %p   %t", 0);
}

%% The actual counting of the various entries.
private define po_statistics ()
{
   variable t, u, f, o, ct, cts, n = 0;

   ifnot ("PO" == get_mode_name ())
     return;
   
   cts = {"translated","untranslated","fuzzy","obsolete","total_entries"};
        
   foreach ct (cts)
     {
        create_blocal_var (ct);
        set_blocal_var (0, ct);
     }
    
   t = count ("t"); u = count ("u"); f = count ("f"); o = count ("o");
   
   push_spot_bob ();
   () = bol_fsearch ("\n");
   push_mark (); push_mark ();
   while (bol_fsearch ("msgstr"))
     {
        if (is_untranslated ())
          u++;
        else 
          t++;
        eol ();
     }
   pop_mark_1 ();
   while (bol_fsearch ("#~ msgid"))
     {
        eol ();
        o++;
     }
   pop_mark_1 ();
   while (bol_fsearch ("#, fuzzy"))
     {
        go_down_1 ();
        ifnot (looking_at ("#~"))
          f++;
     }   
   
   pop_spot (); 

   t = t - f; % translated count includes fuzzies, so deduct them
   
   set_blocal_var (t, "translated");
   set_blocal_var (u, "untranslated");
   set_blocal_var (f, "fuzzy");
   set_blocal_var (o, "obsolete");
   set_blocal_var (t + u + f, "total_entries");
   
   set_po_status_line ();
}
   
%% Shows the counts in the message area, including total count and current
%% position
define show_po_statistics ()
{
   ifnot ("PO" == get_mode_name ())
     return;

   variable t, u, f, o;
   variable n = get_blocal_var ("total_entries");
   variable cn = get_current_entry_number ();
   t = count ("t"); u = count ("u"); f = count ("f"); o = count ("o");
   po_statistics ();
   flush ("Position: $cn/$n; $t translated, $u untranslated, $f fuzzy, $o obsolete"$);
}

%}}}
%{{{ auxillary functions

%% Catch output from a system cmd in a string.
private define syscmd_output_to_string ()
{
   variable exit_status = 0, str = "", fp, cmd = "";

   cmd = ();
   fp = popen (cmd, "r");
   
   if (fp == NULL) 
     throw RunTimeError, "could not open pipe to process";
   
   str = strjoin (fgetslines (fp), "");
   exit_status = pclose (fp);
   str = strtrim (str);
   return (str, exit_status);
}

private define surround_in_quotes (str)
{
   str = strchop (str, '\n', 0);
   str = array_map (String_Type, &strcat, "\"", str, "\"");
   return strjoin (str, "\n");
}

%% Get the language/country code and charset from the enviroment,
private define get_locale_info ()
{
   variable lc = "", locale = "", lang = "", country = "", encoding = "";
   
   (lc, ) = syscmd_output_to_string ("env | egrep \"^LC_.*=|^LANG=\"");

   () = sscanf (lc, "%[A-Z_]=%[a-zA-Z]_%[a-zA-Z].%[a-zA-Z0-9-]",
                &locale, &lang, &country, &encoding);
   
   locale = strcat (lang, "_", strup (country));
   if (strlen (Encoding))
     encoding = Encoding;
   if (strlen (LangCode))
     lang = LangCode;
   if (strlen (CountryCode))
     country = strup (CountryCode);
   if ((strlen (LangCode)) && (strlen (CountryCode)))
     locale = strcat (LangCode, "_", strup (CountryCode));
   
   if (encoding == "utf8") % msgconv does not accept this form
     encoding = "utf-8";

   return locale, lang, country, encoding;
}

private define pcre_replace (str, pat, rep)
{
   variable match, len, pos = 0;
     
   pat = pcre_compile (pat);
   
   while (pcre_exec (pat, str, pos))
     {
        match = pcre_nth_match (pat, 0);
        len = match[1] - match[0];
        str = strcat (str[[0:match[0]-1]], rep, str[[match[1]:]]);
        pos += len;
     }
   
   return str;
}

private define pcre_string_match (str, pat)
{
   pat = pcre_compile (pat);
   return pcre_exec (pat, str);
}

%% determine the type of file, regular, directory, etc.
private define file_type (file, type)
{
   variable st = stat_file (file);
   
   if (st == NULL)
     return 0;
   
   stat_is (type, st.st_mode);
}

%% Probe for directory of source archive
private define init_src_dir ()
{
   variable cur_dir = "", srcdir = "", srcdir_name = "", srcdirs, k = 0;
   variable other = "";
   
   (,cur_dir,,) = getbuf_info (whatbuf ());
   srcdir_name = extract_element (whatbuf (), 0, '.');
   srcdirs = listdir (SrcBaseDir);
   srcdirs = array_map (String_Type, &dircat, SrcBaseDir, srcdirs);
   srcdirs = srcdirs[where (array_map (Int_Type, &file_type, srcdirs, "dir"))];
   srcdirs = srcdirs[where (array_map (Int_Type, 
                                       &string_match, srcdirs, srcdir_name, 1))];
   if (length (srcdirs))
     {
        srcdir = srcdirs[0];
        k = get_mini_response ("Look in: 1) $srcdir, 2) $cur_dir, 3) other"$);
     }
   else
     k = get_mini_response ("Look in: 1) $cur_dir, 2) other"$);
     
   switch (k)
     { case '1': dir = read_with_completion ("Look in:", "", srcdir, 'f'); }
     { case '2': dir = read_with_completion ("Look in:", "", cur_dir, 'f'); }
     { case '3': dir = read_with_completion ("Look in:", "", SrcBaseDir, 'f'); }
     { throw UsageError, "no source directory selected"; }

   return dir;
}

%% Return a program in $PATH
private define check_for_prg (prg)
{
   variable path = getenv ("PATH"), res = "";

   res = search_path_for_file (path, prg);

   if (res == NULL)
     throw OpenError, "$prg is not installed"$;

   return res;
}

%% Check for po files in a directory
private define pofiles_in_dir (dir)
{
   variable files, exts, po_files, po_matches;
   
   files = listdir (dir);
   files = array_map (String_Type, &dircat, dir, files);
   files = files[where (array_map (Int_Type, &file_type, files, "reg"))];
   exts = array_map (String_Type, &path_extname, files);
   po_matches = where (exts == ".po");
   po_files = files[po_matches];
   
   return po_files;
}

%% The two window layout for editing msgstrs and comments
private define setup_win_layout (view_buf, view_str, edit_buf, edit_str)
{
   variable win_rows, nlines_msgid, msgid, delim, msgid_arr;

   recenter (1);
   Po_Buf = pop2buf_whatbuf (edit_buf);
   pop2buf (view_buf);
   insert (view_str);
   set_buffer_modified_flag (0);
   nlines_msgid = what_line ();
   bob ();
   win_rows = window_info ('r');
   otherwindow ();
   loop (win_rows - nlines_msgid-1)
     enlargewin ();
   insert (edit_str);
   ifnot (Multi_Line)
     {
        set_mode (Edit_Mode, 1); % wrap_mode
        WRAP=Wrap;
     }
   else
     set_mode (Edit_Mode, 0);
   
   bob ();
   set_buffer_modified_flag (0);
}

private define write_buf_to_tmpfile ()
{
   push_spot ();
   mark_buffer ();
   () = write_region_to_file (Po_Tmpfile);
   pop_spot ();
}

%% In order to preserve undo information, which erase_buffer() does not.
private define po_erase_buffer ()
{
   mark_buffer (); del_region ();
}

%% Thanks to John E. Davis for this solution.
private define po_edit_wrap_hook ()
{
   push_spot (); bol (); go_left (1); insert (" "); pop_spot ();
}

%% The library function from jed
private define search_path_for_file ()
{
   variable path, f, delim = path_get_delimiter ();
   
   if (_NARGS == 3)
     delim = ();

   (path, f) = ();

   if (path == NULL)
     return NULL;

   foreach (strtok (path, char(delim)))
     {
        variable dir = ();
        variable file = strcat (dir, "/", f);

        if (file_type (file, "reg"))
          return file;
     }

   return NULL;
}

%% Look for a program from an array of programs and return the first
%% one found
private define find_prgs_use_first (prgs)
{
   variable prg, prgs_arr = strtok (prgs), path = getenv ("PATH");

   prgs_arr = prgs_arr[wherenot (_isnull (array_map (String_Type, &search_path_for_file, path, prgs_arr)))];

   ifnot (length (prgs_arr))
     throw OpenError, "Error: You must install one of $prgs"$;
   else
     prg = prgs_arr[0];
   
   return prg;
}

% Use a text browser to format html to text
private define html_to_txt (url)
{
   variable cmd, browser, browser_basename, output, status, enc;
   
   (,,, enc) = get_locale_info ();
   browser = find_prgs_use_first ("lynx elinks w3m");
   browser_basename = path_basename (browser);
   
   switch (browser_basename)
     { case "lynx": 
          cmd = "$browser -dump -nolist -nonumbers -width 500 -display_charset=$enc"$;
     }
     { case "elinks": 
          cmd = "$browser -dump -dump-charset $enc -no-references -no-numbering"$;
     }
     { case "w3m":
          cmd = "$browser -dump -cols 500 -O $enc"$;
     }
   
   (output, status) = syscmd_output_to_string ("$cmd \"$url\""$);
   
   if (0 == status)
     return output;
   else 
     throw RunTimeError, "$cmd failed"$;
}

private define lines_count (str)
{
   return length (strchop (strtrim (str), '\n', 0));
}

private define str_has_end_newline (str)
{
   return ((str[[-3:]] == "\\n\"") || (str == "msgid \"\""));
}

private define str_has_beg_newline (str)
{
   return (str[0] == '\n');
}

private define str_is_multiline (str)
{
   return ((is_substr (str, "\\n")) || (pcre_string_match (str, "^msgid \"\"$")));
}

private define del_html_tags (str)
{
   return strtrim (str_uncomment_string (str, "<", ">"));
}

private define del_format_specifiers (str)
{
   variable letter, letters = [['A':'Z'], ['a':'z']];

   foreach (letters)
     {
        letter = char ();
        str = strreplace (str, strcat ("%", letter), "");
     }
   
   return str;   
}

% This mode depends on each entry being separated by one blank line.
% Gettext, however, allows blank lines inserted randomly within entries.
% Make sure such lines are deleted.
private define parse_blank_lines ()
{
   bob ();
   while (bol_fsearch ("\n"))
     {
        ifnot ((looking_at ("\n#")) || (looking_at ("\nmsgid"))
               && (blooking_at ("\"\n")))
          {
             del ();
          }
        go_right_1 ();
     }
   bob ();
}

%% Check in file with RCS
define check_in_file ()
{
   variable file, dir, flags, rcsdir, rcsfile, cmd, buf_file, msg = "";
   variable ci_prg = check_for_prg ("ci"), logmsg = "";

   (file, dir,,) = getbuf_info ();
   buf_file = dircat (dir, file);
   rcsdir = dircat (dir, "RCS");
   rcsfile = dircat (rcsdir, strcat (file, ",v"));
   
   ifnot (file_status (rcsdir) == 2)
     {
        ifnot (0 == system ("mkdir -p \"$rcsdir\""$))
          throw IOError, "could not create directory \"$rcsdir\""$;
     }

   ifnot (1 == file_status (rcsfile)) % initial revision
     cmd = "ci -l -i -m -t- $buf_file 2>/dev/null"$;
   else
     {
        logmsg = read_mini ("Enter a log message:", "New revision", "");
        cmd = "ci -l -m\"$logmsg\" -t-\"\" $buf_file 2>/dev/null"$;
     }

   ifnot (0 == system (cmd))
     throw RunTimeError, "could not check in $buf_file"$;

   % If you have RCS expansion markers they will change
   % file on disk, in which case reload it
   check_buffers (); % check if disk file is newer and update buffer flags

   (,,,flags) = getbuf_info ();

   if (flags & 0x004)
     {
        delbuf (whatbuf ());
        () = find_file (buf_file);
     }

   flush ("file checked in");
}

define checkout_rcs_file (view)
{
   variable log = "", e, ver = "", fstr = "", dates, revs, lines, file = "";
   variable co_prg = check_for_prg ("co");
   variable rlog_prg = check_for_prg ("rlog");
   
   if (view)
     file = read_mini ("File to check out", buffer_filename, "");
   else
     file = buffer_filename ();
   
   ifnot (file_type (file, "reg"))
     throw RunTimeError, "$file not found"$;
   
   (log, e) = syscmd_output_to_string ("$rlog_prg $file 2>/dev/null"$);

   ifnot (0 == e)
     throw RunTimeError, "Could not obtain RCS log for $file"$;
   
   log = strreplace (log, "\t", " ");
   lines = strchop (log, '\n', 0);
   revs = lines[where (array_map (Int_Type, &string_match, lines, "^revision ", 1))];
   revs = array_map (String_Type, &extract_element, revs, 1, ' ');
   dates = lines[where (array_map (Int_Type, &string_match, lines, "^date: ", 1))];
   dates = array_map (String_Type, &extract_element, dates, 1, ' ' );
   revs = revs[*] + " " + dates[*];
   revs = strjoin (revs, ",");
   ver = read_with_completion (revs, "Choose version <TAB=view versions and complete>:", "", "", 's');
   ver = extract_element (ver, 0, ' ');
   (fstr, e) = syscmd_output_to_string ("$co_prg -q -p$ver $file 2>/dev/null"$);
   
   if (view)
     {
        pop2buf ("Viewing RCS version $ver of $file"$);
        onewindow ();
        insert (fstr);
        set_buffer_modified_flag (0);
        bob ();
        most_mode ();
     }
   else
     return fstr, ver;
}

define exit_po_mode ()
{
   no_mode ();
   use_keymap ("global");
   set_readonly (0);
   call ("redraw");
   set_status_line ("", 0);
   flush ("use \"M-x po_mode\" to return");
}

%% Display help window
define show_help ()
{
   variable file = expand_jedlib_file ("po_mode.hlp");
   
   if (strlen (file))
     jed_easy_help (file);
   else
     throw OpenError, "help file not found";
}

%% Send a bug report
define reportbug ()
{
   mail ();
   () = bol_bsearch ("To: ");
   eol ();
   insert ("Morten Bo Johansen <mbj@spamcop.net");
   () = bol_fsearch ("Subject:"); 
   eol ();
   insert ("[po_mode] ");
}

define po_undo ()
{
   variable n = get_current_entry_number ();
   set_readonly (0);
   call ("undo");
   goto_entry (n);
   po_statistics ();
   set_readonly (1);
}

define cancel_edit ()
{
   po_erase_buffer ();
   set_buffer_modified_flag (0);
   delbuf (Msgid_Buf);
   bury_buffer (Edit_Buf);
   if (bufferp (Po_Comment_Buf))
     delbuf (Po_Comment_Buf);
   sw2buf (Po_Buf);
   widen (); onewindow ();
   find_entry_delim_beg ();
   recenter (1);
   () = bol_fsearch (Last_Edited);
}

%% Use the file(1) program to determine the encoding
private define get_file_encoding (file)
{
   variable prg = check_for_prg ("file");
   variable cmd = "", charset = "", output = "";
   
   ifnot (1 == file_status (file))
     throw ReadError, "$file not found"$;
   
   cmd = "$prg -i $file 2>/dev/null"$;
   (output,) = syscmd_output_to_string (cmd);
   return strchop (output, '=', 0)[1];
}

%}}}
%{{{ mark functions, string functions, hash functions

private define file_as_str (file)
{
   variable str = "";
   variable fp = fopen (file, "r");
   
   if (fp == NULL)
     throw IOError, "could not open \"$file\""$;
   
   str = strjoin (fgetslines (fp), "");
   str = strreplace (str, "\v", "");
   str = strreplace (str, "\a", "");
   () = fclose (fp);
   return str;
}

private define buf_as_str ()
{
   set_readonly (0);
   push_spot_bob ();
   untab_buffer ();
   set_readonly (1);
   set_buffer_modified_flag (0);
   mark_buffer ();
   bufsubstr ();
   pop_spot ();
}

%% Return an entry as an array of its elements, comments, msgids, msgstrs ..
private define strchop_entry (entry)
{
   variable entry_arr, msgctxt, cmt, msgid, delim, strs;

   entry = strreplace (entry, "\t", " ");
   entry = strreplace (entry, "\nmsg", "\tmsg");
   entry_arr = strchop (entry, '\t', 0);
   return array_map (String_Type, &strtrim, entry_arr);
}

%% Return po-file as two arrays consisting of current and obsolete
%% entries respectively
private define po2arr (str)
{
   variable str_arr, current, obsolete;
   
   flush ("creating array of all entries ...");
   str = strreplace (str, "\v", " ");
   str = strreplace (str, "\n\n", "\v");
   str_arr = strchop (str, '\v', 0);
   str_arr = str_arr[where (array_map (Int_Type, &strlen, str_arr))];
   str_arr = array_map (String_Type, &strtrim, str_arr);
   obsolete = array_map (Int_Type, &string_match, str_arr, "#~ msgid", 1);
   current = str_arr[wherenot (obsolete)];
   Obsolete = str_arr[where (obsolete)]; 

   return (current, Obsolete);
}

private define strip_cmts (str)
{
   str = strchop_entry (str);
   str = str[wherenot (array_map (Int_Type, &string_match, str, "^#", 1))];
   str = str[wherenot (array_map (Int_Type, &string_match, str, "^msgctxt", 1))];
   return strtrim (strjoin (str, "\n"));
}

%% Create lists of all cmts, msgids and msgstrs respectively
private define create_strs_list (str)
{
   variable str_arr, cmts, msgids, msgstrs;

   str = strreplace (str, "\v", "");
   str = strreplace (str, "\nmsg", "\vmsg");
   str = strreplace (str, "\n\n", "\v");
   str_arr = strchop (str, '\v', 0);
   flush (sprintf ("Making lists of %d msgids and msgstrs ...",
                   length (str_arr)));
   cmts = str_arr[where (array_map (Int_Type, &string_match, str_arr, "^#", 1))];
   msgids = str_arr[where (array_map (Int_Type, &string_match, str_arr, "^msgid", 1))];
   msgstrs = str_arr[where (array_map (Int_Type, &string_match, str_arr, "^msgstr", 1))];
   cmts = array_map (String_Type, &strtrim, cmts);
   msgids = array_map (String_Type, &strtrim, msgids);
   msgstrs = array_map (String_Type, &strtrim, msgstrs);

   ifnot (length (msgids))
     throw IndexError, "no valid entries";

   ifnot (length (msgids) == length (msgstrs))
     throw IndexError, "some error occured";

   return (cmts, msgids, msgstrs);
}

private define sep_kw_and_str (str)
{
   variable keyword = extract_element (str, 0, ' ');

   if (pcre_string_match (str, "\"\"\n\""))
     str = str[[strlen (keyword)+4:]];
   else
     str = str[[strlen (keyword)+1:]];

   return (keyword, str);
}

private define concat_kw_str (kw, str)
{
   if ((strlen (kw + str) > Wrap) || (lines_count (str) > 1))
     str = strcat (kw, " \"\"\n", str);
    else
     str = strcat (kw, " ", str);
   
   return str;
}

private define trim_chars (str, beg, end)
{
   return str[[beg:strbytelen (str)-1-end]];
}

%% Trim the two single outermost double quotes from each line
private define trim_quotes (str)
{
   str = strchop (str, '\n', 0);
   str = array_map (String_Type, &trim_chars, str, 1, 1);
   return strjoin (str, "\n");
}

%% With this, every element in a po-file entry can be isolated.
private define hash_entry ()
{
   variable po = Assoc_Type[Array_Type];
   variable entry_hash = Assoc_Type[String_Type, ""];
   variable cmts_arr, key, value, entry_arr, entry;
   
   ifnot (_NARGS) 
     entry = entry_as_str ();
   else 
     entry = ();

   entry_arr = strchop_entry (entry);
   
   if (0 == strncmp (entry_arr[0], "#", 1))
     {
        cmts_arr = strchop (entry_arr[0], '\n', 0);

        po["trans_cmts"] = 
          cmts_arr [wherenot (array_map (Int_Type, &strncmp, cmts_arr, "# ", 2))];
        po["extr_cmts"] = 
          cmts_arr [wherenot (array_map (Int_Type, &strncmp, cmts_arr, "#.", 2))];
        po["ref_cmts"] = 
          cmts_arr [wherenot (array_map (Int_Type, &strncmp, cmts_arr, "#:", 2))];
        po["flag_cmts"] = 
          cmts_arr [wherenot (array_map (Int_Type, &strncmp, cmts_arr, "#,", 2))];
        po["ctx_cmts"] = 
          cmts_arr [wherenot (array_map (Int_Type, &strncmp, cmts_arr, "#|", 2))];

        entry_arr = entry_arr[[1:]];
     }
   
   po["msgctxt"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgctxt", 7))];
   po["msgid"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgid ", 6))];
   po["msgid_plural"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgid_", 6))];
   po["msgstr"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr ", 7))];
   po["msgstr[0]"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr[0]", 9))];
   po["msgstr[1]"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr[1]", 9))];
   po["msgstr[2]"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr[2]", 9))];
   po["msgstr[3]"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr[3]", 9))];
   po["msgstr[4]"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr[4]", 9))];
   po["msgstr[5]"] = 
     entry_arr[wherenot (array_map (Int_Type, &strncmp, entry_arr, "msgstr[5]", 9))];
   
   foreach key, value (po) using ("keys", "values")
     {
        if (length (value))
          {
             value = strjoin (value, "\n");
             entry_hash[key] = value;
          }
     }
   
   return entry_hash;
}

%% Create an array of hashed entries of a whole po-file
private define create_entries_hash (str)
{
   variable entries_arr, entries_arr_hash;

   (entries_arr,) = po2arr (str);
   entries_arr_hash = array_map (Assoc_Type, &hash_entry, entries_arr);
   return entries_arr_hash;
}

%% Extract the string keywords, "msgid", "msgstr"
private define extract_keyword ()
{
   variable kw;
   push_spot ();
   kw = extract_element (line_as_string, 0, ' ');
   pop_spot ();
   return kw;
}

private define end_char (str)
{
   try
     return str[[strbytelen (str)-1:strbytelen (str)-1]];
   catch IndexError:
     return str;
}

%% Gettext-like wrapping. Lines are wrapped with trailing blanks
private define po_wrap_str (str)
{
   variable wrappoint = Wrap, i = 0, wrappoint_prev = 0, line;
   variable list = {};
   
   ifnot (strbytelen (str) > Wrap) 
     return str;
  
   str = strreplace (str, "\n", "");

   _for i (0, strbytelen (str)-1, 1)
     {
        if ((str[i] != ' ') && (i > wrappoint))
          {
             while ((str[i] != ' ') && (i >= 0))
               i--;
             line = str[[wrappoint_prev:i]];
             list_append (list, line);
             wrappoint_prev = i + 1;
             wrappoint = i + Wrap;
          }
     }

   list_append (list, str[[wrappoint_prev:]]);
   str = list_to_array (list);
   return strjoin (str, "\n");
}

%% Prepare the msgstr for editing
private define prep_str (str)
{
   str = trim_quotes (str);
   
   variable str_arr = strchop (str, '\n', 0);

   str_arr = str_arr [where (array_map (Integer_Type, &strlen, str_arr))];
   str = strjoin (str_arr, "\n");
   str = strreplace (str, "\\\"", "\"");
   
   if (Multi_Line)
     {
        str = str_delete_chars (str, "\n");
        str = strreplace (str, "\\n", "\n");
     }

   return str;
}

% The formatting done to the edited msgstr before it is written back
% into the po buffer
private define post_prep_str (str)
{
   variable str_arr, i = 0;
   
   str = strreplace (str, "\"", "\\\"");
   if (Multi_Line)
     {
        % Gettext is sensitive to beginning or trailing newlines.
        % Either both msgid and msgstr must have one or neither.
        % Otherwise it is a fatal error. Ensure that this is observed
        % in case user forgets.
        if ((Msgid_Has_Beg_Newline) && (str[0] != '\n'))
          str = "\n" + str;
        ifnot ((Msgid_Has_Beg_Newline) && (str[0] == '\n'))
          str = strtrim_beg (str, "\n");
        if ((Msgid_Has_End_Newline) && (str[-1] != '\n'))
          str += "\n";
        ifnot ((Msgid_Has_End_Newline) && (str[-1] == '\n'))
          str = strtrim_end (str, "\n");
        
        str_arr = strchop (str, '\n', 0);
        str_arr = array_map (String_Type, &po_wrap_str, str_arr);
        str = strjoin (str_arr, "\\n\n");
     }
   else
     str = po_wrap_str (str);

   str_arr = strchop (str, '\n', 0);
   str_arr = str_arr [where (array_map (Integer_Type, &strlen, str_arr))];
   str = strjoin (str_arr, "\n");
   return surround_in_quotes (str);
}

private define get_charset_from_header ()
{
   variable header, header_charset = "", charset_pat = "";
   
   push_spot_bob ();
   header = msgstr_as_str ();
   charset_pat = pcre_compile ("charset=(.*)\\\\n");

   if (pcre_exec (charset_pat, header))
     header_charset = pcre_nth_substr (charset_pat, header, 1);

   pop_spot ();
   
   ifnot (strlen (header_charset))
     throw UsageError, "could not determine header charset";
    else 
     return header_charset ();
}

%% Create an associative array between msgids and msgstrs
private define hash_msgids_msgstrs (pofile, fuzzy)
{
   variable strs = Assoc_Type[String_Type, ""];
   variable strs_fuzzy = Assoc_Type[String_Type, ""];
   variable msgids, msgids_fuzzy, msgstrs, i = 0;
   variable msg = "creating entry hash";

   (, msgids, msgstrs) = create_strs_list (pofile);
   (, msgstrs) = array_map (String_Type, &strtrim_end, msgstrs, "@");
   
   if (fuzzy)
     {
        flush ("preparing msgids for fuzzy matching ...");
        msgids_fuzzy = array_map (String_Type, &del_format_specifiers, msgids);
        msgids_fuzzy = array_map (String_Type, &str_delete_chars, msgids, "^\\w");
        msgids_fuzzy = array_map (String_Type, &strlow, msgids_fuzzy);
        
        _for i (0, length (msgids)-1, 1)
          {
             flush (sprintf ("%s (fuzzy matching): entry %d of %d", msg, i, length (msgids)));
             strs_fuzzy[msgids_fuzzy[i]] = msgstrs[i];
          }
     }

   _for i (0, length (msgids)-1, 1)
     {
        flush (sprintf ("%s: (exact matching) entry %d of %d", msg, i, length (msgids)));
        strs[msgids[i]] = msgstrs[i];
     }
   
   Compendium_Is_Hashed = 1;
   return strs, strs_fuzzy;
}

%% Return msgid and msgstr;
private define return_str_pair ()
{
   variable msgid, msgstr, msgid_kw, msgstr_kw;
   
   try
     {
        push_spot ();
        Entry = hash_entry ();
        find_msgstr_keyword ();
        msgstr_kw = extract_keyword ();
   
        if ((msgstr_kw == "msgstr") || (msgstr_kw == "msgstr[0]"))
          msgid_kw = "msgid";
        else
          msgid_kw = "msgid_plural"; 
  
        msgid = Entry[msgid_kw];
        msgstr = Entry[msgstr_kw];
        return (msgid_kw, msgstr_kw, msgid, msgstr);
     }
   finally
     {
        pop_spot ();
     }
   
}

%% Assemble all the elements of a po-file entry according to the
%% section, "The Format of PO Files", in the gettext manual at:
%% http://www.gnu.org/software/hello/manual/gettext/PO-Files.html
private define assemble_entry (Entry)
{
   variable entry_elems = {}, elem = "";
   variable elems = ["trans_cmts","extr_cmts","ref_cmts","flag_cmts",
                     "ctx_cmts","msgctxt","msgid","msgstr"];

   variable elems_pl = ["trans_cmts","extr_cmts","ref_cmts","flag_cmts",
                        "ctx_cmts","msgctxt","msgid","msgid_plural",
                        "msgstr[0]","msgstr[1]","msgstr[2]","msgstr[3]",
                        "msgstr[4]","msgstr[5]"];
   
   if (strlen (Entry["msgid_plural"]))
       {
          foreach elem (elems_pl)
            list_append (entry_elems, Entry[elem]);
       }
   else
     {
        foreach elem (elems)
          list_append (entry_elems, Entry[elem]);
     }

   Entry = list_to_array (entry_elems);
   Entry = Entry[where (array_map (Int_Type, &strlen, Entry))];
   Entry = array_map (String_Type, &strtrim, Entry);
   Entry = strjoin (Entry, "\n");

   return Entry;
}

%% Replace an element in a entry (cmt, msgid, msgstr)
private define replace_elem (elem, rep)
{
   Entry[elem] = rep;
}

%% Replace a whole entry with a modified one
private define replace_entry (new_entry)
{
   set_readonly (0);
   push_spot (); mark_entry (); del_region ();
   
   if (eobp)
     new_entry += "\n";
   
   insert (new_entry);
   set_readonly (1);
   pop_spot ();
   () = bol_fsearch ("msgstr");
   set_po_status_line ();
}

private define replace_buffer (rep)
{
   variable n = get_current_entry_number ();
   
   set_readonly (0);
   po_erase_buffer ();
   insert (rep);
   set_readonly (1);
   po_statistics ();
   goto_entry (n);
   set_po_status_line ();
}

%% Align the lengths of two arrays 
private define array_align_length (a, b)
{
   variable ldiff = length (a)-length (b);
   variable padarr;
   
   if (ldiff == 0)
     return a, b;
   if (ldiff < 0)
     padarr = String_Type[-ldiff];
   else
     padarr = String_Type[ldiff];
   
   padarr[*] = "";

   if (ldiff < 0) 
     a = [a, padarr];
   else
     b = [b, padarr];
   
   return a, b;
}

private define flag_fuzzy (Entry)
{
   if (string_match (Entry["flag_cmts"], ", fuzzy", 1))
     return Entry;
   
   ifnot (strlen (Entry["flag_cmts"]))
     Entry["flag_cmts"] = "#, fuzzy";
   else
     Entry["flag_cmts"] = pcre_replace (Entry["flag_cmts"],
                                             "#,", "#, fuzzy,");
   return Entry;
}

%% Flag an entry fuzzy. Since each msgstr in a plural string gets a
%% count in the statistcis, make sure that the number of translated
%% messages in the statistcis get decremented by the number of
%% translated msgstrs in the plural entry.
define fuzzy_entry ()
{
   variable entry, msgstrs_all, msgstrs_translated, values;
   
   Entry = hash_entry ();
   values = assoc_get_values (Entry);
   msgstrs_all = values[where (array_map (Int_Type,
                                      &string_match, values, "^msgstr", 1))];
   msgstrs_translated = 
     msgstrs_all[wherenot (array_map (Int_Type, &pcre_string_match,
                                      msgstrs_all, "^msgstr[\\[\\]0-9 ]*\"\"$"))];
   
   find_msgstr_keyword ();

   if (length (msgstrs_translated) == 0)
     return;
   
   Entry = flag_fuzzy (Entry);
   count ("f+"); 

   loop (length (msgstrs_translated))
     count ("t-");
   
   replace_entry (assemble_entry (Entry));
   set_po_status_line ();
}

%% Remove fuzzy flag from an entry. Since each msgstr in a plural
%% string gets a count in the statistcis, make sure that the number of
%% translated messages in the statistcis get incremented by the number
%% of translated msgstrs in the plural entry. Also remove a possible
%% "previous-untranslated-string" context.
define remove_fuzzy_flag ()
{
   variable flags, msgstrs_all, msgstrs_translated, values;
   
   Entry = hash_entry ();
   
   ifnot (string_match (Entry["flag_cmts"], "#, fuzzy", 1))
     return;
   
   values = assoc_get_values (Entry);
   msgstrs_all = values[where (array_map (Int_Type,
                                      &string_match, values, "^msgstr", 1))];
   msgstrs_translated = 
     msgstrs_all[wherenot (array_map (Int_Type, &pcre_string_match,
                                      msgstrs_all, "^msgstr[\\[\\]0-9 ]*\"\"$"))];

   flags = Entry["flag_cmts"];

   if (flags == "#, fuzzy")
     replace_elem ("flag_cmts", Null_String); 
   else
     replace_elem ("flag_cmts", pcre_replace (flags, " fuzzy,", ""));
  
   % remove msgmerge "previous-msgid-string"
   replace_elem ("ctx_cmts", Null_String);
   
   replace_entry (assemble_entry (Entry));
   count ("f-");
   
   loop (length (msgstrs_translated))
     count ("t+");
   
   set_po_status_line ();
}

%% Remove all obsolete entries
define del_obsolete_entries ()
{
   ifnot (get_y_or_n ("Remove all obsolete entries"$))
     return;

   variable entries_arr, entries;
   (entries_arr,) = po2arr (buf_as_str);
   entries = strjoin (entries_arr, "\n\n");
   replace_buffer (entries + "\n");
}

define cut_msgstr ()
{
   if (is_untranslated ())
     return;
   if (is_fuzzy ())
     remove_fuzzy_flag ();
   
   Entry = hash_entry ();
   find_msgstr_keyword ();
   variable kw = extract_keyword ();
   replace_elem (kw, kw + " \"\"");
   count ("t-"); count ("u+");
   replace_entry (assemble_entry (Entry));
   set_po_status_line ();
}

define copy_msgstr ()
{
   push_spot ();
   find_msgstr_keyword ();
   Msgstr_Copy = msgstr_as_str ();
   (, Msgstr_Copy) = sep_kw_and_str (Msgstr_Copy);
   flush ("msgstr copied");
   pop_spot ();
}

define insert_msgstr ()
{
   variable msgstr = "", kw = "";
   
   Entry = hash_entry ();
   find_msgstr_keyword ();
   kw = extract_keyword ();
   msgstr = concat_kw_str (kw, Msgstr_Copy);
   replace_elem (kw, msgstr);
 
   if (is_untranslated ())
     {
        count ("u-"); count ("t+");
        set_po_status_line ();
     }
   else
     ifnot (get_y_or_n ("Overwrite previous translation"))
       return;
   
   replace_entry (assemble_entry (Entry));
}

define copy_msgid_to_msgstr ()
{
   variable msgid, msgstr, msgid_kw, msgstr_kw;

   (msgid_kw, msgstr_kw, msgid, msgstr) = return_str_pair ();
   (, msgid) = sep_kw_and_str (msgid);
   msgid = concat_kw_str (msgstr_kw, msgid);
   replace_elem (msgstr_kw, msgid);
   find_msgstr_keyword ();
   
   if (is_untranslated ())
     {
        count ("u-"); count ("t+");
        set_po_status_line ();
     }
   else
     ifnot (get_y_or_n ("Overwrite previous translation"))
       return;
   
   replace_entry (assemble_entry (Entry));
}
   
%% Count words and characters in all msgstrs
define count_words_and_chars ()
{
   variable msgids, msgstrs, words_strs, words_ids, strs, ids;

   (, msgids, msgstrs) = create_strs_list (buf_as_str ());
   msgstrs = msgstrs[[1:]];
   (, ids) = array_map (String_Type, String_Type, &sep_kw_and_str, msgids);
   (, strs) = array_map (String_Type, String_Type, &sep_kw_and_str, msgstrs);
   ids = array_map (String_Type, &prep_str, ids);
   strs = array_map (String_Type, &prep_str, strs);
   
   words_ids = strtok (strjoin (ids, ""), "^\\w");
   words_strs = strtok (strjoin (strs, ""),"^\\w");
   vmessage ("words/msgids: %d, words/msgstrs: %d, " +
             "chars/msgids: %d, chars/msgstrs: %d",
             length (words_ids), length (words_strs),
             strlen (strjoin (ids, "")), strlen (strjoin (strs, "")));
}

%}}}
%{{{ sources related functions

%% Return source references of current entry as a string array.
private define get_source_refs ()
{
   Entry = hash_entry ();
   variable src_refs = Entry["ref_cmts"];

   ifnot (strlen (src_refs))
     throw UsageError, "no source reference(s) for this entry";
   
   src_refs = strreplace (src_refs, "#: ", "");
   src_refs = strreplace (src_refs, "\n", " ");
   src_refs = strchop (src_refs, ' ', 0);
   
   return src_refs;
}

%% Set the path to source files
define set_source_path ()
{
   variable s = init_src_dir ();
   
   ifnot (file_type (s, "dir"))
     throw OpenError, "$s does not exist or is not a directory"$;

   if (strlen (s))
     {
        create_blocal_var ("Source_Dir");
        set_blocal_var (s, "Source_Dir");
     }
   else
     throw UsageError, "No source directory selected";
}

%% Pop up windows containing files from source references for viewing
define view_source ()
{
   variable buf, oldbuf, src_file, src_line, src_refs, src_ref, alen;
   variable cnt = 1, i;

   src_refs = get_source_refs ();
   alen = length (src_refs);

   ifnot (alen) 
     return flush ("no source reference");
   
   ifnot (blocal_var_exists ("Source_Dir"))
     set_source_path ();
   else
     {
        if (get_blocal_var ("Source_Dir") == NULL)
          set_source_path ();
     }

   foreach src_ref (src_refs)
     {
        src_ref = strchop (src_ref, ':', 0);
        src_file = src_ref[0];
        src_line = src_ref[1];
        src_file = path_concat (get_blocal_var ("Source_Dir"), src_file);
        buf = src_file;
        
        % sometimes source references contain a header file
        % extension ".h" which is not present in the actual
        % source file referenced. A bug in intltool?
        if ((0 == file_status (src_file)) && (path_extname (src_file) == ".h"))
             src_file = path_sans_extname (src_file);

        if (0 == file_status (src_file))
          {
             flush ("Source file not found");
             return set_blocal_var (NULL, "Source_Dir");
          }

        oldbuf = pop2buf_whatbuf (buf);
        () = insert_file (src_file);
        set_buffer_modified_flag (0);
        set_readonly (1);
        goto_line (integer (src_line));
        local_setkey ("close_file", "q");
        c_mode ();
        onewindow ();
        
        _for i (0, alen-1, 1)
          {
             if (alen > 1)
               flush ("Source reference $cnt of $alen "$ +
                        "(space cycles, 'q' closes window, other key to scroll)");
             else
               flush ("Source reference $cnt of $alen "$ +
                        "(space or 'q' closes window, other key to scroll)");
          }
        
        update (1);
        variable ch = getkey ();
        switch (ch)
          { ch == ' ': delbuf (buf); sw2buf (oldbuf); cnt++; }
          { ch == 'q': delbuf (buf); return; }
          { throw UsageError, "'q' closes source window"; }
     }
}

%% Grep for a string in the source directory. Requires grep.sl
%% from http://jedmodes.sourceforge.net/
define grep_src ()
{
   variable str, srcdir;

   ifnot (blocal_var_exists ("Source_Dir"))
     set_source_path ();
   
   if (markp ())
     str = bufsubstr ();
   else
     str = po_mark_word ();

   str = read_mini ("Search in sources:", str, "");
   str = "'" + str + "'";
   srcdir = get_blocal_var ("Source_Dir");
   grep (str, srcdir);
   call ("redraw");
}

%}}}
%{{{ po-header

%% Return the gettext plural forms header appropriate to the iso
%% language code
private define get_plural_forms ()
{
   variable iso_code = "", plural_form_str = "", lang = "";
   variable default = "nplurals=2; plural=(n != 1)";

   (, lang,,) = get_locale_info ();

   ifnot (strlen (lang))
     return default;
   
   % Asian forms
   variable one_form = ["ja","ka","km","ko","lo","ky","bo","dz","fa","hy",
                        "id", "ms","su","zh","th","tr","uz","vi","ayá"];

   % Two forms, singular used for one only
   variable two_forms_sgl = ["so","pt","ca","az","bg","bn","da","de","et",
                             "eu","el","en","eo","es","fi","fo","fy","gl",
                             "gu","hu","it","ha","he","hi","lb","ml","es_AR",
                             "mn","mr","nb","ne","nl","nn","no","or","ps",
                             "pa","sq","sv","ta","te","tg","tk","ur","sco",
                             "pap","pms","fur","nah","nap","af"];
                             
   % Two forms, singular used for zero and one
   variable two_forms_sgl_zo = ["ak","am","wa","fr","ti","mg","mi",
                                "ln","br","fil","gun"];

   variable russian_fam = ["be","bs","ru","sr","uk","hr"];
     
   foreach iso_code (russian_fam)
     {
        if (0 == strcmp (iso_code, lang))
          plural_form_str = "nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 or n%100>=20) ? 1 : 2)";
     }
   foreach iso_code (two_forms_sgl)
     {
        if (0 == strcmp (iso_code, lang))
          plural_form_str = "nplurals=2; plural=(n != 1)";
     }
   foreach iso_code (one_form)
     {
        if (0 == strcmp (iso_code, lang))
          plural_form_str = "nplurals=1; plural=0";
     }
   foreach iso_code (two_forms_sgl_zo)
     {
        if (0 == strcmp (iso_code, lang))
          plural_form_str = "nplurals=2; plural=(n > 1)";
     }

   % other forms
   
   if (lang == "ar") % arabic
     plural_form_str = "nplurals=6; plural= n==0 ? 0 : n==1 ? 1 : n==2 ? 2 : n%100>=3 && n%100<=10 ? 3 : n%100>=11 && n%100<=99 ? 4 : 5;";
   if (lang == "ga")
       plural_form_str = "nplurals=5; plural=n==1 ? 0 : n==2 ? 1 : n<7 ? 2 : n<11 ? 3 : 4";
   if (lang == "is")
       plural_form_str = "nplurals=2; plural=(n%10!=1 or n%100==11)";
   if ((lang == "ku") || (lang == "kn"))
       plural_form_str = "nplurals=2; plural=(n!=1)";
   if (lang == "jv")
       plural_form_str = "nplurals=2; plural=n!=0";
   if (lang == "mk")
       plural_form_str = "nplurals=2; plural= n==1 or n%10==1 ? 0 : 1";
   if (lang == "cy")
       plural_form_str = "nplurals=4; plural= (n==1) ? 0 : (n==2) ? 1 : (n != 8 && n != 11) ? 2 : 3";
   if (lang == "kw")
       plural_form_str = "nplurals=4; plural= (n==1) ? 0 : (n==2) ? 1 : (n == 3) ? 2 : 3";
   if (lang == "mt")
       plural_form_str = "nplurals=4; plural=(n==1 ? 0 : n==0 or ( n%100>1 && n%100<11) ? 1 : (n%100>10 && n%100<20 ) ? 2 : 3)";
   if (lang == "sl")
       plural_form_str = "nplurals=4; plural=(n%100==1 ? 0 : n%100==2 ? 1 : n%100==3 or n%100==4 ? 2 : 3);";
   if (lang == "lv")
       plural_form_str = "nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n != 0 ? 1 : 2)";
   if (lang == "lt")
       plural_form_str = "nplurals=3; plural=(n%10==1 && n%100!=11 ? 0 : n%10>=2 && (n%100<10 or n%100>=20) ? 1 : 2)";
   if (lang == "pl")
       plural_form_str = "nplurals=3; plural=(n==1 ? 0 : n%10>=2 && n%10< =4 && (n%100<10 or n%100>=20) ? 1 : 2)";
   if ((lang == "cs") || (lang == "sk"))
       plural_form_str = "nplurals=3; plural=(n==1) ? 0 : (n>=2 && n< =4) ? 1 : 2";
   if (lang == "ro")
       plural_form_str = "nplurals=3; plural=(n==1 ? 0 : (n==0 or (n%100 > 0 && n%100 < 20)) ? 1 : 2);";
   if (lang == "csb")
       plural_form_str = "nplurals=3; n==1 ? 0 : n%10>=2 && n%10<=4 && (n%100<10 or n%100>=20) ? 1 : 2";

   return plural_form_str;
}

private define return_po_header_template ()
{
   variable plural_str = get_plural_forms ();
   variable header =
     "# SOME DESCRIPTIVE TITLE.\n" +
     "# Copyright (C) YEAR Free Software Foundation, Inc.\n" +
     "# FIRST AUTHOR <EMAIL@ADDRESS>, YEAR.\n" +
     "#\n" +
     "msgid \"\"\n" +
     "msgstr \"\"\n" +
     "\"Project-Id-Version: " + whatbuf () + "\\n\"\n" +
     "\"PO-Revision-Date: " + strftime ("%Y-%m-%d %R%z")+"\\n\"\n" +
     "\"Last-Translator: $Translator\\n\"\n"$ +
     "\"Language-Team: $Language <$Team_Email>\\n\"\n"$ +
     "\"MIME-Version: 1.0\\n\"\n" +
     "\"Content-Type: text/plain; charset=$Encoding\\n\"\n"$ +
     "\"Content-Transfer-Encoding: 8bit\\n\"\n" +
     "\"Plural-Forms: " + plural_str + "\\n\"\n" +
     "\"X-Generator: Jed w/po-mode\\n\"\n\n";
   
   return header;
}

%% Insert a default header
private define insert_po_header ()
{
   set_readonly (0);
   bob ();
   insert (return_po_header_template ());
   set_readonly (1);
}

private define set_po_revision_date ()
{
   ifnot (Mode == get_mode_name)
     return;
 
   variable rev_str, lines, header, rev_line, msgstr;
   
   rev_str = "\"PO-Revision-Date: " + strftime ("%Y-%m-%d %R%z")+"\\n\"";
   
   push_spot_bob ();
   header = hash_entry ();
   lines = strchop (header["msgstr"], '\n', 0);
   rev_line = where (array_map (Int_Type, &string_match, lines, "PO-Revision-Date", 1));
   lines[rev_line] = rev_str;
   msgstr = strjoin (lines, "\n");
   header["msgstr"] = msgstr;;
   replace_entry (assemble_entry (header));
   pop_spot ();
}

append_to_hook ("_jed_save_buffer_before_hooks", &set_po_revision_date);

%% Adjust the po-header to user's settings.
define replace_headers (ask)
{
   if (ask)
     ifnot (get_y_or_n ("Replace headers"))
       return;
   
   variable team, name, charset, jed_header, plural_header, header_arr, ln;
   variable header, i = 0, plural_str = get_plural_forms (), x_header = 0;
   variable lang = "", lang_code = "", enc, filenc = "";

   (, lang_code,, enc) = get_locale_info ();
   filenc = get_file_encoding (buffer_filename ());
   
   name = "\"Last-Translator: $Translator\\n\""$;
   lang = "\"Language: $lang_code\\n\""$;
   team = "\"Language-Team: $Language_Team\\n\""$;
   charset = "\"Content-Type: text/plain; charset=$enc\\n\""$;
   plural_header = "\"Plural-Forms: $plural_str\\n\""$;
   jed_header = ("\"X-Generator: Jed w/po-mode: http://jedmodes.sourceforge.net/mode/po_mode/)\\n\"");
   
   push_spot_bob ();
   header_arr = strchop (entry_as_str (), '\n', 0);

   _for i (0, length (header_arr)-1, 1)
     {
        ln = header_arr[i];
        if (string_match (ln, "^\\C\"Last-Translator.*", 1))
          ln = name;
        else if (string_match (ln, "^\\C\"Language-Team.*", 1))
          ln = team;
        else if (string_match (ln, "^\\C\"Language:.*", 1))
          ln = lang;
        else if (string_match (ln, "^\\C\"Content-Type.*", 1))
          ln = charset;
        else if (string_match (ln, "^\\C\"Plural-Forms.*", 1))
          ln = plural_header;
        else if (string_match (ln, "^\\C\"X-Generator.*", 1))
          x_header = 1;
        
        header_arr[i] = ln;
     }
   
   if (x_header == 0)
     header_arr = [header_arr, jed_header];

   header = strjoin (header_arr, "\n");
   replace_entry (header);
   pop_spot ();
}

%}}}
%{{{ gettext commands

%% Give entries that have errors the fuzzy flag
private define fuzzy_error_entries ()
{
   variable fp, lines, nos = {}, i;
   
   fp = fopen (gettext_err_msg, "r");
   
   if (fp == NULL) 
     return NULL;
   
   lines = fgetslines (fp);
   lines = lines[where (array_map (Int_Type, &pcre_string_match, lines, ":[0-9]+:"))];
   lines = array_map (Array_Type, &strtok, lines, ":");
   
   _for i (0, length (lines)-1, 1)
     {
        goto_line (integer (lines[i][1]));
        fuzzy_entry ();
        find_entry_delim_end ();
     }
   
   set_po_status_line ();
}

private define popup_gettext_err_msg ()
{
   if (bufferp ("*** Errors ***"))
     delbuf ("*** Errors ***");
   
   recenter (1);
   pop2buf ("*** Errors ***"$);
   () = insert_file (gettext_err_msg);
   insert ("\nEntries where errors were found have been marked fuzzy.\n"+
           "You can now visit them in turn by typing 'f'. Type 'q' to close\n"+
           "this window.");
   set_buffer_modified_flag (0);
   most_mode ();
   bob ();
   flush ("errors were found, try to (V)alidate. Type 'q' to close this window");
}

% Apply the result of a gettext command to the current buffer
private define apply_gettext_cmd_to_buffer ()
{
   variable prg = check_for_prg ("msgcat");
   variable output, exit_status, n, cmd = ();
   
   n = get_current_entry_number ();
   write_buf_to_tmpfile ();
   (output, exit_status) = syscmd_output_to_string (cmd);
   () = delete_file (Po_Tmpfile);

   if (0 == exit_status)
     {
        replace_buffer (output);
        goto_entry (n);
        flush ("cmd successful");
        return 1;
     }
     
   return 0;
}

define toggle_wrap ()
{
   variable wrap_flag = "", cmd = "";
   
   Gettext_Wrap = not (Gettext_Wrap);
   
   if (Gettext_Wrap)
     wrap_flag = "--no-wrap";

   cmd = "msgcat $wrap_flag"$;
   
   ifnot (1 == apply_gettext_cmd_to_buffer ("$cmd $Po_Tmpfile"$))
     flush ("$cmd failed, try to (V)alidate"$);
     
}

%% Compile the current buffer as *.mo
define po_compile ()
{
   variable prg = check_for_prg ("msgfmt"), file, mo_file, tmpfile, homedir;
   
   mo_file = path_sans_extname (path_basename (buffer_filename)) + ".mo";
   write_buf_to_tmpfile ();

   ifnot (0 == system ("$prg -o $mo_file $Po_Tmpfile 2>gettext_err_msg"$))
     popup_gettext_err_msg ();
   else
     flush (sprintf ("%s %s %s", path_basename (buffer_filename),
                     "compiled as", getcwd + mo_file));
   
   () = delete_file (Po_Tmpfile);
}

%% Use the gettext program 'msgunfmt' to decompile a *.mo file and read it
%% into the editor
define po_decompile ()
{
   variable prg = check_for_prg ("msgunfmt");
   variable po_filestr, mo_file, exit_status, fname;
   
   mo_file = read_file_from_mini ("[Decompile] path to *.mo-file:");
   ifnot (strlen (mo_file))
     return;
   
   fname = path_sans_extname (mo_file);
   
   (po_filestr, exit_status) = 
     syscmd_output_to_string ("$prg $mo_file 2>$gettext_err_msg"$);
   
   if (0 == exit_status)
     {
        pop2buf (fname + "-decompiled" + ".po");
        onewindow;
        insert (po_filestr);
        po_mode ();
        bob ();
     }
   else
     popup_gettext_err_msg ();
}

%% Convert to user's preferred character set.
define conv_charset ()
{
   variable filenc = "",  enc = "", cmd = "", buf_file = "", file = "", e = 0;
   variable args = __pop_args(_NARGS);
   variable conv = check_for_prg ("iconv");
   
   EXIT_BLOCK
     {
        () = delete_file (Po_Tmpfile);
     }
   
   if (0 == length (args))
     file = buffer_filename ();
   else
     file = args[0].value;
   
   filenc = get_file_encoding (file);
   (,,,enc) = get_locale_info ();
   
   if ((filenc == enc) || (filenc == "us-ascii"))
     return 1;
   
   flush (sprintf ("recoding %s ...", path_basename (file)));

   if (file == buffer_filename ())
     {
        ifnot (apply_gettext_cmd_to_buffer ("$conv -c -t $enc $Po_Tmpfile 2>/dev/null"$))
          {
             flush ("$conv failed, try to (V)alidate"$);
             return 0;
          }
     }
   else
     {
        e = system ("$conv -o $Po_Tmpfile -c -t $enc $file 2>/dev/null"$);

        ifnot(e == 0)
          {
             flush ("$conv failed , try to (V)alidate"$);
             return 0;
          }

        () = rename (Po_Tmpfile, file);
     }

   flush ("File succesfully recoded from $filenc to $enc"$);
   return 1;
}

%% Update a po-file with a newer message catalog.
define po_update ()
{
   variable prg = check_for_prg ("msgmerge"), newer_file, filenc = "", enc = "";
   variable file = buffer_filename (), oldfile = file + "~";

   newer_file = init_src_dir ();

   ifnot (file_type (newer_file, "reg"))
     throw OpenError, "$newer_file does not exist or is not a regular file"$;

   filenc = get_file_encoding (newer_file);
   (,,,enc) = get_locale_info ();
   
   ifnot (filenc == enc)
     {
        ifnot (conv_charset (newer_file))
          throw RunTimeError, "could not correct encoding for $newer_file"$;
     }
   
   ifnot (0 == system ("cp $file $oldfile"$))
     throw RunTimeError, "could not backup file";
   
   ifnot (0 == system (sprintf ("%s -U %s %s >/dev/null 2>&1",
                                prg, buffer_filename, newer_file)))
     throw RunTimeError, "update failed, try to (V)alidate files";
   
   delbuf (whatbuf ());
   () = find_file (file);
   flush ("old file backed up as $oldfile"$);
}

define flag_fuzzy_all ()
{
   ifnot (get_y_or_n ("Flag all entries fuzzy"$))
     return;

   do
     {
        fuzzy_entry ();
        find_entry_delim_end ();
     }
   while (bol_fsearch ("msgid "));
}

%% Use msgids as translations for all untranslated entries
private define msgid_to_msgstr_all ()
{
   ifnot (apply_gettext_cmd_to_buffer ("msgen $Po_Tmpfile"$))
     throw RunTimeError, "could not copy msgids to msgstrs, try to (V)alidate";
}

%}}}
%{{{ validation

private define check_enc_mismatch ()
{
   variable header_charset = strlow (get_charset_from_header ());
   variable file_charset = strlow (get_file_encoding (buffer_filename ()));
   variable msg = "WARNING: header charset is \"$header_charset\" "$ +
                  "but actual file encoding is \"$file_charset\""$;
   
   ifnot (file_charset == header_charset)
     return msg;
   else
     return "";
}

%% Check case mismatch of the first character as well as mismatch in
%% end punctuation between msgid and msgstr. Flag such entries "fuzzy".
private define orto_mismatch (a, b)
{
   variable a_case = 0, b_case = 0, a_punct, b_punct, punct = "\".,;:!?&'|` ";
   variable res_chars = "|&_";
   
   try
     {
        ifnot ((is_substr (res_chars, a[[0:0]])) || 
               (is_substr (res_chars, b[[0:0]])))
          {
             if ((isalpha (a[0]) && (isalpha (b[0]))))
               {
                  a_case = isupper (substr(a, 1, 1));
                  b_case = isupper (substr(b, 1, 1));
               }
             else 
               {
                  if (a[0] != b[0])
                    return 1;
               }
          }
     }
   catch IndexError;

   a_punct = is_substr (punct, end_char (a));
   b_punct = is_substr (punct, end_char (b));

   return ((a_case != b_case) || (a_punct != b_punct));
}

% %% Mark entries fuzzy where there is a mismatch in end punctuation
% %% in msgid and msgstr or in the case of the first characters.
private define check_orto ()
{
   variable msgids, msgstrs, i, I = Integer_Type[0];

   (, msgids, msgstrs) = create_strs_list (buf_as_str ());
   (, msgids) = array_map (String_Type, String_Type, &sep_kw_and_str, msgids);
   (, msgstrs) = array_map (String_Type, String_Type, &sep_kw_and_str, msgstrs);
   msgids = array_map (String_Type, &trim_quotes, msgids);
   msgstrs = array_map (String_Type, &trim_quotes, msgstrs);
   msgids = strtrim (msgids, "\n");
   msgstrs = strtrim (msgstrs, "\n");
   msgids = msgids[[1:]];
   msgstrs = msgstrs[[1:]];
   
   _for i (0, length (msgids)-1, 1)
     {
        if (is_substr (msgids[i], "|"))
          continue;
        if (orto_mismatch (msgids[i], msgstrs[i]))
          I = [I, i+2];
     }
   
   _for i (0, length (I)-1, 1)
     {
        goto_entry (I[i]);
        fuzzy_entry ();
     }
}

%% Check for a variety of more or less cosmetic errors. Entries
%% where such are found are flagged fuzzy.
define parse_cosmetic_errors ()
{
   variable fb = count ("f"), fa;
   
   push_spot ();
   check_orto ();
   po_statistics ();
   fa = count ("f");
   pop_spot ();
   if (fb == fa)
     return flush ("no problems found");
   recenter (1);
   pop2buf ("Cosmetic errors marked fuzzy");
   insert ("The following errors have been checked for:\n\n" +
           "- case mismatch between the first letters of msgid and msgstr\n" +
           "- inconsistencies in end punctuation/trailing whitespace between\n" +
           "  msgid and msgstr\n\n" +
           "Entries with errors been marked fuzzy\n" +
           "You can now visit each entry in turn with the 'f' key\n" +
           "to correct these errors. Expect an occasional false positive!\n\n" +
           "type 'q' to close this window");

   set_buffer_modified_flag (0);
   most_mode ();
   bob ();
}

define po_validate_command ()
{
   variable cmd = "", enc_err = "", n = 1;
   
   n = get_current_entry_number ();
   write_buf_to_tmpfile ();
   cmd = "msgfmt -o /dev/null 2>&1 --check-accelerators -c -v";
   enc_err = check_enc_mismatch ();

   if (0 == system ("$cmd $Po_Tmpfile 2>$gettext_err_msg"$))
     flush ("validation successful");
   else
     {
        fuzzy_error_entries ();
        goto_entry (n);
        popup_gettext_err_msg ();
     }
   
   if (strlen (enc_err))
     flush (enc_err);
   
   () = delete_file (Po_Tmpfile);
}

%}}}
%{{{ po user comments

private define po_comment_mode ()
{
   set_mode ("po_comment", 0);
   use_keymap ("po_comment");
   set_buffer_undo (1);
}

define edit_comment ()
{
   variable msgid, user_cmts;
   
   Entry = hash_entry ();
   msgid = Entry["msgid"];
   user_cmts = Entry["trans_cmts"];
   user_cmts = strreplace (user_cmts, "\n# ", "\n");
   user_cmts = strtrim_beg (user_cmts, "# ");
   setup_win_layout (Msgid_Buf, msgid, Po_Comment_Buf, user_cmts);
   po_comment_mode ();
}

define finish_comment ()
{
   variable user_cmts = "";

   ifnot (buffer_modified )
     return cancel_edit ();
   
   bob ();

   ifnot (eobp && bobp ())
     {
        do 
          {
             insert ("# ");
          }
        while (down_1 ());
     }

   mark_buffer ();
   user_cmts = bufsubstr_delete ();
   replace_elem ("trans_cmts", user_cmts);
   cancel_edit ();
   replace_entry (assemble_entry (Entry));
}

define del_translator_comment ()
{
   Entry = hash_entry ();
   replace_elem ("trans_cmts", Null_String);
   replace_entry (assemble_entry (Entry));
}

%}}}
%{{{ compendiums

%% Create compendium file if it does not exist.
private define touch_compendium ()
{
   variable fp;
   
   ifnot (1 == file_status (Compendium))
     {
        fp = fopen (Compendium, "a+");
        if (fp == NULL)
          throw IOError, "could not create $Compendium"$;
     }
}

private define hash_compendium ()
{
   ifnot (1 == file_status (Compendium))
     throw RunTimeError, "[hash_compendium] $Compendium does not exist"$;
   
   variable compstr = file_as_str (Compendium);
   
   ifnot (strlen (compstr))
     throw RunTimeError, "[hash_compendium] $Compendium is an empty file"$;
   
   flush ("hashing compendium ...");
   (CompHash,) = hash_msgids_msgstrs (compstr, 0);
   Compendium_Is_Hashed = 1;
}

private define write_compendium_from_hash (comp_hash)
{
   variable msgids, msgstrs, fp, i;
   
   flush ("writing compendium ...");
   msgids = assoc_get_keys (comp_hash);
   ifnot (length (msgids))
     return;
   msgstrs = assoc_get_values (comp_hash);
   i = array_sort (msgids);
   fp = fopen (Compendium, "w+");
   if (fp == NULL)
     throw WriteError, "could not open $Compendium"$;
   () = array_map (Int_Type, &fprintf, fp, "%s\n%s\n\n", msgids[i], msgstrs[i]);
   () = fclose (fp);
}

%% Remove duplicate entries from compendium while always preserving
%% the "immutable" translations
private define del_dups_and_write_comp (compstr)
{
   variable strs = Assoc_Type[String_Type, ""];
   variable msgids, msgstrs, i, enc, e, sz;

   ifnot (strlen (Encoding))
     (,,, enc) = get_locale_info ();

   compstr = strtrim (compstr);
   (, msgids, msgstrs) = create_strs_list (compstr);
   
   flush ("...weeding out entries w/duplicate msgids in compendium ...");

   %% since every key (msgid) in an associative array must be unique,
   %% it is a fast way to remove duplicate msgid entries.
   _for i (0, length (msgids)-1, 1)
     strs[msgids[i]] = msgstrs[i];
   
   % make sure "immutable" translations are preserved
   _for i (0, length (msgstrs)-1, 1)
     if (string_match (msgstrs[i], "@$", 1)) % "@" = "immutable"
       strs[msgids[i]] = msgstrs[i];
   
   write_compendium_from_hash (strs);
}

define set_compendium ()
{
   Compendium = read_with_completion ("Compendium Name:", "", Compendium, 'f');
   Compendium_Is_Hashed = 0;
}

define edit_compendium ()
{
   ifnot (find_file (Compendium))
     throw IOError, "Could not open $Compendium";
   no_mode ();
   set_status_line ("", 0);
}   

define add_buffer_to_compendium ()
{
   variable exit_status, filestr, msgids, msgstrs, i, entry, entries, comp;
   variable prg = check_for_prg ("msgattrib");
   
   touch_compendium ();
   write_buf_to_tmpfile ();
   (filestr, exit_status) = 
     syscmd_output_to_string 
     ("$prg --clear-obsolete --no-fuzzy --translated $Po_Tmpfile 2>/dev/null"$);
   
   () = delete_file (Po_Tmpfile);

   ifnot (0 == exit_status)
     throw RunTimeError, "file did not validate";
   
   (, msgids, msgstrs) = create_strs_list (filestr);
   msgids = msgids[[1:]];
   msgstrs = msgstrs[[1:]];
   
   if (get_y_or_n ("mark all translations \"immutable\""))
     msgstrs = array_map (String_Type, &strcat, msgstrs, "@");
   
   entries = array_map (String_Type, &strcat, msgids, "\n", msgstrs);
   entries = array_map (String_Type, &strtrim, entries);
   entries = strtrim (strjoin (entries, "\n\n"));
   comp = strcat (entries, "\n\n", file_as_str (Compendium));
   del_dups_and_write_comp (comp);
   flush ("done");
}

%% Add a whole directory of po-files to the compendium.
define add_dir_to_compendium ()
{
   variable po_files, idx_succ, idx_fail, conv_status, headers;
   variable i, e, filestr = "", compstr = "", file = "", entries_arr;
   variable prg = check_for_prg ("msgattrib");
   variable conv = check_for_prg ("iconv");
   variable conv_failed = [""], failed_files = [""], msgids, msgstrs;
   
   touch_compendium ();
   dir = read_with_completion ("Directory to add to compendium:", "", "", 'f');
   po_files = pofiles_in_dir (dir);
   po_files = po_files[array_sort (po_files)];
   
   ifnot (length (po_files))
     return flush ("No po files in directory");
   
   flush (sprintf ("checking encodings of %d files ...", length (po_files)));
   conv_status = array_map (Int_Type, &conv_charset, po_files);
   idx_succ = where (conv_status);
   idx_fail = wherenot (conv_status);
   
   ifnot (length (idx_succ))
     throw RunTimeError, "No files were converted succesfully";
   
   conv_failed = po_files[idx_fail];
   po_files = po_files[idx_succ];

   if (length (conv_failed))
     conv_failed = array_map (String_Type, &strcat, conv_failed, ": [encoding errors]");

   _for i (0, length (po_files)-1, 1)
     {
        file = po_files[i];
        (filestr, e) = 
          syscmd_output_to_string ("$prg --clear-obsolete --no-fuzzy --translated $file 2>/dev/null"$);

        ifnot (0 == e)
          {
             failed_files = [failed_files, file + ": [validation errors]"];
             continue;
          }
        ifnot (strlen (filestr))
          {
             failed_files = [failed_files, file + ": [no translated messages]"];
             continue;
          }

        filestr = strtrim (filestr);
        compstr += filestr + "\n\n";
        flush (sprintf ("adding %s (%d of %d file(s)) to compendium ...",
                        path_basename (po_files[i]), i+1, length (po_files)));
     }

   (, msgids, msgstrs) = create_strs_list (compstr);
   headers = where (msgids == "msgid \"\"");
   msgids[headers] = ""; % remove headers
   msgstrs[headers] = "";
   entries_arr = array_map (String_Type, &strcat, msgids, "\n", msgstrs);
   compstr = strjoin (entries_arr, "\n");
   compstr = strcat (file_as_str (Compendium), "\n\n", compstr);
   (entries_arr,) = po2arr (compstr);
   entries_arr = array_map (String_Type, &strtrim, entries_arr);
   compstr = strjoin (entries_arr, "\n");
   if (strlen (compstr))
     del_dups_and_write_comp (compstr);
   failed_files = [failed_files, conv_failed];
   failed_files = strtrim (strjoin (failed_files, "\n"));
   if (strlen (failed_files))
     {
        pop2buf ("Failed to add these files");
        vinsert ("The file(s) below were not added to the " + 
                 "compendium,\neither because they contained " +
                 "no translated messages\nor because they did " +
                 "not validate:\n\n%s\n", failed_files);

        most_mode ();
        bob ();
        flush ("type 'q' to close this window");
     }
   else
     flush ("done");
}

%% Copy a translation from the compendium into the current msgstr
define copy_trans_from_comp ()
{
   variable msgid, msgid_fuzzy, msgstr_c;
   
   ifnot (Compendium_Is_Hashed)
     {
        (CompHash, CompHash_Fuzzy) = 
          hash_msgids_msgstrs (file_as_str (Compendium), 1);
        
        Compendium_Is_Hashed = 1;
     }

   Entry = hash_entry ();
   msgid = Entry["msgid"];
   msgid_fuzzy = del_format_specifiers (msgid);
   msgid_fuzzy = strlow (str_delete_chars (msgid_fuzzy, "^\\w"));

   if (assoc_key_exists (CompHash, msgid))
     msgstr_c = strtrim_end (CompHash[msgid], "@");
   else if (assoc_key_exists (CompHash_Fuzzy, msgid_fuzzy))
     msgstr_c = CompHash_Fuzzy[msgid_fuzzy];
   else
     return flush ("nothing matched");

   ifnot (string_match (Entry["msgstr"], " \"\"$", 1))
     {
        ifnot (get_y_or_n ("overwrite existing translation"))
          return;
     }
   replace_elem ("msgstr", msgstr_c);
   replace_entry (assemble_entry (Entry));
   flush ("entry translated from compendium");
}

%% Copy the current entry to the compendium and mark its msgstr
%% "immutable"
define copy_entry_to_compendium ()
{
   variable msgid, msgstr, msgstr_c, entry;

   (,,msgid, msgstr) = return_str_pair ();
   entry = strcat ("\n", msgid, "\n", msgstr, "@\n");
   
   touch_compendium ();
   
   ifnot (strlen (file_as_str (Compendium)))
     {
        entry = strtrim (entry);
        () = append_string_to_file (entry, Compendium);
        return flush ("entry added to $Compendium"$);;
     }
   else
     {
        ifnot (Compendium_Is_Hashed)
          hash_compendium ();
     }
   
   if (assoc_key_exists (CompHash, msgid))
     {
        if (CompHash[msgid] == msgstr + "@")
          return flush ("an identical translation exists in compendium");
          
        if (get_y_or_n ("Overwrite compendium's translation"))
          CompHash[msgid] = msgstr + "@"; % @ = "immutable"
        else
          return;

        write_compendium_from_hash (CompHash);
     }
   else
     {
        ifnot (append_string_to_file (entry, Compendium))
          throw IOError, "could not add entry to $Compendium"$;
     }

   flush ("entry added to $Compendium"$);
}

%% Fill out all entries in the current po-file with translations of
%% corresponding msgids from compendium.
define init_with_compendium ()
{
   variable i = 1, overwrite = 1;
   variable entries_arr, entries_arr_hash, entries = "", kw = "", kw_0 = "";
   variable msgid_pl = "", comp_hash, comp_hash_fuzzy, msgstr_c_fuzzy;
   variable msgid = "",  msgid_fuzzy = "",  msgstr_c = "", msgstr_c_pl = "";
   
   if (count ("t"))
     overwrite = get_y_or_n ("overwrite existing translations");
   flush ("hashing po-file and compendium ...");
   (comp_hash, comp_hash_fuzzy) = hash_msgids_msgstrs (file_as_str (Compendium), 1);
   entries_arr_hash = create_entries_hash (buf_as_str ());
   flush ("filling out entries ...");

   _for i (1, length (entries_arr_hash)-1, 1) % start "1" = skip header
     {
        msgstr_c = "", msgstr_c_pl = "";
        
        flush (sprintf ("processing entry %d of %d entries ...",
                        i, length (entries_arr_hash)-1));
        ifnot (overwrite)
          {
             ifnot (string_match (entries_arr_hash[i]["msgstr"], " \"\"$", 1))
               continue;
          }
        msgid = entries_arr_hash[i]["msgid"];
        msgid_pl = entries_arr_hash[i]["msgid_plural"];
        (, msgstr_c) = sep_kw_and_str (comp_hash[msgid]);
        msgstr_c_pl = comp_hash[msgid_pl];
        (kw, ) = sep_kw_and_str (entries_arr_hash[i]["msgstr"]);
        (kw_0, ) = sep_kw_and_str (entries_arr_hash[i]["msgstr[0]"]);

        if (strlen (msgstr_c)) % exact matching
          {
             msgstr_c = concat_kw_str (kw, msgstr_c);
             entries_arr_hash[i]["msgstr"] = msgstr_c;
             msgstr_c = concat_kw_str (kw_0, msgstr_c);
             entries_arr_hash[i]["msgstr[0]"] = msgstr_c;
          }
        else % "fuzzy" matching
          {
             msgid_fuzzy = strlow (str_delete_chars (msgid, "^\\w"));
             msgid_fuzzy = del_format_specifiers (msgid_fuzzy);
             msgstr_c_fuzzy = comp_hash_fuzzy[msgid_fuzzy];
             ifnot (strlen (msgstr_c_fuzzy))
               continue;
             (, msgstr_c_fuzzy) = sep_kw_and_str (msgstr_c_fuzzy);
             entries_arr_hash[i]["msgstr"] = 
               concat_kw_str (kw, msgstr_c_fuzzy);
             entries_arr_hash[i]["msgstr[0]"] = 
               concat_kw_str (kw_0, msgstr_c_fuzzy);
             entries_arr_hash[i] = flag_fuzzy (entries_arr_hash[i]);
          }
        if (strlen (msgstr_c_pl))
          entries_arr_hash[i]["msgstr[1]"] = msgstr_c_pl;
     }
   
   entries_arr = array_map (String_Type, &assemble_entry, entries_arr_hash);

   if (length (Obsolete))
     entries_arr = [entries_arr, Obsolete];

   entries = strjoin (entries_arr, "\n\n");
   replace_buffer (entries + "\n");
   flush ("done");
}

%}}}
%{{{ wordlist

%% Danish users only
define hash_wordlist_danish ()
{
   variable url, pos, lines, list, i, anb, key, val;
   
   url = "http://www.klid.dk/dansk/ordlister/ordliste.html";
   list = html_to_txt (url);
   lines = strchop (list, '\n', 0);
   
   _for i (0, length (lines)-1, 1)
     {
        if (string_match (lines[i], "^    ", 1))
          {
             lines[i] = strtrim (lines[i]);
             lines[i-1] = strcat (lines[i-1], " ", lines[i]);
             lines[i] = "";
          }
     }

   lines = lines[where (array_map (Int_Type, &strlen, lines) > 2)];
   lines = lines[wherenot (array_map (Int_Type, &string_match, lines, "^ ", 1))];
   anb = where (array_map (Int_Type, &string_match, lines, "Anbefalede vendinger", 1));
   try
     {
        lines = lines[[:anb[0]-1]];
   
        _for i (0, length (lines)-1, 1)
          {
             pos = string_match (lines[i], "   ", 1);
             key = strtrim (lines[i][[:pos]]);
             val = strtrim (lines[i][[pos:]]);
             Trans_Hash[key] = val;
          }
     }
   catch IndexError;
        
   Trans_Hash_Exists = 1;
}

%% Try to get the stem of certain grammatical categories of words
private define uninflect (word)
{
   variable one, two, three, ending;

   word = strlow (word);
   
   if (string_match (word, "[^t]ied$", 1))
     word = word[[:strbytelen (word)-4]] + "y";

   one = ["s","[^akrt]eted","[^o]u[dnrtu]ed","[^eo][ao][dt]ed","created",
          "[^o]ided","[^i][cv]ited","uired","asted","[iy][sz]ed","[^aou]ined",
          "[ ^e][^l]o[dpsv]ed","[bcgdkptu]led","[^a]i[bckmrv]ed","[^a]iled",
          "[aiy]ped","[cvu]ed","[^e]ared","[lpz]oned","cached","seded",
          "[^o]oked","athed","[^i]a[sz]ed","[^einv]aled","t[er]ed",
          "[^cio][bclnt]ored","[^e][aeu]med","[^ie][a-rt-z]sed","[^i][a-z]ged"];

   two = ["[dhklmnprtwxy]ed","urbed","[ias]sed","inged","ffed"];

   three = ["bbed","edded","gged","kked","mmed","nned","pped","rred",
            "tted","[^a]ttened","[^hpr][bcdenop]lled",
            "ing"];

   foreach ending (three)
     {
        if (string_match (word, ending+"$", 1))
          word = word[[:strbytelen (word)-4]];
     }
   foreach ending (one)
     {
        if (string_match (word, ending+"$", 1))
          word = word[[:strbytelen (word)-2]];
     }
   foreach ending (two)
     {
        if (string_match (word, ending+"$", 1))
          word = word[[:strbytelen (word)-3]];
     }

   return word;
}

private define lookup_wordlist_danish (word)
{
   variable trans = "";
   
   ifnot (Trans_Hash_Exists)
     hash_wordlist_danish ();
   
   if (assoc_key_exists (Trans_Hash, uninflect (word)))
     trans = Trans_Hash[uninflect (word)];
   else if (assoc_key_exists (Trans_Hash, word))
     trans = Trans_Hash[word];
   
   return trans;
}

% Look up translations from The Microsoft Language Portal
private define lookup_microsoft_translation (word)
{
   variable out = "", url = "", trans = String_Type[0], i, beg = 0, end = 0;
   variable pb = 0, pe = 0, tran = "", lang = "", country = "";
   
   (, lang, country, ) = get_locale_info ();
   
   url = "http://www.microsoft.com/language/en-us/Search.aspx?sString=$word&langID=$lang-$country"$;
   out = html_to_txt (url);
   out = strchop (out, '\n', 0);

   _for i (0, length (out)-1, 1)
     {
        if (string_match (out[i], "English.*Translation.*Product", 1))
          {
             pb = string_match (out[i], "Translation", 1);
             pe = string_match (out[i], "Product", 1);
             beg = i+1;
          }
        if (string_match (out[i], "Previous.*Page", 1))
          end = i-1;
     }
   
   out = out[[beg:end]]; % lines with translations only

   _for i (0, length (out)-1, 1)
     {
        try 
          { 
             tran = out[i][[pb-1:pe-2]]; % cut translation from line
          } 
        catch IndexError;
        
        tran = strtrim (strlow (tran));
        
        ifnot (length (where (trans == tran))) % collect translations and
          trans = [trans, tran];               % remove duplicates
     }
   
   if (length (trans))
     trans = strjoin (trans, ", " );
   else
     trans = "";
   
   return trans;
}

define lookup_word ()
{
   variable mw = "", cw = "", word = "", lang = "";
   
   (, lang,,) = get_locale_info ();

   ifnot (strlen (word))
     {
        if (markp ())
          word = bufsubstr ();
        else
          word = po_mark_word ();
      }

   word = str_delete_chars (word, "^\\w");
   word = uninflect (word);
   
   if (lang == "da")
     cw = lookup_wordlist_danish (word);

   if (Use_Microsoft_Wordlist)
     {
        flush ("...");
        mw = lookup_microsoft_translation (word);
     }
   
   if ((strlen (cw)) || (strlen (mw)))
     return flush (cw + " | " + mw);
   
   flush ("no translation found");
}

private define po_mouse_2click_hook (line, col, but, shift)
{
   lookup_word ();
   sleep (2);
   return (0);
}

%}}}
%{{{ msgexec function that takes external commands

private define isolate_msgstrs ()
{
   variable msgstrs, entries_arr, header, entries, kws, obsolete, i;
   
   (,, msgstrs) = create_strs_list (buf_as_str ());
   msgstrs = msgstrs[[1:]]; % don't work on header
   (kws, msgstrs) = array_map (String_Type, String_Type, &sep_kw_and_str, msgstrs);
   msgstrs = array_map (String_Type, &strtrim, msgstrs);

   _for i (0, length (msgstrs)-1, 1)
     {
        ifnot (msgstrs[i] == "\"\"")
          msgstrs[i] = trim_quotes (msgstrs[i]);
     }
   
   msgstrs = strjoin (msgstrs, "\n\n\n");
   return kws, msgstrs;
}

%% Read an array of possibly changed msgstrs back into the po-file
private define assemble_pofile (file, kws, msgstrs)
{
   variable i = 0, n = 0, entries_hash, entries;
   variable msgstr, msgstr_pl;
   
   msgstrs = strreplace (msgstrs, "\t", " ");
   msgstrs = strreplace (msgstrs, "\n\n\n", "\t");
   msgstrs = strchop (msgstrs, '\t', 0);
   _for i (0, length (msgstrs)-1, 1)
     {
        ifnot (msgstrs[i] == "\"\"")
          msgstrs[i] = surround_in_quotes (msgstrs[i]);
     }

   ifnot (length (kws) == length (msgstrs))
     throw RunTimeError, "some error occured $file"$;

   msgstrs = array_map (String_Type, &concat_kw_str, kws, msgstrs);
   entries_hash = create_entries_hash (buf_as_str ());
   
   _for i (1, length (entries_hash)-1, 1)
     {
        ifnot (strlen (entries_hash[i]["msgid_plural"]))
          {
             entries_hash[i]["msgstr"] = msgstrs[n];
             n++;
          }
        else
          {
             entries_hash[i]["msgstr[0]"] = msgstrs[n];
             entries_hash[i]["msgstr[1]"] = msgstrs[n+1];
             n++; n++;
          }
     }

   entries = array_map (String_Type, &assemble_entry, entries_hash);
   
   if (length (Obsolete))
     entries = [entries, Obsolete];
   
   entries = strjoin (entries, "\n\n");
   return entries + "\n";
}

%% Isolate all msgstrs in a single string, run a specified command on
%% them and then assemble them back into the po-file. It means that
%% the command needs only to be executed once. As far as I can tell,
%% gettext's msgfilter program runs the command once for every entry
%% in the po-file.
private define msgexec (cmd, interactive)
{
   variable msgstrs, e, kws, entries, tmpfile = "";
   variable cn = get_current_entry_number ();
   
   (kws, msgstrs) = isolate_msgstrs ();
   tmpfile = make_tmp_file ("/tmp/po_msgexec");
   () = write_string_to_file (msgstrs, tmpfile);

   if (interactive) % for use with e.g. an interactive spell checker
     {
        e = system ("$cmd $tmpfile"$);
        msgstrs = file_as_str (tmpfile);
     }
   else
     (msgstrs, e) = syscmd_output_to_string ("$cmd $tmpfile"$);
   
   () = delete_file (tmpfile);
   
   ifnot (0 == e)
     throw RunTimeError, "$cmd failed!"$;

   entries = assemble_pofile (kws, msgstrs);
   replace_buffer (entries);
   goto_entry (cn);
   update (1);
   flush ("done");
}

%% Use the machine translation system "Apertium" for translation
define apertium ()
{
   variable prg = check_for_prg ("apertium"), msg = "", cmd = "";
   variable pairs = "", pairs_l = "", exts, pair;
   
   if (2 == file_status ("/usr/share/apertium/modes"))
     pairs = listdir ("/usr/share/apertium/modes");
   if (2 == file_status ("/usr/local/share/apertium/modes"))
     pairs_l = listdir ("/usr/local/share/apertium/modes");

   pairs = [pairs, pairs_l];
   
   ifnot (length (pairs))
     throw RunTimeError, "could not find language pairs!";
   
   exts = array_map (String_Type, &path_extname, pairs);
   pairs = pairs[wherenot (array_map (Int_Type, &strcmp, exts, ".mode"))];
   pairs = array_map (String_Type, &path_sans_extname, pairs);
   pairs = strjoin (pairs, ",");
   
   if (get_y_or_n ("Translate file with Apertium"))
     Apertium_Langs = 
     read_with_completion (pairs, "Language pair (<tab> for list):", "$Apertium_Langs"$, "", 's');
   else return;
   
   cmd = "$prg $Apertium_Langs -u <"$;

   if (count ("t"))
     {
        flush ("WARNING: Old translations may be modified!");
        sleep (1);
     }
   
   if (Apertium_Langs[[0:1]] == "en") % if translating from English, then
     msgid_to_msgstr_all ();          % copy msgids to msgstrs
   
   msgexec (cmd, 0);
}

%% Fetch translations for untranslated entries in the po-file to be
%% updated ("def") from a po-file in a language used as the
%% from-language in the language pair ("ref"), then translate those
%% entries with Apertium and merge them into "def", also flagging them
%% fuzzy. The "keep_fuzzy" option will transfer and translate fuzzy
%% entries from "ref" to "def".
define apertium_update (keep_fuzzy)
{
   variable i = 0, n = 0, cmd, e, entry, def, ref;
   variable match, matches = {}, idx_def = {}, msgstrs_apertium, kws;
   variable msgids_ref, msgstrs_ref, entries_hash_def, entries, msgid_def;
   variable msgattrib = check_for_prg ("msgattrib");
   variable tmpfile = make_tmp_file ("/tmp/apertium_update"), refstr = "";
   variable cn = get_current_entry_number ();
   
   EXIT_BLOCK 
     { 
        () = delete_file (tmpfile);
     }
   
   ref = init_src_dir ();
   () = conv_charset (ref);
   
   if (keep_fuzzy)
     cmd = "$msgattrib --clear-fuzzy --translated --no-obsolete $ref"$;
   else
     cmd = "$msgattrib --translated --no-fuzzy --no-obsolete $ref"$;
   
   (refstr, e) = syscmd_output_to_string (cmd);
   
   ifnot (0 == e)
     throw RunTimeError, "$cmd failed!"$;
   
   def = buf_as_str ();
   entries_hash_def = create_entries_hash (def);
   (, msgids_ref, msgstrs_ref) = create_strs_list (refstr);

   _for i (0, length (entries_hash_def)-1, 1)
     {
        msgid_def = entries_hash_def[i]["msgid"];
        match = wherefirst (msgid_def == msgids_ref);
        if (match)
          {
             % only fill out untranslated entries in "def"
             if (entries_hash_def[i]["msgstr"] == "msgstr \"\"")
               {
                  list_append (matches, match);
                  list_append (idx_def, i);
               }
          }
     }
   
   ifnot (length (matches))
     throw RunTimeError,
     "no identical msgids found or no untranslated messages"$;
   
   matches = list_to_array (matches);
   idx_def = list_to_array (idx_def);
   msgstrs_apertium = msgstrs_ref[matches];
   (kws, msgstrs_apertium) = array_map (String_Type, String_Type,
                                        &sep_kw_and_str, msgstrs_apertium);
   msgstrs_apertium = array_map (String_Type, &prep_str, msgstrs_apertium);
   msgstrs_apertium = array_map (String_Type, &strtrim, msgstrs_apertium);
   ifnot (length (kws) == length (msgstrs_apertium))
     throw IndexError, "some error occured";
   msgstrs_apertium = strjoin (msgstrs_apertium, "\n\n\n");
   write_string_to_file (msgstrs_apertium, tmpfile);
   (msgstrs_apertium,) = 
     syscmd_output_to_string ("apertium $Apertium_Langs -u < $tmpfile"$);
   msgstrs_apertium = strreplace (msgstrs_apertium, "\n\n\n", "\v");
   msgstrs_apertium = strchop (msgstrs_apertium, '\v', 0);
   msgstrs_apertium = array_map (String_Type, &post_prep_str, msgstrs_apertium);
   msgstrs_apertium = array_map (String_Type, &concat_kw_str, kws, msgstrs_apertium);
   
   _for i (0, length (idx_def)-1, 1)
     {
        entry = entries_hash_def[idx_def[i]];
        entry["msgstr"] = msgstrs_apertium[n];
        entry = flag_fuzzy (entry);
        entries_hash_def[idx_def[i]] = entry;
        n++;
     }
   
   entries = array_map (String_Type, &assemble_entry, entries_hash_def);
   
   if (length (Obsolete))
     entries = [entries, Obsolete];
   
   entries = strjoin (entries, "\n\n");
   replace_buffer (entries);
   goto_entry (cn);
   po_statistics ();
   update (1);
   flush ("done");
}

%% Replace a word/string with another in the msgstrs
define replace_in_msgstrs (old, new, ask)
{
   variable cmd, prompt, kws, msgstrs, entries;
   variable cn = get_current_entry_number ();
   
   if (ask)
     {
        old = read_mini ("Replace in msgstrs:", Null_String, Null_String);
        prompt = "Replace $old with:"$;
        new = read_mini (prompt, "", "");
     }
        
   ifnot (strlen (new))
     return;
   
   (kws, msgstrs) = isolate_msgstrs ();
   msgstrs = strreplace (msgstrs, old, new);
   entries = assemble_pofile (kws, msgstrs);
   replace_buffer (entries);
}

%% From a list of misspelled words, typing enter on a word will
%% replace it with a corrected one.
define replace_word_from_list ()
{
   variable old = po_mark_word ();
   variable new = read_mini ("Replace \"$old\" with:"$, "", old);
   
   ifnot (strlen (new))
     return;
   
   otherwindow ();
   replace_in_msgstrs (old, new, 0);
   otherwindow (); 
   set_readonly (0);  delete_line (); set_readonly (1);
   set_buffer_modified_flag (0);
   flush ("\"$old\" replaced with \"$new\""$);
}

private define sort_personal_wordlist (Spell_Prg)
{
   variable pers_dict = "", aspell_pers_dict_header = "";
   variable locale = "", lang = "", enc = "", words = "";
   
   (locale, lang,, enc) = get_locale_info ();
   
   if (Spell_Prg == "aspell")
     {
        pers_dict = expand_filename ("~/.aspell.$lang.pws"$);
        aspell_pers_dict_header = "personal_ws-1.1 $lang 0 $enc"$;
     }
   if (Spell_Prg == "hunspell")
     pers_dict = expand_filename ("~/.hunspell_$locale"$);
   
   ifnot (1 == file_status (pers_dict))
     return;

   if (Spell_Prg == "aspell")
     {
        (words,) = syscmd_output_to_string ("tail -n +2 $pers_dict | sort -fu"$);
        words = strcat (aspell_pers_dict_header, "\n", words);
     }
   else
     (words,) = syscmd_output_to_string ("sort -fu $pers_dict"$);

   () = write_string_to_file (words, pers_dict);
}


%% Function to let user add words to the spell checker's personal word list.
define add_word_to_personal_spell_dict ()
{
   variable aspell_pers_dict, hunspell_pers_dict, extra_dict_words;
   variable aspell_pers_dict_header, enc = "", lang = "", locale = "";
   variable word = "";
   
   (locale, lang,, enc) = get_locale_info ();
   
   if (eobp () and bobp ()) 
     return most_exit_most ();
   
   word = strlow (line_as_string ());
   set_readonly (0); delete_line; set_readonly (1);
   if (Spell_Prg == "aspell")
     {
        aspell_pers_dict_header = "personal_ws-1.1 $lang 0 $enc"$;
        aspell_pers_dict = expand_filename ("~/.aspell.$lang.pws"$);
             
        if (1 == file_status (aspell_pers_dict))
          () = append_string_to_file (word, aspell_pers_dict);
        else
          () = append_string_to_file (aspell_pers_dict_header + 
                                      "\n" + word, aspell_pers_dict);

        flush ("\"$word\" added to $aspell_pers_dict"$);
     }
   if (Spell_Prg == "hunspell")
     {
        hunspell_pers_dict = expand_filename ("~/.hunspell_$locale"$);
        () = append_string_to_file (word, hunspell_pers_dict);
        flush ("\"$word\" added to $hunspell_pers_dict"$);
     }

   local_unsetkey ("q");
   local_setkey ("most_exit_most", "q");
}

%% Return an array of available spell checker dictionaries for the
%% chosen spell checker prg.
private define get_available_spell_dicts (spellprg)
{
   variable aspell, hunspell, dicts, e;
   variable tmpfile = make_tmp_file ("/tmp/getspelldicts");
   
   EXIT_BLOCK
     {
        () = delete_file (tmpfile);
     }
   
   if (spellprg == "aspell")
     {
        aspell = check_for_prg ("aspell");
        (dicts, e) = syscmd_output_to_string ("$aspell dump dicts"$);
        dicts = strchop (dicts, '\n', 0);
     }
   if (spellprg == "hunspell")
     {
        hunspell = check_for_prg ("hunspell");
        (dicts, e) = 
          syscmd_output_to_string ("$hunspell -D </dev/null >$tmpfile 2>&1"$);
        dicts = file_as_str (tmpfile);
        dicts = strchop (dicts, '\n', 0);
        dicts = dicts[where (array_map (Int_Type, &string_match, dicts, "^/", 1))];
        dicts = array_map (String_Type, &path_basename, dicts);
        dicts = array_map (String_Type, &strlow, dicts);
     }
   
   ifnot (e == 0)
     throw RunTimeError, "Could not get available dictionaries";
   
   return dicts;
}

%% Use the spell checker programs' feature to list misspelled words and
%% from that list let user correct words in the po-file and add words
%% to the personal word list.
define spellcheck_from_list ()
{
   variable msgstrs, misspelled, exit, words, d, locale;
   variable available_dicts, tmpfile = make_tmp_file ("po_list_misspelled");
   variable spell_cmd, cmd, lang, aspell_pers_dict, hunspell_pers_dict;
   variable del_lst = ["^","\\n"], brk_word_lst = [":","/",".","-"];
   
   EXIT_BLOCK
     {
        () = delete_file (tmpfile);
     }
   
   (locale, lang, , ) = get_locale_info ();
   
   ifnot (strlen (Spell_Prg))
     Spell_Prg = find_prgs_use_first ("hunspell aspell");
   
   Spell_Prg = path_basename (Spell_Prg);
   sort_personal_wordlist (Spell_Prg);
   
   if (Spell_Prg == "hunspell")
     {
        available_dicts = get_available_spell_dicts ("hunspell");
        
        ifnot (any (available_dicts == strlow (locale)))
          throw RunTimeError, "dictionary \"$locale\" not installed"$;
        
        cmd = "$Spell_Prg -l -d $locale,en_US,en_GB < $tmpfile | sort -u 2>/dev/null"$;
     }
   if (Spell_Prg == "aspell")
     {
        available_dicts = get_available_spell_dicts ("aspell");
        aspell_pers_dict = expand_filename ("~/.aspell.$lang.pws"$);
        
        ifnot (any ((available_dicts == strlow (lang)) or
                    (any (available_dicts == strlow (locale)))))
          throw RunTimeError, "dictionary \"$lang\" not installed"$;
        
        if (any (available_dicts == "en"))
          cmd = "$Spell_Prg -W3 --ignore-case list -d $lang < $tmpfile | "$ +
                "$Spell_Prg -W3 --ignore-case list -d en | sort -fu 2>/dev/null"$;
        
        else
          cmd = "$Spell_Prg -W3 --ignore-case list -d $lang < $tmpfile | "$ +
                "sort -fu 2>/dev/null";
     }
   
   (,, msgstrs) = create_strs_list (buf_as_str ());
   msgstrs = array_map (String_Type, String_Type, &sep_kw_and_str, msgstrs);
   msgstrs = array_map (String_Type, &prep_str, msgstrs);
   msgstrs = strjoin (msgstrs, " ");
   msgstrs = del_html_tags (msgstrs);
   msgstrs = del_format_specifiers (msgstrs);
   
   foreach d (del_lst)
     msgstrs = strreplace (msgstrs, d,  "");

   foreach d (brk_word_lst)
     msgstrs = strreplace (msgstrs, d, "\n");

   words = strtok (msgstrs);
   words = words[wherenot (array_map (Int_Type, &string_match, words, "[-~\(\)&\\^_]", 1))];
   words = strjoin (words, " ");
   words = strtok (words, "^\\w");
   words = words[where (array_map (Int_Type, &strlen, words) > 3)];
   msgstrs = strjoin (words, "\n\n");
   () = write_string_to_file (msgstrs, tmpfile);
   (misspelled, exit) = syscmd_output_to_string (cmd);
   
   ifnot (0 == exit)
     throw RunTimeError, "$cmd failed!"$;
   
   ifnot (strlen (misspelled))
     return flush ("$Spell_Prg found no misspelled words"$);

   pop2buf ("***Misspelled Words***");
   insert (misspelled);
   bob ();
   most_mode ();
   set_buffer_modified_flag (0);
   local_setkey ("replace_word_from_list", "^M");
   local_setkey ("add_word_to_personal_spell_dict", "+");
   local_setkey ("set_readonly \(0\); delete_line; set_readonly \(1\);", "-");
   flush ("<enter> to replace word; '+' adds word to personal wordlist; '-' removes word; 'q' closes window");
}

%% Interactively spell check the msgstrs with a chosen spell program.
define spellcheck ()
{
   variable cmd, xterm, lang, locale;

   (locale, lang,,) = get_locale_info ();
   
   ifnot (strlen (Spell_Prg))
     Spell_Prg = find_prgs_use_first ("aspell hunspell");
   
   xterm = find_prgs_use_first 
     ("xterm rxvt gnome-terminal konsole xfce4-termninal eterm aterm kterm");

   if (path_basename (Spell_Prg) == "hunspell")
       cmd = "$xterm -e hunspell -d $locale,en_US,en_GB -c "$;
   
   if (path_basename (Spell_Prg) == "aspell")
     cmd = "$xterm -e $Spell_Prg -W3 --ignore-case -d $lang -c "$;

   msgexec (cmd, 1);
}

%}}}
%{{{ po_diff, compare translations, limit view

%% Retain only user cmts, extracted cmts
private define filter_cmt (cmt)
{
   variable cmt_arr = strchop (cmt, '\n', 0);
   
   cmt_arr = cmt_arr[where (array_map (Int_Type, &pcre_string_match,
                                       cmt_arr, "^#[ ]|^#\\."))];
   cmt_arr = array_map (String_Type, &strtrim, cmt_arr);

   return strtrim (strjoin (cmt_arr, "\n"));
}

%% Use the wdiff prg to create a word diff between two strings
private define po_wdiff (old, new)
{
   variable prg = check_for_prg ("wdiff");
   variable tmp_a = make_tmp_file ("po_wdiff_a");
   variable tmp_b = make_tmp_file ("po_wdiff_b");
   variable word_diff = "", exit_status;
   
   () = write_string_to_file (old, tmp_a);
   () = write_string_to_file (new, tmp_b);
   (word_diff, exit_status) = 
     syscmd_output_to_string ("$prg -n $tmp_a $tmp_b 2>/dev/null"$);
   
   () = delete_file (tmp_a);
   () = delete_file (tmp_b);
   
   return word_diff;
}

private define return_msgid_linenos ()
{
   variable str_arr = strchop (buf_as_str, '\n', 0);
   return wherenot (array_map (Int_Type, &strncmp,  str_arr, "msgid ", 6));
}

private define diffu (old, new)
{
   variable prg = check_for_prg ("diff");
   variable tmp_a = make_tmp_file ("diffu_a");
   variable tmp_b = make_tmp_file ("diffu_b");
   variable diff = "", exit_status;
   variable cmd = "$prg --unified=100 $tmp_a $tmp_b | tail -n +4 2>/dev/null"$;   

   () = write_string_to_file (old, tmp_a);
   () = write_string_to_file (new, tmp_b);
   (diff, exit_status) = syscmd_output_to_string (cmd);
   
   ifnot (0 == exit_status)
     throw RunTimeError, "$cmd failed"$;
   
   () = delete_file (tmp_a);
   () = delete_file (tmp_b);
   
   return diff;
}

private define create_diff (msgstr_old, msgstr_new)
{
   variable diff = "", kw, ll, lines, line;
   
   if ((lines_count (msgstr_new) == 1) ||
       (strlen (msgstr_new) < Wrap))
     {
        diff = strcat ("-", msgstr_old, "\n+", msgstr_new);
     }
   else if ((Multi_Line) || (lines_count (msgstr_new) < 3) ||
            (strlen (msgstr_new) < Wrap))
     {
        diff = diffu (msgstr_old, msgstr_new);
     }
   else %% use wdiff for others
     {
        (kw, msgstr_old) = sep_kw_and_str (msgstr_old);
        (kw, msgstr_new) = sep_kw_and_str (msgstr_new);
        msgstr_old = prep_str (msgstr_old);
        msgstr_new = prep_str (msgstr_new);
        diff = po_wdiff (msgstr_old, msgstr_new);

        %% only changes in whitespace. wdiff does not mark
        %% these up so use diff_u
        ifnot (pcre_string_match (diff, "{+|\\[-"))
          {
             msgstr_old = post_prep_str (msgstr_old);
             msgstr_new = post_prep_str (msgstr_new);
             diff = diff_u (msgstr_old, msgstr_new);
          }
        else
          {
             diff = post_prep_str (diff);
          }

        diff = concat_kw_str (kw, diff);
     }
   
   return diff;
}

%% Produce an easy-to-read diff between two po-files
define po_diff ()
{
   variable msgattrib = check_for_prg ("msgattrib");
   variable wdiff_prg = check_for_prg ("wdiff");
   variable linenos = return_msgid_linenos ();
   variable all_msgids_new, oldfile = "", newfile = "", msgid_new = "";
   variable msgstr_new = "", msgstr_old = "", diff = "", diffs = {};
   variable mod_strs = 0, new_strs = 0, e = 0, i = 0, lineno = 0, n = 0;
   variable oldstr = "", newstr = "", thisfile, wmsg = "";
   variable cmts_old, cmts_new, cmt_new = "", cmt_old = "", cmd = "";
   variable ch, rcs_file = "", ver, all_msgstrs_old, strs_old, strs_new;
   variable all_cmts_new, all_cmts_old, all_msgids_old, all_msgstrs_new;
   variable match_old, match_new, header = "";
   
   EXIT_BLOCK
     {
        () = delete_file (Po_Tmpfile);
     }
   
   if ((count ("u") || count ("f")))
     {
        wmsg =
          "\t(WARNING: New file contained fuzzy or untranslated entries.\n" +
          "\tLine and entry numbers are skewed)";
     }

   (thisfile, dir,,) = getbuf_info (whatbuf ());
   thisfile = dircat (dir, thisfile);
   write_buf_to_tmpfile ();
   newfile = Po_Tmpfile;
   cmd = "$msgattrib --translated --no-fuzzy --no-obsolete $newfile"$;
   (newstr, e) = syscmd_output_to_string (cmd);

   if ((e != 0) || (strlen (newstr) == 0))
     throw RunTimeError, "msgattrib cmd on $newfile failed, try to (V)alidate"$;
   
   ch = get_mini_response 
     ("Diff against: 1. Other version, 2. version in RCS? [1 or 2]");
   if (ch == '2')
     {   
        (rcs_file, ver) = checkout_rcs_file (0);
        oldfile = "/tmp/" + whatbuf () + ",v-$ver"$;
        () = write_string_to_file (rcs_file, oldfile);
     }
   else
     oldfile = read_file_from_mini ("[DIFF] Other file:");

   ifnot (file_type (oldfile, "reg"))
     throw ReadError, "$oldfile not found or is not a regular file"$;
   
   ifnot (conv_charset (oldfile))
     throw RunTimeError, "encoding conversion on $oldfile failed, try to (V)alidate"$;
   
   % The "no-fuzzy" flag here ensures that messages that had the fuzzy
   % flag in the old version are simply treated as new messages
   cmd = "$msgattrib --no-fuzzy --translated --no-obsolete $oldfile"$;
   (oldstr, e) = syscmd_output_to_string (cmd);

   if ((e != 0) || (strlen (oldstr) == 0))
     throw RunTimeError, "msgattrib cmd on $oldfile failed, try to (V)alidate"$;
   
   (all_cmts_old, all_msgids_old, all_msgstrs_old) = create_strs_list (oldstr);
   (all_cmts_new, all_msgids_new, all_msgstrs_new) = create_strs_list (newstr);
   (all_cmts_new, ) = array_align_length (all_cmts_new, all_msgids_new);
   (all_cmts_old, ) = array_align_length (all_cmts_old, all_msgids_old);
   all_cmts_old = array_map (String_Type, &filter_cmt, all_cmts_old);
   all_cmts_new = array_map (String_Type, &filter_cmt, all_cmts_new);
   
   _for i (0, length (all_msgids_new)-1, 1)
     {
        lineno = linenos[i];
        cmt_new = all_cmts_new[i];
        msgstr_new = all_msgstrs_new[i];
        msgid_new = all_msgids_new[i];
        
        % skip [[1:]] instances of identical msgids in the same file (msgctxt)
        if (msgid_new == NULL) 
          continue;
        
        Multi_Line = str_is_multiline (msgid_new);
        
        % check for identical msgid in old and new
        match_old = where (msgid_new == all_msgids_old);
        match_new = where (msgid_new == all_msgids_new);
        
        if (length (match_old))
          {
             cmts_old = all_cmts_old[match_old];
             cmts_new = all_cmts_new[match_new];
             strs_old = all_msgstrs_old[match_old];
             strs_new = all_msgstrs_new[match_new];

             % one or more identical msgids present in the same file
             % (msgctxt entries)
             if (length (match_old) > 1)
               {
                  (strs_old, strs_new) = array_align_length (strs_old, strs_new);
                  
                  % process all identical msgids in the same file
                  _for n (0, length (strs_new)-1, 1)
                    {
                       if (strs_old[n] != strs_new[n])
                         {
                            if (strlen (strs_old[n]))
                              {
                                 diff = create_diff (strs_old[n], strs_new[n]);
                                 diff = strcat (cmts_new[n], "\n", msgid_new, "\n", diff);
                                 diff = strtrim (diff);
                                 diff = sprintf ("\t[modified: entry: %d / line: %d]\n\n%s", match_new[n], linenos[match_new[n]]+1, diff);
                                 mod_strs++;
                              }
                            else
                              {
                                 diff = strcat (cmts_new[n], "\n", msgid_new, "\n", strs_new[n]);
                                 diff = strtrim (diff);
                                 diff = sprintf ("\t[new: entry: %d / line: %d]\n\n%s", i+1, lineno+1, diff);
                                 new_strs++;
                              }
                            
                            list_append (diffs, diff);
                         }
                       else
                         {
                            % a new comment was added
                            if (cmts_old[n] != cmts_new[n])
                              {
                                 diff = strcat (cmts_new[n], "\n", msgid_new, "\n", msgstr_new);
                                 diff = strtrim (diff);
                                 diff = sprintf ("\t[new comment only: entry: %d / line: %d]\n\n%s", match_new[n], linenos[match_new[n]]+1, diff);
                                 list_append (diffs, diff);
                              }
                         }
                    }
             
                  % when encountered again identical msgid in same file
                  % is skipped as per above
                  all_msgids_new[match_new] = NULL;
                  continue;
               }
             else % msgid is unique
               {
                  msgstr_old = all_msgstrs_old[match_old[0]];
                  
                  if (msgstr_old != msgstr_new) % translation was modified
                    {
                       diff = create_diff (msgstr_old, msgstr_new);
                       diff = strcat (cmt_new, "\n", msgid_new, "\n", diff);
                       diff = strtrim (diff);
                       diff = sprintf ("\t[modified: entry: %d / line: %d]\n\n%s", i+1, lineno+1, diff);
                       mod_strs++;
                       list_append (diffs, diff);
                    }
                  else
                    {
                       % neither changes in translation nor a new
                       % message but a new translator comment was
                       % added
                       cmt_old = cmts_old[0];
                       if ((cmt_old != cmt_new) && (strlen (cmt_new)))
                         {        
                            diff = strcat (cmt_new, "\n", msgid_new, "\n", msgstr_new);
                            diff = strtrim (diff);
                            diff = sprintf ("\t[new comment only: entry: %d / line: %d]\n\n%s", i+1, lineno+1, diff);
                            list_append (diffs, diff);
                         }
                    }
               }
          }
        else % msgid is new (not found in old file)
          {
             diff = strcat (cmt_new, "\n", msgid_new, "\n", msgstr_new);
             diff = strtrim (diff);
             diff = sprintf ("\t[new: entry: %d / line: %d]\n\n%s", i+1, lineno+1, diff);
             new_strs++;
             list_append (diffs, diff);
          }
     }
   
   if (length (diffs))
     {
        diffs = list_to_array (diffs);
        diffs = diffs [where (array_map (Integer_Type, &strlen, diffs))];
     }

   if (length (diffs) < 2) % if 1 only header has changed
     return flush ("files are identical");
   
   diffs = strjoin (diffs, "\n\n");
   diffs = strchop (diffs, '\n', 0);

   % some aesthetic indentation
   _for i (0, length (diffs)-1, 1)
     {
        ifnot (pcre_string_match (diffs[i], "^[ +-]+"))
          diffs[i] = strcat (" ", diffs[i]);
     }

   diffs = strjoin (diffs, "\n");
   header =
     "--- $oldfile\n+++ $thisfile\n\n$mod_strs translation(s) have been modified and "$ +
     "\n$new_strs translation(s) are new since the previous version.\n\n"$;
   
   if (strlen (wmsg))
     wmsg += "\n\n";
   
   diffs = strcat (header, wmsg, diffs, "\n");
   diff = read_with_completion ("Save diff to file:", "", whatbuf + ".diff", 'f');

   if (-1 == write_string_to_file (diffs, diff))
     throw WriteError, "writing diffs to $diff_file failed"$;
   
   delete_file (newfile);
   flush ("diff written as $diff"$);
}

%% Create lists of msgids and msgstrs for languages with which to
%% compare.
private define create_cmp_langs_strs_lists ()
{
   variable file, srcdir, podir = "po", files = "", lang, msgids, msgstrs;
   variable lang_arr = strchop (Compare_With_Languages, ',', 0);
   variable i = 0, prg = check_for_prg ("msgcat");

   Po_Dir = init_src_dir ();

   ifnot (length (lang_arr))
     throw UsageError, "You must set the variable \"Compare_With_Languages\"";

   ifnot (file_type (Po_Dir, "dir"))
     throw OpenError, "$Po_Dir does not exist or is not a directory"$;

   ifnot (length (pofiles_in_dir (Po_Dir)))
     throw OpenError, "No po-files in $Po_Dir"$;
     
   _for i (0, length (lang_arr)-1, 1)
     {
        if (path_basename (Po_Dir) == lang_arr[i])
          file = dircat (Po_Dir, whatbuf ());
        else
          file = dircat (Po_Dir, lang_arr[i] + ".po");

        if (0 == file_status (file))
          {
             lang_arr[i] = NULL;
             continue;
          }
        
        (file,) = syscmd_output_to_string ("$prg $file 2>/dev/null"$); % gettext wrap
        files += file;
     }
   
   lang_arr = lang_arr[wherenot (_isnull (lang_arr))];
   
   ifnot (length (lang_arr))
     throw OpenError, "no po-files for comparative language(s) found";
   
   Compare_With_Languages = strjoin (lang_arr, ",");
   (, msgids, msgstrs) = create_strs_list (files);
   StrsLists_Exists = 1;
   
   return (msgids, msgstrs);
}

%% Copy a translation for a chosen msgid from a po-file in another
%% language into the corresponding msgstr. This is bound to a
%% double-click with the mouse or the enter key.
define copy_comparative_trans ()
{
   variable msgstr, msgstr_kw;
   
   ifnot (bol_bsearch ("·"))
     bob ();
   else
     go_down_1 ();
   
   push_mark ();
   
   ifnot (bol_fsearch ("·")) 
     eob ();
   else
     go_left_1 ();
   
   msgstr = post_prep_str (bufsubstr ());
   sw2buf (Po_Buf);
   (, msgstr_kw,,) = return_str_pair ();
   replace_elem (msgstr_kw, msgstr_kw + " " + msgstr);
   replace_entry (assemble_entry (Entry));
   delbuf ("***Matching Translations***");
}

%% See how a msgid is translated in other languages
define compare_translations ()
{
   variable tran = "", trans = String_Type[0], msgid = "", i = 0;
   variable matches, msgids, msgstrs;
   
   ifnot (StrsLists_Exists)
     (Msgids, Msgstrs) = create_cmp_langs_strs_lists ();
   
   ifnot (Gettext_Wrap)
     {
        ifnot (apply_gettext_cmd_to_buffer ("msgcat $Po_Tmpfile"$))
          throw RunTimeError, "msgcat failed, try to (V)alidate";
        
        set_buffer_modified_flag (0);
        Gettext_Wrap = 1;
     }

   msgid = msgid_as_str ();
   matches = where (msgid == Msgids);
   msgids = Msgids[matches];
   msgstrs = Msgstrs[matches];
   (, msgids) = array_map (String_Type, String_Type, &sep_kw_and_str, msgids);
   (, msgstrs) = array_map (String_Type, String_Type, &sep_kw_and_str, msgstrs);
   msgids = array_map (String_Type, &prep_str, msgids);
   msgstrs = array_map (String_Type, &prep_str, msgstrs);
   trans = array_map (String_Type, &strcat, msgstrs, "\n·");
   trans = strjoin (trans, "\n");
   trans = strtrim (trans, "· \n");
   (, msgid) = sep_kw_and_str (msgid);
   msgid = prep_str (msgid);
   trans = msgid + "\n·\n" + trans;
   pop2buf ("***Matching Translations***");
   onewindow ();
   insert (trans);
   set_buffer_modified_flag (0);
   bob ();
   most_mode ();
   set_buffer_hook ("mouse_2click", &copy_comparative_trans ());
   local_setkey ("copy_comparative_trans", "^M");
   do
     {
        if (looking_at ("·")) 
          { 
             go_left_1;
             break;
          }
        set_line_color (7);
     }
   while (down_1);
   create_syntax_table ("comptrans");
   dfa_define_highlight_rule ("^·$", "keyword", "comptrans");
   dfa_build_highlight_table ("comptrans");
   use_syntax_table ("comptrans");
   use_dfa_syntax (1);
   flush ("type 'q' to close this window");
}

%% Toggle limitation of display to entries containing an expression
%% This will also limit to expressions that cross lines.
define limit_view ()
{
   variable hits, entry_arr, miss, misses, expr = "";

   Entry_No = get_current_entry_number ();
   
   if (get_blocal_var ("View_Limit") == 1)
     {
        mark_buffer ();
        set_region_hidden (0);
        set_blocal_var (0, "View_Limit");
        set_po_status_line ();
        return goto_entry (Entry_No);
     }

   if (markp ())
     expr = bufsubstr ();
   else 
     expr = read_mini ("Limit to <regexp>:", expr, "");

   ifnot (strlen (expr)) 
     return;

   (entry_arr,) = po2arr (buf_as_str ());
   hits = where (array_map (Int_Type, &string_match, entry_arr, "\\C" + expr, 1));
   misses = wherenot (array_map (Int_Type, &string_match, entry_arr, "\\C" + expr, 1));

   ifnot (length (hits))
     return flush ("no entries match \"$expr\""$);
   
   ifnot (length (misses))
     return flush ("all entries match \"$expr\""$);
   
   foreach miss (misses)
     {
        bob ();
        loop (miss+1)
          {
             () = bol_fsearch ("msgid ");
             eol ();
          }
        find_entry_delim_beg ();
        push_visible_mark ();
        find_entry_delim_end ();
        go_left_1 ();
        set_region_hidden (1);
     }

   push_mark,eob ();
   set_region_hidden (1);
   set_blocal_var (1, "View_Limit");
   set_status_line (sprintf ("(PO) Limit: %d entries matching \"%s\" ('l' unlimits)", length (hits), expr), 0);
   bob ();
   flush ("Limit view is active, type 'l' to unlimit");
}

%}}}
%{{{ menu

private define po_menu (menu)
{
   menu_append_popup (menu, "&Navigate");
   $0 = menu + ".&Navigate";
     {
        menu_append_item ($0, "Next Entry", "po_next_entry");
        menu_append_item ($0, "Previous Entry", "po_previous_entry");
        menu_append_item ($0, "Any Next Unfinished", "any_next_unfinished");
        menu_append_item ($0, "Next Untranslated", "find_msgstr (1, 0)");
        menu_append_item ($0, "Previous Untranslated", "find_msgstr (-1, 0)");
        menu_append_item ($0, "Next Translated", "find_msgstr (1, 1)");
        menu_append_item ($0, "Previous Translated", "find_msgstr (-1, 1)");
        menu_append_item ($0, "Next Fuzzy", "find_fuzzy");
        menu_append_item ($0, "Previous Fuzzy", "bfind_fuzzy");
        menu_append_item ($0, "Next Obsolete", "find_obsolete");
        menu_append_item ($0, "Next Translator Comment", "find_translator_comment");
        menu_append_item ($0, "Go to Entry Number", "goto_entry (-1)");
        menu_append_item ($0, "Show Current Entry Number", "show_current_entry_number");
        menu_append_item ($0, "Top Justify Entry", "top_justify_entry");
     }
   menu_append_popup (menu, "&Modify");
   $1 = menu + ".&Modify";
     {
        menu_append_item ($1, "Undo",  "po_undo");
        menu_append_item ($1, "Edit Msgstr", "po_edit");
        menu_append_item ($1, "Replace Headers", "replace_headers (1)");
        menu_append_item ($1, "Copy Msgstr", "copy_msgstr");
        menu_append_item ($1, "Insert Msgstr", "insert_msgstr");
        menu_append_item ($1, "Copy Msgid To Msgstr", "copy_msgid_to_msgstr");
        menu_append_item ($1, "Cut Msgstr", "cut_msgstr");
        menu_append_item ($1, "Flag Entry As Fuzzy", "fuzzy_entry ()");
        menu_append_item ($1, "Flag All Entries Fuzzy", "flag_fuzzy_all");
        menu_append_item ($1, "Remove Fuzzy Flag", "remove_fuzzy_flag");
        menu_append_item ($1, "Delete Obsolete Entries", "del_obsolete_entries");
        menu_append_item ($1, "Edit Comment", "edit_comment");
        menu_append_item ($1, "Delete Comment", "del_translator_comment");
        menu_append_item ($1, "Edit Entire File", "exit_po_mode");
        menu_append_item ($1, "Interactive Spell Check", "spellcheck");
        menu_append_item ($1, "List and Correct Mispelled Words", "spellcheck_from_list");
        menu_append_item ($1, "Replace in Msgstrs", "replace_in_msgstrs (Null_String, Null_String, 1)");
        menu_append_item ($1, "Translate w/Apertium", "apertium");
        menu_append_item ($1, "Update Untranslated w/Apertium", "apertium_update (0)");
        menu_append_item ($1, "Update Untranslated/Use Fuzzy w/Apertium", "apertium_update (1)");
     }
   menu_append_popup (menu, "&Gettext functions");
   $2 = menu + ".&Gettext functions";
     {
        menu_append_item ($2, "Compile *.po -> *.mo", "po_compile");
        menu_append_item ($2, "Decompile *.mo -> *.po", "po_decompile");
        menu_append_item ($2, "Validate", "po_validate_command");
        menu_append_item ($2, "Update", "po_update");
        menu_append_item ($2, "Toggle wrap", "toggle_wrap");
        menu_append_item ($2, "Change Encoding", "conv_charset");
     }
   menu_append_popup (menu, "&Compendiums and Wordlists");
   $3 = menu + ".&Compendiums and Wordlists";
     {
        menu_append_item ($3, "Add Buffer To Compendium(s)", "add_buffer_to_compendium");
        menu_append_item ($3, "Add Dir to Compendium(s)", "add_dir_to_compendium");
        menu_append_item ($3, "Initialize w/Compendium(s)", "init_with_compendium");
        menu_append_item ($3, "Fill Trans From Gettext Compendium (exact match)", "copy_trans_from_comp");
        menu_append_item ($3, "Copy Entry to Compendium", "copy_entry_to_compendium");
        menu_append_item ($3, "Set Compendium", "set_compendium");
        menu_append_item ($3, "Edit Compendium", "edit_compendium");
        menu_append_item ($3, "Look up word in wordlist", "lookup_word");
     }
   menu_append_item (menu, "Show Help",  "show_help");
   menu_append_item (menu, "Statistics", "show_po_statistics");
   menu_append_item (menu, "Set Source Path", "set_source_path");
   menu_append_item (menu, "View Source Reference", "view_source");
   menu_append_item (menu, "Grep In Source Directory", "grep_src");
   menu_append_item (menu, "Compare Translation To Others", "compare_translations");
   menu_append_item (menu, "Parse Cosmetic Errors", "parse_cosmetic_errors");
   menu_append_item (menu, "Toggle Limited View", "limit_view");
   menu_append_item (menu, "Check In File w/RCS", "check_in_file");
   menu_append_item (menu, "Check Out File w/RCS", "checkout_rcs_file (1)");
   menu_append_item (menu, "Count Words & Characters", "count_words_and_chars");
   menu_append_item (menu, "Send Bug Report", "reportbug");
}

private define po_edit_menu (menu)
{
   menu_append_item (menu, "Finish Editing",         "po_end_edit");
   menu_append_item (menu, "Discard Changes",        "del_editbuf");
}

%}}}
%{{{ mode definitions

%% Environment for the editing buffer.
private define po_edit_mode ()
{
   set_abbrev_mode (1);
   if (abbrev_table_p (Edit_Mode)) use_abbrev_table (Edit_Mode);
   mode_set_mode_info (Edit_Mode, "init_mode_menu", &po_edit_menu);
   set_buffer_modified_flag (0);
   set_buffer_undo (1);
   use_keymap (Edit_Mode);
   run_mode_hooks ("po_edit_mode_hook");
   set_buffer_hook ("wrap_hook", &po_edit_wrap_hook);
}

private define create_edit_buf ()
{
   if (bufferp (Edit_Buf))
     return;
   setbuf (Edit_Buf);
   po_edit_mode ();
   setbuf (Po_Buf);
}

public define po_mode ()
{
   no_mode ();
   set_mode (Mode, 0);
   use_keymap (Mode);
   use_syntax_table (Mode);
   use_dfa_syntax (1);
   mode_set_mode_info (Mode, "init_mode_menu", &po_menu);
   create_blocal_var ("View_Limit");
   set_blocal_var (0, "View_Limit");
   untab_buffer ();
   parse_blank_lines ();
   
   if (eobp () and bobp ())
     insert_po_header ();
   
   set_readonly (1);
   create_edit_buf ();
   set_buffer_modified_flag (0);
   po_statistics ();
   set_buffer_hook("mouse_2click", &po_mouse_2click_hook ());
   run_mode_hooks ("po_mode_hook");
   flush ("F10 -> Mode, gives you access to menu functions. Type '?' for help");
}
add_to_hook ("_jed_find_file_after_hooks", &conv_charset);

%}}}
%{{{ po_edit, po_end_edit

define po_edit ()
{
   variable msgid, msgstr, msgstr_kw;
   
   Buf = whatbuf ();
   
   ifnot (bufferp (Edit_Buf))
     create_edit_buf ();
   
   (,, msgid, msgstr) = return_str_pair ();
   Multi_Line = str_is_multiline (msgid);
   Msgid_Has_End_Newline = str_has_end_newline (msgid);
   
   ifnot (strlen (msgid))
     throw UsageError, "not on a valid entry";
   
   (, msgid) = sep_kw_and_str (msgid);
   (Last_Edited, msgstr) = sep_kw_and_str (msgstr);
   msgid = prep_str (msgid);
   Msgid_Has_Beg_Newline = str_has_beg_newline (msgid);
   msgstr = prep_str (msgstr);
   setup_win_layout (Msgid_Buf, msgid, Edit_Buf, msgstr);
   setbuf (Msgid_Buf);
   setbuf (Edit_Buf);
   
   if (bobp () && eobp ())
     Translation_Status = 0;
   else
     Translation_Status = 1;
}

%% This function is run after finishing the translation
define po_end_edit ()
{
   variable msgstr, status = 0;
   
   if (eobp () && bobp () && 0 == Translation_Status)
     return cancel_edit ();

   if (eobp () && bobp () && 1 == Translation_Status)
     status = -1;
   if (not (eobp () && bobp ()) && 0 == Translation_Status)
     status = 1;
   
   mark_buffer ();
   msgstr = bufsubstr_delete ();
   msgstr = post_prep_str (msgstr);
   replace_elem (Last_Edited, concat_kw_str (Last_Edited, msgstr));
   cancel_edit ();
   
   if (status == -1)
     {
        count ("t-");
        count ("u+");
     }
   if (status == 1)
     {
        count ("t+");
        if (count ("u") > 0) count ("u-");
     }

   sw2buf (Buf); 
   replace_entry (assemble_entry (Entry));
}

%}}}
%{{{ keymaps

ifnot (keymap_p ("po_comment"))
{
   make_keymap ("po_comment");
   definekey ("finish_comment", "\t", "po_comment");
   definekey_reserved ("finish_comment", "^C", "po_comment");
   definekey_reserved ("cancel_edit", "^K", "po_comment");
}

ifnot (keymap_p (Mode))
{
   make_keymap (Mode);
   definekey ("copy_entry_to_compendium", "+", Mode);
   definekey ("copy_trans_from_comp", "/", Mode);
   definekey ("lookup_word", "d", Mode);
   definekey ("wordlist_lookup_all", "W", Mode);
   definekey ("po_decompile", "C", Mode);
   definekey ("find_translator_comment", "\e#", Mode);
   definekey ("apertium", "A", Mode);
   definekey ("show_current_entry_number", "@", Mode);
   definekey ("top_justify_entry", ".", Mode);
   definekey ("po_undo", "_", Mode);
   definekey ("edit_comment", "#", Mode);
   definekey ("show_po_statistics", "=", Mode);
   definekey ("show_help", "?", Mode);
   definekey ("find_fuzzy", "f", Mode);
   definekey ("bfind_fuzzy", "F", Mode);
   definekey ("goto_entry (-1)", "g", Mode);
   definekey ("grep_src", "G", Mode);
   definekey ("count_words_and_chars", "I", Mode);
   definekey ("limit_view", "l", Mode);
   definekey ("compare_translations", "m", Mode);
   definekey ("po_next_entry", "n", Mode);
   definekey ("any_next_unfinished", " ", Mode);
   definekey ("po_previous_entry", "p", Mode);
   definekey ("po_compile", "c", Mode);
   definekey ("copy_msgstr", "w", Mode);
   definekey ("insert_msgstr", "y", Mode);
   definekey ("po_diff", "D", Mode);
   definekey ("exit_po_mode", "E", Mode);
   definekey ("replace_headers (1)", "H", Mode);
   definekey ("find_obsolete", "o", Mode);
   definekey ("view_source", "s", Mode);
   definekey ("replace_in_msgstrs (Null_String, Null_String, 1)", "R", Mode);
   definekey ("spellcheck_from_list", "L", Mode);
   definekey ("set_source_path", "S", Mode);
   definekey ("find_msgstr (1, 1)", "t", Mode);
   definekey ("find_msgstr (-1, 1)", "T", Mode);
   definekey ("find_msgstr (1, 0)", "u", Mode);
   definekey ("find_msgstr (-1, 0)", "U", Mode);
   definekey ("po_validate_command", "V", Mode);
   definekey ("po_edit", "\t", Mode); % tab
   definekey ("po_edit", "^M", Mode); % enter
   definekey ("fuzzy_entry ()", Key_BS, Mode); % backspace
   definekey ("remove_fuzzy_flag", Key_Alt_BS, Mode);
   definekey ("copy_msgid_to_msgstr", "\e^m", Mode);
   definekey ("toggle_wrap", "\\", Mode);
   definekey_reserved ("check_in_file", "i", Mode);
   definekey_reserved ("checkout_rcs_file (1)", "o", Mode);
   definekey_reserved ("set_compendium", "p", Mode);
   definekey_reserved ("init_with_compendium", "c", Mode);
   definekey_reserved ("edit_compendium", "E", Mode);
   definekey_reserved ("add_buffer_to_compendium", "a", Mode);
   definekey_reserved ("apertium_update (0)", "A", Mode);
   definekey_reserved ("apertium_update (1)", "F", Mode);
   definekey_reserved ("add_dir_to_compendium", "d", Mode);
   definekey_reserved ("del_translator_comment", "#", Mode);
   definekey_reserved ("parse_cosmetic_errors", ".", Mode);
   definekey_reserved ("cut_msgstr", "k", Mode);
   definekey_reserved ("spellcheck", "s", Mode);
   definekey_reserved ("conv_charset", "e", Mode);
   definekey_reserved ("flag_fuzzy_all", "z", Mode);
   definekey_reserved ("po_update", "u", Mode);
   definekey_reserved ("del_obsolete_entries", "O", Mode);
}

ifnot (keymap_p ("Po_Edit"))
{
   make_keymap ("Po_Edit");
   definekey ("cancel_edit", "^c^k", Edit_Mode); % emacs-like
   definekey ("po_end_edit", "^c^c", Edit_Mode); % emacs-like
   definekey ("po_end_edit", "\t", Edit_Mode);
}

%}}}

provide (Mode);
