Initial revision

1 files changed, 120 insertions, 0 deletions

diff --git a/lisp/play/morse.el b/lisp/play/morse.el
new file mode 100644
index 00000000000..51d493d013f
--- /dev/null
+++ b/lisp/play/morse.el
@@ -0,0 +1,120 @@
+;;; morse.el --- Convert text to morse code and back.
+
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; 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.")
+
+(defun morse-region (beg end)
+  "Convert all text in a given region to morse code."
+  (interactive "r")
+  (if (integerp end)
+      (setq end (copy-marker end)))
+  (save-excursion
+    (let ((sep "")
+	  str morse)
+      (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))
+	       (delete-char 1)
+	       (insert sep (cdr morse))
+	       (setq sep "/"))
+	      (t
+	       (forward-char 1)
+	       (setq sep "")))))))
+
+(defun unmorse-region (beg end)
+  "Convert morse coded text in region to ordinary ASCII text."
+  (interactive "r")
+  (if (integerp end)
+      (setq end (copy-marker end)))
+  (save-excursion
+    (let (str paren morse)
+      (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)))
+	      (goto-char (match-end 0))
+	    (replace-match
+		  (if (string-equal "(" (car morse))
+		      (if (setq paren (null paren)) "(" ")")
+		    (car morse)) t)
+	    (if (looking-at "/")
+		(delete-char 1))))))))
+
+(provide 'morse)
+
+;;; morse.el ends here