feat: translation works as expected

reverso.el

@@ -32,12 +32,14 @@
 (require 'transient)
 (require 'url-util)
 
+(declare-function evil-define-key* "evil-core")
+
 (defgroup reverso nil
   "Client for the https://reverso.net translation service."
   :group 'applications)
 
 (defface reverso-highlight-face
-  '((t (:inherit bold)))
+  '((t (:inherit underline)))
   "Face for highlighting selected words in translation."
   :group 'reverso)
 
@@ -46,6 +48,16 @@
   "Face for highlighting errors in grammar check."
   :group 'reverso)
 
+(defface reverso-heading-face
+  '((t (:inherit transient-heading)))
+  "Face for heading in reverso buffers."
+  :group 'reverso)
+
+(defface reverso-language-face
+  '((t (:inherit transient-value)))
+  "Face for language names in reverso buffers."
+  :group 'reverso)
+
 (defcustom reverso-max-display-lines-in-input 5
   "Maximum number of lines to display in input."
   :type 'integer
@@ -72,7 +84,8 @@
     (russian . rus)
     (ukrainian . ukr)
     (turkish . tur)
-    (chinese . chi))
+    (chinese . chi)
+    (swedish . swe))
   "Mapping from long language names to short ones.
 
 This one is used for the translation queries.")
@@ -96,22 +109,25 @@ This one is used for the translation queries.")
 
 This one is used for the synonyms queries.")
 
+(defconst reverso--right-to-left-languages
+  '(arabic hebrew)
+  "List of languages that are written from right to left.")
+
 (defcustom reverso-languages (mapcar #'car reverso--language-mapping)
   "Subset of languages to use."
   :type `(set ,@(cl-loop for cell in reverso--language-mapping
                          collect (list 'const (car cell)))))
 
 (defconst reverso--languages
-  '((translation . (arabic chinese dutch english french german hebrew
+  '((translation . (arabic german english spanish french hebrew italian
-                           italian japanese korean polish portugese
+                           japanese dutch polish portuguese romanian russian
-                           romanian russian spanish swedish turkish
+                           swedish turkish ukrainian chinese))
-                           ukrainian))
     (context . (arabic german english spanish french hebrew italian
-                       japanese dutch polish portugese romanian
+                       japanese dutch polish portuguese romanian
                        russian swedish turkish ukrainian chinese))
     (grammar . (english french))
     (synonyms . (arabic german english spanish french hebrew italian
-                        japanese dutch polish portugese romanian
+                        japanese dutch polish portuguese romanian
                         russian)))
   "Available languages for diferent operations.")
 
@@ -149,9 +165,72 @@ This one is used for the synonyms queries.")
                            japanese dutch portuguese english))
         (turkish . (arabic german spanish french italian portuguese
                            romanian english))
-        (chinese . (english french spanish)))))
+        (chinese . (english french spanish))))
+    (translation
+     . ((arabic . (german english spanish french hebrew italian
+                          portuguese russian turkish))
+        (german . (arabic english spanish french hebrew italian
+                          japanese dutch polish portuguese romanian
+                          russian swedish turkish ukrainian))
+        (english . (arabic german spanish french hebrew italian
+                           japanese dutch polish portuguese romanian
+                           russian swedish turkish ukrainian chinese))
+        (spanish . (arabic german english french hebrew italian
+                           japanese dutch polish portuguese romanian
+                           russian swedish turkish chinese ukrainian))
+        (french . (arabic german english spanish hebrew italian
+                          japanese dutch polish portuguese romanian
+                          russian swedish turkish chinese ukrainian))
+        (hebrew . (arabic german english spanish french italian dutch
+                          portuguese russian ukrainian))
+        (italian . (arabic german english spanish french hebrew
+                           japanese dutch polish portuguese romanian
+                           russian swedish turkish ukrainian))
+        (japanese . (german english spanish french italian portuguese
+                            russian ukrainian))
+        (dutch . (german english spanish french hebrew italian
+                         portuguese russian ukrainian))
+        (polish . (german english spanish french italian ukrainian))
+        (portuguese . (arabic german english spanish french hebrew
+                              italian japanese dutch russian turkish
+                              ukrainian))
+        (romanian . (german english spanish french italian turkish
+                            ukrainian))
+        (russian . (arabic german english spanish french hebrew italian
+                           japanese dutch portuguese ukrainian))
+        (swedish . (german english spanish french italian ukrainian))
+        (turkish . (arabic german english spanish french italian
+                           portuguese romanian ukrainian))
+        (ukrainian . (english))
+        (chinese . (english french spanish ukrainian)))))
   "Which languages are compatible with which.")
 
+(defun reverso-verify-settings ()
+  "Check if all the languages are set correctly."
+  (interactive)
+  (let ((languages (mapcar #'car reverso--language-mapping)))
+    (dolist (cell reverso--languages)
+      (dolist (lang (cdr cell))
+        (unless (memq lang languages)
+          (error "Language %s is not available (reverso--languages)" lang))))
+    (dolist (lang reverso-languages)
+      (unless (memq lang languages)
+        (error "Language %s is not available (reverso-languages)" lang)))
+    (dolist (cell-kind reverso--languages-compatible)
+      (dolist (cell-lang (cdr cell-kind))
+        (unless (memq (car cell-lang) languages)
+          (error
+           "Language %s is not available (reverso--languages-compatible)"
+           (car cell-lang)))
+        (dolist (lang (cdr cell-lang))
+          (unless (memq lang languages)
+            (error
+             "Language %s is not available (reverso--languages-compatible)"
+             lang))))))
+  (message "Everything is OK"))
+
+;;; API
+
 (defconst reverso--urls
   '((translation . "https://api.reverso.net/translate/v1/translation")
     (context . "https://context.reverso.net/translation/")
@@ -161,13 +240,13 @@ This one is used for the synonyms queries.")
 
 (defconst reverso--user-agents
   '("Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
-    "Mozilla/5.0 (X11; Linux x86_64; rv:103.0) Gecko/20100101 Firefox/103.0"
+                          "Mozilla/5.0 (X11; Linux x86_64; rv:103.0) Gecko/20100101 Firefox/103.0"
-    "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:103.0) Gecko/20100101 Firefox/103.0"
+                          "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:103.0) Gecko/20100101 Firefox/103.0"
-    "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
+                          "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/104.0.0.0 Safari/537.36"
-    "Mozilla/5.0 (Windows NT 10.0; rv:103.0) Gecko/20100101 Firefox/103.0"
+                          "Mozilla/5.0 (Windows NT 10.0; rv:103.0) Gecko/20100101 Firefox/103.0"
-    "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36"
+                          "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/103.0.0.0 Safari/537.36"
-    "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.6 Safari/605.1.15"
+                          "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_15_7) AppleWebKit/605.1.15 (KHTML, like Gecko) Version/15.6 Safari/605.1.15"
-    "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:103.0) Gecko/20100101 Firefox/103.0")
+                          "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:103.0) Gecko/20100101 Firefox/103.0")
   "User-Agents to use for reverso.el requests.
 
 A random one is be picked at package initialization.")
@@ -180,8 +259,22 @@ A random one is be picked at package initialization.")
 (defun reverso--translate (text source target cb)
   "Translate TEXT from language SOURCE to TARGET.
 
-SOURCE and TARGET are keys of `reverso--languages'.  CB is a function
+SOURCE and TARGET are keys of `reverso--languages'.  CB is called with
-that is called with the result."
+the result.
+
+The result is an alist with the following keys:
+- `:corrected-text': set when the text has been corrected
+- `:language-from': the source language
+- `:language-to': the target language
+- `:detected-language': set when the detected target language is
+  different from the source language
+- `:translation': a string with translated text
+- `:context-results': a list with found contexts.
+   An item of the list is an alist with the keys:
+   - `:source': a string in the source language
+   - `:target': a string in the target language"
+  (when (string-empty-p text)
+    (user-error "Empty input!"))
   (unless (and (alist-get source reverso--language-mapping)
                (member source
                        (alist-get 'translation reverso--languages)))
@@ -209,7 +302,8 @@ that is called with the result."
     :encoding 'utf-8
     :success (cl-function
               (lambda (&key data &allow-other-keys)
-                (funcall cb (reverso--translate-parse data))))
+                (funcall cb (reverso--alist-remove-empty-values
+                             (reverso--translate-parse data)))))
     :error (cl-function
             (lambda (&key error-thrown &allow-other-keys)
               (message "Error!: %S" error-thrown)))))
@@ -246,37 +340,49 @@ that are in tags with `reverso-highlight-face'"
        'body)))))
 
 (defun reverso--alist-remove-empty-values (alist)
+  "Remove empty values from ALIST."
   (cl-loop for (key . value) in alist
            if value
            collect (cons key value)))
 
+(defun reverso--alist-get-inv (alist lookup-value)
+  "Like `alist-get', but with `car' and `cdr' swapped."
+  (cl-loop for (key . value) in alist
+           if (equal lookup-value value)
+           return key))
+
 (defun reverso--translate-parse (response)
   "Convert RESPONSE from the reverso translation API into an alist."
   (let ((corrected-text (alist-get 'correctedText response))
-        (language-from (alist-get 'from response))
+        (language-from (reverso--alist-get-inv
-        (language-to (alist-get 'to response))
+                        reverso--language-mapping
-        (detected-language (alist-get 'detectedLanguage
+                        (intern (alist-get 'from response))))
-                                      (alist-get 'languageDetection response)))
+        (language-to (reverso--alist-get-inv
-        (translation (alist-get 'translation response))
+                      reverso--language-mapping
+                      (intern (alist-get 'to response))))
+        (detected-language (reverso--alist-get-inv
+                            reverso--language-mapping
+                            (intern (or
+                                     (alist-get 'detectedLanguage
+                                                (alist-get 'languageDetection response))
+                                     "nil"))))
+        (translation (seq-elt (alist-get 'translation response) 0))
         (context-results
          (cl-loop for r across (alist-get 'results (alist-get 'contextResults response))
                   collect
-                  `((translation . ,(alist-get 'translation r))
+                  `((:translation . ,(alist-get 'translation r))
-                    (context
+                    (:context
                      . ,(cl-loop for source across (alist-get 'sourceExamples r)
                                  for target across (alist-get 'targetExamples r)
                                  collect
-                                 `((source . ,(reverso--convert-string-html source))
+                                 `((:source . ,(reverso--convert-string-html source))
-                                   (target . ,(reverso--convert-string-html target)))))))))
+                                   (:target . ,(reverso--convert-string-html target)))))))))
-    `((corrected-text . ,corrected-text)
+    `((:corrected-text . ,corrected-text)
-      (language-from . ,language-from)
+      (:language-from . ,language-from)
-      (language-to . ,language-to)
+      (:language-to . ,language-to)
-      (detected-language
+      (:detected-language . ,detected-language)
-       . ,(when (and detected-language
+      (:translation . ,translation)
-                     (not (string= detected-language language-from)))
+      (:context-results . ,context-results))))
-            detected-language))
-      (translation . ,translation)
-      (context-results . ,context-results))))
 
 (defun reverso--get-context (text source target cb)
   "Do a context translation for TEXT from SOURCE to TARGET.
@@ -326,8 +432,8 @@ DATA is an html string."
                when (string-match-p (rx "example") classes)
                collect (let ((src (dom-by-class (dom-by-class child "src") "text"))
                              (trg (dom-by-class (dom-by-class child "trg") "text")))
-                         `((source . ,(reverso--convert-string src))
+                         `((:source . ,(reverso--convert-string src))
-                           (target . ,(reverso--convert-string trg))))))))
+                           (:target . ,(reverso--convert-string trg))))))))
 
 (defun reverso--get-synomyms (text language cb)
   "Get synomyms for TEXT in LANGUAGE.
@@ -445,6 +551,150 @@ HTML is a string."
       (source-text . ,source-text-hl)
       (corrections . ,corrections))))
 
+;;; Buffers
+
+(defvar reverso-result-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map (kbd "q") (lambda ()
+                                (interactive)
+                                (quit-window t)))
+    (when (fboundp #'evil-define-key*)
+      (evil-define-key* '(normal motion) map
+        "q" (lambda ()
+              (interactive)
+              (quit-window t))))
+    map)
+  "Keymap used in `reverso-result-mode' buffers.")
+
+(defvar-local reverso--input nil
+  "Displayed input for `reverso'.")
+
+(defvar-local reverso--output nil
+  "Displayed output for `reverso'.")
+
+(defvar-local reverso--data nil
+  "Received data for `reverso'.")
+
+(define-derived-mode reverso-result-mode special-mode "Reverso results"
+  "Major mode to display results of `reverso'."
+  :group 'reverso)
+
+(defun reverso--translate-render (text data)
+  "Render the translation results.
+
+DATA is an alist as defined in `reverso--translate'.  TEXT is the
+source text."
+  (let ((multiline (string-match-p "\n" text)))
+    (insert (propertize
+             (symbol-name (alist-get :language-from data))
+             'face 'reverso-language-face)
+            " -> "
+            (propertize
+             (symbol-name (alist-get :language-to data))
+             'face 'reverso-language-face))
+    (when (alist-get :detected-language data)
+      (insert " [detected: "
+              (propertize
+               (symbol-name (alist-get :detected-language data))
+               'face 'reverso-language-face)
+              "]"))
+    (insert "\n\n")
+
+    (insert (propertize
+             "Source text: "
+             'face 'reverso-heading-face))
+    (when multiline
+      (insert "\n")
+      (when (memq (alist-get :language-from data)
+                  reverso--right-to-left-languages)
+        (insert "\n")))
+    (insert text "\n\n")
+    (setq-local reverso--input text)
+
+    (when (alist-get :corrected-text data)
+      (insert (propertize
+               "Corrected text: "
+               'face 'reverso-heading-face))
+      (when (memq (alist-get :language-from data)
+                  reverso--right-to-left-languages)
+        (insert "\n"))
+      (insert (alist-get :corrected-text data) "\n\n"))
+
+    (if (alist-get :translation data)
+        (progn
+          (setq-local reverso--output (alist-get :translation data))
+          (insert
+           (propertize
+            "Translation: "
+            'face 'reverso-heading-face))
+          (when multiline
+            (insert "\n")
+            (when (memq (alist-get :language-to data)
+                        reverso--right-to-left-languages)
+              (insert "\n")))
+          (insert (alist-get :translation data) "\n\n"))
+      (insert "No results!"))
+    (when (alist-get :context-results data)
+      (insert (propertize
+               "Context results: "
+               'face 'reverso-heading-face)
+              "\n")
+      (cl-loop for result in (alist-get :context-results data)
+               for translation = (alist-get :translation result)
+               when (not (string-empty-p translation))
+               do (insert
+                   (propertize
+                    translation
+                    'face 'reverso-highlight-face)
+                   "\n")
+               do (reverso--context-render-list
+                   (alist-get :context result)
+                   (alist-get :language-from data)
+                   (or (alist-get :detected-language data)
+                       (alist-get :language-to data)))))))
+
+(defun reverso--context-render-list (data lang-to lang-from)
+  "Render the context results."
+  (cl-loop with lang-to-name = (symbol-name lang-to)
+           with lang-from-name = (symbol-name lang-from)
+           with lang-length = (max (length lang-to-name) (length lang-from-name))
+           for datum in data
+           for source = (alist-get :source datum)
+           for target = (alist-get :target datum)
+           do (insert (propertize
+                       (format (format "%%-%ds: " lang-length) lang-to-name)
+                       'face 'reverso-language-face)
+                      source "\n"
+                      (propertize
+                       (format (format "%%%ds: " lang-length) lang-from-name)
+                       'face 'reverso-language-face)
+                      target "\n\n")))
+
+(defun reverso--translate-render-brief (text data)
+  (setq-local reverso--input text)
+  (if (alist-get :translation data)
+      (progn
+        (setq-local reverso--output (alist-get :translation data))
+        (insert (alist-get :translation data)))
+    (insert "No results!")))
+
+(defmacro reverso--with-buffer (&rest body)
+  "Execute BODY in the clean `reverso' results buffer."
+  (declare (indent 0))
+  `(progn
+     (let ((buffer (get-buffer-create
+                    (generate-new-buffer-name "*Reverso*"))))
+       (with-current-buffer buffer
+         (unless (derived-mode-p 'reverso-result-mode)
+           (reverso-result-mode))
+         (let ((inhibit-read-only t))
+           (erase-buffer)
+           ,@body)
+         (goto-char (point-min)))
+       (switch-to-buffer-other-window buffer))))
+
+;;; Transient
+
 (defclass reverso--transient-input (transient-infix)
   ((format :initform " %k %d: %v"))
   "Class used for retrieving the input string.")
@@ -457,7 +707,10 @@ HTML is a string."
          ((region-active-p)
           (buffer-substring-no-properties (region-beginning) (region-end)))
          ((equal current-prefix-arg '(4))
-          (buffer-substring-no-properties (point-min) (point-max)))
+          (if reverso--output
+              reverso--output
+            (buffer-substring-no-properties (point-min) (point-max))))
+         (reverso--input reverso--input)
          (t ""))))
 
 (cl-defmethod transient-infix-read ((obj reverso--transient-input))
@@ -491,6 +744,7 @@ HTML is a string."
 (defclass reverso--transient-language (transient-infix)
   ((format :initform " %k %d %v")
    (languages :initarg :languages :initform nil)
+   (target-languages :initarg :target-languages :initform nil)
    (is-target :initarg :is-target :initform nil))
   "Class used for switching the language.")
 
@@ -498,7 +752,9 @@ HTML is a string."
 
 (defvar reverso--target-value nil)
 
-(defun reverso--get-available-languages (obj &optional is-target)
+(defvar reverso--prefer-brief nil)
+
+(defun reverso--get-available-languages (obj &optional target-languages-list is-target)
   (let* ((all-languages
           (seq-sort
            (lambda (a b) (string-lessp (symbol-name a)
@@ -508,6 +764,8 @@ HTML is a string."
          (source-language (when is-target
                             (or reverso--source-value
                                 (car all-languages))))
+         (target-languages (when (and is-target target-languages-list)
+                             (alist-get source-language target-languages-list)))
          (languages (cl-loop for lang in all-languages
                              if (or (not source-language)
                                     (not (eq source-language lang)))
@@ -515,7 +773,10 @@ HTML is a string."
     (seq-sort
      (lambda (a b) (string-lessp (symbol-name a)
                                  (symbol-name b)))
-     (seq-intersection languages reverso-languages))))
+     (let ((intersection-1 (seq-intersection languages reverso-languages)))
+       (if (not target-languages)
+           intersection-1
+         (seq-intersection intersection-1 target-languages))))))
 
 (defun reverso--get-language-variable (obj)
   (if (oref obj is-target)
@@ -530,7 +791,9 @@ HTML is a string."
           ((and (symbol-value (reverso--get-language-variable obj)))
            (symbol-value (reverso--get-language-variable obj)))
           (t (car (reverso--get-available-languages
-                   obj (oref obj is-target)))))))
+                   obj
+                   (oref obj target-languages)
+                   (oref obj is-target)))))))
     (set (reverso--get-language-variable obj) value)
     (oset obj value value)))
 
@@ -544,12 +807,18 @@ HTML is a string."
                     (if (eq choice value)
                         'transient-value
                       'transient-inactive-value)))
-      (reverso--get-available-languages obj (oref obj is-target))
+      (reverso--get-available-languages
+       obj
+       (oref obj target-languages)
+       (oref obj is-target))
       (propertize "|" 'face 'transient-inactive-value))
      (propertize "]" 'face 'transient-inactive-value))))
 
 (cl-defmethod transient-infix-read ((obj reverso--transient-language))
-  (let* ((choices (reverso--get-available-languages obj (oref obj is-target)))
+  (let* ((choices (reverso--get-available-languages
+                   obj
+                   (oref obj target-languages)
+                   (oref obj is-target)))
          (current-idx (or (cl-position (oref obj value) choices) -1))
          (next-idx (% (1+ current-idx) (length choices)))
          (next-choice
@@ -566,15 +835,29 @@ HTML is a string."
     next-choice))
 
 (cl-defmethod transient-infix-value ((obj reverso--transient-language))
-  (let* ((choices (reverso--get-available-languages obj (oref obj is-target)))
+  (let* ((choices (reverso--get-available-languages
+                   obj
+                   (oref obj target-languages)
+                   (oref obj is-target)))
          (current-idx (or (cl-position (oref obj value) choices) -1)))
     (nth current-idx choices)))
 
-(transient-define-infix reverso--input ()
+(defclass reverso--transient-brief (transient-switch) ()
+  "Toggle brief output.")
+
+(cl-defmethod transient-init-value ((obj reverso--transient-brief))
+  (oset obj value reverso--prefer-brief))
+
+(cl-defmethod transient-infix-read ((obj reverso--transient-brief))
+  "Toggle the switch on or off."
+  (setq reverso--prefer-brief
+        (null (oref obj value))))
+
+(transient-define-infix reverso--transient-input-infix ()
   :class 'reverso--transient-input
   :description "Input")
 
-(transient-define-infix reverso--translate-source ()
+(transient-define-infix reverso--transient-translate-language-source ()
   :class 'reverso--transient-language
   :description "Source language"
   :key "s"
@@ -582,15 +865,16 @@ HTML is a string."
   :argument "-s"
   :languages (alist-get 'translation reverso--languages))
 
-(transient-define-infix reverso--translate-target ()
+(transient-define-infix reverso--transient-translate-language-target ()
   :class 'reverso--transient-language
   :description "Target language"
   :key "t"
   :argument "-t"
   :languages (alist-get 'translation reverso--languages)
+  :target-languages (alist-get 'translation reverso--languages-compatible)
   :is-target t)
 
-(transient-define-suffix reverso--swap-languages ()
+(transient-define-suffix reverso--transient-swap-languages ()
   :transient t
   :key "S"
   :description "Swap languages"
@@ -611,16 +895,36 @@ HTML is a string."
     (setq reverso--source-value target-value)
     (setq reverso--target-value source-value)))
 
+(transient-define-infix reverso--transient-breif-infix ()
+  :transient t
+  :class 'reverso--transient-brief
+  :key "b"
+  :argument "--brief"
+  :description "Brief translation output")
+
+(transient-define-suffix reverso--translate-exec-suffix (input source target &optional is-brief)
+  :key "e"
+  :description "Translate"
+  (interactive (transient-args transient-current-command))
+  (reverso--translate
+   input source target
+   (lambda (data)
+     (reverso--with-buffer
+       (if is-brief
+           (reverso--translate-render-brief input data)
+         (reverso--translate-render input data))
+       (setq-local reverso--data data)))))
+
 (transient-define-prefix reverso-translate ()
   ["Input"
-   ("i" "Input" reverso--input)]
+   ("i" "Input" reverso--transient-input-infix)]
   ["Parameters"
-   (reverso--translate-source)
+   (reverso--transient-translate-language-source)
-   (reverso--translate-target)
+   (reverso--transient-translate-language-target)
-   (reverso--swap-languages)]
+   (reverso--transient-swap-languages)
+   (reverso--transient-breif-infix)]
   ["Actions"
-   ("t" "Test" (lambda () (interactive)
+   (reverso--translate-exec-suffix)
-                 (setq my/test (transient-args transient-current-command))))
    ("q" "Quit" transient-quit-one)])
 
 (provide 'reverso)