10年くらい前に書いたelisp. 確か, 選択した領域のテキストをgoogle翻訳APIに送って英訳する拡張.

multi-lingual.el

;;; multi-lingual.el --- 

;; Copyright (C) 2010  yamaneko

;; Author: yamaneko <yamaneko1212@gmail.com>
;; Keywords: 

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, 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; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; 

;;; Code:

;; This file rqruires json.el
;; http://cvs.savannah.gnu.org/viewvc/*checkout*/emacs/lisp/json.el?root=emacs
(require 'json)


(defvar multi-lingual-host-charset 'utf-8 
  "charset type of host")


(defun multi-lingual-concat-string-list (l)
  "concat a list of string"
  (let ((tmp "")
        (i 0)
        (count-max (length l)))
    (while (< i count-max)
      (setq tmp (concat tmp (nth i l)))
      (incf i 1))
    tmp))


(defun multi-lingual-url-encode (str charset-type)
  "URL encode STR using CHARSET-TYPE as the coding system."
  (apply 'concat
	 (mapcar (lambda (c)
		   (if (or (and (>= c ?a) (<= c ?z))
			   (and (>= c ?A) (<= c ?Z))
			   (and (>= c ?0) (<= c ?9)))
		       (string c)
		     (format "%%%02x" c)))
		 (encode-coding-string str charset-type))))


(defun multi-lingual-create-request-url (text src-lang dest-lang)
  (concat "http://ajax.googleapis.com/ajax/services/language/translate?v=1.0&q="
          (multi-lingual-url-encode text multi-lingual-host-charset)
          "&langpair="
          src-lang
          "%7C"
          dest-lang))


(defun multi-lingual-translate (text src-lang dest-lang)
  ""
  (let* ((target (multi-lingual-create-request-url text src-lang dest-lang))
         (buf (url-retrieve-synchronously target)))
    (let ((translated-text (save-current-buffer
                             (set-buffer buf)
                             (buffer-substring (point-min) (point-max)))))
      (if (not (string= "" translated-text))
          (progn
            (message "Successful connection.")
            (multi-lingual-extract-result-from-response translated-text))
        (error (format "Failed to getting result : Bad request or process error."))))))


(defun multi-lingual-trans-inner-trans-ja-into-en (ja-text)
  ""
  (multi-lingual-translate ja-text "ja" "en"))


(defun multi-lingual-split-head-content (http-response)
  "split HTTP-RESPONSE to header and content"
  (let* ((line-list (split-string http-response "\n"))
         (count-max (length line-list))
         (head-line-list '())
         (n 0))
    (catch 'break
      (while (< n count-max)
        (if (string= (nth n line-list) "")
            (throw 'break t))
        (setq head-line-list (append head-line-list (list (car line-list))))
        (setq line-list (cdr line-list)))
      ;; HTTP-REPONSE doesn't have ''split''
      (error (format "Response text may be broken.")))
      ;; below line means (head-line-list . content-line-list)
    (cons head-line-list (nthcdr (+ n 1) line-list))))


(defun multi-lingual-extract-result-from-response (response)
  "Extract header and content from RESPONSE"
  (let* ((head-content (multi-lingual-split-head-content response))
         (content (multi-lingual-concat-string-list (cdr head-content))))
    (cdr (assq 'translatedText (cdr (assq 'responseData (json-read-from-string content)))))))


(defun multi-lingual-trans-ja-into-en ()
  "Translate the text in the region and show the result in minibuffer."
  (interactive)
  (message
   (multi-lingual-trans-inner-trans-ja-into-en (buffer-substring (region-beginning) (region-end)))))


(defun multi-lingual-trans-ja-into-en-and-insert ()
  "Translate the text in the region and insert the result after end of the region."
  (interactive)
  (let ((result (multi-lingual-trans-inner-trans-ja-into-en (buffer-substring (region-beginning) (region-end)))))
    (indent-new-comment-line)
    (insert result)))


(defun multi-lingual-trans-ja-into-en-and-replace ()
  "Translate the text in the region and replace it with the result."
  (interactive)
  (let ((result (multi-lingual-trans-inner-trans-ja-into-en (buffer-substring (region-beginning) (region-end)))))
    (delete-region (region-beginning) (region-end))
    (insert result)))


(provide 'multi-lingual)
;;; multi-lingual.el ends here