;;
;;;###autoload
(defun babel-buffer ()
"Use a web translation service to translate the current buffer.
Default is to present the translated text in a *babel* buffer.
With a prefix argument, replace the current buffer contents by the
translated text."
(interactive)
(let (pos)
(cond (prefix-arg
(setq pos (point-max))
(goto-char pos)
(insert
(babel-as-string
(buffer-substring-no-properties (point-min) (point-max))))
(delete-region (point-min) pos))
(t
(babel-region (point-min) (point-max))))))
(defun babel-work (msg from to)
(save-excursion
(save-window-excursion
(set-buffer (get-buffer-create " *babelurl*"))
(erase-buffer)
(funcall fetcher (babel-preprocess msg) from to)
(setq buffer-file-name nil) ; don't know why w3 sets this
(funcall washer)
(babel-postprocess)
(babel-display)
(buffer-substring-no-properties (point-min) (point-max)))))
(defun babel-get-backends (from to)
"Return a list of those backends which are capable of translating
language FROM into language TO."
(loop for b in babel-backends
for name = (symbol-name (cdr b))
for translator = (intern (concat "babel-" name "-translation"))
for translatable = (funcall translator from to)
if translatable collect b))
(defun babel-display ()
(require 'w3)
(save-excursion
(w3-region (point-min) (point-max))))
(defun babel-mode ()
(interactive)
(use-local-map babel-mode-map)
(setq major-mode 'babel-mode
mode-name "Babel")
(run-hooks 'babel-mode-hook))
(cond ((fboundp 'string-make-unibyte)
(fset 'babel-make-unibyte #'string-make-unibyte))
((fboundp 'string-as-unibyte)
(fset 'babel-make-unibyte #'string-as-unibyte))
(t
(fset 'babel-make-unibyte #'identity)))
;; from nnweb.el, with added `string-make-unibyte'.
(defun babel-form-encode (pairs)
"Return PAIRS encoded for forms."
(require 'w3-forms)
(mapconcat
(lambda (data)
(concat (w3-form-encode-xwfu (babel-make-unibyte (car data))) "="
(w3-form-encode-xwfu (babel-make-unibyte (cdr data)))))
pairs "&"))
;; We mark paragraph endings with a special token, so that we can
;; recover a little information on the original message's format after
;; translation and washing and rendering. Should really be using
;; `paragraph-start' and `paragraph-separate' here, but we no longer
;; have any information on the major-mode of the buffer that STR was
;; ripped from.
;;
;; This kludge depends on the fact that all the translation motors
;; seem to leave words they don't know how to translate alone, passing
;; them through untouched.
(defun babel-preprocess (str)
(while (string-match "\n\n\\|^\\s-+$" str)
(setq str (replace-match " FLOBSiCLE " nil t str)))
str)
;; decode paragraph endings in current buffer
(defun babel-postprocess ()
(goto-char (point-min))
(while (search-forward "FLOBSiCLE" nil t)
(replace-match "\n" nil t)))
;; split STR into chunks of around LENGTH characters, trying to
;; maintain sentence structure (this is used to send big requests in
;; several batches, because otherwise the motors cut off the
;; translation).
(defun babel-chunkify (str chunksize)
(let ((start 0)
(pos 0)
(chunks '()))
(while (setq pos (string-match (babel-sentence-end) str pos))
(incf pos)
(when (> (- pos start) chunksize)
(push (substring str start pos) chunks)
(setq start pos)))
(when (/= start (length str))
(push (substring str start) chunks))
(nreverse chunks)))
;;;###autoload
(defun babel-version (&optional here)
"Show the version number of babel in the minibuffer.
If optional argument HERE is non-nil, insert version number at point."
(interactive "P")
(let ((version-string
(format "Babel version %s" babel-version)))
(if here
(insert version-string)
(if (interactive-p)
(message "%s" version-string)
version-string))))
;; Babelfish-specific functions ================================================
;;
;; Babelfish (which uses the SysTran engine) is only able to translate
;; between a limited number of languages.
;; translation from 3-letter names to Babelfish 2-letter names
(defconst babel-fish-languages
'(("eng" . "en")
("ger" . "de")
("ita" . "it")
("poe" . "pt")
("spe" . "es")
("fre" . "fr")))
;; those inter-language translations that Babelfish is capable of
(defconst babel-fish-translations
'("en_fr" "en_de" "en_it" "en_pt" "en_es" "fr_en" "de_en" "it_en"
"es_en" "pt_en"))
;; if Babelfish is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-fish-translation (from to)
(let* ((fromb (cdr (assoc from babel-fish-languages)))
(tob (cdr (assoc to babel-fish-languages)))
(comb (and fromb tob (concat fromb "_" tob))))
(find comb babel-fish-translations :test #'string=)))
(defun babel-fish-fetch (msg from to)
"Connect to the Babelfish server and request the translation."
(require 'url)
(let ((coding-system-for-read 'utf-8)
(translation (babel-fish-translation from to)))
(unless translation
(error "Babelfish can't translate from %s to %s" from to))
(let* ((pairs `(("trtext" . ,(mm-encode-coding-string msg 'utf-8))
("lp" . ,translation)
("doit" . "done")
("intl" . "1")
("tt" . "urltext")
("btnTrTxt" . "Translate")))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://babelfish.altavista.com/tr" 'utf-8))))
(defun babel-fish-wash ()
"Extract the useful information from the HTML returned by Babelfish."
(if (not (babel-wash-regex "
\\([^<]*\\) | "))
(error "Babelfish HTML has changed ; please look for a new version of babel.el")))
;; FreeTranslation.com stuff ===========================================
;; translation from 3-letter names to FreeTranslation names
(defconst babel-free-languages
'(("eng" . "English")
("ger" . "German")
("ita" . "Italian")
("dut" . "Dutch")
("poe" . "Portuguese")
("spe" . "Spanish")
("nor" . "Norwegian")
("rus" . "Russian")
("schi" . "SimplifiedChinese")
("tchi" . "TraditionalChinese")
("fre" . "French")))
;; those inter-language translations that FreeTranslation is capable of
(defconst babel-free-translations
'("English/Spanish" "English/French" "English/German" "English/Italian" "English/Dutch" "English/Portuguese"
"English/Russian" "English/Norwegian" "English/SimplifiedChinese" "English/TraditionalChinese" "Spanish/English"
"French/English" "German/English" "Italian/English" "Dutch/English" "Portuguese/English"))
(defun babel-free-translation (from to)
(let* ((ffrom (cdr (assoc from babel-free-languages)))
(fto (cdr (assoc to babel-free-languages)))
(trans (concat ffrom "/" fto)))
(find trans babel-free-translations :test #'string=)))
(defun babel-free-fetch (msg from to)
"Connect to the FreeTranslation server and request the translation."
(require 'url)
(let ((coding-system-for-read 'utf-8)
(translation (babel-free-translation from to))
url)
(unless translation
(error "FreeTranslation can't translate from %s to %s" from to))
(setq url
(cond ((string= translation "English/Russian") "http://ets6.freetranslation.com/")
((string= translation "English/SimplifiedChinese") "http://ets6.freetranslation.com/")
((string= translation "English/TraditionalChinese") "http://ets6.freetranslation.com/")
(t "http://ets.freetranslation.com/")))
(let* ((pairs `(("sequence" . "core")
("mode" . "html")
("template" . "results_en-us.htm")
("srctext" . ,msg)
("charset" . "UTF-8")
("language" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve url 'utf-8))))
(defun babel-free-wash ()
"Extract the useful information from the HTML returned by FreeTranslation."
;;;
(if (not (babel-wash-regex ""))
(error "FreeTranslations HTML has changed ; please look for a new version of babel.el")))
;; Google stuff ===========================================
;;
;; Contributed by Juergen Hoetzel (Only works on emacs-22.0.5 (CVS))
;; translation from 3-letter names to Google 2-letter names
(defconst babel-google-languages
'(("eng" . "en")
("ger" . "de")
("spe" . "es")
("fre" . "fr")
("ita" . "it")
("pob" . "pt")
("jpn" . "ja")
;TODO: "en|ko"English to Korean BETA
;TODO: "en|zh-CN"English to Chinese (Simplified) BETA
))
;; those inter-language translations that Google is capable of
(defconst babel-google-translations
'("en|de" "en|es" "en|fr" "en|it" "en|pt" "en|ja" "en|ko" "en|zh-CN"
"de|en" "de|fr" "es|en" "fr|en" "fr|de" "it|en" "pt|en" "ja|en" "ko|en" "zh-CN|en"))
;; if Google is able to translate from language FROM to language
;; TO, then return the corresponding string, otherwise return nil
(defun babel-google-translation (from to)
(let* ((fromb (cdr (assoc from babel-google-languages)))
(tob (cdr (assoc to babel-google-languages)))
(comb (and fromb tob (concat fromb "|" tob))))
(find comb babel-google-translations :test #'string=)))
(defun babel-google-fetch (msg from to)
"Connect to google server and request the translation."
(require 'url)
(let ((coding-system-for-read 'utf-8)
(translation (babel-google-translation from to)))
(unless translation
(error "PROMPT can't translate from %s to %s" from to))
(let* ((pairs `(("text" . ,(mm-encode-coding-string msg 'utf-8))
("hl" . "en")
("Language" . "English")
("ie" . "UTF-8")
("oe" . "UTF-8")
("langpair" . ,translation)))
(url-request-data (babel-form-encode pairs))
(url-request-method "POST")
(url-request-extra-headers
'(("Content-Type" . "application/x-www-form-urlencoded"))))
(babel-url-retrieve "http://translate.google.com/translate_t" 'utf-8))))
(defun babel-google-wash ()
"Extract the useful information from the HTML returned by google."
(if (not (babel-wash-regex ""))
(error "Google HTML has changed ; please look for a new version of babel.el")))
;; TODO: ecs.freetranslation.com
;; (defun babel-debug ()
;; (let ((buf (get-buffer-create "*babel-debug*")))
;; (set-buffer buf)
;; (babel-free-fetch "state mechanisms are too busy" "eng" "ger")))
(easy-menu-add-item nil '("tools") ["Babel Translation" babel t])
(provide 'babel)
;; babel.el ends here