1;;; morse.el --- convert text to morse code and back             -*- coding: utf-8 -*-
2
3;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005,
4;;   2006, 2007 Free Software Foundation, Inc.
5
6;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
7;; Keywords: games
8
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; Converts text to Morse code and back with M-x morse-region and
29;; M-x unmorse-region (though Morse code is no longer official :-().
30
31;;; Code:
32
33(defvar morse-code '(("a" . ".-")
34		     ("b" . "-...")
35		     ("c" . "-.-.")
36		     ("d" . "-..")
37		     ("e" . ".")
38		     ("f" . "..-.")
39		     ("g" . "--.")
40		     ("h" . "....")
41		     ("i" . "..")
42		     ("j" . ".---")
43		     ("k" . "-.-")
44		     ("l" . ".-..")
45		     ("m" . "--")
46		     ("n" . "-.")
47		     ("o" . "---")
48		     ("p" . ".--.")
49		     ("q" . "--.-")
50		     ("r" . ".-.")
51		     ("s" . "...")
52		     ("t" . "-")
53		     ("u" . "..-")
54		     ("v" . "...-")
55		     ("w" . ".--")
56		     ("x" . "-..-")
57		     ("y" . "-.--")
58		     ("z" . "--..")
59		     ;; Punctuation
60		     ("=" . "-...-")
61		     ("?" . "..--..")
62		     ("/" . "-..-.")
63		     ("," . "--..--")
64		     ("." . ".-.-.-")
65		     (":" . "---...")
66		     ("'" . ".----.")
67		     ("-" . "-....-")
68		     ("(" . "-.--.-")
69		     (")" . "-.--.-")
70		     ;; Numbers
71		     ("0" . "-----")
72		     ("1" . ".----")
73		     ("2" . "..---")
74		     ("3" . "...--")
75		     ("4" . "....-")
76		     ("5" . ".....")
77		     ("6" . "-....")
78		     ("7" . "--...")
79		     ("8" . "---..")
80		     ("9" . "----.")
81		     ;; Non-ASCII
82		     ("Ä" . ".-.-")
83		     ("Æ" . ".-.-")
84		     ("Á" . ".--.-")
85		     ("Å" . ".--.-")
86		     ;; ligature character?? ("Ch" . "----")
87		     ("ß" . ".../...")
88		     ("É" . "..-..")
89		     ("Ñ" . "--.--")
90		     ("Ö" . "---.")
91		     ("Ø" . "---.")
92		     ("Ü" . "..--")
93		     ;; Recently standardized
94		     ("@" . ".--.-."))
95  "Morse code character set.")
96
97;;;###autoload
98(defun morse-region (beg end)
99  "Convert all text in a given region to morse code."
100  (interactive "r")
101  (if (integerp end)
102      (setq end (copy-marker end)))
103  (save-excursion
104    (let ((sep "")
105	  str morse)
106      (goto-char beg)
107      (while (< (point) end)
108	(setq str (downcase (buffer-substring (point) (1+ (point)))))
109	(cond ((looking-at "\\s-+")
110	       (goto-char (match-end 0))
111	       (setq sep ""))
112	      ((setq morse (assoc str morse-code))
113	       (delete-char 1)
114	       (insert sep (cdr morse))
115	       (setq sep "/"))
116	      (t
117	       (forward-char 1)
118	       (setq sep "")))))))
119
120;;;###autoload
121(defun unmorse-region (beg end)
122  "Convert morse coded text in region to ordinary ASCII text."
123  (interactive "r")
124  (if (integerp end)
125      (setq end (copy-marker end)))
126  (save-excursion
127    (let (str paren morse)
128      (goto-char beg)
129      (while (< (point) end)
130	(if (null (looking-at "[-.]+"))
131	    (forward-char 1)
132	  (setq str (buffer-substring (match-beginning 0) (match-end 0)))
133	  (if (null (setq morse (rassoc str morse-code)))
134	      (goto-char (match-end 0))
135	    (replace-match
136		  (if (string-equal "(" (car morse))
137		      (if (setq paren (null paren)) "(" ")")
138		    (car morse)) t)
139	    (if (looking-at "/")
140		(delete-char 1))))))))
141
142(provide 'morse)
143
144;;; arch-tag: 3331e6c1-9a9e-453f-abfd-163a9c3f93a6
145;;; morse.el ends here
146