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

[Aidan Kehoe]

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 at MENTORG.COM>
 ;; 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)
-------------- next part --------------
A non-text attachment was scrubbed...
Name: morsing.diff.bz2
Type: application/octet-stream
Size: 1891 bytes
Desc: not available
Url : http://calypso.tux.org/pipermail/xemacs-patches/attachments/20061214/3433964d/morsing.diff.obj