+++ /dev/null
-;;; gts-implements.el --- Component implements -*- lexical-binding: t -*-
-
-;; Copyright (C) 2021 lorniu <lorniuNOSPAMgmail.com>
-;; SPDX-License-Identifier: MIT
-
-;;; Commentary:
-
-;; Builtin implements of basic components
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'url)
-(require 'json)
-(require 'gts-core)
-(require 'gts-faces)
-
-\f
-;;; [Logger] Log all to a standalone buffer
-
-(defclass gts-buffer-logger (gts-logger)
- ((buffer :initarg buf :initform nil))) ; dont set :initarg to buffer, it will make an error on emacsv27.
-
-(defvar gts-logger-buffer-name " *gts-logger*")
-
-(cl-defmethod gts-log ((logger gts-buffer-logger) tag msg)
- (with-current-buffer (get-buffer-create (or (oref logger buffer) gts-logger-buffer-name))
- (goto-char (point-max))
- (if (or (= (length msg) 0) (string= msg "\n"))
- (insert "")
- (insert
- (propertize (cl-subseq (format "%-.1f" (time-to-seconds)) 6) 'face 'gts-logger-buffer-timestamp-face)
- " "
- (propertize (concat "[" tag "] ") 'face 'gts-logger-buffer-tag-face))
- (insert msg))
- (insert "\n")))
-
-(setq gts-default-logger (gts-buffer-logger))
-
-\f
-;;; [Cacher] Cache in the memory
-
-(defclass gts-memory-cacher (gts-cacher) ()
- "Cache in the memory.")
-
-(cl-defmethod gts-cache-get ((cacher gts-memory-cacher) task)
- (when gts-cache-enable
- (with-slots (caches expired) cacher
- (let ((key (gts-cache-key cacher task)))
- (when-let ((cache (assoc key caches)))
- (when (> (cddr cache) (time-to-seconds))
- (gts-do-log 'memory-cacher (format "%s: get from cache %s (%s)" (oref task id) key (length caches)))
- (cadr cache)))))))
-
-(cl-defmethod gts-cache-set ((cacher gts-memory-cacher) task result)
- (when gts-cache-enable
- (with-slots (caches expired) cacher
- (let* ((key (gts-cache-key cacher task))
- (cache (assoc key caches))
- (text (oref task text))
- (etime
- ;; sentence with shorter expired time, but word with longer.
- (if (string-match-p "[[:space:]\n]" text)
- (+ (time-to-seconds) gts-cache-expired-factor)
- (+ (time-to-seconds) (* 100 gts-cache-expired-factor)))))
- (if cache
- (progn
- (setf (cadr cache) result)
- (setf (cddr cache) etime)
- (gts-do-log 'memory-cacher (format "%s: update cache %s (%s)" (oref task id) key (length caches))))
- (oset cacher caches (cons (cons key (cons result etime)) caches))
- (gts-do-log 'memory-cacher (format "%s: add to cache %s (%s)" (oref task id) key (length caches))))
- (gts-clear-expired cacher)))))
-
-(setq gts-default-cacher (gts-memory-cacher))
-
-\f
-;;; [Http Client] implement with builtin `url.el'.
-;; This will be used as the default http client.
-
-(defclass gts-url-http-client (gts-http-client) ())
-
-(defcustom gts-user-agent "Mozilla/5.0 (X11; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.75 Safari/537.36"
- "The user agent used when send a request."
- :type 'string
- :group 'go-translate)
-
-(defvar url-http-end-of-headers)
-
-(cl-defmethod gts-request ((_ gts-url-http-client) url &key done fail data headers)
- "Request URL with DATA and HEADERS asynchronous.
-Execute DONE when success, or FAIL when failed."
- (cl-assert (and url done fail))
- (let ((url-debug gts-debug-p)
- (url-user-agent gts-user-agent)
- (url-request-extra-headers headers)
- (url-request-method (if data "POST" "GET"))
- (url-request-data data))
- (url-retrieve url (lambda (status)
- (unwind-protect
- (if-let ((err (cond
- ((eq (car status) :error) (cadr status))
- ((null url-http-end-of-headers) "Nothing responsed from server"))))
- (funcall fail err)
- (when done
- (delete-region (point-min) url-http-end-of-headers)
- (funcall done)))
- (kill-buffer)))
- nil t)))
-
-(setq gts-default-http-client (gts-url-http-client)) ; use this as default
-
-\f
-;;; [Render] buffer render
-
-(defclass gts-buffer-render (gts-render) ())
-
-(defcustom gts-split-width-threshold 80
- "Threshold width for window horizontal split."
- :group 'go-translate
- :type '(choice
- (const :tag "Disable" nil)
- (integer :tag "Threshold")))
-
-(defcustom gts-buffer-follow-p nil
- "If t then pop to the result window after translation."
- :type 'boolean
- :group 'go-translate)
-
-(defcustom gts-buffer-name "*Go-Translate*"
- "The name of translation result buffer."
- :type 'string
- :group 'go-translate)
-
-(defcustom gts-buffer-window-config nil
- "Window configuration used by the result buffer window.
-
-For example, set to:
-
- \\='((display-buffer-reuse-window display-buffer-in-side-window)
- (side . right))
-
-will force opening in right side window."
- :type 'list
- :group 'go-translate)
-
-(defcustom gts-buffer-render-task-header-function #'gts-buffer-render-task-header
- "Function used to render the task header when in multiple engines's query."
- :type 'function
- :group 'go-translate)
-
-(defvar-local gts-buffer-translator nil)
-(defvar-local gts-buffer-keybinding-messages nil)
-(defvar-local gts-buffer-local-map nil)
-
-(cl-defmacro gts-buffer-set-key ((key &optional desc) form)
- "Helper for define KEY in buffer."
- (declare (indent 1))
- `(progn (define-key gts-buffer-local-map
- (kbd ,key)
- ,(if (equal 'function (car form)) `,form `(lambda () (interactive) ,form)))
- (when ,desc
- (cl-delete ,key gts-buffer-keybinding-messages :key #'car :test #'string=)
- (push (cons ,key ,desc) gts-buffer-keybinding-messages))))
-
-(defun gts-buffer-init-header-line (path &optional desc)
- "Setup header line format.
-It will show the basic information of the translation,
-including PATH and other DESC."
- (setq header-line-format
- (list
- " "
- "[" (propertize (car path) 'face 'gts-render-buffer-header-line-lang-face) "]"
- (if desc (concat " ― " (propertize desc 'face 'gts-render-buffer-header-line-desc-face)) "")
- " → "
- "[" (propertize (cdr path) 'face 'gts-render-buffer-header-line-lang-face) "]"
- " (" (propertize "h" 'face 'font-lock-type-face) " for help)"
- " "
- "Loading...")))
-
-(defun gts-buffer-change-header-line-state (type)
- "Update header line according TYPE."
- (cl-case type
- (done
- (when (string-equal (car (last header-line-format)) "Loading...")
- (setq header-line-format (butlast header-line-format))))))
-
-(defun gts-buffer-display-or-focus-buffer (buffer)
- "Only display the BUFFER, or display and focus."
- (with-current-buffer buffer
- (if gts-buffer-follow-p (pop-to-buffer buffer)
- (display-buffer buffer))))
-
-(defun gts-buffer-ensure-a-blank-line-at-beginning (buffer)
- "Ensure a blank line at beginning of BUFFER."
- (with-current-buffer buffer
- (let ((inhibit-read-only t))
- (save-excursion
- (let ((m (mark-marker)))
- (goto-char (point-min))
- (unless (equal (char-after) ?\n)
- (insert "\n"))
- (when (ignore-errors (= (marker-position m) 1))
- (set-marker m (point))))
- (set-buffer-modified-p nil)))))
-
-(defun gts-childframe-of-buffer (&optional buffer)
- "Get the childframe of BUFFER if it exists, or return nil."
- (let ((cf (window-frame (get-buffer-window buffer t))))
- (when (frame-parameter cf 'parent-frame) cf)))
-
-(defun gts-buffer-render-task-header (engine-tag parser-tag)
- (concat (propertize
- (format "%s %s\n" engine-tag (if parser-tag (format "(%s) " parser-tag) ""))
- 'face 'gts-render-buffer-me-header-backgroud-face)))
-
-(defun gts-render-buffer-prepare (buffer translator)
- (with-current-buffer (get-buffer-create buffer)
- (let ((inhibit-read-only t)
- (engines (gts-get translator 'engines)))
- (with-slots (text path) translator
- ;; setup
- (deactivate-mark)
- (visual-line-mode -1)
- (font-lock-mode 1)
- (setq-local cursor-type 'hbar)
- (setq-local cursor-in-non-selected-windows nil)
- (setq-local gts-buffer-translator translator)
- ;; headline
- (gts-buffer-init-header-line path (unless (cdr engines) (oref (car engines) tag)))
- ;; source text
- (erase-buffer)
- (unless (gts-childframe-of-buffer (current-buffer)) (insert "\n")) ; except childframe
- (insert text)
- ;; keybinds
- (setq gts-buffer-local-map (make-sparse-keymap))
- (gts-buffer-set-key ("x" "Reverse Path")
- (gts-translate translator text (cons (cdr path) (car path))))
- (gts-buffer-set-key ("M-p" "Prev Path")
- (gts-translate translator text (gts-next-path (gts-get translator 'picker) text path t)))
- (gts-buffer-set-key ("M-n" "Next Path")
- (gts-translate translator text (gts-next-path (gts-get translator 'picker) text path)))
- (gts-buffer-set-key ("g" "Refresh")
- (gts-translate translator text path))
- (gts-buffer-set-key ("y" "TTS")
- (if-let ((task (get-text-property (point) 'task)))
- (gts-do-tts text (car path) (oref task engine))
- (message "[TTS] No engine found at point")))
- (gts-buffer-set-key ("O" "Open Externally")
- (when-let ((task (get-text-property (point) 'task)))
- (let* ((meta (oref task meta)) (url (plist-get meta :url)))
- (cond (url (browse-url url) (message "Opening %s... Done!" url))
- (t (message "Don't know how to open externally for this."))))))
- (gts-buffer-set-key ("C" "Clean Cache")
- (gts-clear-all gts-default-cacher))
- (gts-buffer-set-key ("t" "Toggle-Follow")
- (let ((state (if (setq gts-buffer-follow-p (not gts-buffer-follow-p)) "allowed" "disabled")))
- (message "Now, buffer following %s." state)))
- (gts-buffer-set-key ("q" "Quit") #'kill-buffer-and-window)
- (gts-buffer-set-key ("p") #'previous-line)
- (gts-buffer-set-key ("n") #'next-line)
- (gts-buffer-set-key ("C-g")
- (unwind-protect (gts-tts-try-interrupt-playing-process)
- (keyboard-quit)))
- (gts-buffer-set-key ("h")
- (message (mapconcat
- (lambda (kd) (concat (propertize (car kd) 'face 'font-lock-keyword-face) ": " (cdr kd)))
- (reverse gts-buffer-keybinding-messages) " ")))
- (gts-buffer-set-key ("C-x C-q")
- (progn (read-only-mode -1)
- (use-local-map nil)
- (local-set-key (kbd "C-x C-q")
- (lambda ()
- (interactive)
- (read-only-mode 1)
- (use-local-map gts-buffer-local-map)))))
- (read-only-mode 1)
- (use-local-map gts-buffer-local-map)
- ;; execute the hook if exists
- (run-hooks 'gts-after-buffer-prepared-hook)))))
-
-(defun gts-render-buffer (buffer task)
- "For single engine translation."
- (when-let ((inhibit-read-only t)
- (buf (get-buffer buffer)))
- (with-current-buffer buf
- (with-slots (err parsed meta engine translator) task
- ;; error
- (if err
- (progn
- (goto-char (point-max))
- (insert (propertize (format "\n\n%s" err) 'face 'gts-render-buffer-error-face)))
- (erase-buffer)
- (cond
- ;; content (non-split)
- ((stringp parsed)
- (let ((tbeg (plist-get meta :tbeg))
- (tend (plist-get meta :tend)))
- (unless tbeg
- (insert (propertize (oref translator text) 'face 'gts-render-buffer-source-face) "\n\n"))
- (unless tbeg (setq tbeg (point)))
- (insert parsed)
- (unless tend (setq tend (point)))
- ;; try set mark in beginning of the translate result,
- ;; and set currsor position in end of the translate result,
- ;; so you can quick select the translate result with C-x C-x.
- (when (not (gts-childframe-of-buffer buf)) ; when not childframe
- (push-mark tend 'nomsg)
- (goto-char tbeg)
- (set-window-point (get-buffer-window buf t) tbeg))))
- ;; content (split)
- (t (cl-loop for idx from 0
- for src in (gts-get translator 'sptext)
- for tar in parsed
- concat (concat (propertize src 'face 'gts-render-buffer-source-face) "\n\n" tar "\n\n") into res
- finally (insert res)))))
- ;; update states
- (set-buffer-modified-p nil)
- (gts-buffer-change-header-line-state 'done)
- (put-text-property (point-min) (point-max) 'task task)
- ;; execute the hook if exists
- (run-hooks 'gts-after-buffer-render-hook))
- buf)))
-
-(defun gts-render-buffer-multi-engines (buffer task)
- "For multiple engines translation."
- (when-let ((inhibit-read-only t)
- (buf (get-buffer buffer)))
- (with-slots (from to translator) task
- (with-slots (text task-queue version) translator
- (with-current-buffer buf
- (when (equal (oref gts-buffer-translator version) version)
- (erase-buffer)
- (insert (propertize (format "\n%s\n\n" text) 'face 'gts-render-buffer-source-face))
- ;; content
- (save-excursion
- (dolist (task task-queue)
- (with-slots (err parsed meta engine) task
- (let* ((result (if (or err (stringp parsed)) parsed
- (string-join parsed "\n\n")))
- (header (funcall gts-buffer-render-task-header-function
- (oref engine tag)
- (oref (oref engine parser) tag)))
- (content (cond
- (err
- (concat header (propertize (format "\n%s\n\n" err) 'face 'gts-render-buffer-error-face)))
- ((string-empty-p result)
- (concat header "\nLoading...\n\n"))
- (t (concat header "\n" (string-trim result) "\n\n")))))
- (put-text-property 0 (length content) 'task task content)
- (insert content)))))
- ;; states
- (set-buffer-modified-p nil)
- ;; all tasks finished
- (when (= (oref translator state) 3)
- ;; cursor
- (unless (gts-childframe-of-buffer buf)
- (set-window-point (get-buffer-window buf t) (save-excursion (forward-line 2) (point))))
- ;; state
- (gts-buffer-change-header-line-state 'done))
- ;; execute the hook if exists
- (run-hooks 'gts-after-buffer-multiple-render-hook)))
- buf))))
-
-(cl-defmethod gts-pre ((_ gts-buffer-render) translator)
- ;; init and setup
- (gts-render-buffer-prepare gts-buffer-name translator)
- ;; display
- (let ((split-width-threshold (or gts-split-width-threshold split-width-threshold)))
- (display-buffer gts-buffer-name gts-buffer-window-config)))
-
-(cl-defmethod gts-out ((_ gts-buffer-render) task)
- ;; render & display
- (when-let ((buf (gts-render-buffer gts-buffer-name task)))
- (gts-buffer-ensure-a-blank-line-at-beginning buf)
- (gts-buffer-display-or-focus-buffer buf)))
-
-(cl-defmethod gts-me-out ((_ gts-buffer-render) task)
- ;; render & display
- (when-let ((buf (gts-render-buffer-multi-engines gts-buffer-name task)))
- (when (= (oref (oref task translator) state) 3)
- (gts-buffer-display-or-focus-buffer buf))))
-
-\f
-;;; [Render] Child-Frame Render (Popup Mode)
-;; implements via package Posframe, you should install it before use this
-
-(defclass gts-posframe-pop-render (gts-render)
- ((width :initarg :width :initform 100)
- (height :initarg :height :initform 15)
- (forecolor :initarg :forecolor :initform nil)
- (backcolor :initarg :backcolor :initform nil)
- (padding :initarg :padding :initform 12))
- "Pop up a childframe to show the result.
-The frame will disappear when do do anything but focus in it.
-Manually close the frame with `q'.")
-
-(require 'posframe nil t)
-(declare-function posframe-show "ext:posframe.el" t t)
-(declare-function posframe-delete "ext:posframe.el" t t)
-(declare-function posframe-hide "ext:posframe.el" t t)
-(declare-function posframe-refresh "ext:posframe.el" t t)
-(declare-function posframe-poshandler-frame-top-right-corner "ext:posframe.el" t t)
-
-(defcustom gts-posframe-pop-render-buffer " *GTS-Pop-Posframe*"
- "Buffer name of Pop Posframe."
- :type 'string
- :group 'go-translate)
-
-(defvar gts-posframe-pop-render-timeout 30)
-(defvar gts-posframe-pop-render-poshandler nil)
-
-(defun gts-posframe-init-header-line (from to)
- (setq header-line-format
- (list "[" (propertize from 'face 'gts-render-buffer-header-line-lang-face) "]"
- " → "
- "[" (propertize to 'face 'gts-render-buffer-header-line-lang-face) "]")))
-
-(defun gts-posframe-render-auto-close-handler ()
- "Close the pop-up posframe window."
- (interactive)
- (unless (or (and gts-current-command
- (member this-command (list gts-current-command #'exit-minibuffer)))
- (and gts-posframe-pop-render-buffer
- (string= (buffer-name) gts-posframe-pop-render-buffer)))
- (ignore-errors (posframe-delete gts-posframe-pop-render-buffer))
- (remove-hook 'post-command-hook #'gts-posframe-render-auto-close-handler)))
-
-(cl-defmethod gts-pre ((render gts-posframe-pop-render) translator)
- (with-slots (width height forecolor backcolor padding) render
- (let ((inhibit-read-only t)
- (buf gts-posframe-pop-render-buffer))
- (posframe-show buf
- :string "Loading..."
- :timeout gts-posframe-pop-render-timeout
- :max-width width
- :max-height height
- :foreground-color (or forecolor gts-pop-posframe-forecolor)
- :background-color (or backcolor gts-pop-posframe-backcolor)
- :internal-border-width padding
- :internal-border-color (or backcolor gts-pop-posframe-backcolor)
- :accept-focus t
- :position (point)
- :poshandler gts-posframe-pop-render-poshandler)
- ;; render
- (gts-render-buffer-prepare buf translator)
- (posframe-refresh buf)
- ;; setup
- (with-current-buffer buf
- (gts-buffer-set-key ("q" "Close") (posframe-delete buf))))))
-
-(cl-defmethod gts-out ((_ gts-posframe-pop-render) task)
- ;; render & refresh
- (when-let ((buf (gts-render-buffer gts-posframe-pop-render-buffer task)))
- (posframe-refresh buf)
- (add-hook 'post-command-hook #'gts-posframe-render-auto-close-handler)))
-
-(cl-defmethod initialize-instance :after ((_ gts-posframe-pop-render) &rest _)
- (unless (featurep 'posframe)
- (user-error "To use `gts-posframe-render', you should install and load package `posframe' first")))
-
-\f
-;;; [Render] Child-Frame Render (Pin Mode)
-
-(defclass gts-posframe-pin-render (gts-posframe-pop-render)
- ((width :initarg :width :initform 60)
- (height :initarg :height :initform 20)
- (padding :initarg :padding :initform 8)
- (bd-width :initarg :bd-width :initform 1)
- (bd-color :initarg :bd-color :initform nil)
- (backcolor :initarg :backcolor :initform nil)
- (fri-color :initarg :fringe-color :initform nil)
- (position :initarg :position :initform nil))
- "Pin the childframe in a fixed position to display the translate result.
-The childframe will not close, until you kill it with `q'.
-Other operations in the childframe buffer, just like in 'gts-buffer-render'.")
-
-(defcustom gts-posframe-pin-render-buffer " *GTS-Pin-Posframe*"
- "Buffer name of Pin Posframe."
- :type 'string
- :group 'go-translate)
-
-(defvar gts-posframe-pin-render-frame nil)
-(defvar gts-posframe-pin-render-poshandler #'posframe-poshandler-frame-top-right-corner)
-
-(cl-defmethod gts-pre ((render gts-posframe-pin-render) translator)
- ;; create/show frame
- (if (and (get-buffer gts-posframe-pin-render-buffer) gts-posframe-pin-render-frame)
- (make-frame-visible gts-posframe-pin-render-frame)
- (with-slots (width height min-width min-height bd-width forecolor backcolor bd-color padding position) render
- (setq gts-posframe-pin-render-frame
- (let ((inhibit-read-only t))
- (posframe-show gts-posframe-pin-render-buffer
- :string "\nLoading..."
- :width width
- :height height
- :min-width width
- :min-height height
- :foreground-color (or forecolor gts-pin-posframe-forecolor)
- :background-color (or backcolor gts-pin-posframe-backcolor)
- :internal-border-width bd-width
- :border-color (or bd-color gts-pin-posframe-bdcolor)
- :left-fringe padding
- :right-fringe padding
- :refresh nil
- :accept-focus t
- :respect-header-line t
- :position position
- :poshandler (unless position gts-posframe-pin-render-poshandler)))))
- (set-frame-parameter gts-posframe-pin-render-frame 'drag-internal-border t)
- (set-frame-parameter gts-posframe-pin-render-frame 'drag-with-header-line t)
- (when-let ((color (or (oref render fri-color) gts-pin-posframe-fringe-color)))
- (set-face-background 'fringe color gts-posframe-pin-render-frame)))
- ;; render
- (gts-render-buffer-prepare gts-posframe-pin-render-buffer translator)
- (gts-buffer-ensure-a-blank-line-at-beginning gts-posframe-pin-render-buffer)
- ;; setup
- (with-current-buffer gts-posframe-pin-render-buffer
- (gts-buffer-set-key ("q" "Hide") (posframe-hide gts-posframe-pin-render-buffer))
- (gts-buffer-set-key ("Q" "Close") (posframe-delete gts-posframe-pin-render-buffer))))
-
-(cl-defmethod gts-out ((_ gts-posframe-pin-render) task)
- ;; render & refresh
- (when-let ((buf (gts-render-buffer gts-posframe-pin-render-buffer task)))
- (gts-buffer-ensure-a-blank-line-at-beginning buf)))
-
-(cl-defmethod gts-me-out ((_ gts-posframe-pin-render) task)
- ;; render & refresh
- (gts-render-buffer-multi-engines gts-posframe-pin-render-buffer task))
-
-\f
-;;; [Render] kill-ring render
-
-(defclass gts-kill-ring-render (gts-render) ())
-
-(cl-defmethod gts-out ((_ gts-kill-ring-render) task)
- (deactivate-mark)
- (with-slots (err parsed) task
- (if err
- (user-error "%s" err)
- (kill-new (if (listp parsed) (string-join parsed "\n\n") parsed))
- (message "Translate result already in the kill ring."))))
-
-\f
-;;; [Render] Alert Render
-
-(require 'alert nil t)
-(declare-function alert "ext:alert.el" t t)
-
-(defvar gts-alert-args '(:timeout 10))
-
-(defclass gts-alert-render (gts-render) ())
-
-(cl-defmethod gts-out ((_ gts-alert-render) task)
- (with-slots (text err parsed) task
- (if err
- (user-error "%s" err)
- (apply #'alert
- (if (listp parsed) (string-join parsed "\n\n") parsed)
- :title (if (string-match-p "\n" text) "*Go-Translate*" text)
- gts-alert-args))))
-
-\f
-;;; [Texter] take current-at-point-or-selection as source text
-
-(defclass gts-current-or-selection-texter (gts-texter) ())
-
-(cl-defmethod gts-text ((_ gts-current-or-selection-texter))
- (cond ((eq major-mode 'pdf-view-mode)
- (if (pdf-view-active-region-p)
- (car (pdf-view-active-region-text))))
- ((use-region-p)
- (string-trim (buffer-substring-no-properties (region-beginning) (region-end))))
- (t (current-word t t))))
-
-;; silence!
-(declare-function pdf-view-active-region-p "ext:pdf-view.el" t t)
-(declare-function pdf-view-active-region-text "ext:pdf-view.el" t t)
-
-\f
-;;; [Texter] take whole-buffer for as source text
-
-(defclass gts-whole-buffer-texter (gts-texter) ())
-
-(cl-defmethod gts-text ((_ gts-whole-buffer-texter))
- (buffer-substring-no-properties (point-min) (point-max)))
-
-\f
-;;; [Picker] noprompt picker
-
-(defclass gts-noprompt-picker (gts-picker)
- ((texter :initarg :texter :initform (gts-current-or-selection-texter))))
-
-(defvar gts-picker-current-picker nil)
-(defvar gts-picker-current-path nil)
-
-(cl-defmethod gts-pick ((picker gts-noprompt-picker))
- (let ((text (gts-text (oref picker texter))))
- (when (= 0 (length (if text (string-trim text) "")))
- (user-error "Make sure there is any word at point, or selection exists"))
- (let ((path (gts-path picker text)))
- (setq gts-picker-current-path path)
- (cl-values text path))))
-
-\f
-;;; [Picker] prompt, and flexible
-
-(defclass gts-prompt-picker (gts-picker)
- ((texter :initarg :texter :initform (gts-current-or-selection-texter))))
-
-(defvar gts-prompt-picker-keymap
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "\C-g" #'top-level)
- (define-key map "\C-n" #'gts-prompt-picker-next-path)
- (define-key map "\C-p" (lambda () (interactive) (gts-prompt-picker-next-path t)))
- (define-key map "\C-l" #'delete-minibuffer-contents)
- map)
- "Minibuffer keymap used when prompt user input.")
-
-(defun gts-prompt-picker-next-path (&optional backwardp)
- "Pick next available translate path.
-If BACKWARDP is t, then pick the previous one."
- (interactive "P")
- (let* ((text (minibuffer-contents))
- (path (gts-next-path gts-picker-current-picker
- text gts-picker-current-path backwardp)))
- (setq gts-picker-current-path path)
- (gts-prompt-picker-pick text path)))
-
-(defun gts-prompt-picker-pick (&optional text path)
- (setq gts-picker-current-path path)
- (let* ((enable-recursive-minibuffers t)
- (minibuffer-allow-text-properties t)
- (prompt (concat (concat "[" (car path) " > " (cdr path) "] ") "Text: "))
- (text (read-from-minibuffer prompt text gts-prompt-picker-keymap)))
- (throw 'gts-minibuffer `(,text . ,path))))
-
-(cl-defmethod gts-pick ((picker gts-prompt-picker))
- (setq gts-picker-current-picker picker)
- (pcase-let* ((text (gts-text (oref picker texter)))
- (path (gts-path picker text))
- (`(,current-text . ,current-path)
- (catch 'gts-minibuffer (gts-prompt-picker-pick text path))))
- (when (zerop (length (string-trim current-text)))
- (user-error "Text should not be null"))
- (cl-values current-text current-path)))
-
-\f
-;;; [Splitter] split text by paragraph
-
-(defclass gts-paragraph-splitter (gts-splitter) ())
-
-(cl-defmethod gts-split ((_ gts-paragraph-splitter) text)
- (setq text (split-string text "\n\n" t))
- (if (and (listp text) (cadr text)) text))
-
-
-(provide 'gts-implements)
-
-;;; gts-implements.el ends here
--- /dev/null
+;;; google-translate-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*-
+;; Generated by the `loaddefs-generate' function.
+
+;; This file is part of GNU Emacs.
+
+;;; Code:
+
+(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path)))
+
+
+\f
+;;; Generated autoloads from google-translate-backend.el
+
+(register-definition-prefixes "google-translate-backend" '("google-translate-backend-"))
+
+\f
+;;; Generated autoloads from google-translate-core.el
+
+(register-definition-prefixes "google-translate-core" '("google-translate-"))
+
+\f
+;;; Generated autoloads from google-translate-core-ui.el
+
+(register-definition-prefixes "google-translate-core-ui" '("google-translate-"))
+
+\f
+;;; Generated autoloads from google-translate-default-ui.el
+
+(autoload 'google-translate-query-translate "google-translate-default-ui" "\
+Interactively translate text with Google Translate.
+
+Query a text (a word or a phrase), and pop up a buffer named *Google
+Translate* displaying available translations of the text.
+
+If no defaults for the source and target languages are specified (by
+setting the variables `google-translate-default-source-language' and
+`google-translate-default-target-language'), interactively query the
+missing parts. For example, a reasonable option may be to specify a
+default for the target language and always be queried for the source
+language.
+
+With a `C-u' prefix argument, query the source and target languages,
+even if any defaults are specified. For example, you may frequently
+need to translate from English to Russian, and you may choose to set
+the default source and target languages to \"en\" and \"ru\", resp.
+However, occasionally you may also need to translate from Russian to
+English. With a `C-u' prefix argument you can override the defaults
+and specify the source and target languages explicitly.
+
+The languages are queried with completion, and the null input at the
+source language prompt is considered as an instruction for Google
+Translate to detect the source language.
+
+(fn &optional OVERRIDE-P)" t)
+(autoload 'google-translate-query-translate-reverse "google-translate-default-ui" "\
+Like `google-translate-query-translate', but performs translation
+in the reverse direction.
+
+The value of the variable `google-translate-default-source-language'
+(if set) becomes the target language, and the value of the variable
+`google-translate-default-target-language' (if also set) becomes the
+source language.
+
+In particular, when both variables are set, translation is performed
+in the reverse direction.
+
+(fn &optional OVERRIDE-P)" t)
+(autoload 'google-translate-at-point "google-translate-default-ui" "\
+Translate the word at point or the words in the active region.
+
+For the meaning of OVERRIDE-P, see `google-translate-query-translate'.
+
+(fn &optional OVERRIDE-P)" t)
+(autoload 'google-translate-at-point-reverse "google-translate-default-ui" "\
+Like `google-translate-at-point', but performs translation in the
+reverse direction.
+
+(fn &optional OVERRIDE-P)" t)
+(autoload 'google-translate-buffer "google-translate-default-ui" "\
+Translate current buffer.
+
+For the meaning of OVERRIDE-P, see `google-translate-query-translate'.
+
+(fn &optional OVERRIDE-P REVERSE-P)" t)
+(autoload 'google-translate-paragraphs-overlay "google-translate-default-ui" "\
+Translate current buffer with paragraph by paragraph and SHOW results in overlay below paragraph.
+This command also specificly support org-mode.
+
+(fn &optional OVERRIDE-P REVERSE-P)" t)
+(autoload 'google-translate-paragraphs-insert "google-translate-default-ui" "\
+Translate current buffer with paragraph by paragraph and INSERT results below paragraph.
+This command does NOT support document format like org-mode.
+
+(fn &optional OVERRIDE-P REVERSE-P)" t)
+(register-definition-prefixes "google-translate-default-ui" '("%google-translate-" "google-translate-"))
+
+\f
+;;; Generated autoloads from google-translate-smooth-ui.el
+
+(autoload 'google-translate-smooth-translate "google-translate-smooth-ui" "\
+Translate a text using translation directions.
+
+Make a prompt in minibuffer for a text to translate. Default text
+is word at point.
+
+In case of `google-translate-translation-directions-alist' is
+empty list then after inputed translating text prompts for source
+language and then for target languages.
+
+In case of `google-translate-translation-directions-alist' is not
+empty list takes current translation direction and makes
+appropriate translation. Current translation direction indicates
+in the minibuffers' prompt.
+
+A current translation direction could be changed directly in the
+minibuffer by means of key bindings such as C-n and C-p for
+changing to the next translation direction and to the previous
+one respectively." t)
+(register-definition-prefixes "google-translate-smooth-ui" '("google-translate-"))
+\f
+;;; End of scraped data
+
+(provide 'google-translate-autoloads)
+
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; no-native-compile: t
+;; coding: utf-8-emacs-unix
+;; End:
+
+;;; google-translate-autoloads.el ends here
--- /dev/null
+;;; google-translate-backend.el --- Backend methods for url retrieve.
+
+;; Copyright (C) 2019 Tomotaka SUWA <tomotaka.suwaNOSPAMgmail.com>
+
+;; Author: Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+;; Maintainer: Andrey Tykhonov <atykhonovNOSPAMgmail.com>
+;; URL: https://github.com/atykhonov/google-translate
+;; Keywords: convenience
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Provide backend facilities to cope with google translate.
+
+;;; Code:
+
+(defvar google-translate-backend-method 'emacs
+ "The backend method for URL retrieve.
+
+Valid symbols are below:
+
+ - emacs: use built in `url-retrieve-synchronously'
+ - curl: invoke curl command
+ - wget: invoke wget command
+
+and any other keys of `google-translate-backend-commands'.")
+
+(defvar google-translate-backend-user-agent "Emacs"
+ "The user agent string for HTTP request header.")
+
+(defvar google-translate-backend-commands
+ '((curl :args ("-s" "-L" "-A"))
+ (wget :args ("-q" "-O" "-" "-U")))
+ "An alist of external program specifications.
+
+The form of each element is (KEY P-LIST). The variable
+`google-translate-backend-method' may have one of KEYs and is
+used for determine the command to execute. The P-LIST of each
+element represents command specific information.
+
+Available properties:
+
+ - Property `:name': the program name(optional)
+ - Property `:args': a list of arguments passed to the program
+
+If you omit the `:name' property, (symbol-name KEY) will be used
+as the program name. The `:args' property must be composed to
+satisfy all the following conditions:
+
+ - Output content to standard output
+ - Suppress non-content(HTTP headers, progress messages, etc)
+ - Handle location response header
+ - Place User-Agent option at last
+
+So if you would like to use another program \"foo\", for example:
+
+\(push \\='(foo :name \"foo-x86\"
+ :args (\"-q\" \"--agent\"))
+ google-translate-backend-commands)
+
+\(setq google-translate-backend-method \\='foo)
+
+And the command line looks like:
+
+foo-x86 -q --agent ['google-translate-backend-user-agent] [URL]")
+
+(defvar google-translate-backend-debug nil
+ "Non-nil means log http activities to the *google-translate-debug* buffer.")
+
+(defun google-translate-backend--log (&rest args)
+ "Log http activities to the *google-translate-debug* buffer along with ARGS.
+
+Disabled if `google-translate-backend-debug' is nil."
+ (when google-translate-backend-debug
+ (let ((message (mapconcat 'identity
+ (list (current-time-string)
+ (prin1-to-string args)
+ "-- begin --"
+ (buffer-string)
+ "-- end --")
+ "\n")))
+ (with-current-buffer
+ (get-buffer-create "*google-translate-backend-debug*")
+ (goto-char (point-max))
+ (insert message)
+ (newline)))))
+
+(defun google-translate-backend--emacs (url)
+ "Get URL contents by `url-retrieve-synchronously'."
+ (insert
+ (let ((url-user-agent google-translate-backend-user-agent))
+ (with-current-buffer (url-retrieve-synchronously url nil nil 15)
+ (set-buffer-multibyte t)
+ (google-translate-backend--log url 'emacs)
+ (goto-char (point-min))
+ (re-search-forward "\n\n")
+ (prog1 (buffer-substring (point)
+ (point-max))
+ (kill-buffer))))))
+
+(defun google-translate-backend--process (url key spec)
+ "Get URL contents by `call-process'.
+
+\(KEY SPEC) would be exist in `google-translate-backend-commands'."
+ (let ((name (or (plist-get spec :name)
+ (symbol-name key)))
+ (args (plist-get spec :args))
+ (agent google-translate-backend-user-agent))
+ (apply 'call-process
+ (append (list name nil t nil)
+ args
+ (list agent url)))
+ (google-translate-backend--log url key spec)))
+
+(defun google-translate-backend-retrieve (url)
+ "Get URL contents via `google-translate-backend-method'."
+ (let ((method google-translate-backend-method))
+ (if (eq method 'emacs)
+ (google-translate-backend--emacs url)
+ (let ((spec (cdr (assq method
+ google-translate-backend-commands))))
+ (if (null spec)
+ (error "Unknown backend method: %s" method)
+ (google-translate-backend--process url method spec))))))
+
+(provide 'google-translate-backend)
+;;; google-translate-backend.el ends here
--- /dev/null
+;;; google-translate-core-ui.el --- The google translate core UI
+
+;; Copyright (C) 2012 Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+
+;; Author: Oleksandr Manzyuk <manzyuk@gmail.com>
+;; Maintainer: Andrey Tykhonov <atykhonovNOSPAMgmail.com>
+;; URL: https://github.com/atykhonov/google-translate
+;; Package-Requires: ((emacs "24.3") (popup "0.5.8"))
+;; Keywords: convenience
+
+;; Contributors:
+;; Tassilo Horn <tsdhNOSPAMgnu.org>
+;; Bernard Hurley <bernardNOSPAMmarcade.biz>
+;; Chris Bilson <cbilsonNOSPAMpobox.com>
+;; Takumi Kinjo <takumi.kinjoNOSPAMgmail.com>
+;; momomo5717 <momomo5717NOSPAMgmail.com>
+;; stardiviner <numbchildNOSPAMgmail.com>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This script provides the most common functions and variables for
+;; UI. It does not contain any interactive functions and overall is
+;; not going to be used directly by means of
+;; `execute-extended-command' (M-x). Its purpose to provide the most
+;; valuable and useful functionality for packages and scripts which
+;; provide UI.
+;;
+;; The most important functions are the following:
+;;
+;; - `google-translate-translate'
+;;
+;; - `google-translate-read-source-language'
+;;
+;; - `google-translate-read-target-language'
+;;
+;; `google-translate-translate' translates the given text from source
+;; language to target language and shows a translation.
+;;
+;; `google-translate-read-source-language' reads source language from
+;; minibuffer and returns language
+;; abbreviation. `google-translate-read-target-language' reads target
+;; language from minibuffer and returns language abbreviation.
+
+;; Customization:
+
+;; You can customize the following variables:
+;;
+;; - `google-translate-output-destination'
+;;
+;; - `google-translate-enable-ido-completion'
+;;
+;; - `google-translate-show-phonetic'
+;;
+;; - `google-translate-listen-program'
+;;
+;; - `google-translate-pop-up-buffer-set-focus'
+;;
+;; - `google-translate-preferable-input-methods-alist'
+;;
+;; `google-translate-output-destination' determines translation output
+;; destination. If `nil' the translation output will be displayed in
+;; the pop up buffer. If value equal to `echo-area' then translation
+;; outputs in the Echo Area. In case of `popup' the translation
+;; outputs to the popup tooltip using `popup' package. In case of
+;; `kill-ring' the translation outputs to the kill ring. And in case
+;; of `current-buffer' the translation outputs to the current
+;; buffer. If you would like output translation to the Echo Area you
+;; would probably like to increase it because only part of translation
+;; could visible there with the default settings. To increase Echo
+;; Area you could increase the value of `max-mini-window-height'
+;; variable, for example: `(setq max-mini-window-height 0.5)'.
+;;
+;; If `google-translate-enable-ido-completion' is non-NIL, the input
+;; will be read with ido-style completion.
+;;
+;; The variable `google-translate-show-phonetic' controls whether the
+;; phonetic spelling of the original text and its translation is
+;; displayed if available. If you want to see the phonetics, set this
+;; variable to t.
+;;
+;; The variable `google-translate-listen-program' determines the
+;; program to use to listen translations. By default the program looks
+;; for `mplayer' in the PATH, if `mplayer' is found then listening
+;; function will be available and you'll see `Listen' button in the
+;; buffer with the translation. You can use any other suitable
+;; program. If you use Windows please download and unpack `mplayer'
+;; and add its path (directory) to the system PATH variable. Please
+;; note that translation listening is not available if
+;; `google-translate-output-destination' is set to `echo-area' or
+;; `popup'.
+;;
+;; The variable `google-translate-pop-up-buffer-set-focus' determines
+;; whether window (buffer) with translation gets focus when it pop
+;; ups. If `nil', it doesn't get focus and focus remains in the same
+;; window as was before translation. If `t', window (buffer with
+;; translation) gets focus. Please note that that setting works only
+;; for pop up buffer, i.e. when `google-translate-output-destination'
+;; is `nil'.
+;;
+;; The `google-translate-input-method-auto-toggling' variable
+;; determines whether input method auto toggling is enabled or not.
+;;
+;; While switching among languages I noticed that I change input
+;; method quite often. Input method auto toggling allows switch on
+;; appropriate input method while switching among languages. Auto
+;; toggling will work in case of
+;; `google-translate-input-method-auto-toggling' is set to `t' and
+;; `google-translate-preferable-input-methods-alist' is defined
+;; properly.
+;;
+;; This variable may be defined as follow (just for example):
+;;
+;; (setq google-translate-preferable-input-methods-alist '((nil . ("en"))
+;; (ukrainian-programmer-dvorak . ("ru" "uk"))))
+;;
+;; In this way, input method is disabled (because of nil) for the
+;; minibuffer when source language is English. And
+;; "ukrainian-programmer-dvorak" input method is enabled when source
+;; language is Russian or Ukrainian.
+
+;; Customization of faces:
+
+;; - `google-translate-text-face', used to display the original text
+;; (defaults to `default')
+;;
+;; - `google-translate-phonetic-face', used to display the phonetics
+;; (defaults to `shadow')
+;;
+;; - `google-translate-translation-face', used to display the highest
+;; ranking translation (defaults to `default' with the `weight'
+;; attribute set to `bold')
+;;
+;; - `google-translate-suggestion-label-face' used to display the
+;; label for suggestion (defaults to `default' with the `foreground'
+;; attribute set to `red')
+;;
+;; - `google-translate-suggestion-face' used to display the suggestion
+;; in case of word is misspelled (defaults to `default' with the
+;; `slant' attribute set to `italic' and `underline' attribute set
+;; to `t')
+;;
+;; - `google-translate-listen-button-face' used to display the "Listen"
+;; button (defaults to `height' 0.8).
+;;
+;; For example, to show the translation in a larger font change the
+;; `height' attribute of the face `google-translate-translation-face'
+;; like so:
+;;
+;; (set-face-attribute 'google-translate-translation-face nil :height 1.4)
+;;
+;;
+;;; Code:
+;;
+
+(eval-when-compile (require 'cl-lib))
+(require 'google-translate-core)
+(require 'ido)
+(require 'popup)
+(require 'color)
+(require 'facemenu)
+
+(defvar google-translate-supported-languages-alist
+ '(("Afrikaans" . "af")
+ ("Albanian" . "sq")
+ ("Amharic" . "am")
+ ("Arabic" . "ar")
+ ("Armenian" . "hy")
+ ("Azerbaijani" . "az")
+ ("Basque" . "eu")
+ ("Belarusian" . "be")
+ ("Bengali" . "bn")
+ ("Bosnian" . "bs")
+ ("Bulgarian" . "bg")
+ ("Catalan" . "ca")
+ ("Cebuano" . "ceb")
+ ("Chichewa" . "ny")
+ ("Chinese Simplified" . "zh-CN")
+ ("Chinese Traditional" . "zh-TW")
+ ("Corsican" . "co")
+ ("Croatian" . "hr")
+ ("Czech" . "cs")
+ ("Danish" . "da")
+ ("Dutch" . "nl")
+ ("English" . "en")
+ ("Esperanto" . "eo")
+ ("Estonian" . "et")
+ ("Filipino" . "tl")
+ ("Finnish" . "fi")
+ ("French" . "fr")
+ ("Frisian" . "fy")
+ ("Galician" . "gl")
+ ("Georgian" . "ka")
+ ("German" . "de")
+ ("Greek" . "el")
+ ("Gujarati" . "gu")
+ ("Haitian Creole" . "ht")
+ ("Hausa" . "ha")
+ ("Hawaiian" . "haw")
+ ("Hebrew" . "iw")
+ ("Hindi" . "hi")
+ ("Hmong" . "hmn")
+ ("Hungarian" . "hu")
+ ("Icelandic" . "is")
+ ("Igbo" . "ig")
+ ("Indonesian" . "id")
+ ("Irish" . "ga")
+ ("Italian" . "it")
+ ("Japanese" . "ja")
+ ("Javanese" . "jw")
+ ("Kannada" . "kn")
+ ("Kazakh" . "kk")
+ ("Khmer" . "km")
+ ("Korean" . "ko")
+ ("Kurdish (Kurmanji)" . "ku")
+ ("Kyrgyz" . "ky")
+ ("Lao" . "lo")
+ ("Latin" . "la")
+ ("Latvian" . "lv")
+ ("Lithuanian" . "lt")
+ ("Luxembourgish" . "lb")
+ ("Macedonian" . "mk")
+ ("Malagasy" . "mg")
+ ("Malay" . "ms")
+ ("Malayalam" . "ml")
+ ("Maltese" . "mt")
+ ("Maori" . "mi")
+ ("Marathi" . "mr")
+ ("Mongolian" . "mn")
+ ("Myanmar (Burmese)" . "my")
+ ("Nepali" . "ne")
+ ("Norwegian" . "no")
+ ("Pashto" . "ps")
+ ("Persian" . "fa")
+ ("Polish" . "pl")
+ ("Portuguese" . "pt")
+ ("Punjabi" . "pa")
+ ("Romanian" . "ro")
+ ("Russian" . "ru")
+ ("Samoan" . "sm")
+ ("Scots Gaelic" . "gd")
+ ("Serbian" . "sr")
+ ("Sesotho" . "st")
+ ("Shona" . "sn")
+ ("Sindhi" . "sd")
+ ("Sinhala" . "si")
+ ("Slovak" . "sk")
+ ("Slovenian" . "sl")
+ ("Somali" . "so")
+ ("Spanish" . "es")
+ ("Sundanese" . "su")
+ ("Swahili" . "sw")
+ ("Swedish" . "sv")
+ ("Tajik" . "tg")
+ ("Tamil" . "ta")
+ ("Telugu" . "te")
+ ("Thai" . "th")
+ ("Turkish" . "tr")
+ ("Ukrainian" . "uk")
+ ("Urdu" . "ur")
+ ("Uzbek" . "uz")
+ ("Vietnamese" . "vi")
+ ("Welsh" . "cy")
+ ("Xhosa" . "xh")
+ ("Yiddish" . "yi")
+ ("Yoruba" . "yo")
+ ("Zulu" . "zu"))
+ "Alist of the languages supported by Google Translate.
+
+Each element is a cons-cell of the form (NAME . CODE), where NAME
+is a human-readable language name and CODE is its code used as a
+query parameter in HTTP requests.")
+
+(defvar google-translate-translation-listening-debug nil
+ "For debug translation listening purposes.")
+
+(cl-defstruct gtos
+ "google translate output structure contains miscellaneous
+ information which intended to be outputed to the buffer, echo
+ area or popup tooltip."
+ source-language target-language text
+ auto-detected-language text-phonetic translation
+ translation-phonetic detailed-translation suggestion detailed-definition)
+
+(defgroup google-translate-core-ui nil
+ "Emacs core UI script for the Google Translate package."
+ :group 'processes)
+
+(defcustom google-translate-enable-ido-completion nil
+ "If non-NIL, use `ido-completing-read' rather than `completing-read' for reading input."
+ :group 'google-translate-core-ui
+ :type '(choice (const :tag "No" nil)
+ (other :tag "Yes" t)))
+
+(defcustom google-translate-show-phonetic nil
+ "If non-NIL, try to show the phonetic spelling."
+ :group 'google-translate-core-ui
+ :type '(choice (const :tag "No" nil)
+ (const :tag "Yes" t)))
+
+(defcustom google-translate-listen-program
+ (executable-find "mplayer")
+ "The program to use to listen translations.
+
+By default the program looks for `mplayer' in the PATH, if
+`mplayer' is found then listening function will be available and
+you'll see `Listen' button in the buffer with the translation.
+You can use any other suitable program."
+ :group 'google-translate-core-ui
+ :type '(string))
+
+(defcustom google-translate-output-destination
+ nil
+ "Determines where translation output will be displayed.
+
+- If it is `nil', output to temporary pop up buffer (default).
+- `echo-area': output to the Echo Area.
+- `popup': output to the popup tooltip using `popup' package.
+- `kill-ring': the output will be added in `kill-ring'.
+- `current-buffer': the output will be inserted to current buffer.
+- `help': output to help buffer.
+- `paragraph-overlay': output in current buffer overlay paragraph by paragraph.
+- `paragraph-insert': output will be inserted in buffer paragraph by paragraph."
+ :group 'google-translate-core-ui
+ :type '(repeat (choice (const :tag "temporary popup buffer" nil)
+ (const :tag "Echo Area" echo-area)
+ (const :tag "popup tooltip using popup.el" popup)
+ (const :tag "kill-ring" kill-ring)
+ (const :tag "current buffer" current-buffer)
+ (const :tag "popup Help buffer" help)
+ (const :tag "paragraph-by-paragraph in overlay" paragraph-overlay)
+ (const :tag "paragraph-by-paragraph inserted in buffer" paragraph-insert))))
+
+(defcustom google-translate-pop-up-buffer-set-focus
+ nil
+ "Determines whether result window (buffer) gets focus when it pop ups.
+
+If nil, it doesn't get focus and focus remains in the same
+window as was before translation. If t, window (buffer with
+translation) gets focus.")
+
+(defcustom google-translate-display-translation-phonetic t
+ "Determines whether display phonetic transcription of the translating text.")
+
+(defcustom google-translate-listen-button-label
+ "[Listen]"
+ "Label of the 'Listen' button."
+ :group 'google-translate-core-ui
+ :type 'string)
+
+(defcustom google-translate-translation-to-kill-ring nil
+ "Add translation to kill-ring after translate commands if it's `t'."
+ :type 'boolean
+ :safe #'booleanp
+ :group 'google-translate-core-ui)
+
+(defface google-translate-text-face
+ '((t (:inherit default)))
+ "Face used to display the original text."
+ :group 'google-translate-core-ui)
+
+(defface google-translate-phonetic-face
+ '((t (:inherit shadow)))
+ "Face used to display the phonetic spelling."
+ :group 'google-translate-core-ui)
+
+(defface google-translate-translation-face
+ '((t (:weight bold)))
+ "Face used to display the probable translation."
+ :group 'google-translate-core-ui)
+
+(defface google-translate-suggestion-label-face
+ '((t (:foreground "red")))
+ "Face used to display the suggestion label."
+ :group 'google-translate-core-ui)
+
+(defface google-translate-suggestion-face
+ '((t (:slant italic :underline t)))
+ "Face used to display the suggestion."
+ :group 'google-translate-core-ui)
+
+(defface google-translate-listen-button-face
+ '((t (:inherit button :height 0.8)))
+ "Face used to display button \"Listen\"."
+ :group 'google-translate-core-ui)
+
+(defvar google-translate-input-method-auto-toggling nil
+ "When t, the current source language is compared.
+
+Compared with the values from
+`google-translate-preferable-input-methods-alist' and enables
+appropriate input method for the minibuffer. So this feature may
+allow to avoid switching between input methods while translating
+using different languages.")
+
+(defvar google-translate-preferable-input-methods-alist
+ '((nil . nil))
+ "Alist of preferable input methods for certain languages.
+
+Each element is a cons-cell of the form (INPUT-METHOD
+. LANGUAGES-LIST), where INPUT-METHOD is the input method which
+will be switched on, when translation source language equals to
+one of the language from the LANGUAGE-LIST.
+
+INPUT-METHOD could be specified as nil. In such case input method
+disables.
+
+As example, this alist could looks like the following:
+
+ '((nil . \"en\")
+ (ukrainian-programmer-dvorak . (\"ru\" \"uk\")))
+
+In this way, `ukrainian-programmer-dvorak' will be auto enabled
+for the minibuffer when Russian or Ukrainian (as source language)
+is active.")
+
+
+(defvar google-translate-result-translation nil
+ "The result translation of `google-translate-translate'.")
+
+(defun google-translate-supported-languages ()
+ "Return a list of names of languages supported by Google Translate."
+ (mapcar #'car google-translate-supported-languages-alist))
+
+(defun google-translate-language-abbreviation (language)
+ "Return the abbreviation of LANGUAGE."
+ (if (string-equal language "Detect language")
+ "auto"
+ (cdr (assoc language google-translate-supported-languages-alist))))
+
+(defun google-translate-language-display-name (abbreviation)
+ "Return a name suitable for use in prompts of the language whose abbreviation is ABBREVIATION."
+ (if (string-equal abbreviation "auto")
+ "unspecified language"
+ (car (rassoc abbreviation google-translate-supported-languages-alist))))
+
+(defun google-translate-paragraph (text face &optional output-format)
+ "Return TEXT as a filled paragraph into the current buffer.
+And apply FACE to it. Optionally use OUTPUT-FORMAT."
+ (let ((beg (point))
+ (output-format
+ (if output-format output-format "\n%s\n")))
+ (with-temp-buffer
+ (insert (format output-format text))
+ (facemenu-set-face face beg (point))
+ (fill-region beg (point))
+ (buffer-substring (point-min) (point-max)))))
+
+(defun google-translate-setup-preferable-input-method (source-language)
+ "Set input method which takes from the value of
+`google-translate-preferable-input-methods-alist' variable."
+ (interactive)
+ (let* ((preferable-input-method
+ (google-translate-find-preferable-input-method source-language)))
+ (set-input-method preferable-input-method)))
+
+(defun google-translate-find-preferable-input-method (source-language)
+ "Look for the SOURCE-LANGUAGE in the
+`google-translate-preferable-input-methods-alist' and return
+input method for it."
+ (let ((input-method nil))
+ (dolist (item google-translate-preferable-input-methods-alist)
+ (dolist (language (cdr item))
+ (when (string-equal source-language language)
+ (setq input-method (car item)))))
+ input-method))
+
+(defun google-translate--translation-title (gtos format)
+ "Return translation title which contains information about used
+source and target languages."
+ (let ((source-language (gtos-source-language gtos))
+ (target-language (gtos-target-language gtos))
+ (auto-detected-language (gtos-auto-detected-language gtos)))
+ (format format
+ (if (string-equal source-language "auto")
+ (format "%s (detected)"
+ (google-translate-language-display-name
+ auto-detected-language))
+ (google-translate-language-display-name
+ source-language))
+ (google-translate-language-display-name
+ target-language))))
+
+(defun google-translate--translating-text (gtos format)
+ "Outputs in buffer translating text."
+ (let ((text (gtos-text gtos)))
+ (let ((output-format format))
+ (google-translate-paragraph
+ text
+ 'google-translate-text-face
+ output-format))))
+
+(defun google-translate--text-phonetic (gtos format)
+ "Outputs in buffer text phonetic in case of
+`google-translate-show-phonetic' is set to t."
+ (let ((text-phonetic (gtos-text-phonetic gtos)))
+ (if (and google-translate-show-phonetic
+ (not (string-equal text-phonetic "")))
+ (google-translate-paragraph
+ text-phonetic
+ 'google-translate-phonetic-face
+ format)
+ "")))
+
+(defun google-translate--translated-text (gtos format)
+ "Output in buffer translation."
+ (let ((translation (gtos-translation gtos)))
+ (google-translate-paragraph
+ translation
+ 'google-translate-translation-face
+ format)))
+
+(defun google-translate--translation-phonetic (gtos format)
+ "Output in buffer translation phonetic in case of
+`google-translate-show-phonetic' is set to t."
+ (let ((translation-phonetic (gtos-translation-phonetic gtos)))
+ (if (and google-translate-show-phonetic
+ (not (string-equal translation-phonetic "")))
+ (google-translate-paragraph
+ translation-phonetic
+ 'google-translate-phonetic-face
+ format)
+ "")))
+
+(defun google-translate--detailed-translation (detailed-translation translation
+ format1
+ format2)
+ "Return detailed translation."
+ (with-temp-buffer
+ (cl-loop for item across detailed-translation do
+ (let ((index 0)
+ (label (aref item 0)))
+ (unless (string-equal label "")
+ (put-text-property 0 (length label)
+ 'font-lock-face
+ 'google-translate-translation-face
+ label)
+ (insert (format format1 label))
+ (cl-loop for translation across (aref item 2) do
+ (let ((content
+ (format "%s (%s)"
+ (aref translation 0)
+ (mapconcat 'identity
+ (aref translation 1)
+ ", "))))
+ (insert (format format2
+ (cl-incf index)
+ content)))))))
+ (buffer-substring (point-min) (point-max))))
+
+(defun google-translate--detailed-definition (detailed-definition definition
+ format1
+ format2)
+ "Return detailed definition."
+ (with-temp-buffer
+ (let ((section "DEFINITION"))
+ (put-text-property 0 (length section)
+ 'font-lock-face
+ 'google-translate-translation-face
+ section)
+ (insert (format "\n%s\n" section)))
+ (cl-loop for item across detailed-definition do
+ (let ((index 0)
+ (label (aref item 0)))
+ (unless (string-equal label "")
+ (put-text-property 0 (length label)
+ 'font-lock-face
+ 'google-translate-translation-face
+ label)
+ (insert (format format1 label))
+ (cl-loop for definition across (aref item 1) do
+ (insert (format format2
+ (cl-incf index)
+ (if (> (length definition) 2)
+ (format "%s\n \"%s\""
+ (aref definition 0)
+ (aref definition 2))
+ (format "%s" (aref definition 0)))))))))
+ (buffer-substring (point-min) (point-max))))
+
+(defun google-translate--suggestion (gtos)
+ "Return suggestion."
+ (let ((source-language (gtos-source-language gtos))
+ (target-language (gtos-target-language gtos))
+ (suggestion (gtos-suggestion gtos)))
+ (if suggestion
+ (with-temp-buffer
+ (insert "\n")
+ (let ((beg (point)))
+ (insert "Did you mean: ")
+ (facemenu-set-face 'google-translate-suggestion-label-face
+ beg (point)))
+ (goto-char (+ (point) 1))
+ (let ((beg (point)))
+ (insert-text-button suggestion
+ 'action 'google-translate--suggestion-action
+ 'follow-link t
+ 'suggestion suggestion
+ 'source-language source-language
+ 'target-language target-language)
+ (facemenu-set-face 'google-translate-suggestion-face
+ beg (point))
+ (insert "\n"))
+ (buffer-substring (point-min) (point-max)))
+ "")))
+
+(defun google-translate--suggestion-action (button)
+ "Suggestion action which occur when suggestion button is
+clicked."
+ (interactive)
+ (let ((suggestion (button-get button 'suggestion))
+ (source-language (button-get button 'source-language))
+ (target-language (button-get button 'target-language)))
+ (google-translate-translate source-language
+ target-language
+ suggestion)))
+
+(defun google-translate--listen-button (language text)
+ "Return listen button."
+ (with-temp-buffer
+ (insert " ")
+ (insert-text-button google-translate-listen-button-label
+ 'action 'google-translate--listen-action
+ 'face 'google-translate-listen-button-face
+ 'follow-link t
+ 'text text
+ 'language language)
+ (insert "\n")
+ (buffer-substring (point-min) (point-max))))
+
+(defun google-translate--listen-action (button)
+ "Do translation listening."
+ (interactive)
+ (let ((text (button-get button 'text))
+ (language (button-get button 'language)))
+ (google-translate-listen-translation language text)))
+
+(defun google-translate-listen-translation (language text)
+ (let ((buf "*mplayer output*"))
+ (message "Retrieving audio message...")
+ (if google-translate-translation-listening-debug
+ (with-current-buffer (get-buffer-create buf)
+ (insert (format "Listen program: %s\r\n" google-translate-listen-program))
+ (mapc (lambda (x) (insert (format "Listen URL: %s\r\n" x)))
+ (google-translate-format-listen-urls text language))
+ (apply 'call-process google-translate-listen-program nil t nil
+ (google-translate-format-listen-urls text language))
+ (switch-to-buffer buf))
+ (apply 'call-process google-translate-listen-program nil nil nil
+ (google-translate-format-listen-urls text language)))))
+
+(defun google-translate-translate (source-language target-language text &optional output-destination)
+ "Translate TEXT from SOURCE-LANGUAGE to TARGET-LANGUAGE.
+
+About the OUTPUT-DESTINATION, check out option
+`google-translate-output-destination'.
+
+To deal with multi-line regions, sequences of white space
+are replaced with a single space. If the region contains not text, a
+message is printed.
+
+At last will save result translation to `google-translate-result-translation'."
+ (let* ((json (google-translate-request source-language
+ target-language
+ text)))
+ (if (null json)
+ (message "Nothing to translate.")
+ (let* ((detailed-translation
+ (google-translate-json-detailed-translation json))
+ (detailed-definition
+ (google-translate-json-detailed-definition json))
+ (gtos
+ (make-gtos
+ :source-language source-language
+ :target-language target-language
+ :auto-detected-language (aref json 2)
+ :text text
+ :text-phonetic (google-translate-json-text-phonetic json)
+ :translation (google-translate-json-translation json)
+ :translation-phonetic (if google-translate-display-translation-phonetic
+ (google-translate-json-translation-phonetic json) "")
+ :detailed-translation detailed-translation
+ :detailed-definition detailed-definition
+ :suggestion (when (null detailed-translation)
+ (google-translate-json-suggestion json))))
+ (output-destination (if (null output-destination)
+ google-translate-output-destination
+ output-destination)))
+ (cond
+ ((null output-destination)
+ (google-translate-buffer-output-translation gtos))
+ ((equal output-destination 'echo-area)
+ (google-translate-echo-area-output-translation gtos))
+ ((equal output-destination 'popup)
+ (google-translate-popup-output-translation gtos))
+ ((equal output-destination 'kill-ring)
+ (google-translate-kill-ring-output-translation gtos))
+ ((equal output-destination 'current-buffer)
+ (google-translate-current-buffer-output-translation gtos))
+ ((equal output-destination 'help)
+ (let ((describe-func
+ (function
+ (lambda (gtos)
+ (google-translate-help-buffer-output-translation gtos)))))
+ (help-setup-xref (list 'google-translate-translate source-language target-language text) nil)
+ (with-help-window (help-buffer)
+ (funcall describe-func gtos))))
+ ((equal output-destination 'paragraph-overlay)
+ (google-translate-paragraph-overlay-output-translation gtos))
+ ((equal output-destination 'paragraph-insert)
+ (google-translate-paragraph-insert-output-translation gtos)))
+ (setq google-translate-result-translation (gtos-translation gtos))
+ (when google-translate-translation-to-kill-ring
+ (kill-new google-translate-result-translation))))))
+
+(defun google-translate-popup-output-translation (gtos)
+ "Output translation to the popup tooltip using `popup'
+package."
+ (require 'popup)
+ (popup-tip
+ (with-temp-buffer
+ (google-translate-insert-translation gtos)
+ (google-translate--trim-string
+ (buffer-substring (point-min) (point-max))))))
+
+(defun google-translate-echo-area-output-translation (gtos)
+ "Output translation to the echo area (See
+http://www.gnu.org/software/emacs/manual/html_node/elisp/The-Echo-Area.html)"
+ (message
+ (with-temp-buffer
+ (google-translate-insert-translation gtos)
+ (google-translate--trim-string
+ (buffer-substring (point-min) (point-max))))))
+
+(defun google-translate-kill-ring-output-translation (gtos)
+ "Output translation to the kill ring."
+ (kill-new
+ (with-temp-buffer
+ (insert
+ (gtos-translation gtos))
+ (google-translate--trim-string
+ (buffer-substring (point-min) (point-max)))))
+ (message "Translated text was added to the kill ring."))
+
+(defun google-translate-current-buffer-output-translation (gtos)
+ "Output translation to current buffer."
+ (insert
+ (gtos-translation gtos))
+ (message "Translated text was added to current buffer."))
+
+(defun google-translate-insert-translation (gtos)
+ "Insert translation to the current buffer."
+ (let ((translation (gtos-translation gtos))
+ (detailed-translation (gtos-detailed-translation gtos)))
+ (insert
+ (google-translate--translation-title gtos "%s -> %s:")
+ (google-translate--translating-text gtos " %s")
+ (google-translate--text-phonetic gtos " [%s]")
+ " - "
+ (google-translate--translated-text gtos "%s")
+ (google-translate--translation-phonetic gtos " [%s]")
+ (if detailed-translation
+ (google-translate--detailed-translation
+ detailed-translation translation
+ "\n* %s " "%d. %s ")
+ (google-translate--suggestion gtos)))))
+
+(defun google-translate-buffer-output-translation (gtos)
+ "Output translation to the temp buffer."
+ (let ((buffer-name "*Google Translate*"))
+ (with-output-to-temp-buffer buffer-name
+ (if google-translate-pop-up-buffer-set-focus
+ (select-window (display-buffer buffer-name))
+ (set-buffer buffer-name))
+ (google-translate-buffer-insert-translation gtos))))
+
+(defun google-translate-paragraph-overlay-output-translation (gtos)
+ "Output translation below the paragraph with overlay."
+ (let ((start (save-excursion (start-of-paragraph-text) (point)))
+ (end (save-excursion (end-of-paragraph-text) (point)))
+ (below-paragraph (if (eq major-mode 'org-mode)
+ (save-excursion (previous-line) (point))
+ (save-excursion (end-of-paragraph-text) (forward-line) (point))))
+ (translation (gtos-translation gtos)))
+ (with-silent-modifications
+ (put-text-property
+ (1- below-paragraph) below-paragraph
+ 'display (propertize
+ (concat "\n\n" translation "\n")
+ 'face `(:background ,(color-darken-name (face-background 'default) 4)))))))
+
+(defun google-translate-paragraph-insert-output-translation (gtos)
+ "Insert translation below the paragraph with overlay."
+ (let ((start (save-excursion (start-of-paragraph-text) (point)))
+ (end (save-excursion (end-of-paragraph-text) (point)))
+ (below-paragraph (save-excursion (end-of-paragraph-text) (forward-line) (point)))
+ (translation (gtos-translation gtos)))
+ (goto-char below-paragraph)
+ (insert (concat "\n" translation "\n"))))
+
+(defun google-translate-help-buffer-output-translation (gtos)
+ "Output translation to the help buffer."
+ (and google-translate-pop-up-buffer-set-focus
+ (select-window (display-buffer "*Help*")))
+ (google-translate-buffer-insert-translation gtos))
+
+(defun google-translate-buffer-insert-translation (gtos)
+ "Insert translation to the current temp buffer."
+ (let ((translation (gtos-translation gtos))
+ (detailed-translation (gtos-detailed-translation gtos))
+ (detailed-definition (gtos-detailed-definition gtos))
+ (source-language (gtos-source-language gtos))
+ (target-language (gtos-target-language gtos))
+ (auto-detected-language (gtos-auto-detected-language gtos))
+ (text (gtos-text gtos)))
+ (insert
+ (google-translate--translation-title gtos "Translate from %s to %s:\n")
+ "\n"
+ (google-translate--translating-text
+ gtos
+ (if (null google-translate-listen-program)
+ "%s\n"
+ "%s"))
+ (if google-translate-listen-program
+ (google-translate--listen-button
+ (if (string-equal source-language "auto")
+ auto-detected-language
+ source-language) text) "")
+ (google-translate--text-phonetic gtos "\n%s\n")
+ "\n"
+ (google-translate--translated-text
+ gtos
+ (if (null google-translate-listen-program)
+ "%s\n"
+ "%s"))
+ (if google-translate-listen-program
+ (google-translate--listen-button target-language translation) "")
+ (google-translate--translation-phonetic gtos "\n%s\n")
+ (if detailed-translation
+ (google-translate--detailed-translation
+ detailed-translation translation
+ "\n%s\n" "%2d. %s\n")
+ (google-translate--suggestion gtos))
+ (if detailed-definition
+ (google-translate--detailed-definition
+ detailed-definition translation
+ "\n%s\n" "%2d. %s\n")
+ ""))))
+
+(defun google-translate-read-source-language (&optional prompt)
+ "Read a source language, with completion, and return its abbreviation.
+
+The null input is equivalent to \"Detect language\"."
+ (let ((completion-ignore-case t)
+ (prompt
+ (if (null prompt)
+ "Translate from: "
+ prompt)))
+ (google-translate-language-abbreviation
+ (google-translate-completing-read
+ prompt
+ (google-translate-supported-languages)
+ "Detect language"))))
+
+(defun google-translate-read-target-language (&optional prompt)
+ "Read a target language, with completion, and return its abbreviation.
+
+The input is guaranteed to be non-null."
+ (let ((completion-ignore-case t)
+ (prompt
+ (if (null prompt)
+ "Translate to: "
+ prompt)))
+ (cl-flet ((read-language ()
+ (google-translate-completing-read
+ prompt
+ (google-translate-supported-languages))))
+ (let ((target-language (read-language)))
+ (while (string-equal target-language "")
+ (setq target-language (read-language)))
+ (google-translate-language-abbreviation target-language)))))
+
+(defun google-translate-completing-read (prompt choices &optional def)
+ "Read a string in the minibuffer with completion.
+
+If `google-translate-enable-ido-completion' is non-NIL, use
+ido-style completion."
+ (funcall (if google-translate-enable-ido-completion
+ #'ido-completing-read
+ #'completing-read)
+ prompt choices nil t nil nil def))
+
+(provide 'google-translate-core-ui)
+
+;;; google-translate-core-ui.el ends here
--- /dev/null
+;;; google-translate-core.el --- google-translate core script.
+
+;; Copyright (C) 2012 Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+
+;; Author: Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+;; Maintainer: Andrey Tykhonov <atykhonovNOSPAMgmail.com>
+;; URL: https://github.com/atykhonov/google-translate
+;; Package-Requires: ((emacs "25.1"))
+;; Keywords: convenience
+
+;; Contributors:
+;; Tassilo Horn <tsdhNOSPAMgnu.org>
+;; Bernard Hurley <bernardNOSPAMmarcade.biz>
+;; Chris Bilson <cbilsonNOSPAMpobox.com>
+;; Takumi Kinjo <takumi.kinjoNOSPAMgmail.com>
+;; momomo5717 <momomo5717NOSPAMgmail.com>
+;; stardiviner <numbchildNOSPAMgmail.com>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file is the core of `google-translate' package. It does contains
+;; the most important and vital functions and variables for the
+;; package functionality.
+;;
+;; The most important is the `google-translate-request' function which
+;; is intended to be used by other scripts and packages, expecially by
+;; the packages which provides UI.
+;;
+;; This, `google-translate-core', package doesn't provide any UI.
+;;
+;; `google-translate-request' function sends http request to the
+;; google service and returns JSON response which contains translation
+;; and other info.
+;;
+;; There are also a set of helper functions which are going to be
+;; useful to retrieve data from the mentioned JSON response:
+;;
+;; `google-translate-json-text-phonetic' - retrieves text phonetic;
+;;
+;; `google-translate-json-translation' - retrieves translation;
+;;
+;; `google-translate-json-translation-phonetic' - retrieves
+;; phonetic translation;
+;;
+;; `google-translate-json-detailed-translation' - retrieves
+;; additional, detailed information which relates to the
+;; translation.
+;;
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(require 'json)
+(require 'url)
+(require 'google-translate-backend)
+
+(defgroup google-translate-core nil
+ "Google Translate core script."
+ :group 'processes)
+
+(defcustom google-translate-base-url
+ "http://translate.google.com/translate_a/single"
+ "Google Translate base url"
+ :group 'google-translate-core
+ :type 'string)
+
+(defcustom google-translate-listen-url
+ "http://translate.google.com/translate_tts"
+ "Google Translate listen url"
+ :group 'google-translate-core
+ :type 'string)
+
+(defvar google-translate-host-language
+ (if current-iso639-language
+ (symbol-name current-iso639-language)
+ "en")
+ "Host language to translate.")
+
+(defvar google-translate-punctuation-re "[,、]"
+ "Regexp describing the punctuation.")
+
+(defvar google-translate-listen-maxlen 200
+ "Split text for tts url to less than this. If 0, disable split.")
+
+(defun google-translate--split-text (text maxlen)
+ "Split TEXT to less than MAXLEN at applicable point for translating."
+ (let (result)
+ (if (or (null maxlen) (<= maxlen 0))
+ (push text result)
+ ;; split long text?
+ (with-temp-buffer
+ (save-excursion (insert text))
+ ;; strategy to split at applicable point
+ ;; 1) fill-region remaining text by maxlen
+ ;; 2) find end of sentence, end of punctuation, word boundary
+ ;; 3) consume from remaining text between start and (2)
+ ;; 4) repeat
+ (let ((fill-column (* maxlen 3))
+ (sentence-end-double-space nil)
+ (pos (point-min)))
+ (while (< pos (point-max))
+ (save-restriction
+ (narrow-to-region pos (point-max))
+ (fill-region pos (point-max))
+ (let ((limit (+ pos maxlen)))
+ (if (>= limit (point-max))
+ (setq limit (point-max))
+ (goto-char limit)
+ ;; try to split at end of sentence
+ (if (> (backward-sentence) pos)
+ (setq limit (point))
+ ;; try to split at end of punctuation
+ (goto-char limit)
+ (if (re-search-backward google-translate-punctuation-re
+ pos t)
+ (setq limit (1+ (point))) ; include punctuation
+ (goto-char limit)
+ ;; try to split at word boundary
+ (forward-word-strictly -1)
+ (when (> (point) pos)
+ (setq limit (point))))))
+ (push (buffer-substring-no-properties pos limit) result)
+ (goto-char limit)
+ (setq pos limit)))))))
+ (reverse result)))
+
+(defun google-translate--format-query-string (query-params)
+ "Format QUERY-PARAMS as a query string.
+
+QUERY-PARAMS must be an alist of field-value pairs."
+ (mapconcat #'(lambda (p)
+ (format "%s=%s"
+ (url-hexify-string (car p))
+ (url-hexify-string (cdr p))))
+ query-params "&"))
+
+(defun google-translate--format-request-url (query-params)
+ "Format QUERY-PARAMS as a Google Translate HTTP request URL.
+
+QUERY-PARAMS must be an alist of field-value pairs."
+ (concat google-translate-base-url
+ "?"
+ (google-translate--format-query-string query-params)))
+
+(defun google-translate--format-listen-url (query-params)
+ "Format QUERY-PARAMS as a Google Translate HTTP request URL for listen translation.
+
+QUERY-PARAMS must be an alist of field-value pairs."
+ (concat google-translate-listen-url
+ "?"
+ (google-translate--format-query-string query-params)))
+
+(defun google-translate-format-listen-url (text language &optional total idx)
+ "Format listen url for TEXT and TARGET-LANGUAGE."
+ (google-translate--format-listen-url `(("ie" . "UTF-8")
+ ("q" . ,text)
+ ("tl" . ,language)
+ ("total" . ,(or total "1"))
+ ("idx" . ,(or idx "0"))
+ ("textlen" . ,(number-to-string (length text)))
+ ("client" . "gtx")
+ ("prev" . "input"))))
+
+(defun google-translate-format-listen-urls (text language)
+ "Split TEXT with `google-translate--split-text', then format
+listen url for TEXT and TARGET-LANGUAGE."
+ (let* ((texts (google-translate--split-text
+ text google-translate-listen-maxlen))
+ (total (number-to-string (length texts)))
+ (idx 0))
+ (mapcar (lambda (x)
+ (prog1 (google-translate-format-listen-url x language total
+ (number-to-string idx))
+ (setq idx (1+ idx))))
+ texts)))
+
+(defun google-translate--http-response-body (url &optional for-test-purposes)
+ "Retrieve URL and return the response body as a string."
+ (let ((google-translate-backend-debug (or for-test-purposes
+ google-translate-backend-debug)))
+ (with-temp-buffer
+ (save-excursion
+ (google-translate-backend-retrieve url))
+ (set-buffer-multibyte t)
+ (buffer-string))))
+
+(defun google-translate--insert-nulls (string)
+ "Google Translate responses with an almost valid JSON string
+respresentation except that the nulls appear to be dropped. In
+particular the response may contain the substrings \"[,\",
+\",,\", and \",]\". This function undoes that."
+ (with-temp-buffer
+ (set-buffer-multibyte t)
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\\[,\\|,,\\|,\\]\\)" (point-max) t)
+ (backward-char)
+ (insert "null"))
+ (buffer-string)))
+
+(defun google-translate--trim-string (string)
+ "Remove whitespaces in beginning and ending of STRING.
+ White space here is any of: space, tab, emacs newline (line feed, ASCII 10)."
+ (replace-regexp-in-string "\\`[ \t\n\r]*" ""
+ (replace-regexp-in-string "[ \t\n\r]*\\'" "" string)))
+
+(defun google-translate--strip-string (string)
+ "Replace spaces, tabs, line feeds (ASCII 10) and carridge
+returns (ASCII 13) by a single space symbol."
+ (replace-regexp-in-string "[[:space:]\n\r]+" " " string))
+
+(defun google-translate-prepare-text-for-request (text)
+ "Make TEXT as clean as possible berofe sending it in the
+request."
+ (google-translate--trim-string
+ (google-translate--strip-string text)))
+
+(defun google-translate-request (source-language target-language text)
+ "Send to the Google Translate http request which consigned to
+translate TEXT from SOURCE-LANGUAGE to TARGET-LANGUAGE. Returns
+response in json format."
+ (let ((cleaned-text (google-translate-prepare-text-for-request text)))
+ (when (and
+ (stringp cleaned-text)
+ (> (length cleaned-text) 0))
+ (json-read-from-string
+ (google-translate--insert-nulls
+ (google-translate--request source-language target-language text))))))
+
+(defun google-translate--request (source-language
+ target-language
+ text
+ &optional for-test-purposes)
+ "Send to the Google Translate http request which consigned to
+translate TEXT from SOURCE-LANGUAGE to TARGET-LANGUAGE."
+ (google-translate--http-response-body
+ (google-translate--format-request-url
+ `(("client" . "gtx")
+ ("ie" . "UTF-8")
+ ("oe" . "UTF-8")
+ ("hl" . ,google-translate-host-language)
+ ("sl" . ,source-language)
+ ("tl" . ,target-language)
+ ("q" . ,text)
+ ("dt" . "bd")
+ ("dt" . "ex")
+ ("dt" . "ld")
+ ("dt" . "md")
+ ("dt" . "qc")
+ ("dt" . "rw")
+ ("dt" . "rm")
+ ("dt" . "ss")
+ ("dt" . "t")
+ ("dt" . "at")
+ ("pc" . "1")
+ ("otf" . "1")
+ ("srcrom" . "1")
+ ("ssel" . "0")
+ ("tsel" . "0")))
+ for-test-purposes))
+
+(defun google-translate-json-text-phonetic (json)
+ "Retrieve from the JSON (which returns by the
+`google-translate-request' function) phonetic transcription of
+the translating text."
+ (mapconcat (lambda (item) (if (> (length item) 3) (aref item 3) ""))
+ (aref json 0) ""))
+
+(defun google-translate-json-translation (json)
+ "Retrieve from the JSON (which returns by the
+`google-translate-request' function) translation of the
+translating text."
+ (mapconcat #'(lambda (item) (aref item 0))
+ (aref json 0) ""))
+
+(defun google-translate-json-translation-phonetic (json)
+ "Retrieve from the JSON (which returns by the
+`google-translate-request' function) phonetic transcription of
+the translating text."
+ (mapconcat #'(lambda (item) (if (> (length item) 2) (aref item 2) ""))
+ (aref json 0) ""))
+
+(defun google-translate-json-detailed-translation (json)
+ "Retrieve from the JSON (which returns by the
+`google-translate-request' function) a dictionary article
+represented by a vector of items, where each item is a 2-element
+vector whose zeroth element is the name of a part of speech and
+whose first element is a vector of translations for that part of
+speech."
+ (aref json 1))
+
+(defun google-translate-json-detailed-definition (json)
+ "Retrieve the definition of translating text in source language from the JSON
+which returned by the `google-translate-request' function.
+
+This function returns the definition if it's included within the JSON as 12th
+element, or returns nil if not included.
+
+The definition is a dictionary article represented by a vector of items, where
+each item is a 2-element vector whose zeroth element is the name of a part of
+speech and whose first element is a vector of definitions for that part of
+speech."
+ (if (> (length json) 12)
+ (aref json 12)))
+
+(defun google-translate-json-suggestion (json)
+ "Retrieve from JSON (which returns by the
+`google-translate-request' function) suggestion. This function
+does matter when translating misspelled word. So instead of
+translation it is possible to get suggestion."
+ (let ((info (aref json 7)))
+ (unless (seq-empty-p info)
+ (aref info 1))))
+
+(defun google-translate-version ()
+ (interactive)
+ (message "Google Translate (version): %s" "0.12.0"))
+
+
+(provide 'google-translate-core)
+
+;;; google-translate-core.el ends here
--- /dev/null
+;;; google-translate-default-ui.el --- default UI for Google Translate
+;;; package
+
+;; Copyright (C) 2012 Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+
+;; Author: Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+;; Maintainer: Andrey Tykhonov <atykhonovNOSPAMgmail.com>
+;; URL: https://github.com/atykhonov/google-translate
+;; Keywords: convenience
+
+;; Contributors:
+;; Tassilo Horn <tsdhNOSPAMgnu.org>
+;; Bernard Hurley <bernardNOSPAMmarcade.biz>
+;; Chris Bilson <cbilsonNOSPAMpobox.com>
+;; Takumi Kinjo <takumi.kinjoNOSPAMgmail.com>
+;; momomo5717 <momomo5717NOSPAMgmail.com>
+;; stardiviner <numbchildNOSPAMgmail.com>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides default UI for the Google Translate package. It
+;; was originally written by Oleksandr Manzyuk and was part of
+;; google-translate.el. It was extracted to this,
+;; google-translate-default-ui.el file due to refactoring (the goal of
+;; which is to separate backend from UI and provide better way for
+;; having different UIs for Google Translate package).
+;;
+;; Invoking the function `google-translate-query-translate' queries the source
+;; and target languages and text to translate, and shows a buffer with
+;; available translations of the text. Invoking the function
+;; `google-translate-at-point' translates the word at point or the active
+;; region.
+
+;; Customization:
+
+;; You can customize the following variables:
+;;;;
+;; - `google-translate-default-source-language'
+;;
+;; - `google-translate-default-target-language'
+
+;; If the variable `google-translate-default-source-language' is set
+;; to a non-NIL value, the source language won't be queried and that
+;; value will be used instead. Analogously, if you set the variable
+;; `google-translate-default-target-language' to some non-NIL value,
+;; that value will be used without querying.
+
+;; You can always override this behavior by supplying a `C-u' prefix
+;; argument to the function `google-translate-query-translate'.
+
+;; Here is an example. Suppose that your native language is Russian
+;; and you frequently need to translate from various languages to
+;; Russian. Then it is reasonable
+;;
+;; - to set the variable `google-translate-default-target-language'
+;; to "ru", and
+;;
+;; - to leave `google-translate-default-source-language' set to its
+;; default value, NIL.
+;;
+;; In this case, the function `google-translate-query-translate' is
+;; only going to query the source language and text to translate.
+;; If you need to translate to some language other than Russian, you
+;; can override the default for the target language by supplying a
+;; `C-u' prefix argument, in which case you will be queried for both
+;; the source and target languages, as well as text to translate.
+
+;; If you frequently translate from some fixed language, it is also
+;; reasonable to set `google-translate-default-source-language' to
+;; an appropriate value.
+;;
+;; If you have both the default source and target languages specified,
+;; you may like to bind functions `google-translate-at-point-reverse'
+;; and `google-translate-query-translate-reverse' to some keys, e.g.:
+;;
+;; (global-set-key (kbd "C-c r") 'google-translate-at-point-reverse)
+;; (global-set-key (kbd "C-c R") 'google-translate-query-translate-reverse)
+;;
+;; This will allow you to quickly translate in the reverse direction.
+;; When the default source (resp. target) language is not set, the
+;; target (resp. source) language of the reverse translation will be
+;; queried interactively.
+
+;; The admitted values of `google-translate-default-source-language'
+;; and `google-translate-default-target-language' are the codes of the
+;; languages supported by Google Translate (like "ru" for Russian
+;; above). See `google-translate-supported-languages' for the list of
+;; the supported languages, or customize the defaults using the
+;; customization mechanism of Emacs. Setting a default language to
+;; NIL means that language will always be queried. Moreover, the
+;; variable `google-translate-default-source-language' can be set to a
+;; special value "auto" that is interpreted as the instruction for
+;; Google Translate to detect the source language. This option is
+;; also available when you are queried for the source language: simply
+;; leave this parameter blank by pressing RET. (If you have enabled
+;; the ido-style completion, "Detect language" is going to be the
+;; first option, which you can select simply by hitting RET.)
+;;
+
+;;; Code:
+
+
+(require 'google-translate-core-ui)
+
+
+(defgroup google-translate-default-ui nil
+ "Default UI interface to the Google Translate package."
+ :group 'processes)
+
+(defcustom google-translate-default-source-language nil
+ "Default source language.
+
+A string designating a language supported by Google Translate.
+Set this variable to NIL (the default value) if you want to
+always be queried for the source language, or to \"auto\" if you
+want Google Translate to always detect the source language.
+
+See the variable `google-translate-supported-languages-alist' for
+the list of available languages."
+ :group 'google-translate-manzyuk-ui
+ :type `(radio ,@(mapcar #'(lambda (lang)
+ `(const :tag ,(car lang) ,(cdr lang)))
+ google-translate-supported-languages-alist)
+ (const :tag "Detect language" "auto")
+ (other :tag "Always ask" nil)))
+
+(defcustom google-translate-default-target-language nil
+ "Default target language.
+
+A string designating a language supported by Google Translate.
+Set this variable to NIL (the default value) if you want to
+always be queried for the target language.
+
+See the variable `google-translate-supported-languages-alist' for
+the list of available languages."
+ :group 'google-translate-manzyuk-ui
+ :type `(radio ,@(mapcar #'(lambda (lang)
+ `(const :tag ,(car lang) ,(cdr lang)))
+ google-translate-supported-languages-alist)
+ (other :tag "Always ask" nil)))
+
+(defun google-translate-read-args (override-p reverse-p)
+ "Query and return the language arguments of `google-translate-translate'.
+
+When OVERRIDE-P is NIL, the source (resp. target) language is queried
+only if the variable `google-translate-default-source-language' (resp.
+`google-translate-default-target-language') is NIL. If OVERRIDE-P is
+non-NIL, both the source and target languages are queried, allowing
+one to override the defaults if they are specified.
+
+REVERSE-P is used to reverse the default direction of translation: if
+it's non-NIL, the value of `google-translate-default-source-language'
+becomes the default target language and vice versa."
+ (let* ((default-source-language
+ (if reverse-p
+ google-translate-default-target-language
+ google-translate-default-source-language))
+ (default-target-language
+ (if reverse-p
+ google-translate-default-source-language
+ google-translate-default-target-language))
+ (source-language
+ (if (and default-source-language
+ (not override-p))
+ default-source-language
+ (google-translate-read-source-language
+ "Translate from: ")))
+ (target-language
+ (if (and default-target-language
+ (not override-p))
+ default-target-language
+ (google-translate-read-target-language
+ (format "Translate from %s to: "
+ (google-translate-language-display-name
+ source-language))))))
+ (list source-language target-language)))
+
+(defun %google-translate-query-translate (override-p reverse-p)
+ (let* ((langs (google-translate-read-args override-p reverse-p))
+ (source-language (car langs))
+ (target-language (cadr langs)))
+ (google-translate-translate
+ source-language target-language
+ (if google-translate-input-method-auto-toggling
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (google-translate-setup-preferable-input-method source-language))
+ (%google-translate-default-ui-read-from-minibuffer source-language target-language))
+ (%google-translate-default-ui-read-from-minibuffer source-language target-language)))))
+
+(defun %google-translate-default-ui-read-from-minibuffer (source-language target-language)
+ (read-from-minibuffer
+ (format "Translate from %s to %s: "
+ (google-translate-language-display-name source-language)
+ (google-translate-language-display-name target-language))))
+
+;;;###autoload
+(defun google-translate-query-translate (&optional override-p)
+ "Interactively translate text with Google Translate.
+
+Query a text (a word or a phrase), and pop up a buffer named *Google
+Translate* displaying available translations of the text.
+
+If no defaults for the source and target languages are specified (by
+setting the variables `google-translate-default-source-language' and
+`google-translate-default-target-language'), interactively query the
+missing parts. For example, a reasonable option may be to specify a
+default for the target language and always be queried for the source
+language.
+
+With a `C-u' prefix argument, query the source and target languages,
+even if any defaults are specified. For example, you may frequently
+need to translate from English to Russian, and you may choose to set
+the default source and target languages to \"en\" and \"ru\", resp.
+However, occasionally you may also need to translate from Russian to
+English. With a `C-u' prefix argument you can override the defaults
+and specify the source and target languages explicitly.
+
+The languages are queried with completion, and the null input at the
+source language prompt is considered as an instruction for Google
+Translate to detect the source language."
+ (interactive "P")
+ (%google-translate-query-translate override-p nil))
+
+;;;###autoload
+(defun google-translate-query-translate-reverse (&optional override-p)
+ "Like `google-translate-query-translate', but performs translation
+in the reverse direction.
+
+The value of the variable `google-translate-default-source-language'
+\(if set) becomes the target language, and the value of the variable
+`google-translate-default-target-language' (if also set) becomes the
+source language.
+
+In particular, when both variables are set, translation is performed
+in the reverse direction."
+ (interactive "P")
+ (%google-translate-query-translate override-p t))
+
+(defun %google-translate-at-point (override-p reverse-p)
+ (let* ((langs (google-translate-read-args override-p reverse-p))
+ (source-language (car langs))
+ (target-language (cadr langs))
+ (bounds nil))
+ (google-translate-translate
+ source-language target-language
+ (cond ((string-equal major-mode "pdf-view-mode") (car (pdf-view-active-region-text)))
+ ((use-region-p) (buffer-substring-no-properties (region-beginning) (region-end)))
+ (t (or (and (setq bounds (bounds-of-thing-at-point 'word))
+ (buffer-substring-no-properties (car bounds) (cdr bounds)))
+ (error "No word at point.")))))))
+
+;;;###autoload
+(defun google-translate-at-point (&optional override-p)
+ "Translate the word at point or the words in the active region.
+
+For the meaning of OVERRIDE-P, see `google-translate-query-translate'."
+ (interactive "P")
+ (%google-translate-at-point override-p nil))
+
+;;;###autoload
+(defun google-translate-at-point-reverse (&optional override-p)
+ "Like `google-translate-at-point', but performs translation in the
+reverse direction."
+ (interactive "P")
+ (%google-translate-at-point override-p t))
+
+;;;###autoload
+(defun google-translate-buffer (&optional override-p reverse-p)
+ "Translate current buffer.
+
+For the meaning of OVERRIDE-P, see `google-translate-query-translate'."
+ (interactive "P")
+ (if (string-equal major-mode "pdf-view-mode")
+ (message "In PDF, select region and use google-translate-at-point")
+ (let* ((langs (google-translate-read-args override-p reverse-p))
+ (source-language (car langs))
+ (target-language (cadr langs)))
+ (google-translate-translate
+ source-language target-language
+ (if (use-region-p)
+ (buffer-substring-no-properties (region-beginning) (region-end))
+ (or (buffer-substring-no-properties (point-min) (point-max))
+ (error "Translate current buffer error.")))))))
+
+;;;###autoload
+(defun google-translate-paragraphs-overlay (&optional override-p reverse-p)
+ "Translate current buffer with paragraph by paragraph and SHOW results in overlay below paragraph.
+This command also specificly support org-mode."
+ (interactive "P")
+ (let* ((langs (google-translate-read-args override-p reverse-p))
+ (source-language (car langs))
+ (target-language (cadr langs))
+ (last-paragraph-begin 1))
+ (goto-char (point-min))
+ (while (not (equal (point) (point-max))) ; reached end of buffer
+ (if (eq major-mode 'org-mode)
+ (if (eq (car (org-element-at-point)) 'paragraph)
+ (progn
+ (org-mark-element)
+ (exchange-point-and-mark)
+ (unless (= last-paragraph-begin (region-beginning))
+ (google-translate-translate
+ source-language target-language
+ (buffer-substring-no-properties (region-beginning) (region-end))
+ 'paragraph-overlay)
+ (setq last-paragraph-begin (region-beginning)))
+ (deactivate-mark))
+ (forward-line 2))
+ (google-translate-translate
+ source-language target-language
+ (save-excursion
+ (mark-paragraph)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ 'paragraph-overlay)
+ (deactivate-mark)
+ (forward-paragraph)
+ (forward-line)))))
+
+;;;###autoload
+(defun google-translate-paragraphs-insert (&optional override-p reverse-p)
+ "Translate current buffer with paragraph by paragraph and INSERT results below paragraph.
+This command does NOT support document format like org-mode."
+ (interactive "P")
+ (let* ((langs (google-translate-read-args override-p reverse-p))
+ (source-language (car langs))
+ (target-language (cadr langs)))
+ (goto-char (point-min))
+ (while (not (equal (point) (point-max))) ; reached end of buffer
+ (google-translate-translate
+ source-language target-language
+ (save-excursion
+ (mark-paragraph)
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ 'paragraph-insert)
+ (deactivate-mark)
+ (forward-line))))
+
+(provide 'google-translate-default-ui)
+
+
+;;; google-translate-default-ui.el ends here
--- /dev/null
+;; -*- no-byte-compile: t; lexical-binding: nil -*-
+(define-package "google-translate" "20220921.245"
+ "Emacs interface to Google Translate."
+ '((emacs "24.3")
+ (popup "0.5.8"))
+ :url "https://github.com/atykhonov/google-translate"
+ :commit "e60dd6eeb9cdb931d9d8bfbefc29a48ef9a21bd9"
+ :revdesc "e60dd6eeb9cd"
+ :keywords '("convenience")
+ :authors '(("Oleksandr Manzyuk" . "manzyukNOSPAMgmail.com"))
+ :maintainers '(("Andrey Tykhonov" . "atykhonovNOSPAMgmail.com")))
--- /dev/null
+;;; google-translate-smooth-ui.el --- Just another UI to Google
+;;; Translate package
+
+;; Copyright (C) 2012 Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+
+;; Author: Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+;; Maintainer: Andrey Tykhonov <atykhonovNOSPAMgmail.com>
+;; URL: https://github.com/atykhonov/google-translate
+;; Keywords: convenience
+
+;; Contributors:
+;; Tassilo Horn <tsdhNOSPAMgnu.org>
+;; Bernard Hurley <bernardNOSPAMmarcade.biz>
+;; Chris Bilson <cbilsonNOSPAMpobox.com>
+;; Takumi Kinjo <takumi.kinjoNOSPAMgmail.com>
+;; momomo5717 <momomo5717NOSPAMgmail.com>
+;; stardiviner <numbchildNOSPAMgmail.com>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; `google-translate-smooth-ui' is a just alternative to the default
+;; `google-translate-default-ui'. It was written with mind to provide
+;; impoved user interface and, especially, to achieve better
+;; supporting of many default languages. `google-translate-default-ui'
+;; supports two default languages very well but there is no space for
+;; the third one.
+;;
+;; Invoking the function `google-translate-smooth-translate' queries
+;; text and (optionally) the source and target languages to translate,
+;; and shows a buffer with available translations of the text.
+
+;; Installation:
+
+;; Assuming that the files `google-translate.el',
+;; `google-translate-core.el', `google-translate-core-ui.el' and
+;; `google-translate-smooth-ui.el' are somewhere on the load path, add
+;; the following lines to your .emacs file:
+;;
+;; (require 'google-translate-smooth-ui)
+;; (global-set-key "\C-ct" 'google-translate-smooth-translate)
+;;
+;; Change the key bindings to your liking.
+;;
+;; Configuration:
+;;
+;; `google-translate-translation-directions-alist' alist is intended
+;; to contain translation directions.
+;;
+;; For example it could be defined (in your .emacs or init.el) as:
+;;
+;; (setq google-translate-translation-directions-alist '(("en" . "ru"))
+;;
+;; in this way one translation direction ("en" > "ru") is defined and
+;; when `google-translate-smooth-translate' function executes it will
+;; output the prompt (in minibuffer) which will looks like as the
+;; following:
+;;
+;; [English > Russian] Translate:
+;;
+;; You may set as many translation directions as you would like
+;; to. For example such piece of code will define four translation
+;; directions:
+;;
+;; (setq google-translate-translation-directions-alist
+;; '(("de" . "en") ("en" . "de") ("de" . "fr") ("fr" . "de")))
+;;
+;; in this way, when `google-translate-smooth-translate' function
+;; executes you'll be queried by the prompt which will looks like the
+;; following:
+;;
+;; [German > English] Translate:
+;;
+;; and, also in this way, you'll be able to switch between different
+;; translation directions directly from minibuffer by using "C-n" and
+;; "C-p" key bindings. "C-n" key binding changes current translation
+;; direction to the next direction defined in the
+;; `google-translate-translation-directions-alist' variable. And "C-p"
+;; key binding changes current translation direction to the previous
+;; one. Thus, while executing `google-translate-smooth-translate'
+;; function and having in minibuffer such prompt:
+;;
+;; [German > English] Translate:
+;;
+;; then after pressing "C-n" you'll get the following prompt:
+;;
+;; [English > German] Translate:
+;;
+;; By default `google-translate-translation-directions-alist' is empty
+;; and thus during execution of `google-translate-smooth-translate'
+;; you'll be queried (to input a text) by the prompt:
+;;
+;; Translate:
+;;
+;; And after inputed text you'll be queried also for the source and
+;; target languages. To let the package to be known which languages
+;; you would like to always use and to avoid repetitive language
+;; quering it is reasonable to define them in the mentioned
+;; `google-translate-translation-directions-alist' variable.
+
+;; Customization:
+
+;; `google-translate-smooth-ui' doesn't contain any customizable
+;; variables. But `google-translate-smooth-ui' extends
+;; `google-translate-core-ui' and thus it could be customized via this
+;; package's variables. Please read documentation for the
+;; `google-translate-core-ui' package.
+;;
+
+;;; Code:
+
+
+(require 'google-translate-core-ui)
+
+
+(defgroup google-translate-smooth-ui nil
+ "Just Another UI for Google Translate package."
+ :group 'processes)
+
+(defvar google-translate-translation-directions-alist
+ '()
+ "Alist of translation directions. Each of direction could be
+selected directly in the minibuffer during translation.
+
+Each element is a cons-cell of the form (SOURCE_CODE
+. TARGET_CODE), where SOURCE_CODE is a source language code and
+TARGET_CODE is a target language code.
+
+Language codes are defined in
+`google-translate-supported-languages-alist' variable.
+
+As example, this alist could looks like the following:
+
+ '((\"en\" . \"ru\")
+ (\"ru\" . \"en\")
+ (\"uk\" . \"ru\")
+ (\"ru\" . \"uk\"))")
+
+(defvar google-translate-current-translation-direction 0
+ "Points to nth element of
+`google-translate-translation-directions-alist' variable and
+keeps current translation direction while changing translation
+directions.")
+
+(defvar google-translate-last-translation-direction nil
+ "The last used translation direction.
+Points to nth element of `google-translate-translation-directions-alist' variable.")
+
+(defvar google-translate-translation-direction-query ""
+ "Temporal variable which keeps a minibuffer text while
+switching translation directions.")
+
+(defvar google-translate-try-other-direction nil
+ "Indicates that other translation direction is going to be
+used.")
+
+(defvar google-translate-minibuffer-keymap nil
+ "Keymap for minibuffer for changing translation directions.")
+
+(defun google-translate-change-translation-direction (direction)
+ "Change translation direction. If DIRECTION is 'next then
+change current direction by the next one. Otherwise change it to
+the previous one."
+ (let ((current google-translate-current-translation-direction)
+ (length (length google-translate-translation-directions-alist)))
+ (setq current
+ (if (equal direction 'next)
+ (+ current 1)
+ (- current 1)))
+ (when (< current 0)
+ (setq current (- length 1)))
+ (when (> current (- length 1))
+ (setq current 0))
+ (setq google-translate-current-translation-direction current)
+ (setq google-translate-translation-direction-query
+ (minibuffer-contents))))
+
+(defun google-translate-next-translation-direction ()
+ "Switch to the next translation direction. If current direction
+is the last in the list of existing directions then switch to the
+first one."
+ (interactive)
+ (google-translate-change-translation-direction 'next)
+ (setq google-translate-try-other-direction t)
+ (exit-minibuffer))
+
+(defun google-translate-previous-translation-direction ()
+ "Switch to the previous translation direction. If current
+direction is the first in the list of existing directions then
+switch to the last one."
+ (interactive)
+ (google-translate-change-translation-direction 'previous)
+ (setq google-translate-try-other-direction t)
+ (exit-minibuffer))
+
+(defun google-translate-query-translate-using-directions ()
+ "Tranlate query using translation directions described by
+`google-translate-translation-directions-alist' variable.
+
+This function allows to select desired translation direction
+directly in the minibuffer while translating a word or a
+sentence.
+
+This function defines two key bindings for the minibuffer which
+allow to select direction:
+C-p - to select previous direction,
+C-n - to select next direction."
+ (interactive)
+ (let ((text ""))
+ (setq google-translate-try-other-direction nil)
+ (setq text
+ (if google-translate-input-method-auto-toggling
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (google-translate-setup-preferable-input-method
+ (google-translate--current-direction-source-language)))
+ 'google-translate-setup-preferable-input-method
+ (google-translate--read-from-minibuffer))
+ (google-translate--read-from-minibuffer)))
+ (if google-translate-try-other-direction
+ (call-interactively 'google-translate-query-translate-using-directions)
+ text)))
+
+(defun google-translate--setup-minibuffer-keymap ()
+ "Setup additional key bindings for minibuffer."
+ (unless google-translate-minibuffer-keymap
+ (setq google-translate-minibuffer-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-p" 'google-translate-previous-translation-direction)
+ (define-key map "\C-n" 'google-translate-next-translation-direction)
+ (define-key map "\C-l" 'google-translate-clear-minibuffer)
+ (set-keymap-parent map minibuffer-local-map)
+ map))))
+
+(defun google-translate-clear-minibuffer ()
+ "Delete minibuffer contents."
+ (interactive)
+ (delete-minibuffer-contents))
+
+(defun google-translate--read-from-minibuffer ()
+ "Read string from minibuffer."
+ (let* ((source-language
+ (google-translate--current-direction-source-language))
+ (target-language
+ (google-translate--current-direction-target-language))
+ (prompt (if (or (null source-language)
+ (null target-language))
+ "Translate: "
+ (format "[%s > %s] Translate: "
+ (google-translate-language-display-name source-language)
+ (google-translate-language-display-name target-language)))))
+ (google-translate--setup-minibuffer-keymap)
+ (read-from-minibuffer
+ prompt
+ google-translate-translation-direction-query
+ google-translate-minibuffer-keymap nil nil
+ google-translate-translation-direction-query t)))
+
+(defun google-translate--current-direction-source-language ()
+ "Retrieve source language from the current translation
+direction."
+ (car (nth google-translate-current-translation-direction
+ google-translate-translation-directions-alist)))
+
+(defun google-translate--current-direction-target-language ()
+ "Retrieve target language from the current translation
+direction."
+ (cdr (nth google-translate-current-translation-direction
+ google-translate-translation-directions-alist)))
+
+;;;###autoload
+(defun google-translate-smooth-translate ()
+ "Translate a text using translation directions.
+
+Make a prompt in minibuffer for a text to translate. Default text
+is word at point.
+
+In case of `google-translate-translation-directions-alist' is
+empty list then after inputed translating text prompts for source
+language and then for target languages.
+
+In case of `google-translate-translation-directions-alist' is not
+empty list takes current translation direction and makes
+appropriate translation. Current translation direction indicates
+in the minibuffers' prompt.
+
+A current translation direction could be changed directly in the
+minibuffer by means of key bindings such as C-n and C-p for
+changing to the next translation direction and to the previous
+one respectively."
+ (interactive)
+
+ (setq google-translate-translation-direction-query
+ (if (use-region-p)
+ (google-translate--strip-string
+ (buffer-substring-no-properties (region-beginning) (region-end)))
+ (unless current-prefix-arg
+ (current-word t t))))
+
+ (setq google-translate-current-translation-direction
+ (or google-translate-last-translation-direction 0))
+
+ (let* ((text (google-translate-query-translate-using-directions))
+ (source-language (google-translate--current-direction-source-language))
+ (target-language (google-translate--current-direction-target-language)))
+ (when (null source-language)
+ (setq source-language (google-translate-read-source-language)))
+ (when (null target-language)
+ (setq target-language (google-translate-read-target-language)))
+ (google-translate-translate source-language target-language text)
+ (setq google-translate-last-translation-direction
+ google-translate-current-translation-direction)))
+
+
+(provide 'google-translate-smooth-ui)
+
+;;; google-translate-smooth-ui.el ends here
--- /dev/null
+;;; google-translate.el --- Emacs interface to Google Translate
+
+;; Copyright (C) 2012 Oleksandr Manzyuk <manzyuk@gmail.com>
+
+;; Author: Oleksandr Manzyuk <manzyukNOSPAMgmail.com>
+;; Maintainer: Andrey Tykhonov <atykhonovNOSPAMgmail.com>
+;; URL: https://github.com/atykhonov/google-translate
+;; Package-Requires: ((emacs "24.3") (popup "0.5.8"))
+;; Package-Version: 20220921.245
+;; Package-Revision: e60dd6eeb9cd
+;; Keywords: convenience
+
+;; Contributors:
+;; Tassilo Horn <tsdhNOSPAMgnu.org>
+;; Bernard Hurley <bernardNOSPAMmarcade.biz>
+;; Chris Bilson <cbilsonNOSPAMpobox.com>
+;; Takumi Kinjo <takumi.kinjoNOSPAMgmail.com>
+;; momomo5717 <momomo5717NOSPAMgmail.com>
+;; stardiviner <numbchildNOSPAMgmail.com>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This 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 2, or (at your option)
+;; any later version.
+
+;; This file 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Installation:
+
+;; From MELPA or Marmalade.
+
+;; Just run `M-x package-install RET google-translate RET`
+
+;; Manual installation.
+
+;; Assuming that the file `google-translate.el' and other files which
+;; relates to this package is somewhere on the load path, add the
+;; following lines to your `.emacs' file:
+
+;; (require 'google-translate)
+;; (require 'google-translate-default-ui)
+;; (global-set-key "\C-ct" 'google-translate-at-point)
+;; (global-set-key "\C-cT" 'google-translate-query-translate)
+
+;; or
+
+;; (require 'google-translate)
+;; (require 'google-translate-smooth-ui)
+;; (global-set-key "\C-ct" 'google-translate-smooth-translate)
+;;
+;; Change the key bindings to your liking.
+
+;; The difference between these configurations is in UI which will be
+;; used: Default UI or Smooth UI.
+;;
+;; Please read the source of `google-translate-default-ui.el' and
+;; `google-translate-smooth-ui.el' for more details.
+
+;; Customization:
+
+;; Variables which are available for customization are depends on UI
+;; package which is selected for the google-translate
+;; package. google-translate-default-ui - is UI which is selected by
+;; default. It loads by default and is available right after
+;; google-translate installation and its initialization. Please read
+;; documentation for the `google-translate-core-ui.el' and
+;; `google-translate-default-ui.el' packages for more info about
+;; customization.
+;;
+
+;;; Code:
+
+(require 'google-translate-default-ui)
+
+(provide 'google-translate)
+
+;;; google-translate.el ends here
projects / emacsconfig.git / commitdiff