[PATCH] Support German, Spanish, French, Russian in morse.el

Of the many things remaining to do in XEmacs development, it did strike me when writing it that there could be few more useless than adding incomplete multilingual support to morse-region and unmorse-region. But, on discovering that Wikipedia has complete articles in several languages on the subject, it seemed the thing to do. Yes, I need to test this with non-Mule. No, it doesn’t yet have Japanese or Chinese support; I can recognise Kana enough to do the former, but not enough Hanzi for the latter. --- morse.el.orig 2006-12-14 18:08:31.218750000 +0100 +++ morse.el 2006-12-14 18:13:10.750000000 +0100 ＠＠ -1,6 +1,6 ＠＠ ;;; morse.el --- convert text to morse code and back -;; Copyright (C) 1995 Free Software Foundation, Inc. +;; Copyright (C) 1995, 2006 Free Software Foundation, Inc. ;; Author: Rick Farnbach <rick_farnbach(a)MENTORG.COM&gt; ;; Keywords: games ＠＠ -29,55 +29,153 ＠＠ ;;; Code: -(defvar morse-code '(("a" . ".-") - ("b" . "-...") - ("c" . "-.-.") - ("d" . "-..") - ("e" . ".") - ("f" . "..-.") - ("g" . "--.") - ("h" . "....") - ("i" . "..") - ("j" . ".---") - ("k" . "-.-") - ("l" . ".-..") - ("m" . "--") - ("n" . "-.") - ("o" . "---") - ("p" . ".--.") - ("q" . "--.-") - ("r" . ".-.") - ("s" . "...") - ("t" . "-") - ("u" . "..-") - ("v" . "...-") - ("w" . ".--") - ("x" . "-..-") - ("y" . "-.--") - ("z" . "--..") - ;; Punctuation - ("=" . "-...-") - ("?" . "..--..") - ("/" . "-..-.") - ("," . "--..--") - ("." . ".-.-.-") - (":" . "---...") - ("'" . ".----.") - ("-" . "-....-") - ("(" . "-.--.-") - (")" . "-.--.-") - ;; Numbers - ("0" . "-----") - ("1" . ".----") - ("2" . "..---") - ("3" . "...--") - ("4" . "....-") - ("5" . ".....") - ("6" . "-....") - ("7" . "--...") - ("8" . "---..") - ("9" . "----.")) - "Morse code character set.") +(defvar english-alphabet-morse-code '(("a" . ".-") + ("b" . "-...") + ("c" . "-.-.") + ("d" . "-..") + ("e" . ".") + ("f" . "..-.") + ("g" . "--.") + ("h" . "....") + ("i" . "..") + ("j" . ".---") + ("k" . "-.-") + ("l" . ".-..") + ("m" . "--") + ("n" . "-.") + ("o" . "---") + ("p" . ".--.") + ("q" . "--.-") + ("r" . ".-.") + ("s" . "...") + ("t" . "-") + ("u" . "..-") + ("v" . "...-") + ("w" . ".--") + ("x" . "-..-") + ("y" . "-.--") + ("z" . "--..")) + "Morse code, as used for the letters of English.") + +(defvar german-alphabet-morse-code (nconc + '(("ä" . ".-.-") + ("ö" . "---.") + ("ü" . "..--") + ("ß" . "...--..") + ("ch". "----")) + english-alphabet-morse-code) + "Morse code, as used for the letters of German.") + +(defvar spanish-alphabet-morse-code (nconc + '(("ch". "----") + ("ñ" . "--.--") + ("ü" . "..--")) + english-alphabet-morse-code) + "Morse code, as used for the letters of Spanish.") + +(defvar french-alphabet-morse-code (nconc + '(("ç". "-.-..") + ("è". ".-..-") + ("é" . "..-..") + ("à" . ".--.-")) + english-alphabet-morse-code)) + +(defvar swedish-alphabet-morse-code (nconc + '(("ä" . ".-.-") + ("ö" . "---.") + ("å" . ".--.-")) + english-alphabet-morse-code) + "Morse code, as used for the letters of Swedish. ") + +(when (featurep 'mule) + (defvar cyrillic-alphabet-morse-code + (mapcar (lambda (entry) + (cons (string (make-char 'cyrillic-iso8859-5 (pop entry))) + (pop entry))) + '((#xb0 ".-") + (#xb1 "-...") + (#xb2 ".--") + (#xb3 "--.") + (#xb4 "-..") + (#xb5 ".") + (#xb6 "...-") + (#xb7 "--..") + (#xb8 "..") + (#xb9 ".---") + (#xba "-.-") + (#xbb ".-..") + (#xbc "--") + (#xbd "-.") + (#xbe "---") + (#xbf ".--.") + (#xc0 ".-.") + (#xc1 "...") + (#xc2 "-") + (#xc3 "..-") + (#xc4 "..-.") + (#xc5 "....") + (#xc6 "-.-.") + (#xc7 "---.") + (#xc8 "----") + (#xc9 "--.-") + (#xcc "-..-") + (#xcb "-.--") + (#xcd "..-..") + (#xce "..--") + (#xcf ".-.-"))) + "Morse code, as used for the letters of Russian.")) + +(defvar digits-punctuation-morse-code '(("0" . "-----") + ("1" . ".----") + ("2" . "..---") + ("3" . "...--") + ("4" . "....-") + ("5" . ".....") + ("6" . "-....") + ("7" . "--...") + ("8" . "---..") + ("9" . "----.") + ;; Punctuation + ("=" . "-...-") + ("?" . "..--..") + ("/" . "-..-.") + ("," . "--..--") + ("." . ".-.-.-") + (":" . "---...") + ("'" . ".----.") + ("-" . "-....-") + ("(" . "-.--.-") + (")" . "-.--.-") + ("＠" . ".--.-.") + ("+" . ".-.-.")) + "The digits and punctuation in morse code, as used internationally.") + +(defvar active-morse-code nil + "The active Morse alphabet, digits, and puncuation, as an alist.") + +(defun choose-active-morse-code () + "Work out what `active-morse-code' should be. +Depends on the current language environment." + (let ((alphabet-sym (intern-soft + (format "%s-alphabet-morse-code" + (if (and (boundp 'current-language-environment) + current-language-environment) + (downcase + (car (split-string + current-language-environment + "[- ]"))) + "english"))))) + (if (and alphabet-sym (boundp alphabet-sym)) + (setq active-morse-code + (append (symbol-value alphabet-sym) + digits-punctuation-morse-code)) + (setq active-morse-code + (append english-alphabet-morse-code + digits-punctuation-morse-code))))) + +(choose-active-morse-code) + +(add-hook 'set-language-environment-hook 'choose-active-morse-code) ;;;###autoload (defun morse-region (beg end) ＠＠ -94,7 +192,7 ＠＠ (cond ((looking-at "\\s-+") (goto-char (match-end 0)) (setq sep "")) - ((setq morse (assoc str morse-code)) + ((setq morse (assoc str active-morse-code)) (delete-char 1) (insert sep (cdr morse)) (setq sep "/")) ＠＠ -104,7 +202,7 ＠＠ ;;;###autoload (defun unmorse-region (beg end) - "Convert morse coded text in region to ordinary ASCII text." + "Convert morse coded text in region to ordinary text." (interactive "r") (if (integerp end) (setq end (copy-marker end))) ＠＠ -115,7 +213,7 ＠＠ (if (null (looking-at "[-.]+")) (forward-char 1) (setq str (buffer-substring (match-beginning 0) (match-end 0))) - (if (null (setq morse (rassoc str morse-code))) + (if (null (setq morse (rassoc str active-morse-code))) (goto-char (match-end 0)) (replace-match (if (string-equal "(" (car morse)) -- “No one can guarantee that any course of action in Iraq at this point will stop sectarian warfare, growing violence, or a slide toward chaos.” (Iraq Study Group Report, Dec. 6, 2006) _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches