[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] Make morse-region and unmorse-region respect the language enviro
|
From: |
Aidan Kehoe |
|
Subject: |
[PATCH] Make morse-region and unmorse-region respect the language environment. |
|
Date: |
Sun, 14 Jan 2007 15:27:57 +0100 |
Every major participant in World War II (and many of the minor ones) used
Morse code, and extended it as necessary to support their written language,
with some of these extensions incompatible with English. This patch adds
support for all the language-specific variants I could find in Wikipedia; in
total, and going by their emacs language environment names rather than the
actual language names, English, German, Spanish, French, Swedish, Danish,
Norwegian, Cyrillic, Japanese, Korean.
In the event that my mailer or yours trashes the encoding of the patch, I’ve
made a bzip2’d version of the entire file available under
http://www.parhasard.net/morse-20070114.el.bz2 .
lisp/ChangeLog addition:
2007-01-14 Aidan Kehoe <address@hidden>
* play/morse.el:
* play/morse.el (require):
* play/morse.el (morse-code): Removed.
* play/morse.el (active-morse-code): New.
Replace the static morse-code variable with active-morse-code,
which will change depending on the language environment or,
alternatively, whether a language environment argument was
supplied to morse-region or unmorse-region.
* play/morse.el (digits-punctuation-morse-code): New.
The digits and punctuation in Morse code are not language
specific; separate them out.
* play/morse.el (english-alphabet-morse-code): New.
* play/morse.el (german-alphabet-morse-code): New.
* play/morse.el (spanish-alphabet-morse-code): New.
* play/morse.el (french-alphabet-morse-code): New.
* play/morse.el (swedish-alphabet-morse-code): New.
* play/morse.el (danish-alphabet-morse-code): New.
* play/morse.el (norwegian-alphabet-morse-code): New.
* play/morse.el (cyrillic-alphabet-morse-code): New.
* play/morse.el (japanese-alphabet-morse-code): New.
* play/morse.el (korean-alphabet-morse-code): New.
Add language-environment specific Morse-code mappings, to be used
by choose-active-morse-code.
* play/morse.el (choose-active-morse-code): New.
Function to determine what `active-morse-code' should be, run on
load and whenever the current language environment is changed.
* play/morse.el (morse-region):
* play/morse.el (unmorse-region):
* play/morse.el (read-morse-args): New.
Accept a prefix argument to morse-region and unmorse-region; when
it is specified, prompt for a language environment in which to run
the commands.
GNU Emacs Trunk source patch:
Index: lisp/play/morse.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/play/morse.el,v
retrieving revision 1.13
diff -u -u -r1.13 morse.el
--- lisp/play/morse.el 9 Dec 2006 03:45:05 -0000 1.13
+++ lisp/play/morse.el 14 Jan 2007 14:22:45 -0000
@@ -1,4 +1,4 @@
-;;; morse.el --- convert text to morse code and back -*- coding:
utf-8 -*-
+;;; morse.el --- convert to Morse code and back -*- coding: iso-8859-1 -*-
;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005,
;; 2006 Free Software Foundation, Inc.
@@ -30,86 +30,305 @@
;;; 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" . "----.")
- ;; Non-ASCII
- ("Ã" . ".-.-")
- ("Ã" . ".-.-")
- ("Ã" . ".--.-")
- ("Ã
" . ".--.-")
- ;; ligature character?? ("Ch" . "----")
- ("Ã" . ".../...")
- ("Ã" . "..-..")
- ("Ã" . "--.--")
- ("Ã" . "---.")
- ("Ã" . "---.")
- ("Ã" . "..--")
- ;; Recently standardized
- ("@" . ".--.-."))
- "Morse code character set.")
+(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)
- "Convert all text in a given region to morse code."
- (interactive "r")
+(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 morse-code))
+ ((setq morse (assoc str active-morse-code))
(delete-char 1)
(insert sep (cdr morse))
(setq sep "/"))
@@ -118,19 +337,27 @@
(setq sep "")))))))
;;;###autoload
-(defun unmorse-region (beg end)
- "Convert morse coded text in region to ordinary ASCII text."
- (interactive "r")
+(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 (str paren morse)
+ (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 morse-code)))
+ (if (null (setq morse (rassoc str active-morse-code)))
(goto-char (match-end 0))
(replace-match
(if (string-equal "(" (car morse))
--
When I was in the scouts, the leader told me to pitch a tent. I couldn't
find any pitch, so I used creosote.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [PATCH] Make morse-region and unmorse-region respect the language environment.,
Aidan Kehoe <=