cgit.sxemacs.org Git - packages/blob - xemacs-packages/misc-games/morse.el

   1 ;;; morse.el --- convert to Morse code and back  -*- coding: iso-8859-1 -*-
   2
   3 ;; Copyright (C) 1995, 2002, 2005, 2006 Free Software Foundation, Inc.
   4
   5 ;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
   6 ;; Keywords: games
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; Converts text to Morse code and back with M-x morse-region and
  28 ;; M-x unmorse-region (though Morse code is no longer official :-().
  29
  30 ;;; Code:
  31
  32 (eval-when-compile (require 'cl))
  33
  34 (defvar digits-punctuation-morse-code '(("0" . "-----")
  35                                         ("1" . ".----")
  36                                         ("2" . "..---")
  37                                         ("3" . "...--")
  38                                         ("4" . "....-")
  39                                         ("5" . ".....")
  40                                         ("6" . "-....")
  41                                         ("7" . "--...")
  42                                         ("8" . "---..")
  43                                         ("9" . "----.")
  44                                         ;; Punctuation
  45                                         ("=" . "-...-")
  46                                         ("?" . "..--..")
  47                                         ("/" . "-..-.")
  48                                         ("," . "--..--")
  49                                         ("." . ".-.-.-")
  50                                         (":" . "---...")
  51                                         ("'" . ".----.")
  52                                         ("-" . "-....-")
  53                                         ("(" . "-.--.-")
  54                                         (")" . "-.--.-")
  55                                         ("@" . ".--.-.")
  56                                         ("+" . ".-.-."))
  57   "The digits and punctuation in Morse code, as used internationally.")
  58
  59 (defvar english-alphabet-morse-code '(("a" . ".-")
  60                                       ("b" . "-...")
  61                                       ("c" . "-.-.")
  62                                       ("d" . "-..")
  63                                       ("e" . ".")
  64                                       ("f" . "..-.")
  65                                       ("g" . "--.")
  66                                       ("h" . "....")
  67                                       ("i" . "..")
  68                                       ("j" . ".---")
  69                                       ("k" . "-.-")
  70                                       ("l" . ".-..")
  71                                       ("m" . "--")
  72                                       ("n" . "-.")
  73                                       ("o" . "---")
  74                                       ("p" . ".--.")
  75                                       ("q" . "--.-")
  76                                       ("r" . ".-.")
  77                                       ("s" . "...")
  78                                       ("t" . "-")
  79                                       ("u" . "..-")
  80                                       ("v" . "...-")
  81                                       ("w" . ".--")
  82                                       ("x" . "-..-")
  83                                       ("y" . "-.--")
  84                                       ("z" . "--.."))
  85   "Morse code, as used for the letters of English.  ")
  86
  87 (defvar german-alphabet-morse-code  (nconc
  88                                      '(("ä" . ".-.-")
  89                                        ("ö" . "---.")
  90                                        ("ü" . "..--")
  91                                        ("ß" . "...--..")
  92                                        ;; Bug; unmorse-region respects
  93                                        ;; ch, morse-region doesn't.
  94                                        ("ch". "----"))
  95                                      english-alphabet-morse-code)
  96   "Morse code, as used for the letters of German.  ")
  97
  98 (defvar spanish-alphabet-morse-code (nconc
  99                                      '(("ch". "----")
 100                                        ("ñ" . "--.--")
 101                                        ("ü" . "..--"))
 102                                      english-alphabet-morse-code)
 103   "Morse code, as used for the letters of Spanish.  ")
 104
 105 (defvar french-alphabet-morse-code (nconc
 106                                      '(("ç". "-.-..")
 107                                        ("è". ".-..-")
 108                                        ("é" . "..-..")
 109                                        ("à" . ".--.-"))
 110                                      english-alphabet-morse-code))
 111
 112 (defvar swedish-alphabet-morse-code (nconc
 113                                      '(("ä" . ".-.-")
 114                                        ("ö" . "---.")
 115                                        ("å" . ".--.-"))
 116                                      english-alphabet-morse-code)
 117   "Morse code, as used for the letters of Swedish.  ")
 118
 119 (defvar danish-alphabet-morse-code (nconc
 120                                      '(("æ" . ".-.-")
 121                                        ("ø" . "---.")
 122                                        ("å" . ".--.-"))
 123                                      english-alphabet-morse-code)
 124   "Morse code, as used for the letters of Danish.  ")
 125
 126 (defvar norwegian-alphabet-morse-code danish-alphabet-morse-code
 127   "Morse code, as used for the letters of Norwegian.  ")
 128
 129 (when (featurep 'mule)
 130   (defvar cyrillic-alphabet-morse-code
 131     (loop
 132       for (cyrillic morse)
 133       in '((#xd0 ".-")
 134            (#xd1 "-...")
 135            (#xd2 ".--")
 136            (#xd3 "--.")
 137            (#xd4 "-..")
 138            (#xd5 ".")
 139            (#xd6 "...-")
 140            (#xd7 "--..")
 141            (#xd8 "..")
 142            (#xd9 ".---")
 143            (#xda "-.-")
 144            (#xdb ".-..")
 145            (#xdc "--")
 146            (#xdd "-.")
 147            (#xde "---")
 148            (#xdf ".--.")
 149            (#xe0 ".-.")
 150            (#xe1 "...")
 151            (#xe2 "-")
 152            (#xe3 "..-")
 153            (#xe4 "..-.")
 154            (#xe5 "....")
 155            (#xe6 "-.-.")
 156            (#xe7 "---.")
 157            (#xe8 "----")
 158            (#xe9 "--.-")
 159            (#xec "-..-")
 160            (#xeb "-.--")
 161            (#xed "..-..")
 162            (#xee "..--")
 163            (#xef ".-.-"))
 164       collect (cons (string (make-char 'cyrillic-iso8859-5 cyrillic))
 165                     morse))
 166     "Morse code, as used for the letters of Russian.  ")
 167   (defvar japanese-alphabet-morse-code
 168     (loop
 169       for (first-octet second-octet morse)
 170       in '((37 36 ".-")
 171            (37 78 "..--")
 172            (37 109 ".-.-")
 173            (37 42 ".-...")
 174            (37 79 "-...")
 175            (37 47 "...-")
 176            (37 75 "-.-.")
 177            (37 100 ".--")
 178            (37 91 "-..")
 179            (37 94 "-..-")
 180            (37 88 ".")
 181            (37 49 "-.--")
 182            (37 72 "..-..")
 183            (37 85 "--..")
 184            (37 65 "..-.")
 185            (37 51 "----")
 186            (37 106 "--.")
 187            (37 40 "-.---")
 188            (37 76 "....")
 189            (37 70 ".-.--")
 190            (37 107 "-.--.")
 191            (37 34 "--.--")
 192            (37 114 ".---")
 193            (37 53 "-.-.-")
 194            (37 111 "-.-")
 195            (37 45 "-.-..")
 196            (37 43 ".-..")
 197            (37 102 "-..--")
 198            (37 104 "--")
 199            (37 97 "-...-")
 200            (37 63 "-.")
 201            (37 95 "..-.-")
 202            (37 108 "---")
 203            (37 55 "--.-.")
 204            (37 61 "---.")
 205            (37 113 ".--..")
 206            (37 68 ".--.")
 207            (37 82 "--..-")
 208            (37 77 "--.-")
 209            (37 98 "-..-.")
 210            (37 74 ".-.")
 211            (37 59 ".---.")
 212            (37 105 "...")
 213            (37 57 "---.-")
 214            (37 96 "-")
 215            (37 115 ".-.-.")
 216            (37 38 "..-")
 217            (37 112 ".-..-")
 218            (33 43 "..")
 219            (33 44 "..--.")
 220            (33 60 ".--.-")
 221            (33 87 ".-.-.."))
 222       collect (cons (string (make-char 'japanese-jisx0208
 223                                        first-octet second-octet))
 224                     morse))
 225     "Morse code, as used for Katakana. ")
 226   (defvar korean-alphabet-morse-code
 227     (loop
 228       for (first-octet second-octet morse)
 229       in '((36 33 ".-..")
 230            (36 62 ".---")
 231            (36 36 "..-.")
 232            (36 63 ".")
 233            (36 39 "-...")
 234            (36 65 "..")
 235            (36 41 "...-")
 236            (36 67 "-")
 237            (36 49 "--")
 238            (36 69 "...")
 239            (36 50 ".--")
 240            (36 71 ".-")
 241            (36 53 "--.")
 242            (36 75 "-.")
 243            (36 55 "-.-")
 244            (36 76 "....")
 245            (36 56 ".--.")
 246            (36 80 ".-.")
 247            (36 58 "-.-.")
 248            (36 81 "-..")
 249            (36 59 "-..-")
 250            (36 83 "..-")
 251            (36 60 "--..")
 252            (36 64 "--.-")
 253            (36 61 "---")
 254            (36 68 "-.--"))
 255       collect (cons (string (make-char 'korean-ksc5601
 256                                        first-octet second-octet))
 257                     morse))
 258     "Morse code, as used for Hangul.  "))
 259
 260 (defvar active-morse-code nil
 261   "The active Morse alphabet, digits, and punctuation, as an alist.  ")
 262
 263 (defun choose-active-morse-code ()
 264   "Work out what `active-morse-code' should be, and set it to that.
 265 Depends on the current language environment.  "
 266   (let ((alphabet-sym (intern-soft
 267                        (format "%s-alphabet-morse-code"
 268                                (if (and (boundp 'current-language-environment)
 269                                         current-language-environment)
 270                                    (downcase
 271                                     (car (split-string
 272                                           current-language-environment
 273                                           "[- ]")))
 274                                  "english")))))
 275     (if (and alphabet-sym (boundp alphabet-sym))
 276         (setq active-morse-code
 277               (append (symbol-value alphabet-sym)
 278                       digits-punctuation-morse-code))
 279       (setq active-morse-code
 280             (append english-alphabet-morse-code
 281                     digits-punctuation-morse-code)))))
 282
 283 (add-hook 'set-language-environment-hook 'choose-active-morse-code)
 284
 285 (choose-active-morse-code)
 286
 287 (defun read-morse-args ()
 288   "Return a list of the beginning and end of the region, and a language.
 289 The language will only be non-nil if the current command has a prefix
 290 argument specified. "
 291   (list
 292    (if (and (boundp 'zmacs-regions) zmacs-regions (not zmacs-region-active-p))
 293        (error "The region is not active now")
 294      (let ((tem (marker-buffer (apply 'mark-marker
 295                                       (if (boundp 'zmacs-regions)
 296                                           '(t))))))
 297        (unless (and tem (eq tem (current-buffer)))
 298          (error "The mark is now set now"))
 299        (region-beginning)))
 300    (region-end)
 301    (and current-prefix-arg
 302         (if (fboundp 'read-language-name)
 303             (read-language-name nil "Language environment: ")
 304           (read-string "Language environment: ")))))
 305
 306 ;;;###autoload
 307 (defun morse-region (beg end &optional lang)
 308   "Convert all text in a given region to morse code.
 309 Optional prefix arg LANG gives a language environment to use for conversion.  "
 310   (interactive (read-morse-args))
 311   (if (integerp end)
 312       (setq end (copy-marker end)))
 313   (save-excursion
 314     (let ((sep "")
 315           (current-language-environment
 316            (and (boundp 'current-language-environment)
 317                 current-language-environment))
 318           (active-morse-code active-morse-code)
 319           str morse)
 320       (when lang
 321         ;; An actual use of dynamic binding in anger!
 322         (setq current-language-environment lang)
 323         (choose-active-morse-code))
 324       (goto-char beg)
 325       (while (< (point) end)
 326         (setq str (downcase (buffer-substring (point) (1+ (point)))))
 327         (cond ((looking-at "\\s-+")
 328                (goto-char (match-end 0))
 329                (setq sep ""))
 330               ((setq morse (assoc str active-morse-code))
 331                (delete-char 1)
 332                (insert sep (cdr morse))
 333                (setq sep "/"))
 334               (t
 335                (forward-char 1)
 336                (setq sep "")))))))
 337
 338 ;;;###autoload
 339 (defun unmorse-region (beg end &optional lang)
 340   "Convert morse coded text in region to ordinary text.
 341 Optional prefix arg LANG gives a language environment to use for conversion."
 342   (interactive (read-morse-args))
 343   (if (integerp end)
 344       (setq end (copy-marker end)))
 345   (save-excursion
 346     (let ((current-language-environment
 347            (and (boundp 'current-language-environment)
 348                 current-language-environment))
 349           (active-morse-code active-morse-code)
 350           str paren morse)
 351       (when lang
 352         (setq current-language-environment lang)
 353         (choose-active-morse-code))
 354       (goto-char beg)
 355       (while (< (point) end)
 356         (if (null (looking-at "[-.]+"))
 357             (forward-char 1)
 358           (setq str (buffer-substring (match-beginning 0) (match-end 0)))
 359           (if (null (setq morse (rassoc str active-morse-code)))
 360               (goto-char (match-end 0))
 361             (replace-match
 362                   (if (string-equal "(" (car morse))
 363                       (if (setq paren (null paren)) "(" ")")
 364                     (car morse)) t)
 365             (if (looking-at "/")
 366                 (delete-char 1))))))))
 367
 368 (provide 'morse)
 369
 370 ;;; morse.el ends here