Re: Emacs i18n

[Juri Linkov <juri@linkov.net>]

[-- Attachment #1: Type: text/plain, Size: 825 bytes --]

>> It seems pretty good.  When installing it, it should not use
>> `advice-add'.  Rather, `message' should call a list of functions.
>
> Unfortunately, past discussions didn't lead to any significant
> progress wrt this.

My intention was to fix the bug which manifests itself in
grammatically incorrect sentences displayed by ‘message’ like

  Deleted 1 matching lines
  1 matches found
  ...

After searching for available packages I found only this page
https://savannah.nongnu.org/projects/emacs-i18n
that shows no progress for many years.

So here is a patch that fixes the bug by translating currently
invalid messages into grammatically correct English.  It also
opens the gate towards translation of messages in many languages.
Currently this feature is activated by (require 'i18n-message):

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: i18n-message.patch --]
[-- Type: text/x-diff, Size: 10283 bytes --]

diff --git a/lisp/replace.el b/lisp/replace.el
index 59ad1a375b..b05bb51353 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -986,6 +986,12 @@ flush-lines
     (when interactive (message "Deleted %d matching lines" count))
     count))
 
+(eval-after-load "i18n-message"
+  '(i18n-add-translation "English"
+                         "Deleted %d matching lines"
+                         '("Deleted %d matching line"
+                           "Deleted %d matching lines")))
+
 (defun how-many (regexp &optional rstart rend interactive)
   "Print and return number of matches for REGEXP following point.
 When called from Lisp and INTERACTIVE is omitted or nil, just return
@@ -1032,11 +1038,15 @@ how-many
 	(if (= opoint (point))
 	    (forward-char 1)
 	  (setq count (1+ count))))
-      (when interactive (message "%d occurrence%s"
-				 count
-				 (if (= count 1) "" "s")))
+      (when interactive (message "%d occurrences" count))
       count)))
 
+(eval-after-load "i18n-message"
+  '(i18n-add-translation "English"
+                         "%d occurrences"
+                         '("%d occurrence"
+                           "%d occurrences")))
+
 \f
 (defvar occur-menu-map
   (let ((map (make-sparse-keymap)))
@@ -2730,10 +2740,7 @@ perform-replace
                                            (1+ num-replacements))))))
                              (when (and (eq def 'undo-all)
                                         (null (zerop num-replacements)))
-                               (message "Undid %d %s" num-replacements
-                                        (if (= num-replacements 1)
-                                            "replacement"
-                                          "replacements"))
+                               (message "Undid %d replacements" num-replacements)
                                (ding 'no-terminate)
                                (sit-for 1)))
 			   (setq replaced nil last-was-undo t last-was-act-and-show nil)))
@@ -2859,9 +2866,8 @@ perform-replace
                       last-was-act-and-show     nil))))))
       (replace-dehighlight))
     (or unread-command-events
-	(message "Replaced %d occurrence%s%s"
+	(message "Replaced %d occurrences%s"
 		 replace-count
-		 (if (= replace-count 1) "" "s")
 		 (if (> (+ skip-read-only-count
 			   skip-filtered-count
 			   skip-invisible-count)
@@ -2883,6 +2889,16 @@ perform-replace
 		   "")))
     (or (and keep-going stack) multi-buffer)))
 
+(eval-after-load "i18n-message"
+  '(i18n-add-translations
+    "English"
+    '(("Undid %d replacements"
+       ("Undid %d replacement"
+        "Undid %d replacements"))
+      ("Replaced %d occurrences%s"
+       ("Replaced %d occurrence%s"
+        "Replaced %d occurrences%s")))))
+
 (provide 'replace)
 
 ;;; replace.el ends here
diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el
index 3fd2a7e701..d2d748fca3 100644
--- a/lisp/progmodes/grep.el
+++ b/lisp/progmodes/grep.el
@@ -459,7 +459,7 @@ grep-mode-font-lock-keywords
      ;; remove match from grep-regexp-alist before fontifying
      ("^Grep[/a-zA-z]* started.*"
       (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t))
-     ("^Grep[/a-zA-z]* finished with \\(?:\\(\\(?:[0-9]+ \\)?matches found\\)\\|\\(no matches found\\)\\).*"
+     ("^Grep[/a-zA-z]* finished with \\(?:\\(\\(?:[0-9]+ \\)?match\\(?:es\\)? found\\)\\|\\(no matches found\\)\\).*"
       (0 '(face nil compilation-message nil help-echo nil mouse-face nil) t)
       (1 compilation-info-face nil t)
       (2 compilation-warning-face nil t))
@@ -561,6 +561,12 @@ grep-exit-message
 	     (cons msg code)))
     (cons msg code)))
 
+(eval-after-load "i18n-message"
+  '(i18n-add-translation "English"
+                         "finished with %d matches found\n"
+                         '("finished with %d match found\n"
+                           "finished with %d matches found\n")))
+
 (defun grep-filter ()
   "Handle match highlighting escape sequences inserted by the grep process.
 This function is called from `compilation-filter-hook'."
diff --git a/lisp/international/i18n-message.el b/lisp/international/i18n-message.el
new file mode 100644
index 0000000000..14755966e0
--- /dev/null
+++ b/lisp/international/i18n-message.el
@@ -0,0 +1,118 @@
+;;; i18n-message.el --- internationalization of messages  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2019 Free Software Foundation, Inc.
+
+;; Author: Juri Linkov <juri@linkov.net>
+;; Maintainer: emacs-devel@gnu.org
+;; Keywords: i18n, multilingual
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(defcustom i18n-fallbacks
+  '(("en" "English"))
+  "An alist mapping the current language to possible fallbacks.
+Each element should look like (\"LANG\" . FALLBACK-LIST), where
+FALLBACK-LIST is a list of languages to try to find a translation."
+  :type '(alist :key-type (string :tag "Current language")
+                :value-type (repeat :tag "A list of fallbacks" string))
+  :group 'i18n
+  :version "27.1")
+
+(defvar i18n-dictionaries (make-hash-table :test 'equal))
+
+(defun i18n-add-dictionary (lang)
+  (unless (gethash lang i18n-dictionaries)
+    (puthash lang (make-hash-table :test 'equal) i18n-dictionaries)))
+
+;;;###autoload
+(defun i18n-add-translation (lang from to)
+  (let ((dict (gethash lang i18n-dictionaries)))
+    (unless dict
+      (setq dict (i18n-add-dictionary lang)))
+    (puthash from to dict)))
+
+;;;###autoload
+(defun i18n-add-translations (lang translations)
+  (dolist (translation translations)
+    (i18n-add-translation lang (nth 0 translation) (nth 1 translation))))
+
+(defun i18n-get-plural (lang n)
+  ;; Source: (info "(gettext) Plural forms")
+  (pcase lang
+    ((or "Japanese" "Vietnamese" "Korean" "Thai")
+     0)
+    ((or "English" "German" "Dutch" "Swedish" "Danish" "Norwegian"
+         "Faroese" "Spanish" "Portuguese" "Italian" "Bulgarian" "Greek"
+         "Finnish" "Estonian" "Hebrew" "Bahasa Indonesian" "Esperanto"
+         "Hungarian" "Turkish")
+     (if (/= n 1) 1 0))
+    ((or "Brazilian Portuguese" "French")
+     (if (> n 1) 1 0))
+    ((or "Latvian")
+     (if (and (= (% n 10) 1) (/= (% n 100) 11)) 0 (if (/= n 0) 1 2)))
+    ((or "Gaeilge" "Irish")
+     (if (= n 1) 0 (if (= n 2) 1 2)))
+    ((or "Romanian")
+     (if (= n 1) 0 (if (or (= n 0) (and (> (% n 100) 0) (< (% n 100) 20))) 1 2)))
+    ((or "Lithuanian")
+     (if (and (= (% n 10) 1) (/= (% n 100) 11)) 0
+       (if (and (>= (% n 10) 2) (or (< (% n 100) 10) (>= (% n 100) 20))) 1 2)))
+    ((or "Russian" "Ukrainian" "Belarusian" "Serbian" "Croatian")
+     (if (and (= (% n 10) 1) (/= (% n 100) 11)) 0
+       (if (and (>= (% n 10) 2) (<= (% n 10) 4) (or (< (% n 100) 10) (>= (% n 100) 20))) 1 2)))
+    ((or "Czech" "Slovak")
+     (if (= n 1) 0 (if (and (>= n 2) (<= n 4)) 1 2)))
+    ((or "Polish")
+     (if (= n 1) 0
+       (if (and (>= (% n 10) 2) (<= (% n 10) 4) (or (< (% n 100) 10) (>= (% n 100) 20))) 1 2)))
+    ((or "Slovenian")
+     (if (= (% n 100) 1) 0 (if (= (% n 100) 2) 1 (if (or (= (% n 100) 3) (= (% n 100) 4)) 2 3))))
+    ((or "Arabic")
+     (if (= n 0) 0 (if (= n 1) 1 (if (= n 2) 2 (if (and (>= (% n 100) 3) (<= (% n 100) 10)) 3
+                                                 (if (>= (% n 100) 11) 4 5))))))))
+
+(defun i18n-get-translation (format-string &rest args)
+  (let* ((lang current-language-environment)
+	 (fallbacks (cdr (assoc lang i18n-fallbacks)))
+	 dict found)
+    (while (and (not found) lang)
+      (when (setq dict (gethash lang i18n-dictionaries))
+	(setq found
+              (pcase (gethash format-string dict)
+		((and (pred functionp) f) (apply f format-string args))
+		((and (pred stringp) s) s)
+		((and (pred consp) l)
+		 (let ((n (i18n-get-plural lang (car args))))
+		   (when n (nth n l)))))))
+      (unless found
+	(setq lang (pop fallbacks))))
+    (or found format-string)))
+
+(defun i18n-message-translate (&rest args)
+  (apply 'i18n-get-translation args))
+
+(defvar message-translate-function)
+
+(setq message-translate-function 'i18n-message-translate)
+
+(provide 'i18n-message)
+;;; i18n-message.el ends here
diff --git a/src/editfns.c b/src/editfns.c
index bffb5db43e..f517679576 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -3050,6 +3050,14 @@ produced text.
 usage: (format STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
+  if (!NILP (Vmessage_translate_function) && nargs > 0)
+    {
+      Lisp_Object format = apply1 (Vmessage_translate_function,
+				   Flist (nargs, args));
+      if (STRINGP (format))
+	args[0] = format;
+    }
+
   return styled_format (nargs, args, false);
 }
 
@@ -3066,6 +3074,14 @@ and right quote replacement characters are specified by
 usage: (format-message STRING &rest OBJECTS)  */)
   (ptrdiff_t nargs, Lisp_Object *args)
 {
+  if (!NILP (Vmessage_translate_function) && nargs > 0)
+    {
+      Lisp_Object format = apply1 (Vmessage_translate_function,
+				   Flist (nargs, args));
+      if (STRINGP (format))
+	args[0] = format;
+    }
+
   return styled_format (nargs, args, true);
 }
 
@@ -4462,6 +4478,11 @@ of the buffer being accessed.  */);
 functions if all the text being accessed has this property.  */);
   Vbuffer_access_fontified_property = Qnil;
 
+  DEFVAR_LISP ("message-translate-function",
+	       Vmessage_translate_function,
+	       doc: /* Function that translates messages.  */);
+  Vmessage_translate_function = Qnil;
+
   DEFVAR_LISP ("system-name", Vsystem_name,
 	       doc: /* The host name of the machine Emacs is running on.  */);
   Vsystem_name = cached_system_name = Qnil;