Source

misc-games / morse.el

Full commit
aidan b628b57 
steveb 5439ca9 
aidan b628b57 
steveb 5439ca9 

scop e70b9b9 
steveb 5439ca9 

















scop e70b9b9 

aidan b628b57 
scop e70b9b9 

steveb 5439ca9 

aidan b628b57 
















































































































































































































































































steveb 5439ca9 
scop e70b9b9 
aidan b628b57 



steveb 5439ca9 



aidan b628b57 



steveb 5439ca9 
aidan b628b57 



steveb 5439ca9 





aidan b628b57 
steveb 5439ca9 






scop e70b9b9 
aidan b628b57 



steveb 5439ca9 


aidan b628b57 







steveb 5439ca9 




aidan b628b57 
steveb 5439ca9 









;;; morse.el --- convert to Morse code and back  -*- coding: iso-8859-1 -*- 

;; Copyright (C) 1995, 2002, 2005, 2006 Free Software Foundation, Inc.

;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
;; Keywords: games

;; 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, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; 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:

(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 &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 active-morse-code))
	       (delete-char 1)
	       (insert sep (cdr morse))
	       (setq sep "/"))
	      (t
	       (forward-char 1)
	       (setq sep "")))))))

;;;###autoload
(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 ((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 active-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