Merge from emacs-23 branch, up to 2010-05-20T22:16:19Z!juri@jurta.org.
[bpt/emacs.git] / lisp / play / morse.el
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, 2008, 2009, 2010, 2011 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 3 of the License, or
14 ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; Converts text to Morse code and back with M-x morse-region and
27 ;; M-x unmorse-region (though Morse code is no longer official :-().
28
29 ;;; Code:
30
31 (defvar morse-code '(("a" . ".-")
32 ("b" . "-...")
33 ("c" . "-.-.")
34 ("d" . "-..")
35 ("e" . ".")
36 ("f" . "..-.")
37 ("g" . "--.")
38 ("h" . "....")
39 ("i" . "..")
40 ("j" . ".---")
41 ("k" . "-.-")
42 ("l" . ".-..")
43 ("m" . "--")
44 ("n" . "-.")
45 ("o" . "---")
46 ("p" . ".--.")
47 ("q" . "--.-")
48 ("r" . ".-.")
49 ("s" . "...")
50 ("t" . "-")
51 ("u" . "..-")
52 ("v" . "...-")
53 ("w" . ".--")
54 ("x" . "-..-")
55 ("y" . "-.--")
56 ("z" . "--..")
57 ;; Punctuation
58 ("=" . "-...-")
59 ("?" . "..--..")
60 ("/" . "-..-.")
61 ("," . "--..--")
62 ("." . ".-.-.-")
63 (":" . "---...")
64 ("'" . ".----.")
65 ("-" . "-....-")
66 ("(" . "-.--.-")
67 (")" . "-.--.-")
68 ;; Numbers
69 ("0" . "-----")
70 ("1" . ".----")
71 ("2" . "..---")
72 ("3" . "...--")
73 ("4" . "....-")
74 ("5" . ".....")
75 ("6" . "-....")
76 ("7" . "--...")
77 ("8" . "---..")
78 ("9" . "----.")
79 ;; Non-ASCII
80 ("Ä" . ".-.-")
81 ("Æ" . ".-.-")
82 ("Á" . ".--.-")
83 ("Å" . ".--.-")
84 ;; ligature character?? ("Ch" . "----")
85 ("ß" . ".../...")
86 ("É" . "..-..")
87 ("Ñ" . "--.--")
88 ("Ö" . "---.")
89 ("Ø" . "---.")
90 ("Ü" . "..--")
91 ;; Recently standardized
92 ("@" . ".--.-."))
93 "Morse code character set.")
94
95 ;;;###autoload
96 (defun morse-region (beg end)
97 "Convert all text in a given region to morse code."
98 (interactive "r")
99 (if (integerp end)
100 (setq end (copy-marker end)))
101 (save-excursion
102 (let ((sep "")
103 str morse)
104 (goto-char beg)
105 (while (< (point) end)
106 (setq str (downcase (buffer-substring (point) (1+ (point)))))
107 (cond ((looking-at "\\s-+")
108 (goto-char (match-end 0))
109 (setq sep ""))
110 ((setq morse (assoc str morse-code))
111 (delete-char 1)
112 (insert sep (cdr morse))
113 (setq sep "/"))
114 (t
115 (forward-char 1)
116 (setq sep "")))))))
117
118 ;;;###autoload
119 (defun unmorse-region (beg end)
120 "Convert morse coded text in region to ordinary ASCII text."
121 (interactive "r")
122 (if (integerp end)
123 (setq end (copy-marker end)))
124 (save-excursion
125 (let (str paren morse)
126 (goto-char beg)
127 (while (< (point) end)
128 (if (null (looking-at "[-.]+"))
129 (forward-char 1)
130 (setq str (buffer-substring (match-beginning 0) (match-end 0)))
131 (if (null (setq morse (rassoc str morse-code)))
132 (goto-char (match-end 0))
133 (replace-match
134 (if (string-equal "(" (car morse))
135 (if (setq paren (null paren)) "(" ")")
136 (car morse)) t)
137 (if (looking-at "/")
138 (delete-char 1))))))))
139
140 (provide 'morse)
141
142 ;;; morse.el ends here