diff --git a/reverso.el b/reverso.el index dda6e76..6039bf0 100644 --- a/reverso.el +++ b/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 - italian japanese korean polish portugese - romanian russian spanish swedish turkish - ukrainian)) + '((translation . (arabic german english spanish french hebrew italian + japanese dutch polish portuguese romanian russian + swedish turkish ukrainian chinese)) (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 (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 (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 (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 (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 (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; 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; 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 -that is called with the result." +SOURCE and TARGET are keys of `reverso--languages'. CB is called with +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-to (alist-get 'to response)) - (detected-language (alist-get 'detectedLanguage - (alist-get 'languageDetection response))) - (translation (alist-get 'translation response)) + (language-from (reverso--alist-get-inv + reverso--language-mapping + (intern (alist-get 'from response)))) + (language-to (reverso--alist-get-inv + 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)) - (context + `((:translation . ,(alist-get 'translation r)) + (:context . ,(cl-loop for source across (alist-get 'sourceExamples r) for target across (alist-get 'targetExamples r) collect - `((source . ,(reverso--convert-string-html source)) - (target . ,(reverso--convert-string-html target))))))))) - `((corrected-text . ,corrected-text) - (language-from . ,language-from) - (language-to . ,language-to) - (detected-language - . ,(when (and detected-language - (not (string= detected-language language-from))) - detected-language)) - (translation . ,translation) - (context-results . ,context-results)))) + `((:source . ,(reverso--convert-string-html source)) + (:target . ,(reverso--convert-string-html target))))))))) + `((:corrected-text . ,corrected-text) + (:language-from . ,language-from) + (:language-to . ,language-to) + (:detected-language . ,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)) - (target . ,(reverso--convert-string trg)))))))) + `((:source . ,(reverso--convert-string src)) + (: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--translate-target) - (reverso--swap-languages)] + (reverso--transient-translate-language-source) + (reverso--transient-translate-language-target) + (reverso--transient-swap-languages) + (reverso--transient-breif-infix)] ["Actions" - ("t" "Test" (lambda () (interactive) - (setq my/test (transient-args transient-current-command)))) + (reverso--translate-exec-suffix) ("q" "Quit" transient-quit-one)]) (provide 'reverso)