Commits

Anonymous committed b628b57

Support Japanese, Cyrillic, Korean, other languages in morse-region,
umorse-region.

Comments (0)

Files changed (2)

+ 2006-12-29  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* morse.el:
+	* morse.el (morse-code): Removed.
+	* morse.el (digits-punctuation-morse-code): New.
+	* morse.el (english-alphabet-morse-code): New.
+	* morse.el (german-alphabet-morse-code): New.
+	* morse.el (spanish-alphabet-morse-code): New.
+	* morse.el (french-alphabet-morse-code): New.
+	* morse.el (swedish-alphabet-morse-code): New.
+	* morse.el (danish-alphabet-morse-code): New.
+	* morse.el (norwegian-alphabet-morse-code): New.
+	* morse.el (active-morse-code): New.
+	* morse.el (choose-active-morse-code): New.
+	* morse.el (read-morse-args): New.
+	Add support for encoding German, Spanish, French, Swedish,
+	Norwegian, Cyrillic, Katakana, Hangul in Morse code. Default the
+	language used based on the current language environment; make it
+	possible to specify the language environment to use
+	interactively.
+
 2003-10-31  Norbert Koch  <viteno@xemacs.org>
 
 	* Makefile (VERSION): XEmacs package 1.18 released.
-;;; morse.el --- convert text to morse code and back
+;;; morse.el --- convert to Morse code and back  -*- coding: iso-8859-1 -*- 
 
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 2002, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
 ;; Keywords: games
 
 ;;; Commentary:
 
-;; Converts text to Morse code and back with M-x morese-region and
+;; Converts text to Morse code and back with M-x morse-region and
 ;; M-x unmorse-region (though Morse code is no longer official :-().
 
 ;;; 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.")
+(eval-when-compile (require 'cl))
+
+(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 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 
+				     '(("�" . ".-.-")
+				       ("�" . "---.")
+				       ("�" . "..--")
+				       ("�" . "...--..")
+				       ;; Bug; unmorse-region respects
+				       ;; ch, morse-region doesn't.
+				       ("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.  ")
+
+(defvar danish-alphabet-morse-code (nconc
+				     '(("�" . ".-.-")
+				       ("�" . "---.")
+				       ("�" . ".--.-"))
+				     english-alphabet-morse-code)
+  "Morse code, as used for the letters of Danish.  ")
+
+(defvar norwegian-alphabet-morse-code danish-alphabet-morse-code
+  "Morse code, as used for the letters of Norwegian.  ")
+
+(when (featurep 'mule)
+  (defvar cyrillic-alphabet-morse-code 
+    (loop 
+      for (cyrillic morse)
+      in '((#xd0 ".-")
+	   (#xd1 "-...")
+	   (#xd2 ".--")
+	   (#xd3 "--.")
+	   (#xd4 "-..")
+	   (#xd5 ".")
+	   (#xd6 "...-")
+	   (#xd7 "--..")
+	   (#xd8 "..")
+	   (#xd9 ".---")
+	   (#xda "-.-")
+	   (#xdb ".-..")
+	   (#xdc "--")
+	   (#xdd "-.")
+	   (#xde "---")
+	   (#xdf ".--.")
+	   (#xe0 ".-.")
+	   (#xe1 "...")
+	   (#xe2 "-")
+	   (#xe3 "..-")
+	   (#xe4 "..-.")
+	   (#xe5 "....")
+	   (#xe6 "-.-.")
+	   (#xe7 "---.")
+	   (#xe8 "----")
+	   (#xe9 "--.-")
+	   (#xec "-..-")
+	   (#xeb "-.--")
+	   (#xed "..-..")
+	   (#xee "..--")
+	   (#xef ".-.-"))
+      collect (cons (string (make-char 'cyrillic-iso8859-5 cyrillic))
+		    morse))
+    "Morse code, as used for the letters of Russian.  ")
+  (defvar japanese-alphabet-morse-code
+    (loop
+      for (first-octet second-octet morse) 
+      in '((37 36 ".-")
+	   (37 78 "..--")
+	   (37 109 ".-.-")
+	   (37 42 ".-...")
+	   (37 79 "-...")
+	   (37 47 "...-")
+	   (37 75 "-.-.")
+	   (37 100 ".--")
+	   (37 91 "-..")
+	   (37 94 "-..-")
+	   (37 88 ".")
+	   (37 49 "-.--")
+	   (37 72 "..-..")
+	   (37 85 "--..")
+	   (37 65 "..-.")
+	   (37 51 "----")
+	   (37 106 "--.")
+	   (37 40 "-.---")
+	   (37 76 "....")
+	   (37 70 ".-.--")
+	   (37 107 "-.--.")
+	   (37 34 "--.--")
+	   (37 114 ".---")
+	   (37 53 "-.-.-")
+	   (37 111 "-.-")
+	   (37 45 "-.-..")
+	   (37 43 ".-..")
+	   (37 102 "-..--")
+	   (37 104 "--")
+	   (37 97 "-...-")
+	   (37 63 "-.")
+	   (37 95 "..-.-")
+	   (37 108 "---")
+	   (37 55 "--.-.")
+	   (37 61 "---.")
+	   (37 113 ".--..")
+	   (37 68 ".--.")
+	   (37 82 "--..-")
+	   (37 77 "--.-")
+	   (37 98 "-..-.")
+	   (37 74 ".-.")
+	   (37 59 ".---.")
+	   (37 105 "...")
+	   (37 57 "---.-")
+	   (37 96 "-")
+	   (37 115 ".-.-.")
+	   (37 38 "..-")
+	   (37 112 ".-..-")
+	   (33 43 "..")
+	   (33 44 "..--.")
+	   (33 60 ".--.-")
+	   (33 87 ".-.-.."))
+      collect (cons (string (make-char 'japanese-jisx0208 
+				       first-octet second-octet))
+		    morse))
+    "Morse code, as used for Katakana. ")
+  (defvar korean-alphabet-morse-code
+    (loop
+      for (first-octet second-octet morse)
+      in '((36 33 ".-..")
+	   (36 62 ".---")
+	   (36 36 "..-.")
+	   (36 63 ".")
+	   (36 39 "-...")
+	   (36 65 "..")
+	   (36 41 "...-")
+	   (36 67 "-")
+	   (36 49 "--")
+	   (36 69 "...")
+	   (36 50 ".--")
+	   (36 71 ".-")
+	   (36 53 "--.")
+	   (36 75 "-.")
+	   (36 55 "-.-")
+	   (36 76 "....")
+	   (36 56 ".--.")
+	   (36 80 ".-.")
+	   (36 58 "-.-.")
+	   (36 81 "-..")
+	   (36 59 "-..-")
+	   (36 83 "..-")
+	   (36 60 "--..")
+	   (36 64 "--.-")
+	   (36 61 "---")
+	   (36 68 "-.--"))
+      collect (cons (string (make-char 'korean-ksc5601
+				       first-octet second-octet))
+		    morse))
+    "Morse code, as used for Hangul.  "))
+
+(defvar active-morse-code nil
+  "The active Morse alphabet, digits, and punctuation, as an alist.  ")
+
+(defun choose-active-morse-code ()
+  "Work out what `active-morse-code' should be, and set it to that.
+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)))))
+
+(add-hook 'set-language-environment-hook 'choose-active-morse-code)
+
+(choose-active-morse-code)
+
+(defun read-morse-args ()
+  "Return a list of the beginning and end of the region, and a language.
+The language will only be non-nil if the current command has a prefix
+argument specified. "
+  (list
+   (if (and (boundp 'zmacs-regions) zmacs-regions (not zmacs-region-active-p))
+       (error "The region is not active now")
+     (let ((tem (marker-buffer (apply 'mark-marker
+				      (if (boundp 'zmacs-regions)
+					  '(t))))))
+       (unless (and tem (eq tem (current-buffer)))
+	 (error "The mark is now set now"))
+       (region-beginning)))
+   (region-end)
+   (and current-prefix-arg
+	(if (fboundp 'read-language-name)
+	    (read-language-name nil "Language environment: ")
+	  (read-string "Language environment: ")))))
 
 ;;;###autoload
-(defun morse-region (beg end)
-  "Convert all text in a given region to morse code."
-  (interactive "r")
+(defun morse-region (beg end &optional lang)
+  "Convert all text in a given region to morse code.
+Optional prefix arg LANG gives a language environment to use for conversion.  "
+  (interactive (read-morse-args))
   (if (integerp end)
       (setq end (copy-marker end)))
   (save-excursion
     (let ((sep "")
+	  (current-language-environment 
+           (and (boundp 'current-language-environment)
+                current-language-environment))
+	  (active-morse-code active-morse-code)
 	  str morse)
+      (when lang
+	;; An actual use of dynamic binding in anger!
+	(setq current-language-environment lang)
+	(choose-active-morse-code))
       (goto-char beg)
       (while (< (point) end)
 	(setq str (downcase (buffer-substring (point) (1+ (point)))))
 	(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 "/"))
 	       (setq sep "")))))))
 
 ;;;###autoload
-(defun unmorse-region (beg end)
-  "Convert morse coded text in region to ordinary ASCII text."
-  (interactive "r")
+(defun unmorse-region (beg end &optional lang)
+  "Convert morse coded text in region to ordinary text.
+Optional prefix arg LANG gives a language environment to use for conversion."
+  (interactive (read-morse-args))
   (if (integerp end)
       (setq end (copy-marker end)))
   (save-excursion
-    (let (str paren morse)
+    (let ((current-language-environment 
+           (and (boundp 'current-language-environment)
+                current-language-environment))
+	  (active-morse-code active-morse-code)
+	  str paren morse)
+      (when lang
+	(setq current-language-environment lang)
+	(choose-active-morse-code))
       (goto-char beg)
       (while (< (point) end)
 	(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))