Mercurial > hg > xemacs-beta
annotate lisp/mule/ethio-util.el @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | 308d34e9f07d |
| children | ba0ff364bd94 |
| rev | line source |
|---|---|
| 771 | 1 ;;; ethio-util.el --- utilities for Ethiopic -*- coding: iso-2022-7bit; -*- |
| 2 | |
| 3 ;; Copyright (C) 1997, 2001 Electrotechnical Laboratory, JAPAN. | |
| 4 ;; Licensed to the Free Software Foundation. | |
| 5 | |
| 6 ;; Keywords: mule, multilingual, Ethiopic | |
| 7 | |
| 8 ;; This file is part of XEmacs. | |
| 9 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
13 ;; option) any later version. |
| 771 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
18 ;; for more details. |
| 771 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
4783
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 771 | 22 |
| 778 | 23 ;;; Synched up with: Emacs 21.1 (language/ethio-util.el). |
| 771 | 24 |
| 25 ;; Author: TAKAHASHI Naoto <ntakahas@m17n.org> | |
| 26 | |
| 778 | 27 ;;; Commentary: |
| 28 | |
| 771 | 29 ;;; Code: |
| 30 | |
| 788 | 31 (globally-declare-boundp '(sera-being-called-by-w3 |
| 32 rmail-message-vector rmail-current-message)) | |
| 33 (globally-declare-fboundp '(rfc822-goto-eoh line-end-position quail-title | |
| 34 quail-defrule)) | |
| 35 | |
| 771 | 36 ;; Information for exiting Ethiopic environment. |
| 37 (defvar exit-ethiopic-environment-data nil) | |
| 38 | |
| 39 ;;;###autoload | |
| 40 (defun setup-ethiopic-environment-internal () | |
| 41 (let ((key-bindings '((" " . ethio-insert-space) | |
| 42 ([?\S- ] . ethio-insert-ethio-space) | |
| 43 ([?\C-'] . ethio-gemination) | |
| 44 | |
| 45 ;; these old bindings conflict | |
| 46 ;; with Emacs' binding policy | |
| 47 | |
| 48 ;; ([f2] . ethio-toggle-space) | |
| 49 ;; ([S-f2] . ethio-replace-space) ; as requested | |
| 50 ;; ([f3] . ethio-toggle-punctuation) | |
| 51 ;; ([f4] . ethio-sera-to-fidel-buffer) | |
| 52 ;; ([S-f4] . ethio-sera-to-fidel-region) | |
| 53 ;; ([C-f4] . ethio-sera-to-fidel-mail-or-marker) | |
| 54 ;; ([f5] . ethio-fidel-to-sera-buffer) | |
| 55 ;; ([S-f5] . ethio-fidel-to-sera-region) | |
| 56 ;; ([C-f5] . ethio-fidel-to-sera-mail-or-marker) | |
| 57 ;; ([f6] . ethio-modify-vowel) | |
| 58 ;; ([f7] . ethio-replace-space) | |
| 59 ;; ([f8] . ethio-input-special-character) | |
| 60 | |
| 61 ;; this is the rewritten bindings | |
| 62 | |
| 63 ([f3] . ethio-fidel-to-sera-buffer) | |
| 64 ([S-f3] . ethio-fidel-to-sera-region) | |
| 65 ([C-f3] . ethio-fidel-to-sera-mail-or-marker) | |
| 66 ([f4] . ethio-sera-to-fidel-buffer) | |
| 67 ([S-f4] . ethio-sera-to-fidel-region) | |
| 68 ([C-f4] . ethio-sera-to-fidel-mail-or-marker) | |
| 69 ([S-f5] . ethio-toggle-punctuation) | |
| 70 ([S-f6] . ethio-modify-vowel) | |
| 71 ([S-f7] . ethio-replace-space) | |
| 72 ([S-f8] . ethio-input-special-character) | |
| 73 ([C-f9] . ethio-toggle-space) | |
| 74 ([S-f9] . ethio-replace-space) ; as requested | |
| 75 )) | |
| 76 kb) | |
| 77 (while key-bindings | |
| 78 (setq kb (car (car key-bindings))) | |
| 79 (setq exit-ethiopic-environment-data | |
| 80 (cons (cons kb (global-key-binding kb)) | |
| 81 exit-ethiopic-environment-data)) | |
| 82 (global-set-key kb (cdr (car key-bindings))) | |
| 83 (setq key-bindings (cdr key-bindings)))) | |
| 84 | |
| 85 (add-hook 'quail-activate-hook 'ethio-select-a-translation) | |
| 86 (add-hook 'find-file-hooks 'ethio-find-file) | |
| 87 (add-hook 'write-file-hooks 'ethio-write-file) | |
| 88 (add-hook 'after-save-hook 'ethio-find-file)) | |
| 89 | |
| 90 (defun exit-ethiopic-environment () | |
| 91 "Exit Ethiopic language environment" | |
| 92 (while exit-ethiopic-environment-data | |
| 93 (global-set-key (car (car exit-ethiopic-environment-data)) | |
| 94 (cdr (car exit-ethiopic-environment-data))) | |
| 95 (setq exit-ethiopic-environment-data | |
| 96 (cdr exit-ethiopic-environment-data))) | |
| 97 | |
| 98 (remove-hook 'quail-activate-hook 'ethio-select-a-translation) | |
| 99 (remove-hook 'find-file-hooks 'ethio-find-file) | |
| 100 (remove-hook 'write-file-hooks 'ethio-write-file) | |
| 101 (remove-hook 'after-save-hook 'ethio-find-file)) | |
| 102 | |
| 103 ;; | |
| 104 ;; ETHIOPIC UTILITY FUNCTIONS | |
| 105 ;; | |
| 106 | |
| 107 ;; If the filename ends in ".sera", editing is done in fidel | |
| 108 ;; but file I/O is done in SERA. | |
| 109 ;; | |
| 110 ;; If the filename ends in ".java", editing is done in fidel | |
| 111 ;; but file I/O is done in the \uXXXX style, where XXXX is | |
| 112 ;; the Unicode codepoint for the Ethiopic character. | |
| 113 ;; | |
| 114 ;; If the filename ends in ".tex", editing is done in fidel | |
| 115 ;; but file I/O is done in EthioTeX format. | |
| 116 ;; | |
| 117 ;; To automatically convert Ethiopic text to SERA format when sending mail, | |
| 118 ;; (add-hook 'mail-send-hook 'ethio-fidel-to-sera-mail) | |
| 119 ;; | |
| 120 ;; To automatically convert SERA format to Ethiopic when receiving mail, | |
| 121 ;; (add-hook 'rmail-show-message-hook 'ethio-sera-to-fidel-mail) | |
| 122 ;; | |
| 123 ;; To automatically convert Ethiopic text to SERA format when posting news, | |
| 124 ;; (add-hook 'news-inews-hook 'ethio-fidel-to-sera-mail) | |
| 125 | |
| 126 ;; | |
| 127 ;; users' preference | |
| 128 ;; | |
| 129 | |
| 130 (defvar ethio-primary-language 'tigrigna | |
| 131 "*Symbol that defines the primary language in SERA --> FIDEL conversion. | |
| 132 The value should be one of: `tigrigna', `amharic' or `english'.") | |
| 133 | |
| 134 (defvar ethio-secondary-language 'english | |
| 135 "*Symbol that defines the secondary language in SERA --> FIDEL conversion. | |
| 136 The value should be one of: `tigrigna', `amharic' or `english'.") | |
| 137 | |
| 138 (defvar ethio-use-colon-for-colon nil | |
| 139 "*Non-nil means associate ASCII colon with Ethiopic colon. | |
| 140 If nil, associate ASCII colon with Ethiopic word separator, i.e., two | |
| 141 vertically stacked dots. All SERA <--> FIDEL converters refer this | |
| 142 variable.") | |
| 143 | |
| 144 (defvar ethio-use-three-dot-question nil | |
| 145 "*Non-nil means associate ASCII question mark with Ethiopic old style question mark (three vertically stacked dots). | |
| 146 If nil, associate ASCII question mark with Ethiopic stylised question | |
| 147 mark. All SERA <--> FIDEL converters refer this variable.") | |
| 148 | |
| 149 (defvar ethio-quote-vowel-always nil | |
| 150 "*Non-nil means always put an apostrophe before an isolated vowel (except at word initial) in FIDEL --> SERA conversion. | |
| 151 If nil, put an apostrophe only between a sixth-form consonant and an | |
| 152 isolated vowel.") | |
| 153 | |
| 154 (defvar ethio-W-sixth-always nil | |
| 155 "*Non-nil means convert the Wu-form of a 12-form consonant to \"W'\" instead of \"Wu\" in FIDEL --> SERA conversion.") | |
| 156 | |
| 157 (defvar ethio-numeric-reduction 0 | |
| 158 "*Degree of reduction in converting Ethiopic digits into Arabic digits. | |
| 159 Should be 0, 1 or 2. | |
| 160 For example, ({10}{9}{100}{80}{7}) is converted into: | |
| 161 `10`9`100`80`7 if `ethio-numeric-reduction' is 0, | |
| 162 `109100807 if `ethio-numeric-reduction' is 1, | |
| 163 `10900807 if `ethio-numeric-reduction' is 2.") | |
| 164 | |
| 165 (defvar ethio-implicit-period-conversion t | |
| 166 "*Non-nil means replacing the Ethiopic dot at the end of an Ethiopic sentence | |
| 167 with an Ethiopic full stop.") | |
| 168 | |
| 169 (defvar ethio-java-save-lowercase nil | |
| 170 "*Non-nil means save Ethiopic characters in lowercase hex numbers to Java files. | |
| 171 If nil, use uppercases.") | |
| 172 | |
| 173 ;; | |
| 174 ;; SERA to FIDEL | |
| 175 ;; | |
| 176 | |
| 177 (defconst ethio-sera-to-fidel-table | |
| 178 [ | |
| 179 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
| 180 nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil | |
| 181 ;;; SP | |
| 182 (" " | |
| 183 (?: (if ethio-use-colon-for-colon " $(3$l(B" "$(3$h(B") | |
| 184 (32 (if ethio-use-colon-for-colon " $(3$l(B " "$(3$h(B")) | |
| 185 (?- " $(3$m(B") | |
| 186 (?: " $(3$i(B") | |
| 187 (?| (if ethio-use-colon-for-colon " $(3$l(B|" " $(3$h(B|") | |
| 188 (?: " $(3$o(B")))) | |
| 189 | |
| 190 ;;; ! " # $ % & ' | |
| 191 nil nil nil nil nil nil ("" (?' "$(3%s(B")) | |
| 192 ;;; ( ) * + , - . | |
| 193 nil nil nil nil ("$(3$j(B") ("-" (?: "$(3$l(B")) ("$(3%u(B") | |
| 194 ;;; / 0 1 2 3 4 5 6 7 8 9 | |
| 195 nil nil nil nil nil nil nil nil nil nil nil | |
| 196 ;;; : | |
| 197 ((if ethio-use-colon-for-colon "$(3$l(B" "$(3$h(B") | |
| 198 (32 (if ethio-use-colon-for-colon "$(3$l(B " "$(3$h(B")) | |
| 199 (?- "$(3$m(B") | |
| 200 (?: "$(3$i(B") | |
| 201 (?| (if ethio-use-colon-for-colon "$(3$l(B|" "$(3$h(B|") | |
| 202 (?: "$(3$o(B"))) | |
| 203 ;;; ; < = > | |
| 204 ("$(3$k(B") ("<" (?< "$(3%v(B")) nil (">" (?> "$(3%w(B")) | |
| 205 ;;; ? | |
| 206 ((if ethio-use-three-dot-question "$(3$n(B" "$(3%x(B")) | |
| 207 ;;; @ | |
| 208 nil | |
| 209 ;;; A | |
| 210 ("$(3"f(B" (?2 "$(3#8(B")) | |
| 211 ;;; B | |
| 212 ("$(3"((B" (?e "$(3"#(B") (?u "$(3"$(B") (?i "$(3"%(B") (?a "$(3"&(B") (?E "$(3"'(B") (?o "$(3")(B") | |
| 213 (?W "$(3%b(B" (?e "$(3%2(B") (?u "$(3%b(B") (?i "$(3%B(B") (?a "$(3"*(B") (?E "$(3%R(B"))) | |
| 214 ;;; C | |
| 215 ("$(3$4(B" (?e "$(3$/(B") (?u "$(3$0(B") (?i "$(3$1(B") (?a "$(3$2(B") (?E "$(3$3(B") (?o "$(3$5(B") | |
| 216 (?W "$(3$6(B" (?a "$(3$6(B") | |
| 217 (?e "$(3$4%n(B") (?u "$(3$4%r(B") (?i "$(3$4%o(B") (?E "$(3$4%q(B"))) | |
| 218 ;;; D | |
| 219 ("$(3#b(B" (?e "$(3#](B") (?u "$(3#^(B") (?i "$(3#_(B") (?a "$(3#`(B") (?E "$(3#a(B") (?o "$(3#c(B") | |
| 220 (?W "$(3#d(B" (?a "$(3#d(B") | |
| 221 (?e "$(3#b%n(B") (?u "$(3#b%r(B") (?i "$(3#b%o(B") (?E "$(3#b%q(B"))) | |
| 222 ;;; E | |
| 223 ("$(3"g(B" (?2 "$(3#9(B")) | |
| 224 ;;; F | |
| 225 ("$(3$T(B" (?e "$(3$O(B") (?u "$(3$P(B") (?i "$(3$Q(B") (?a "$(3$R(B") (?E "$(3$S(B") (?o "$(3$U(B") | |
| 226 (?W "$(3%d(B" (?e "$(3%4(B") (?u "$(3%d(B") (?i "$(3%D(B") (?a "$(3$V(B") (?E "$(3%T(B")) | |
| 227 (?Y "$(3$a(B" (?a "$(3$a(B"))) | |
| 228 ;;; G | |
| 229 ("$(3$$(B" (?e "$(3#}(B") (?u "$(3#~(B") (?i "$(3$!(B") (?a "$(3$"(B") (?E "$(3$#(B") (?o "$(3$%(B") | |
| 230 (?W "$(3%c(B" (?e "$(3%3(B") (?u "$(3%c(B") (?i "$(3%C(B") (?a "$(3$&(B") (?E "$(3%S(B"))) | |
| 231 ;;; H | |
| 232 ("$(3!6(B" (?e "$(3!1(B") (?u "$(3!2(B") (?i "$(3!3(B") (?a "$(3!4(B") (?E "$(3!5(B") (?o "$(3!7(B") | |
| 233 (?W "$(3!8(B" (?a "$(3!8(B") | |
| 234 (?e "$(3!6%n(B") (?u "$(3!6%r(B") (?i "$(3!6%o(B") (?E "$(3!6%q(B"))) | |
| 235 ;;; I | |
| 236 ("$(3"h(B" (?2 "$(3#:(B")) | |
| 237 ;;; J | |
| 238 ("$(3#j(B" (?e "$(3#e(B") (?u "$(3#f(B") (?i "$(3#g(B") (?a "$(3#h(B") (?E "$(3#i(B") (?o "$(3#k(B") | |
| 239 (?W "$(3#l(B" (?a "$(3#l(B") | |
| 240 (?e "$(3#j%n(B") (?u "$(3#j%r(B") (?i "$(3#j%o(B") (?E "$(3#j%q(B"))) | |
| 241 ;;; K | |
| 242 ("$(3#"(B" (?e "$(3"{(B") (?u "$(3"|(B") (?i "$(3"}(B") (?a "$(3"~(B") (?E "$(3#!(B") (?o "$(3##(B") | |
| 243 (?W "$(3#*(B" (?e "$(3#%(B") (?u "$(3#*(B") (?i "$(3#'(B") (?a "$(3#((B") (?E "$(3#)(B"))) | |
| 244 ;;; L | |
| 245 ("$(3!.(B" (?e "$(3!)(B") (?u "$(3!*(B") (?i "$(3!+(B") (?a "$(3!,(B") (?E "$(3!-(B") (?o "$(3!/(B") | |
| 246 (?W "$(3!0(B" (?a "$(3!0(B") | |
| 247 (?e "$(3!.%n(B") (?u "$(3!.%r(B") (?i "$(3!.%o(B") (?E "$(3!.%q(B"))) | |
| 248 ;;; M | |
| 249 ("$(3!>(B" (?e "$(3!9(B") (?u "$(3!:(B") (?i "$(3!;(B") (?a "$(3!<(B") (?E "$(3!=(B") (?o "$(3!?(B") | |
| 250 (?W "$(3%a(B" (?e "$(3%1(B") (?u "$(3%a(B") (?i "$(3%A(B") (?a "$(3!@(B") (?E "$(3%Q(B")) | |
| 251 (?Y "$(3$_(B" (?a "$(3$_(B"))) | |
| 252 ;;; N | |
| 253 ("$(3"`(B" (?e "$(3"[(B") (?u "$(3"\(B") (?i "$(3"](B") (?a "$(3"^(B") (?E "$(3"_(B") (?o "$(3"a(B") | |
| 254 (?W "$(3"b(B" (?a "$(3"b(B") | |
| 255 (?e "$(3"`%n(B") (?u "$(3"`%r(B") (?i "$(3"`%o(B") (?E "$(3"`%q(B"))) | |
| 256 ;;; O | |
| 257 ("$(3"i(B" (?2 "$(3#;(B")) | |
| 258 ;;; P | |
| 259 ("$(3$<(B" (?e "$(3$7(B") (?u "$(3$8(B") (?i "$(3$9(B") (?a "$(3$:(B") (?E "$(3$;(B") (?o "$(3$=(B") | |
| 260 (?W "$(3$>(B" (?a "$(3$>(B") | |
| 261 (?e "$(3$<%n(B") (?u "$(3$<%r(B") (?i "$(3$<%o(B") (?E "$(3$<%q(B"))) | |
| 262 ;;; Q | |
| 263 ("$(3!v(B" (?e "$(3!q(B") (?u "$(3!r(B") (?i "$(3!s(B") (?a "$(3!t(B") (?E "$(3!u(B") (?o "$(3!w(B") | |
| 264 (?W "$(3!~(B" (?e "$(3!y(B") (?u "$(3!~(B") (?i "$(3!{(B") (?a "$(3!|(B") (?E "$(3!}(B"))) | |
| 265 ;;; R | |
| 266 ("$(3!N(B" (?e "$(3!I(B") (?u "$(3!J(B") (?i "$(3!K(B") (?a "$(3!L(B") (?E "$(3!M(B") (?o "$(3!O(B") | |
| 267 (?W "$(3!P(B" (?a "$(3!P(B") | |
| 268 (?e "$(3!N%n(B") (?u "$(3!N%r(B") (?i "$(3!N%o(B") (?E "$(3!N%q(B")) | |
| 269 (?Y "$(3$`(B" (?a "$(3$`(B"))) | |
| 270 ;;; S | |
| 271 ("$(3$D(B" (?e "$(3$?(B") (?u "$(3$@(B") (?i "$(3$A(B") (?a "$(3$B(B") (?E "$(3$C(B") (?o "$(3$E(B") | |
| 272 (?W "$(3$F(B" (?a "$(3$F(B") | |
| 273 (?e "$(3$D%n(B") (?u "$(3$D%r(B") (?i "$(3$D%o(B") (?E "$(3$D%q(B")) | |
| 274 (?2 "$(3$L(B" | |
| 275 (?e "$(3$G(B") (?u "$(3$H(B") (?i "$(3$I(B") (?a "$(3$J(B") (?E "$(3$K(B") (?o "$(3$M(B") | |
| 276 (?W "$(3$F(B" (?a "$(3$F(B") | |
| 277 (?e "$(3$L%n(B") (?u "$(3$L%r(B") (?i "$(3$L%o(B") (?E "$(3$L%q(B")))) | |
| 278 ;;; T | |
| 279 ("$(3$,(B" (?e "$(3$'(B") (?u "$(3$((B") (?i "$(3$)(B") (?a "$(3$*(B") (?E "$(3$+(B") (?o "$(3$-(B") | |
| 280 (?W "$(3$.(B" (?a "$(3$.(B") | |
| 281 (?e "$(3$,%n(B") (?u "$(3$,%r(B") (?i "$(3$,%o(B") (?E "$(3$,%q(B"))) | |
| 282 ;;; U | |
| 283 ("$(3"d(B" (?2 "$(3#6(B")) | |
| 284 ;;; V | |
| 285 ("$(3"0(B" (?e "$(3"+(B") (?u "$(3",(B") (?i "$(3"-(B") (?a "$(3".(B") (?E "$(3"/(B") (?o "$(3"1(B") | |
| 286 (?W "$(3"2(B" (?a "$(3"2(B") | |
| 287 (?e "$(3"0%n(B") (?u "$(3"0%r(B") (?i "$(3"0%o(B") (?E "$(3"0%q(B"))) | |
| 288 ;;; W | |
| 289 ("$(3%r(B" (?e "$(3%n(B") (?u "$(3%r(B") (?i "$(3%o(B") (?a "$(3%p(B") (?E "$(3%q(B")) | |
| 290 ;;; X | |
| 291 ("$(3%N(B" (?e "$(3%I(B") (?u "$(3%J(B") (?i "$(3%K(B") (?a "$(3%L(B") (?E "$(3%M(B") (?o "$(3%O(B")) | |
| 292 ;;; Y | |
| 293 ("$(3#R(B" (?e "$(3#M(B") (?u "$(3#N(B") (?i "$(3#O(B") (?a "$(3#P(B") (?E "$(3#Q(B") (?o "$(3#S(B") | |
| 294 (?W "$(3#T(B" (?a "$(3#T(B") | |
| 295 (?e "$(3#R%n(B") (?u "$(3#R%r(B") (?i "$(3#R%o(B") (?E "$(3#R%q(B"))) | |
| 296 ;;; Z | |
| 297 ("$(3#J(B" (?e "$(3#E(B") (?u "$(3#F(B") (?i "$(3#G(B") (?a "$(3#H(B") (?E "$(3#I(B") (?o "$(3#K(B") | |
| 298 (?W "$(3#L(B" (?a "$(3#L(B") | |
| 299 (?e "$(3#J%n(B") (?u "$(3#J%r(B") (?i "$(3#J%o(B") (?E "$(3#J%q(B"))) | |
| 300 ;;; [ \ ] ^ _ | |
| 301 nil nil nil nil nil | |
| 302 ;;; ` | |
| 303 ("" | |
| 304 (?: "$(3$h(B") | |
| 305 (?? (if ethio-use-three-dot-question "$(3%x(B" "$(3$n(B")) | |
| 306 (?! "$(3%t(B") | |
| 307 (?e "$(3#5(B") (?u "$(3#6(B") (?U "$(3#6(B") (?i "$(3#7(B") (?a "$(3#8(B") (?A "$(3#8(B") | |
| 308 (?E "$(3#9(B") (?I "$(3#:(B") (?o "$(3#;(B") (?O "$(3#;(B") | |
| 309 (?g "$(3%^(B" | |
| 310 (?e "$(3%Y(B") (?u "$(3%Z(B") (?i "$(3%[(B") (?a "$(3%\(B") (?E "$(3%](B") (?o "$(3%_(B")) | |
| 311 (?h "$(3"H(B" | |
| 312 (?e "$(3"C(B") (?u "$(3"D(B") (?i "$(3"E(B") (?a "$(3"F(B") (?E "$(3"G(B") (?o "$(3"I(B") | |
| 313 (?W "$(3"P(B" (?e "$(3"K(B") (?u "$(3"P(B") (?i "$(3"M(B") (?a "$(3"N(B") (?E "$(3"O(B"))) | |
| 314 (?k "$(3%>(B" | |
| 315 (?e "$(3%9(B") (?u "$(3%:(B") (?i "$(3%;(B") (?a "$(3%<(B") (?E "$(3%=(B") (?o "$(3%?(B")) | |
| 316 (?s "$(3!F(B" | |
| 317 (?e "$(3!A(B") (?u "$(3!B(B") (?i "$(3!C(B") (?a "$(3!D(B") (?E "$(3!E(B") (?o "$(3!G(B") | |
| 318 (?W "$(3!H(B" (?a "$(3!H(B") | |
| 319 (?e "$(3!F%n(B") (?u "$(3!F%r(B") (?i "$(3!F%o(B") (?E "$(3!F%q(B"))) | |
| 320 (?S "$(3$L(B" | |
| 321 (?e "$(3$G(B") (?u "$(3$H(B") (?i "$(3$I(B") (?a "$(3$J(B") (?E "$(3$K(B") (?o "$(3$M(B") | |
| 322 (?W "$(3$F(B" (?a "$(3$F(B") | |
| 323 (?e "$(3$L%n(B") (?u "$(3$L%r(B") (?i "$(3$L%o(B") (?E "$(3$L%q(B"))) | |
| 324 (?q "$(3%.(B" (?e "$(3%)(B") (?u "$(3%*(B") (?i "$(3%+(B") (?a "$(3%,(B") (?E "$(3%-(B") (?o "$(3%/(B"))) | |
| 325 ;;; a | |
| 326 ("$(3"f(B" (?2 "$(3#8(B")) | |
| 327 ;;; b | |
| 328 ("$(3"((B" (?e "$(3"#(B") (?u "$(3"$(B") (?i "$(3"%(B") (?a "$(3"&(B") (?E "$(3"'(B") (?o "$(3")(B") | |
| 329 (?W "$(3%b(B" (?e "$(3%2(B") (?u "$(3%b(B") (?i "$(3%B(B") (?a "$(3"*(B") (?E "$(3%R(B"))) | |
| 330 ;;; c | |
| 331 ("$(3"@(B" (?e "$(3";(B") (?u "$(3"<(B") (?i "$(3"=(B") (?a "$(3">(B") (?E "$(3"?(B") (?o "$(3"A(B") | |
| 332 (?W "$(3"B(B" (?a "$(3"B(B") | |
| 333 (?e "$(3"@%n(B") (?u "$(3"@%r(B") (?i "$(3"@%o(B") (?E "$(3"@%q(B"))) | |
| 334 ;;; d | |
| 335 ("$(3#Z(B" (?e "$(3#U(B") (?u "$(3#V(B") (?i "$(3#W(B") (?a "$(3#X(B") (?E "$(3#Y(B") (?o "$(3#[(B") | |
| 336 (?W "$(3#\(B" (?a "$(3#\(B") | |
| 337 (?e "$(3#Z%o(B") (?u "$(3#Z%r(B") (?i "$(3#Z%p(B") (?E "$(3#Z%q(B"))) | |
| 338 ;;; e | |
| 339 ("$(3"c(B" (?2 "$(3#5(B") (?a "$(3"j(B")) | |
| 340 ;;; f | |
| 341 ("$(3$T(B" (?e "$(3$O(B") (?u "$(3$P(B") (?i "$(3$Q(B") (?a "$(3$R(B") (?E "$(3$S(B") (?o "$(3$U(B") | |
| 342 (?W "$(3%d(B" (?e "$(3%4(B") (?u "$(3%d(B") (?i "$(3%D(B") (?a "$(3$V(B") (?E "$(3%T(B")) | |
| 343 (?Y "$(3$a(B" (?a "$(3$a(B"))) | |
| 344 ;;; g | |
| 345 ("$(3#r(B" (?e "$(3#m(B") (?u "$(3#n(B") (?i "$(3#o(B") (?a "$(3#p(B") (?E "$(3#q(B") (?o "$(3#s(B") | |
| 346 (?W "$(3#z(B" (?e "$(3#u(B") (?u "$(3#z(B") (?i "$(3#w(B") (?a "$(3#x(B") (?E "$(3#y(B")) | |
| 347 (?2 "$(3%^(B" (?e "$(3%Y(B") (?u "$(3%Z(B") (?i "$(3%[(B") (?a "$(3%\(B") (?E "$(3%](B") (?o "$(3%_(B"))) | |
| 348 ;;; h | |
| 349 ("$(3!&(B" (?e "$(3!!(B") (?u "$(3!"(B") (?i "$(3!#(B") (?a "$(3!$(B") (?E "$(3!%(B") (?o "$(3!'(B") | |
| 350 (?W "$(3"P(B" (?e "$(3"K(B") (?u "$(3"P(B") (?i "$(3"M(B") (?a "$(3"N(B") (?E "$(3"O(B")) | |
| 351 (?2 "$(3"H(B" (?e "$(3"C(B") (?u "$(3"D(B") (?i "$(3"E(B") (?a "$(3"F(B") (?E "$(3"G(B") (?o "$(3"I(B") | |
| 352 (?W "$(3"P(B" (?e "$(3"K(B") (?u "$(3"P(B") (?i "$(3"M(B") (?a "$(3"N(B") (?E "$(3"O(B")))) | |
| 353 ;;; i | |
| 354 ("$(3"e(B" (?2 "$(3#7(B")) | |
| 355 ;;; j | |
| 356 ("$(3#j(B" (?e "$(3#e(B") (?u "$(3#f(B") (?i "$(3#g(B") (?a "$(3#h(B") (?E "$(3#i(B") (?o "$(3#k(B") | |
| 357 (?W "$(3#l(B" (?a "$(3#l(B") | |
| 358 (?e "$(3#j%n(B") (?u "$(3#j%r(B") (?i "$(3#j%o(B") (?E "$(3#j%q(B"))) | |
| 359 ;;; k | |
| 360 ("$(3"p(B" (?e "$(3"k(B") (?u "$(3"l(B") (?i "$(3"m(B") (?a "$(3"n(B") (?E "$(3"o(B") (?o "$(3"q(B") | |
| 361 (?W "$(3"x(B" (?e "$(3"s(B") (?u "$(3"x(B") (?i "$(3"u(B") (?a "$(3"v(B") (?E "$(3"w(B")) | |
| 362 (?2 "$(3%>(B" (?e "$(3%9(B") (?u "$(3%:(B") (?i "$(3%;(B") (?a "$(3%<(B") (?E "$(3%=(B") (?o "$(3%?(B"))) | |
| 363 ;;; l | |
| 364 ("$(3!.(B" (?e "$(3!)(B") (?u "$(3!*(B") (?i "$(3!+(B") (?a "$(3!,(B") (?E "$(3!-(B") (?o "$(3!/(B") | |
| 365 (?W "$(3!0(B" (?a "$(3!0(B") | |
| 366 (?e "$(3!.%n(B") (?u "$(3!.%r(B") (?i "$(3!.%o(B") (?E "$(3!.%q(B"))) | |
| 367 ;;; m | |
| 368 ("$(3!>(B" (?e "$(3!9(B") (?u "$(3!:(B") (?i "$(3!;(B") (?a "$(3!<(B") (?E "$(3!=(B") (?o "$(3!?(B") | |
| 369 (?W "$(3%a(B" (?e "$(3%1(B") (?u "$(3%a(B") (?i "$(3%A(B") (?a "$(3!@(B") (?E "$(3%Q(B")) | |
| 370 (?Y "$(3$_(B" (?a "$(3$_(B"))) | |
| 371 ;;; n | |
| 372 ("$(3"X(B" (?e "$(3"S(B") (?u "$(3"T(B") (?i "$(3"U(B") (?a "$(3"V(B") (?E "$(3"W(B") (?o "$(3"Y(B") | |
| 373 (?W "$(3"Z(B" (?a "$(3"Z(B") | |
| 374 (?e "$(3"X%n(B") (?u "$(3"X%r(B") (?i "$(3"X%o(B") (?E "$(3"X%q(B"))) | |
| 375 ;;; o | |
| 376 ("$(3"i(B" (?2 "$(3#;(B")) | |
| 377 ;;; p | |
| 378 ("$(3$\(B" (?e "$(3$W(B") (?u "$(3$X(B") (?i "$(3$Y(B") (?a "$(3$Z(B") (?E "$(3$[(B") (?o "$(3$](B") | |
| 379 (?W "$(3%e(B" (?e "$(3%5(B") (?u "$(3%e(B") (?i "$(3%E(B") (?a "$(3$^(B") (?E "$(3%U(B"))) | |
| 380 ;;; q | |
| 381 ("$(3!f(B" (?e "$(3!a(B") (?u "$(3!b(B") (?i "$(3!c(B") (?a "$(3!d(B") (?E "$(3!e(B") (?o "$(3!g(B") | |
| 382 (?W "$(3!n(B" (?e "$(3!i(B") (?u "$(3!n(B") (?i "$(3!k(B") (?a "$(3!l(B") (?E "$(3!m(B")) | |
| 383 (?2 "$(3%.(B" (?e "$(3%)(B") (?u "$(3%*(B") (?i "$(3%+(B") (?a "$(3%,(B") (?E "$(3%-(B") (?o "$(3%/(B"))) | |
| 384 ;;; r | |
| 385 ("$(3!N(B" (?e "$(3!I(B") (?u "$(3!J(B") (?i "$(3!K(B") (?a "$(3!L(B") (?E "$(3!M(B") (?o "$(3!O(B") | |
| 386 (?W "$(3!P(B" (?a "$(3!P(B") | |
| 387 (?e "$(3!N%n(B") (?u "$(3!N%r(B") (?i "$(3!N%o(B") (?E "$(3!N%q(B")) | |
| 388 (?Y "$(3$`(B" (?a "$(3$`(B"))) | |
| 389 ;;; s | |
| 390 ("$(3!V(B" (?e "$(3!Q(B") (?u "$(3!R(B") (?i "$(3!S(B") (?a "$(3!T(B") (?E "$(3!U(B") (?o "$(3!W(B") | |
| 391 (?W "$(3!X(B" (?a "$(3!X(B") | |
| 392 (?e "$(3!V%n(B") (?u "$(3!V%r(B") (?i "$(3!V%o(B") (?E "$(3!V%q(B")) | |
| 393 (?2 "$(3!F(B" (?e "$(3!A(B") (?u "$(3!B(B") (?i "$(3!C(B") (?a "$(3!D(B") (?E "$(3!E(B") (?o "$(3!G(B") | |
| 394 (?W "$(3!H(B" (?a "$(3!H(B") | |
| 395 (?e "$(3!F%n(B") (?u "$(3!F%r(B") (?i "$(3!F%o(B") (?E "$(3!F%q(B")))) | |
| 396 ;;; t | |
| 397 ("$(3"8(B" (?e "$(3"3(B") (?u "$(3"4(B") (?i "$(3"5(B") (?a "$(3"6(B") (?E "$(3"7(B") (?o "$(3"9(B") | |
| 398 (?W "$(3":(B" (?a "$(3":(B") | |
| 399 (?e "$(3"8%n(B") (?u "$(3"8%r(B") (?i "$(3"8%o(B") (?E "$(3"8%q(B"))) | |
| 400 ;;; u | |
| 401 ("$(3"d(B" (?2 "$(3#6(B")) | |
| 402 ;;; v | |
| 403 ("$(3"0(B" (?e "$(3"+(B") (?u "$(3",(B") (?i "$(3"-(B") (?a "$(3".(B") (?E "$(3"/(B") (?o "$(3"1(B") | |
| 404 (?W "$(3"2(B" (?a "$(3"2(B") | |
| 405 (?e "$(3"0%n(B") (?u "$(3"0%r(B") (?i "$(3"0%o(B") (?E "$(3"0%q(B"))) | |
| 406 ;;; w | |
| 407 ("$(3#2(B" (?e "$(3#-(B") (?u "$(3#.(B") (?i "$(3#/(B") (?a "$(3#0(B") (?E "$(3#1(B") (?o "$(3#3(B") | |
| 408 (?W "$(3%p(B" (?e "$(3%n(B") (?u "$(3%r(B") (?i "$(3%o(B") (?a "$(3%p(B") (?E "$(3%q(B"))) | |
| 409 ;;; x | |
| 410 ("$(3!^(B" (?e "$(3!Y(B") (?u "$(3!Z(B") (?i "$(3![(B") (?a "$(3!\(B") (?E "$(3!](B") (?o "$(3!_(B") | |
| 411 (?W "$(3!`(B" (?a "$(3!`(B") | |
| 412 (?e "$(3!^%n(B") (?u "$(3!^%r(B") (?i "$(3!^%o(B") (?E "$(3!^%q(B"))) | |
| 413 ;;; y | |
| 414 ("$(3#R(B" (?e "$(3#M(B") (?u "$(3#N(B") (?i "$(3#O(B") (?a "$(3#P(B") (?E "$(3#Q(B") (?o "$(3#S(B") | |
| 415 (?W "$(3#T(B" (?a "$(3#T(B") | |
| 416 (?e "$(3#R%n(B") (?u "$(3#R%r(B") (?i "$(3#R%o(B") (?E "$(3#R%q(B"))) | |
| 417 ;;; z | |
| 418 ("$(3#B(B" (?e "$(3#=(B") (?u "$(3#>(B") (?i "$(3#?(B") (?a "$(3#@(B") (?E "$(3#A(B") (?o "$(3#C(B") | |
| 419 (?W "$(3#D(B" (?a "$(3#D(B") | |
| 420 (?e "$(3#B%n(B") (?u "$(3#B%r(B") (?i "$(3#B%o(B") (?E "$(3#B%q(B"))) | |
| 421 ;;; { | } ~ DEL | |
| 422 nil nil nil nil nil | |
| 423 ]) | |
| 424 | |
| 425 ;;;###autoload | |
| 426 (defun ethio-sera-to-fidel-region (beg end &optional secondary force) | |
| 427 "Convert the characters in region from SERA to FIDEL. | |
| 428 The variable `ethio-primary-language' specifies the primary language | |
| 429 and `ethio-secondary-language' specifies the secondary. | |
| 430 | |
| 431 If the 3rd parameter SECONDARY is given and non-nil, assume the region | |
| 2116 | 432 begins with the secondary language; otherwise with the primary |
| 771 | 433 language. |
| 434 | |
| 435 If the 4th parameter FORCE is given and non-nil, perform conversion | |
| 436 even if the buffer is read-only. | |
| 437 | |
| 438 See also the descriptions of the variables | |
| 439 `ethio-use-colon-for-colon' and | |
| 440 `ethio-use-three-dot-question'." | |
| 441 | |
| 442 (interactive "r\nP") | |
| 443 (save-restriction | |
| 444 (narrow-to-region beg end) | |
| 445 (ethio-sera-to-fidel-buffer secondary force))) | |
| 446 | |
| 447 ;;;###autoload | |
| 448 (defun ethio-sera-to-fidel-buffer (&optional secondary force) | |
| 449 "Convert the current buffer from SERA to FIDEL. | |
| 450 | |
| 451 The variable `ethio-primary-language' specifies the primary | |
| 452 language and `ethio-secondary-language' specifies the secondary. | |
| 453 | |
| 454 If the 1st optional parameter SECONDARY is non-nil, assume the buffer | |
| 455 begins with the secondary language; otherwise with the primary | |
| 456 language. | |
| 457 | |
| 458 If the 2nd optional parametr FORCE is non-nil, perform conversion even if the | |
| 459 buffer is read-only. | |
| 460 | |
| 461 See also the descriptions of the variables | |
| 462 `ethio-use-colon-for-colon' and | |
| 463 `ethio-use-three-dot-question'." | |
| 464 | |
| 465 (interactive "P") | |
| 466 | |
| 467 (if (and buffer-read-only | |
| 468 (not force) | |
| 469 (not (y-or-n-p "Buffer is read-only. Force to convert? "))) | |
| 470 (error "")) | |
| 471 | |
| 472 (let ((ethio-primary-language ethio-primary-language) | |
| 473 (ethio-secondary-language ethio-secondary-language) | |
| 474 (ethio-use-colon-for-colon ethio-use-colon-for-colon) | |
| 475 (ethio-use-three-dot-question ethio-use-three-dot-question) | |
| 476 ;; The above four variables may be changed temporary | |
| 477 ;; by tilde escapes during conversion. So we bind them to other | |
| 478 ;; variables but of the same names. | |
| 479 (buffer-read-only nil) | |
| 480 (case-fold-search nil) | |
| 481 current-language | |
| 482 next-language) | |
| 483 | |
| 484 (setq current-language | |
| 485 (if secondary | |
| 486 ethio-secondary-language | |
| 487 ethio-primary-language)) | |
| 488 | |
| 489 (goto-char (point-min)) | |
| 490 | |
| 491 (while (not (eobp)) | |
| 492 (setq next-language | |
| 493 (cond | |
| 494 ((eq current-language 'english) | |
| 495 (ethio-sera-to-fidel-english)) | |
| 496 ((eq current-language 'amharic) | |
| 497 (ethio-sera-to-fidel-ethio 'amharic)) | |
| 498 ((eq current-language 'tigrigna) | |
| 499 (ethio-sera-to-fidel-ethio 'tigrigna)) | |
| 500 (t ; we don't know what to do | |
| 501 (ethio-sera-to-fidel-english)))) | |
| 502 | |
| 503 (setq current-language | |
| 504 (cond | |
| 505 | |
| 506 ;; when language tag is explicitly specified | |
| 507 ((not (eq next-language 'toggle)) | |
| 508 next-language) | |
| 509 | |
| 510 ;; found a toggle in a primary language section | |
| 511 ((eq current-language ethio-primary-language) | |
| 512 ethio-secondary-language) | |
| 513 | |
| 514 ;; found a toggle in a secondary, third, fourth, ... | |
| 515 ;; language section | |
| 516 (t | |
| 517 ethio-primary-language)))) | |
| 518 | |
| 519 ;; If ethio-implicit-period-conversion is non-nil, the | |
| 520 ;; Ethiopic dot "$(3%u(B" at the end of an Ethiopic sentence is | |
| 521 ;; replaced with the Ethiopic full stop "$(3$i(B". | |
| 522 (if ethio-implicit-period-conversion | |
| 523 (progn | |
| 524 (goto-char (point-min)) | |
| 525 (while (re-search-forward "\\([$(3!!(B-$(3$a%)(B-$(3%e%n(B-$(3%r%s(B]\\)$(3%u(B\\([ \t]\\)" | |
| 526 nil t) | |
| 527 (replace-match "\\1$(3$i(B\\2")) | |
| 528 (goto-char (point-min)) | |
| 529 (while (re-search-forward "\\([$(3!!(B-$(3$a%)(B-$(3%e%n(B-$(3%r%s(B]\\)$(3%u(B$" nil t) | |
| 530 (replace-match "\\1$(3$i(B")))) | |
| 531 | |
| 532 ;; gemination | |
| 533 (goto-char (point-min)) | |
| 534 (while (re-search-forward "\\ce$(3%s(B" nil 0) | |
| 535 (compose-region | |
| 536 (save-excursion (backward-char 2) (point)) | |
| 537 (point))) | |
| 538 )) | |
| 539 | |
| 540 (defun ethio-sera-to-fidel-english nil | |
| 541 "Handle English section in SERA to FIDEL conversion. | |
| 542 Conversion stops when a language switch is found. Then delete that | |
| 543 switch and return the name of the new language as a symbol." | |
| 544 (let ((new-language nil)) | |
| 545 | |
| 546 (while (and (not (eobp)) (null new-language)) | |
| 547 (cond | |
| 548 | |
| 549 ;; if no more "\", nothing to do. | |
| 550 ((not (search-forward "\\" nil 0))) | |
| 551 | |
| 552 ;; hereafter point is put after a "\". | |
| 553 ;; first delete that "\", then check the following chars | |
| 554 | |
| 555 ;; "\\" : leave the second "\" | |
| 556 ((progn | |
| 557 (delete-backward-char 1) | |
| 558 (= (following-char) ?\\ )) | |
| 559 (forward-char 1)) | |
| 560 | |
| 561 ;; "\ " : delete the following " " | |
| 562 ((= (following-char) 32) | |
| 563 (delete-char 1) | |
| 564 (setq new-language 'toggle)) | |
| 565 | |
| 566 ;; a language flag | |
| 567 ((setq new-language (ethio-process-language-flag))) | |
| 568 | |
| 569 ;; just a "\" : not special sequence. | |
| 570 (t | |
| 571 (setq new-language 'toggle)))) | |
| 572 | |
| 573 new-language)) | |
| 574 | |
| 575 (defun ethio-sera-to-fidel-ethio (lang) | |
| 576 "Handle Ethiopic section in SERA to FIDEL conversion. | |
| 577 Conversion stops when a language switch is found. Then delete that | |
| 578 switch and return the name of the new language as a symbol. | |
| 579 | |
| 580 The parameter LANG (symbol, either `amharic' or `tigrigna') affects | |
| 581 the conversion of \"a\"." | |
| 582 | |
| 583 (let ((new-language nil) | |
| 584 (verbatim nil) | |
| 585 start table table2 ch) | |
| 586 | |
| 587 (setcar (aref ethio-sera-to-fidel-table ?a) | |
| 588 (if (eq lang 'tigrigna) "$(3"f(B" "$(3"c(B")) | |
| 589 | |
| 590 (while (and (not (eobp)) (null new-language)) | |
| 591 (setq ch (following-char)) | |
| 592 (cond | |
| 593 | |
| 594 ;; skip from "<" to ">" (or from "&" to ";") if in w3-mode | |
| 595 ((and (boundp 'sera-being-called-by-w3) | |
| 596 sera-being-called-by-w3 | |
| 597 (or (= ch ?<) (= ch ?&))) | |
| 598 (search-forward (if (= ch ?<) ">" ";") | |
| 599 nil 0)) | |
| 600 | |
| 601 ;; leave non-ASCII characters as they are | |
| 602 ((>= ch 128) | |
| 603 (forward-char 1)) | |
| 604 | |
| 605 ;; ethiopic digits | |
| 606 ((looking-at "`[1-9][0-9]*") | |
| 607 (delete-char 1) | |
| 608 (ethio-convert-digit)) | |
| 609 | |
| 610 ;; if not seeing a "\", do sera to fidel conversion | |
| 611 ((/= ch ?\\ ) | |
| 612 (setq start (point)) | |
| 613 (forward-char 1) | |
| 614 (setq table (aref ethio-sera-to-fidel-table ch)) | |
| 615 (while (setq table2 (cdr (assoc (following-char) table))) | |
| 616 (setq table table2) | |
| 617 (forward-char 1)) | |
| 618 (if (setq ch (car table)) | |
| 619 (progn | |
| 620 (delete-region start (point)) | |
| 621 (if (stringp ch) | |
| 622 (insert ch) | |
| 623 (insert (eval ch)))))) | |
| 624 | |
| 625 ;; if control reaches here, we must be looking at a "\" | |
| 626 | |
| 627 ;; verbatim mode | |
| 628 (verbatim | |
| 629 (if (looking-at "\\\\~! ?") | |
| 630 | |
| 631 ;; "\~!" or "\~! ". switch to non-verbatim mode | |
| 632 (progn | |
| 633 (replace-match "") | |
| 634 (setq verbatim nil)) | |
| 635 | |
| 636 ;; "\" but not "\~!" nor "\~! ". skip the current "\". | |
| 637 (forward-char 1))) | |
| 638 | |
| 639 ;; hereafter, non-verbatim mode and looking at a "\" | |
| 640 ;; first delete that "\", then check the following chars. | |
| 641 | |
| 642 ;; "\ " : delete the following " " | |
| 643 ((progn | |
| 644 (delete-char 1) | |
| 645 (setq ch (following-char)) | |
| 646 (= ch 32)) | |
| 647 (delete-char 1) | |
| 648 (setq new-language 'toggle)) | |
| 649 | |
| 650 ;; "\~!" or "\~! " : switch to verbatim mode | |
| 651 ((looking-at "~! ?") | |
| 652 (replace-match "") | |
| 653 (setq verbatim t)) | |
| 654 | |
| 655 ;; a language flag | |
| 656 ((setq new-language (ethio-process-language-flag))) | |
| 657 | |
| 658 ;; "\~" but not "\~!" nor a language flag | |
| 659 ((= ch ?~) | |
| 660 (delete-char 1) | |
| 661 (ethio-tilde-escape)) | |
| 662 | |
| 663 ;; ASCII punctuation escape. skip | |
| 664 ((looking-at "\\(,\\|\\.\\|;\\|:\\|'\\|`\\|\?\\|\\\\\\)+") | |
| 665 (goto-char (match-end 0))) | |
| 666 | |
| 667 ;; "\", but not special sequence | |
| 668 (t | |
| 669 (setq new-language 'toggle)))) | |
| 670 | |
| 671 new-language)) | |
| 672 | |
| 673 (defun ethio-process-language-flag nil | |
| 674 "Process a language flag of the form \"~lang\" or \"~lang1~lang2\". | |
| 675 | |
| 676 If looking at \"~lang1~lang2\", set `ethio-primary-language' and | |
| 677 `ethio-une-secondary-language' based on \"lang1\" and \"lang2\". | |
| 678 Then delete the language flag \"~lang1~lang2\" from the buffer. | |
| 679 Return value is the new primary language. | |
| 680 | |
| 681 If looking at \"~lang\", delete that language flag \"~lang\" from the | |
| 682 buffer and return that language. In this case | |
| 683 `ethio-primary-language' and `ethio-uni-secondary-language' | |
| 684 are left unchanged. | |
| 685 | |
| 686 If an unsupported language flag is found, just return nil without | |
| 687 changing anything." | |
| 688 | |
| 689 (let (lang1 lang2) | |
| 690 (cond | |
| 691 | |
| 692 ;; ~lang1~lang2 | |
| 693 ((and (looking-at | |
| 694 "~\\([a-z][a-z][a-z]?\\)~\\([a-z][a-z][a-z]?\\)[ \t\n\\]") | |
| 695 (setq lang1 | |
| 696 (ethio-flag-to-language | |
| 697 (buffer-substring (match-beginning 1) (match-end 1)))) | |
| 698 (setq lang2 | |
| 699 (ethio-flag-to-language | |
| 700 (buffer-substring (match-beginning 2) (match-end 2))))) | |
| 701 (setq ethio-primary-language lang1 | |
| 702 ethio-secondary-language lang2) | |
| 703 (delete-region (point) (match-end 2)) | |
| 704 (if (= (following-char) 32) | |
| 705 (delete-char 1)) | |
| 706 ethio-primary-language) | |
| 707 | |
| 708 ;; ~lang | |
| 709 ((and (looking-at "~\\([a-z][a-z][a-z]?\\)[ \t\n\\]") | |
| 710 (setq lang1 | |
| 711 (ethio-flag-to-language | |
| 712 (buffer-substring (match-beginning 1) (match-end 1))))) | |
| 713 (delete-region (point) (match-end 1)) | |
| 714 (if (= (following-char) 32) | |
| 715 (delete-char 1)) | |
| 716 lang1) | |
| 717 | |
| 718 ;; otherwise | |
| 719 (t | |
| 720 nil)))) | |
| 721 | |
| 722 (defun ethio-tilde-escape nil | |
| 723 "Handle a SERA tilde escape in Ethiopic section and delete it. | |
| 724 Delete the escape even it is not recognised." | |
| 725 | |
| 726 (let ((p (point)) command) | |
| 727 (skip-chars-forward "^ \t\n\\\\") | |
| 728 (setq command (buffer-substring p (point))) | |
| 729 (delete-region p (point)) | |
| 730 (if (= (following-char) 32) | |
| 731 (delete-char 1)) | |
| 732 | |
| 733 (cond | |
| 734 | |
| 735 ;; \~-: | |
| 736 ((string= command "-:") | |
| 737 (setq ethio-use-colon-for-colon t)) | |
| 738 | |
| 739 ;; \~`: | |
| 740 ((string= command "`:") | |
| 741 (setq ethio-use-colon-for-colon nil)) | |
| 742 | |
| 743 ;; \~? | |
| 744 ((string= command "?") | |
| 745 (setq ethio-use-three-dot-question nil)) | |
| 746 | |
| 747 ;; \~`| | |
| 748 ((string= command "`|") | |
| 749 (setq ethio-use-three-dot-question t)) | |
| 750 | |
| 751 ;; \~e | |
| 752 ((string= command "e") | |
| 753 (insert "$(3%j(B")) | |
| 754 | |
| 755 ;; \~E | |
| 756 ((string= command "E") | |
| 757 (insert "$(3%k(B")) | |
| 758 | |
| 759 ;; \~a | |
| 760 ((string= command "a") | |
| 761 (insert "$(3%l(B")) | |
| 762 | |
| 763 ;; \~A | |
| 764 ((string= command "A") | |
| 765 (insert "$(3%m(B")) | |
| 766 | |
| 767 ;; \~X | |
| 768 ((string= command "X") | |
| 769 (insert "$(3%i(B")) | |
| 770 | |
| 771 ;; unsupported tilde escape | |
| 772 (t | |
| 773 nil)))) | |
| 774 | |
| 775 (defun ethio-flag-to-language (flag) | |
| 776 (cond | |
| 777 ((or (string= flag "en") (string= flag "eng")) 'english) | |
| 778 ((or (string= flag "ti") (string= flag "tir")) 'tigrigna) | |
| 779 ((or (string= flag "am") (string= flag "amh")) 'amharic) | |
| 780 (t nil))) | |
| 781 | |
| 782 (defun ethio-convert-digit nil | |
| 783 "Convert Arabic digits to Ethiopic digits." | |
| 784 (let (ch z) | |
| 785 (while (and (>= (setq ch (following-char)) ?1) | |
| 786 (<= ch ?9)) | |
| 787 (delete-char 1) | |
| 788 | |
| 789 ;; count up following zeros | |
| 790 (setq z 0) | |
| 791 (while (= (following-char) ?0) | |
| 792 (delete-char 1) | |
| 793 (setq z (1+ z))) | |
| 794 | |
| 795 (cond | |
| 796 | |
| 797 ;; first digit is 10, 20, ..., or 90 | |
| 798 ((= (mod z 2) 1) | |
| 799 (insert (aref [?$(3$y(B ?$(3$z(B ?$(3${(B ?$(3$|(B ?$(3$}(B ?$(3$~(B ?$(3%!(B ?$(3%"(B ?$(3%#(B] (- ch ?1))) | |
| 800 (setq z (1- z))) | |
| 801 | |
| 802 ;; first digit is 2, 3, ..., or 9 | |
| 803 ((/= ch ?1) | |
| 804 (insert (aref [?$(3$q(B ?$(3$r(B ?$(3$s(B ?$(3$t(B ?$(3$u(B ?$(3$v(B ?$(3$w(B ?$(3$x(B] (- ch ?2)))) | |
| 805 | |
| 806 ;; single 1 | |
| 807 ((= z 0) | |
| 808 (insert "$(3$p(B"))) | |
| 809 | |
| 810 ;; 100 | |
| 811 (if (= (mod z 4) 2) | |
| 812 (insert "$(3%$(B")) | |
| 813 | |
| 814 ;; 10000 | |
| 815 (insert-char ?$(3%%(B (/ z 4))))) | |
| 816 | |
| 817 ;;;###autoload | |
| 818 (defun ethio-sera-to-fidel-mail-or-marker (&optional arg) | |
| 819 "Execute ethio-sera-to-fidel-mail or ethio-sera-to-fidel-marker depending on the current major mode. | |
| 820 If in rmail-mode or in mail-mode, execute the former; otherwise latter." | |
| 821 | |
| 822 (interactive "P") | |
| 823 (if (or (eq major-mode 'rmail-mode) | |
| 824 (eq major-mode 'mail-mode)) | |
| 825 (ethio-sera-to-fidel-mail (prefix-numeric-value arg)) | |
| 826 (ethio-sera-to-fidel-marker arg))) | |
| 827 | |
| 828 ;;;###autoload | |
| 829 (defun ethio-sera-to-fidel-mail (&optional arg) | |
| 830 "Convert SERA to FIDEL to read/write mail and news. | |
| 831 | |
| 832 If the buffer contains the markers \"<sera>\" and \"</sera>\", | |
| 833 convert the segments between them into FIDEL. | |
| 834 | |
| 835 If invoked interactively and there is no marker, convert the subject field | |
| 836 and the body into FIDEL using `ethio-sera-to-fidel-region'." | |
| 837 | |
| 838 (interactive "p") | |
| 839 (let ((buffer-read-only nil) | |
| 840 border) | |
| 841 (save-excursion | |
| 842 | |
| 843 ;; follow RFC822 rules instead of looking for a fixed separator | |
| 844 (rfc822-goto-eoh) | |
| 845 (forward-line 1) | |
| 846 (setq border (point)) | |
| 847 | |
| 848 ;; note that the point is placed at the border | |
| 849 (if (or (re-search-forward "^<sera>$" nil t) | |
| 850 (progn | |
| 851 (goto-char (point-min)) | |
| 852 (re-search-forward "^Subject: <sera>" border t))) | |
| 853 | |
| 854 ;; there are markers | |
| 855 (progn | |
| 856 ;; we start with the body so that the border will not change | |
| 857 ;; use "^<sera>\n" instead of "^<sera>$" not to leave a blank line | |
| 858 (goto-char border) | |
| 859 (while (re-search-forward "^<sera>\n" nil t) | |
| 860 (replace-match "") | |
| 861 (ethio-sera-to-fidel-region | |
| 862 (point) | |
| 863 (progn | |
| 864 (if (re-search-forward "^</sera>\n" nil 0) | |
| 865 (replace-match "")) | |
| 866 (point)))) | |
| 867 ;; now process the subject | |
| 868 (goto-char (point-min)) | |
| 869 (if (re-search-forward "^Subject: <sera>" border t) | |
| 870 (ethio-sera-to-fidel-region | |
| 871 (progn (delete-backward-char 6) (point)) | |
| 872 (progn | |
| 873 (if (re-search-forward "</sera>$" (line-end-position) 0) | |
| 874 (replace-match "")) | |
| 875 (point))))) | |
| 876 | |
| 877 ;; in case there are no marks but invoked interactively | |
| 878 (if arg | |
| 879 (progn | |
| 880 (ethio-sera-to-fidel-region border (point-max)) | |
| 881 (goto-char (point-min)) | |
| 882 (if (re-search-forward "^Subject: " border t) | |
| 883 (ethio-sera-to-fidel-region (point) (line-end-position)))))) | |
| 884 | |
| 885 ;; adjust the rmail marker | |
| 886 (if (eq major-mode 'rmail-mode) | |
| 887 (set-marker | |
| 888 (aref rmail-message-vector (1+ rmail-current-message)) | |
| 889 (point-max)))))) | |
| 890 | |
| 891 ;;;###autoload | |
| 892 (defun ethio-sera-to-fidel-marker (&optional force) | |
| 893 "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL. | |
| 894 Assume that each region begins with `ethio-primary-language'. | |
| 895 The markers \"<sera>\" and \"</sera>\" themselves are not deleted." | |
| 896 (interactive "P") | |
| 897 (if (and buffer-read-only | |
| 898 (not force) | |
| 899 (not (y-or-n-p "Buffer is read-only. Force to convert? "))) | |
| 900 (error "")) | |
| 901 (save-excursion | |
| 902 (goto-char (point-min)) | |
| 903 (while (re-search-forward "<sera>" nil t) | |
| 904 (ethio-sera-to-fidel-region | |
| 905 (point) | |
| 906 (if (re-search-forward "</sera>" nil t) | |
| 907 (match-beginning 0) | |
| 908 (point-max)) | |
| 909 nil | |
| 910 'force)))) | |
| 911 | |
| 912 ;; | |
| 913 ;; FIDEL to SERA | |
| 914 ;; | |
| 915 | |
| 916 (defconst ethio-fidel-to-sera-map | |
| 917 [ "he" "hu" "hi" "ha" "hE" "h" "ho" "" ;; 0 - 7 | |
| 918 "le" "lu" "li" "la" "lE" "l" "lo" "lWa" ;; 8 | |
| 919 "He" "Hu" "Hi" "Ha" "HE" "H" "Ho" "HWa" ;; 16 | |
| 920 "me" "mu" "mi" "ma" "mE" "m" "mo" "mWa" ;; 24 | |
| 921 "`se" "`su" "`si" "`sa" "`sE" "`s" "`so" "`sWa" ;; 32 | |
| 922 "re" "ru" "ri" "ra" "rE" "r" "ro" "rWa" ;; 40 | |
| 923 "se" "su" "si" "sa" "sE" "s" "so" "sWa" ;; 48 | |
| 924 "xe" "xu" "xi" "xa" "xE" "x" "xo" "xWa" ;; 56 | |
| 925 "qe" "qu" "qi" "qa" "qE" "q" "qo" "" ;; 64 | |
| 926 "qWe" "" "qWi" "qWa" "qWE" "qW'" "" "" ;; 72 | |
| 927 "Qe" "Qu" "Qi" "Qa" "QE" "Q" "Qo" "" ;; 80 | |
| 928 "QWe" "" "QWi" "QWa" "QWE" "QW'" "" "" ;; 88 | |
| 929 "be" "bu" "bi" "ba" "bE" "b" "bo" "bWa" ;; 96 | |
| 930 "ve" "vu" "vi" "va" "vE" "v" "vo" "vWa" ;; 104 | |
| 931 "te" "tu" "ti" "ta" "tE" "t" "to" "tWa" ;; 112 | |
| 932 "ce" "cu" "ci" "ca" "cE" "c" "co" "cWa" ;; 120 | |
| 933 "`he" "`hu" "`hi" "`ha" "`hE" "`h" "`ho" "" ;; 128 | |
| 934 "hWe" "" "hWi" "hWa" "hWE" "hW'" "" "" ;; 136 | |
| 935 "ne" "nu" "ni" "na" "nE" "n" "no" "nWa" ;; 144 | |
| 936 "Ne" "Nu" "Ni" "Na" "NE" "N" "No" "NWa" ;; 152 | |
| 937 "e" "u" "i" "A" "E" "I" "o" "ea" ;; 160 | |
| 938 "ke" "ku" "ki" "ka" "kE" "k" "ko" "" ;; 168 | |
| 939 "kWe" "" "kWi" "kWa" "kWE" "kW'" "" "" ;; 176 | |
| 940 "Ke" "Ku" "Ki" "Ka" "KE" "K" "Ko" "" ;; 184 | |
| 941 "KWe" "" "KWi" "KWa" "KWE" "KW'" "" "" ;; 192 | |
| 942 "we" "wu" "wi" "wa" "wE" "w" "wo" "" ;; 200 | |
| 943 "`e" "`u" "`i" "`a" "`E" "`I" "`o" "" ;; 208 | |
| 944 "ze" "zu" "zi" "za" "zE" "z" "zo" "zWa" ;; 216 | |
| 945 "Ze" "Zu" "Zi" "Za" "ZE" "Z" "Zo" "ZWa" ;; 224 | |
| 946 "ye" "yu" "yi" "ya" "yE" "y" "yo" "yWa" ;; 232 | |
| 947 "de" "du" "di" "da" "dE" "d" "do" "dWa" ;; 240 | |
| 948 "De" "Du" "Di" "Da" "DE" "D" "Do" "DWa" ;; 248 | |
| 949 "je" "ju" "ji" "ja" "jE" "j" "jo" "jWa" ;; 256 | |
| 950 "ge" "gu" "gi" "ga" "gE" "g" "go" "" ;; 264 | |
| 951 "gWe" "" "gWi" "gWa" "gWE" "gW'" "" "" ;; 272 | |
| 952 "Ge" "Gu" "Gi" "Ga" "GE" "G" "Go" "GWa" ;; 280 | |
| 953 "Te" "Tu" "Ti" "Ta" "TE" "T" "To" "TWa" ;; 288 | |
| 954 "Ce" "Cu" "Ci" "Ca" "CE" "C" "Co" "CWa" ;; 296 | |
| 955 "Pe" "Pu" "Pi" "Pa" "PE" "P" "Po" "PWa" ;; 304 | |
| 956 "Se" "Su" "Si" "Sa" "SE" "S" "So" "SWa" ;; 312 | |
| 957 "`Se" "`Su" "`Si" "`Sa" "`SE" "`S" "`So" "" ;; 320 | |
| 958 "fe" "fu" "fi" "fa" "fE" "f" "fo" "fWa" ;; 328 | |
| 959 "pe" "pu" "pi" "pa" "pE" "p" "po" "pWa" ;; 336 | |
| 960 "mYa" "rYa" "fYa" "" "" "" "" "" ;; 344 | |
| 961 " " " : " "::" "," ";" "-:" ":-" "`?" ;; 352 | |
| 962 ":|:" "1" "2" "3" "4" "5" "6" "7" ;; 360 | |
| 963 "8" "9" "10" "20" "30" "40" "50" "60" ;; 368 | |
| 964 "70" "80" "90" "100" "10000" "" "" "" ;; 376 | |
| 965 "`qe" "`qu" "`qi" "`qa" "`qE" "`q" "`qo" "" ;; 384 | |
| 966 "mWe" "bWe" "GWe" "fWe" "pWe" "" "" "" ;; 392 | |
| 967 "`ke" "`ku" "`ki" "`ka" "`kE" "`k" "`ko" "" ;; 400 | |
| 968 "mWi" "bWi" "GWi" "fWi" "pWi" "" "" "" ;; 408 | |
| 969 "Xe" "Xu" "Xi" "Xa" "XE" "X" "Xo" "" ;; 416 | |
| 970 "mWE" "bWE" "GWE" "fWE" "pWE" "" "" "" ;; 424 | |
| 971 "`ge" "`gu" "`gi" "`ga" "`gE" "`g" "`go" "" ;; 432 | |
| 972 "mW'" "bW'" "GW'" "fW'" "pW'" "" "" "" ;; 440 | |
| 973 "\\~X " "\\~e " "\\~E " "\\~a " "\\~A " "wWe" "wWi" "wWa" ;; 448 | |
| 974 "wWE" "wW'" "''" "`!" "." "<<" ">>" "?" ]) ;; 456 | |
| 975 | |
| 976 (defun ethio-prefer-amharic-p nil | |
| 977 (or (eq ethio-primary-language 'amharic) | |
| 978 (and (not (eq ethio-primary-language 'tigrigna)) | |
| 979 (eq ethio-secondary-language 'amharic)))) | |
| 980 | |
| 981 (defun ethio-language-to-flag (lang) | |
| 982 (cond | |
| 983 ((eq lang 'english) "eng") | |
| 984 ((eq lang 'tigrigna) "tir") | |
| 985 ((eq lang 'amharic) "amh") | |
| 986 (t ""))) | |
| 987 | |
| 988 ;;;###autoload | |
| 989 (defun ethio-fidel-to-sera-region (begin end &optional secondary force) | |
| 990 "Replace all the FIDEL characters in the region to the SERA format. | |
| 991 The variable `ethio-primary-language' specifies the primary | |
| 992 language and `ethio-secondary-language' specifies the secondary. | |
| 993 | |
| 994 If the 3dr parameter SECONDARY is given and non-nil, try to convert | |
| 995 the region so that it begins in the secondary language; otherwise with | |
| 996 the primary language. | |
| 997 | |
| 998 If the 4th parameter FORCE is given and non-nil, convert even if the | |
| 999 buffer is read-only. | |
| 1000 | |
| 1001 See also the descriptions of the variables | |
| 1002 `ethio-use-colon-for-colon', `ethio-use-three-dot-question', | |
| 1003 `ethio-quote-vowel-always' and `ethio-numeric-reduction'." | |
| 1004 | |
| 1005 (interactive "r\nP") | |
| 1006 (save-restriction | |
| 1007 (narrow-to-region begin end) | |
| 1008 (ethio-fidel-to-sera-buffer secondary force))) | |
| 1009 | |
| 1010 ;;;###autoload | |
| 1011 (defun ethio-fidel-to-sera-buffer (&optional secondary force) | |
| 1012 "Replace all the FIDEL characters in the current buffer to the SERA format. | |
| 1013 The variable `ethio-primary-language' specifies the primary | |
| 1014 language and `ethio-secondary-language' specifies the secondary. | |
| 1015 | |
| 1016 If the 1st optional parameter SECONDARY is non-nil, try to convert the | |
| 1017 region so that it begins in the secondary language; otherwise with the | |
| 1018 primary language. | |
| 1019 | |
| 1020 If the 2nd optional parameter FORCE is non-nil, convert even if the | |
| 1021 buffer is read-only. | |
| 1022 | |
| 1023 See also the descriptions of the variables | |
| 1024 `ethio-use-colon-for-colon', `ethio-use-three-dot-question', | |
| 1025 `ethio-quote-vowel-always' and `ethio-numeric-reduction'." | |
| 1026 | |
| 1027 (interactive "P") | |
| 1028 (if (and buffer-read-only | |
| 1029 (not force) | |
| 1030 (not (y-or-n-p "Buffer is read-only. Force to convert? "))) | |
| 1031 (error "")) | |
| 1032 | |
| 1033 (let ((buffer-read-only nil) | |
| 1034 (case-fold-search nil) | |
| 1035 (lonec nil) ;; t means previous char was a lone consonant | |
| 1036 (fidel nil) ;; t means previous char was a FIDEL | |
| 1037 (digit nil) ;; t means previous char was an Ethiopic digit | |
| 1038 (flag (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir ")) | |
| 1039 mode ch) | |
| 1040 | |
| 1041 ;; user's preference in transcription | |
| 1042 (if ethio-use-colon-for-colon | |
| 1043 (progn | |
| 1044 (aset ethio-fidel-to-sera-map 353 "`:") | |
| 1045 (aset ethio-fidel-to-sera-map 357 ":")) | |
| 1046 (aset ethio-fidel-to-sera-map 353 " : ") | |
| 1047 (aset ethio-fidel-to-sera-map 357 "-:")) | |
| 1048 | |
| 1049 (if ethio-use-three-dot-question | |
| 1050 (progn | |
| 1051 (aset ethio-fidel-to-sera-map 359 "?") | |
| 1052 (aset ethio-fidel-to-sera-map 463 "`?")) | |
| 1053 (aset ethio-fidel-to-sera-map 359 "`?") | |
| 1054 (aset ethio-fidel-to-sera-map 463 "?")) | |
| 1055 | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4021
diff
changeset
|
1056 (mapc |
| 4021 | 1057 #'(lambda (x) |
| 1058 (aset (aref ethio-fidel-to-sera-map x) | |
| 1059 2 | |
| 1060 (if ethio-W-sixth-always ?' ?u))) | |
| 771 | 1061 '(77 93 141 181 197 277 440 441 442 443 444 457)) |
| 1062 | |
| 1063 (if (ethio-prefer-amharic-p) | |
| 1064 (aset ethio-fidel-to-sera-map 160 "a") | |
| 1065 (aset ethio-fidel-to-sera-map 160 "e")) | |
| 1066 ;; end of user's preference | |
| 1067 | |
| 1068 ;; first, decompose geminated characters | |
| 1069 (decompose-region (point-min) (point-max)) | |
| 1070 | |
| 1071 ;; main conversion routine | |
| 1072 (goto-char (point-min)) | |
| 1073 (while (not (eobp)) | |
| 1074 (setq ch (following-char)) | |
| 1075 | |
| 1076 (cond ; ethiopic, english, neutral | |
| 1077 | |
| 1078 ;; ethiopic character. must go to ethiopic mode, if not in it. | |
| 1079 ((eq (char-charset ch) 'ethiopic) | |
| 1080 (setq ch (ethio-char-to-ethiocode ch)) | |
| 1081 (delete-char 1) | |
| 1082 (if (not (eq mode 'ethiopic)) | |
| 1083 (progn | |
| 1084 (insert flag) | |
| 1085 (setq mode 'ethiopic))) | |
| 1086 | |
| 1087 (cond ; fidel, punc, digit | |
| 1088 | |
| 1089 ;; fidels | |
| 1090 ((or (<= ch 346) ; he - fYa | |
| 1091 (and (>= ch 384) (<= ch 444)) ; `qe - pw | |
| 1092 (and (>= ch 453) (<= ch 457))) ; wWe - wW | |
| 1093 (if (and (memq ch '(160 161 162 163 164 166 167)) ; (e - ea) | |
| 1094 (or lonec | |
| 1095 (and ethio-quote-vowel-always | |
| 1096 fidel))) | |
| 1097 (insert "'")) | |
| 1098 (insert (aref ethio-fidel-to-sera-map ch)) | |
| 1099 (setq lonec (ethio-lone-consonant-p ch) | |
| 1100 fidel t | |
| 1101 digit nil)) | |
| 1102 | |
| 1103 ;; punctuations or icons | |
| 1104 ((or (and (>= ch 353) (<= ch 360)) ; : - :|: | |
| 1105 (>= ch 458) ; '' - ? | |
| 1106 (and (>= ch 448) (<= ch 452))) ; \~X \~e \~E \~a \~A | |
| 1107 (insert (aref ethio-fidel-to-sera-map ch)) | |
| 1108 (setq lonec nil | |
| 1109 fidel nil | |
| 1110 digit nil)) | |
| 1111 | |
| 1112 ;; now CH must be an ethiopic digit | |
| 1113 | |
| 1114 ;; reduction = 0 or not preceded by Ethiopic number(s) | |
| 1115 ((or (= ethio-numeric-reduction 0) | |
| 1116 (not digit)) | |
| 1117 (insert "`" (aref ethio-fidel-to-sera-map ch)) | |
| 1118 (setq lonec nil | |
| 1119 fidel nil | |
| 1120 digit t)) | |
| 1121 | |
| 1122 ;; reduction = 2 and following 10s, 100s, 10000s | |
| 1123 ((and (= ethio-numeric-reduction 2) | |
| 1124 (memq ch '(370 379 380))) | |
| 1125 (insert (substring (aref ethio-fidel-to-sera-map ch) 1)) | |
| 1126 (setq lonec nil | |
| 1127 fidel nil | |
| 1128 digit t)) | |
| 1129 | |
| 1130 ;; ordinary following digits | |
| 1131 (t | |
| 1132 (insert (aref ethio-fidel-to-sera-map ch)) | |
| 1133 (setq lonec nil | |
| 1134 fidel nil | |
| 1135 digit t)))) | |
| 1136 | |
| 1137 ;; english character. must go to english mode, if not in it. | |
| 1138 ((or (and (>= ch ?a) (<= ch ?z)) | |
| 1139 (and (>= ch ?A) (<= ch ?Z))) | |
| 1140 (if (not (eq mode 'english)) | |
| 1141 (insert "\\~eng ")) | |
| 1142 (forward-char 1) | |
| 1143 (setq mode 'english | |
| 1144 lonec nil | |
| 1145 fidel nil | |
| 1146 digit nil)) | |
| 1147 | |
| 1148 ;; ch can appear both in ethiopic section and in english section. | |
| 1149 (t | |
| 1150 | |
| 1151 ;; we must decide the mode, if not decided yet | |
| 1152 (if (null mode) | |
| 1153 (progn | |
| 1154 (setq mode | |
| 1155 (if secondary | |
| 1156 ethio-secondary-language | |
| 1157 ethio-primary-language)) | |
| 1158 (if (eq mode 'english) | |
| 1159 (insert "\\~eng ") | |
| 1160 (insert flag) | |
| 1161 (setq mode 'ethiopic)))) ; tigrigna & amharic --> ethiopic | |
| 1162 | |
| 1163 (cond ; \ , eng-mode , punc , w3 , other | |
| 1164 | |
| 1165 ;; backslash is always quoted | |
| 1166 ((= ch ?\\ ) | |
| 1167 (insert "\\") | |
| 1168 (forward-char 1)) | |
| 1169 | |
| 1170 ;; nothing to do if in english mode | |
| 1171 ((eq mode 'english) | |
| 1172 (forward-char 1)) | |
| 1173 | |
| 1174 ;; now we must be in ethiopic mode and seeing a non-"\" | |
| 1175 | |
| 1176 ;; ascii punctuations in ethiopic mode | |
| 1177 ((looking-at "[,.;:'`?]+") | |
| 1178 (insert "\\") | |
| 1179 (goto-char (1+ (match-end 0)))) ; because we inserted one byte (\) | |
| 1180 | |
| 1181 ;; skip from "<" to ">" (or from "&" to ";") if called from w3 | |
| 1182 ((and (boundp 'sera-being-called-by-w3) | |
| 1183 sera-being-called-by-w3 | |
| 1184 (or (= ch ?<) (= ch ?&))) | |
| 1185 (search-forward (if (= ch ?<) ">" ";") | |
| 1186 nil 0)) | |
| 1187 | |
| 1188 ;; neutral character. no need to quote. just skip it. | |
| 1189 (t | |
| 1190 (forward-char 1))) | |
| 1191 | |
| 1192 (setq lonec nil | |
| 1193 fidel nil | |
| 1194 digit nil))) | |
| 1195 ;; end of main conversion routine | |
| 1196 ))) | |
| 1197 | |
| 1198 (defun ethio-lone-consonant-p (ethiocode) | |
| 1199 "If ETHIOCODE is an Ethiopic lone consonant, return t." | |
| 1200 (or (and (< ethiocode 344) (= (% ethiocode 8) 5)) | |
| 1201 | |
| 1202 ;; `q `k X `g mW bW GW fW pW wW | |
| 1203 (memq ethiocode '(389 405 421 437 440 441 442 443 444 457)))) | |
| 1204 | |
| 1205 ;;;###autoload | |
| 1206 (defun ethio-fidel-to-sera-mail-or-marker (&optional arg) | |
| 1207 "Execute ethio-fidel-to-sera-mail or ethio-fidel-to-sera-marker depending on the current major mode. | |
| 1208 If in rmail-mode or in mail-mode, execute the former; otherwise latter." | |
| 1209 | |
| 1210 (interactive "P") | |
| 1211 (if (or (eq major-mode 'rmail-mode) | |
| 1212 (eq major-mode 'mail-mode)) | |
| 1213 (ethio-fidel-to-sera-mail) | |
| 1214 (ethio-fidel-to-sera-marker arg))) | |
| 1215 | |
| 1216 ;;;###autoload | |
| 1217 (defun ethio-fidel-to-sera-mail nil | |
| 1218 "Convert FIDEL to SERA to read/write mail and news. | |
| 1219 | |
| 1220 If the body contains at least one Ethiopic character, | |
| 1221 1) insert the string \"<sera>\" at the beginning of the body, | |
| 1222 2) insert \"</sera>\" at the end of the body, and | |
| 1223 3) convert the body into SERA. | |
| 1224 | |
| 1225 The very same procedure applies to the subject field, too." | |
| 1226 | |
| 1227 (interactive) | |
| 1228 (let ((buffer-read-only nil) | |
| 1229 border) | |
| 1230 (save-excursion | |
| 1231 | |
| 1232 ;; follow RFC822 rules instead of looking for a fixed separator | |
| 1233 (rfc822-goto-eoh) | |
| 1234 (forward-line 1) | |
| 1235 (setq border (point)) | |
| 1236 | |
| 1237 ;; process body first not to change the border | |
| 1238 ;; note that the point is already at the border | |
| 1239 (if (re-search-forward "\\ce" nil t) | |
| 1240 (progn | |
| 1241 (ethio-fidel-to-sera-region border (point-max)) | |
| 1242 (goto-char border) | |
| 1243 (insert "<sera>") | |
| 1244 (goto-char (point-max)) | |
| 1245 (insert "</sera>"))) | |
| 1246 | |
| 1247 ;; process subject | |
| 1248 (goto-char (point-min)) | |
| 1249 (if (re-search-forward "^Subject: " border t) | |
| 1250 (let ((beg (point)) | |
| 1251 (end (line-end-position))) | |
| 1252 (if (re-search-forward "\\ce" end t) | |
| 1253 (progn | |
| 1254 (ethio-fidel-to-sera-region beg end) | |
| 1255 (goto-char beg) | |
| 1256 (insert "<sera>") | |
| 1257 (end-of-line) | |
| 1258 (insert "</sera>"))))) | |
| 1259 | |
| 1260 ;; adjust the rmail marker | |
| 1261 (if (eq major-mode 'rmail-mode) | |
| 1262 (set-marker | |
| 1263 (aref rmail-message-vector (1+ rmail-current-message)) | |
| 1264 (point-max)))))) | |
| 1265 | |
| 1266 ;;;###autoload | |
| 1267 (defun ethio-fidel-to-sera-marker (&optional force) | |
| 1268 "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to SERA. | |
| 1269 The markers \"<sera>\" and \"</sera>\" themselves are not deleted." | |
| 1270 | |
| 1271 (interactive "P") | |
| 1272 (if (and buffer-read-only | |
| 1273 (not force) | |
| 1274 (not (y-or-n-p "Buffer is read-only. Force to convert? "))) | |
| 1275 (error "")) | |
| 1276 (save-excursion | |
| 1277 (goto-char (point-min)) | |
| 1278 (while (re-search-forward "<sera>" nil t) | |
| 1279 (ethio-fidel-to-sera-region | |
| 1280 (point) | |
| 1281 (if (re-search-forward "</sera>" nil t) | |
| 1282 (match-beginning 0) | |
| 1283 (point-max)) | |
| 1284 nil | |
| 1285 'force)))) | |
| 1286 | |
| 1287 ;; | |
| 1288 ;; vowel modification | |
| 1289 ;; | |
| 1290 | |
| 1291 ;;;###autoload | |
| 1292 (defun ethio-modify-vowel nil | |
| 1293 "Modify the vowel of the FIDEL that is under the cursor." | |
| 1294 (interactive) | |
| 1295 (let ((ch (following-char)) | |
| 1296 (composite nil) ; geminated or not | |
| 1297 newch base vowel modulo) | |
| 1298 | |
| 1299 (cond | |
| 1300 ;; in case of gemination | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4021
diff
changeset
|
1301 ;; XEmacs change; the (and nil ...) eliminates a warning about using |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4021
diff
changeset
|
1302 ;; decompose-composite-char. The name of the composite charset is |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4021
diff
changeset
|
1303 ;; composite, anyway, not composition; and it has never worked. |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4021
diff
changeset
|
1304 ((and nil (eq (char-charset ch) 'composition)) |
| 771 | 1305 (setq ch (string-to-char (decompose-composite-char ch)) |
| 1306 composite t)) | |
| 1307 ;; neither gemination nor fidel | |
| 1308 ((not (eq (char-charset ch) 'ethiopic)) | |
| 778 | 1309 (error "Not a valid character"))) |
| 771 | 1310 |
| 1311 ;; set frequently referred character features | |
| 1312 (setq ch (ethio-char-to-ethiocode ch) | |
| 1313 base (* (/ ch 8) 8) | |
| 1314 modulo (% ch 8)) | |
| 1315 | |
| 1316 (if (or (and (>= ch 344) (<= ch 380)) ;; mYa - `10000 | |
| 1317 (and (>= ch 448) (<= ch 452)) ;; \~X - \~A | |
| 1318 (>= ch 458)) ;; private punctuations | |
| 778 | 1319 (error "Not a valid character")) |
| 771 | 1320 |
| 1321 (setq | |
| 1322 newch | |
| 1323 (cond | |
| 1324 | |
| 1325 ;; first standalone vowels | |
| 1326 ((= base 160) | |
| 1327 (if (ethio-prefer-amharic-p) | |
| 1328 (message "Modify vowel to: [auiAEIoW\"] ") | |
| 1329 (message "Modify vowel to: [euiAEIoW\"] ")) | |
| 1330 (setq vowel (read-char)) | |
| 1331 (cond | |
| 1332 ((= vowel ?e) 160) | |
| 1333 ((= vowel ?u) 161) | |
| 1334 ((= vowel ?i) 162) | |
| 1335 ((= vowel ?A) 163) | |
| 1336 ((= vowel ?E) 164) | |
| 1337 ((= vowel ?I) 165) | |
| 1338 ((= vowel ?o) 166) | |
| 1339 ((= vowel ?W) 167) | |
| 1340 ((= vowel ?a) (if (ethio-prefer-amharic-p) 160 163)) | |
| 1341 ((= vowel ?\") (setq composite t) ch) | |
| 1342 (t nil))) | |
| 1343 | |
| 1344 ;; second standalone vowels | |
| 1345 ((= base 208) | |
| 1346 (message "Modify vowel to: [euiaEIo\"] ") | |
| 1347 (setq vowel (read-char)) | |
| 1348 (cond | |
| 1349 ((= vowel ?e) 208) | |
| 1350 ((= vowel ?u) 209) | |
| 1351 ((= vowel ?i) 210) | |
| 1352 ((= vowel ?a) 211) | |
| 1353 ((= vowel ?E) 212) | |
| 1354 ((= vowel ?I) 213) | |
| 1355 ((= vowel ?o) 214) | |
| 1356 ((= vowel ?\") (setq composite t) ch) | |
| 1357 (t nil))) | |
| 1358 | |
| 1359 ;; 12-form consonants, *W* form | |
| 1360 ((memq base '(72 88 136 176 192 272)) ; qW QW hW kW KW gW | |
| 1361 (message "Modify vowel to: [euiaE'\"] ") | |
| 1362 (setq vowel (read-char)) | |
| 1363 (cond | |
| 1364 ((= vowel ?e) base) | |
| 1365 ((= vowel ?u) (+ base 5)) | |
| 1366 ((= vowel ?i) (+ base 2)) | |
| 1367 ((= vowel ?a) (+ base 3)) | |
| 1368 ((= vowel ?E) (+ base 4)) | |
| 1369 ((= vowel ?') (+ base 5)) | |
| 1370 ((= vowel ?\") (setq composite t) ch) | |
| 1371 (t nil))) | |
| 1372 | |
| 1373 ;; extended 12-form consonants, mWa bWa GWa fWa pWa | |
| 1374 ((= ch 31) ; mWa | |
| 1375 (message "Modify vowel to: [euiaE'\"] ") | |
| 1376 (setq vowel (read-char)) | |
| 1377 (cond | |
| 1378 ((= vowel ?e) 392) | |
| 1379 ((= vowel ?u) 440) | |
| 1380 ((= vowel ?i) 408) | |
| 1381 ((= vowel ?a) ch) | |
| 1382 ((= vowel ?E) 424) | |
| 1383 ((= vowel ?') 440) | |
| 1384 ((= vowel ?\") (setq composite t) ch) | |
| 1385 (t nil))) | |
| 1386 ((= ch 103) ; bWa | |
| 1387 (message "Modify vowel to: [euiaE'\"] ") | |
| 1388 (setq vowel (read-char)) | |
| 1389 (cond | |
| 1390 ((= vowel ?e) 393) | |
| 1391 ((= vowel ?u) 441) | |
| 1392 ((= vowel ?i) 409) | |
| 1393 ((= vowel ?a) ch) | |
| 1394 ((= vowel ?E) 425) | |
| 1395 ((= vowel ?') 441) | |
| 1396 ((= vowel ?\") (setq composite t) ch) | |
| 1397 (t nil))) | |
| 1398 ((= ch 287) ; GWa | |
| 1399 (message "Modify vowel to: [euiaE'\"] ") | |
| 1400 (setq vowel (read-char)) | |
| 1401 (cond | |
| 1402 ((= vowel ?e) 394) | |
| 1403 ((= vowel ?u) 442) | |
| 1404 ((= vowel ?i) 410) | |
| 1405 ((= vowel ?a) ch) | |
| 1406 ((= vowel ?E) 426) | |
| 1407 ((= vowel ?') 442) | |
| 1408 ((= vowel ?\") (setq composite t) ch) | |
| 1409 (t nil))) | |
| 1410 ((= ch 335) ; fWa | |
| 1411 (message "Modify vowel to: [euiaE'\"] ") | |
| 1412 (setq vowel (read-char)) | |
| 1413 (cond | |
| 1414 ((= vowel ?e) 395) | |
| 1415 ((= vowel ?u) 443) | |
| 1416 ((= vowel ?i) 411) | |
| 1417 ((= vowel ?a) ch) | |
| 1418 ((= vowel ?E) 427) | |
| 1419 ((= vowel ?') 443) | |
| 1420 ((= vowel ?\") (setq composite t) ch) | |
| 1421 (t nil))) | |
| 1422 ((= ch 343) ; pWa | |
| 1423 (message "Modify vowel to: [euiaE'\"] ") | |
| 1424 (setq vowel (read-char)) | |
| 1425 (cond | |
| 1426 ((= vowel ?e) 396) | |
| 1427 ((= vowel ?u) 444) | |
| 1428 ((= vowel ?i) 412) | |
| 1429 ((= vowel ?a) ch) | |
| 1430 ((= vowel ?E) 428) | |
| 1431 ((= vowel ?') 444) | |
| 1432 ((= vowel ?\") (setq composite t) ch) | |
| 1433 (t nil))) | |
| 1434 | |
| 1435 ;; extended 12-form consonatns, mW* bW* GW* fW* pW* | |
| 1436 ((memq base '(392 408 424 440)) ; *We *Wi *WE *W | |
| 1437 (message "Modify vowel to: [eiEau'\"] ") | |
| 1438 (setq vowel (read-char)) | |
| 1439 (cond | |
| 1440 ((= vowel ?e) (+ 392 modulo)) | |
| 1441 ((= vowel ?i) (+ 408 modulo)) | |
| 1442 ((= vowel ?E) (+ 424 modulo)) | |
| 1443 ((= vowel ?a) (cond | |
| 1444 ((= modulo 0) 31) ; mWa | |
| 1445 ((= modulo 1) 103) ; bWa | |
| 1446 ((= modulo 2) 287) ; GWa | |
| 1447 ((= modulo 3) 335) ; fWa | |
| 1448 ((= modulo 4) 343) ; pWa | |
| 1449 (t nil))) ; never reach here | |
| 1450 ((= vowel ?') (+ 440 modulo)) | |
| 1451 ((= vowel ?u) (+ 440 modulo)) | |
| 1452 ((= vowel ?\") (setq composite t) ch) | |
| 1453 (t nil))) | |
| 1454 | |
| 1455 ((and (>= ch 453) (<= ch 457)) ; wWe wWi wWa wWE wW | |
| 1456 (message "Modify vowel to: [eiaE'u\"] ") | |
| 1457 (setq vowel (read-char)) | |
| 1458 (cond | |
| 1459 ((= vowel ?e) 453) | |
| 1460 ((= vowel ?i) 454) | |
| 1461 ((= vowel ?a) 455) | |
| 1462 ((= vowel ?E) 456) | |
| 1463 ((= vowel ?') 457) | |
| 1464 ((= vowel ?u) 457) | |
| 1465 ((= vowel ?\") (setq composite t) ch) | |
| 1466 (t nil))) | |
| 1467 | |
| 1468 ;; 7-form consonants, or | |
| 1469 ;; first 7 of 8-form consonants | |
| 1470 ((<= modulo 6) | |
| 1471 (message "Modify vowel to: [euiaE'o\"] ") | |
| 1472 (setq vowel (read-char)) | |
| 1473 (cond | |
| 1474 ((= vowel ?e) base) | |
| 1475 ((= vowel ?u) (+ base 1)) | |
| 1476 ((= vowel ?i) (+ base 2)) | |
| 1477 ((= vowel ?a) (+ base 3)) | |
| 1478 ((= vowel ?E) (+ base 4)) | |
| 1479 ((= vowel ?') (+ base 5)) | |
| 1480 ((= vowel ?o) (+ base 6)) | |
| 1481 ((= vowel ?\") (setq composite t) ch) | |
| 1482 (t nil))) | |
| 1483 | |
| 1484 ;; otherwise | |
| 1485 (t | |
| 1486 nil))) | |
| 1487 | |
| 1488 (cond | |
| 1489 | |
| 1490 ;; could not get new character | |
| 1491 ((null newch) | |
| 1492 (error "Invalid vowel")) | |
| 1493 | |
| 1494 ;; vowel changed on a composite Fidel | |
| 1495 (composite | |
| 1496 (delete-char 1) | |
| 1497 (insert | |
| 1498 (compose-string | |
| 1499 (concat (char-to-string (ethio-ethiocode-to-char newch)) "$(3%s(B")))) | |
| 1500 | |
| 1501 ;; simple vowel modification | |
| 1502 (t | |
| 1503 (delete-char 1) | |
| 1504 (insert (ethio-ethiocode-to-char newch)))))) | |
| 1505 | |
| 1506 (defun ethio-ethiocode-to-char (ethiocode) | |
| 1507 (make-char | |
| 1508 'ethiopic | |
| 1509 (+ (/ ethiocode 94) 33) | |
| 1510 (+ (mod ethiocode 94) 33))) | |
| 1511 | |
| 1512 (defun ethio-char-to-ethiocode (ch) | |
| 1513 (and (eq (char-charset ch) 'ethiopic) | |
| 1514 (let ((char-components (split-char ch))) | |
| 1515 (+ (* (- (nth 1 char-components) 33) 94) | |
| 1516 (- (nth 2 char-components) 33))))) | |
| 1517 | |
| 1518 ;; | |
| 1519 ;; space replacement | |
| 1520 ;; | |
| 1521 | |
| 1522 ;;;###autoload | |
| 1523 (defun ethio-replace-space (ch begin end) | |
| 1524 "Replace ASCII spaces with Ethiopic word separators in the region. | |
| 1525 | |
| 1526 In the specified region, replace word separators surrounded by two | |
| 1527 Ethiopic characters, depending on the first parameter CH, which should | |
| 1528 be 1, 2, or 3. | |
| 1529 | |
| 1530 If CH = 1, word separator will be replaced with an ASCII space. | |
| 1531 If CH = 2, with two ASCII spaces. | |
| 1532 If CH = 3, with the Ethiopic colon-like word separator. | |
| 1533 | |
| 1534 The second and third parameters BEGIN and END specify the region." | |
| 1535 | |
| 1536 (interactive "*cReplace spaces to: 1 (sg col), 2 (dbl col), 3 (Ethiopic)\nr") | |
| 1537 (if (not (memq ch '(?1 ?2 ?3))) | |
| 1538 (error "")) | |
| 1539 (save-excursion | |
| 1540 (save-restriction | |
| 1541 (narrow-to-region begin end) | |
| 1542 | |
| 1543 (cond | |
| 1544 ((= ch ?1) | |
| 1545 ;; an Ethiopic word separator --> an ASCII space | |
| 1546 (goto-char (point-min)) | |
| 1547 (while (search-forward "$(3$h(B" nil t) | |
| 1548 (replace-match " " nil t)) | |
| 1549 | |
| 1550 ;; two ASCII spaces between Ethiopic characters --> an ASCII space | |
| 1551 (goto-char (point-min)) | |
| 1552 (while (re-search-forward "\\(\\ce\\) \\(\\ce\\)" nil t) | |
| 1553 (replace-match "\\1 \\2") | |
| 1554 (goto-char (match-beginning 2)))) | |
| 1555 | |
| 1556 ((= ch ?2) | |
| 1557 ;; An Ethiopic word separator --> two ASCII spaces | |
| 1558 (goto-char (point-min)) | |
| 1559 (while (search-forward "$(3$h(B" nil t) | |
| 1560 (replace-match " ")) | |
| 1561 | |
| 1562 ;; An ASCII space between Ethiopic characters --> two ASCII spaces | |
| 1563 (goto-char (point-min)) | |
| 1564 (while (re-search-forward "\\(\\ce\\) \\(\\ce\\)" nil t) | |
| 1565 (replace-match "\\1 \\2") | |
| 1566 (goto-char (match-beginning 2)))) | |
| 1567 | |
| 1568 (t | |
| 1569 ;; One or two ASCII spaces between Ethiopic characters | |
| 1570 ;; --> An Ethiopic word separator | |
| 1571 (goto-char (point-min)) | |
| 1572 (while (re-search-forward "\\(\\ce\\) ?\\(\\ce\\)" nil t) | |
| 1573 (replace-match "\\1$(3$h(B\\2") | |
| 1574 (goto-char (match-beginning 2))) | |
| 1575 | |
| 1576 ;; Three or more ASCII spaces between Ethiopic characters | |
| 1577 ;; --> An Ethiopic word separator + (N - 2) ASCII spaces | |
| 1578 (goto-char (point-min)) | |
| 1579 (while (re-search-forward "\\(\\ce\\) \\( *\\ce\\)" nil t) | |
| 1580 (replace-match "\\1$(3$h(B\\2") | |
| 1581 (goto-char (match-beginning 2)))))))) | |
| 1582 | |
| 1583 ;; | |
| 1584 ;; special icons | |
| 1585 ;; | |
| 1586 | |
| 1587 ;;;###autoload | |
| 1588 (defun ethio-input-special-character (arg) | |
| 1589 "Allow the user to input special characters." | |
| 1590 (interactive "*cInput number: 1.$(3%j(B 2.$(3%k(B 3.$(3%l(B 4.$(3%m(B 5.$(3%i(B") | |
| 1591 (cond | |
| 1592 ((= arg ?1) | |
| 1593 (insert "$(3%j(B")) | |
| 1594 ((= arg ?2) | |
| 1595 (insert "$(3%k(B")) | |
| 1596 ((= arg ?3) | |
| 1597 (insert "$(3%l(B")) | |
| 1598 ((= arg ?4) | |
| 1599 (insert "$(3%m(B")) | |
| 1600 ((= arg ?5) | |
| 1601 (insert "$(3%i(B")) | |
| 1602 (t | |
| 1603 (error "")))) | |
| 1604 | |
| 1605 ;; | |
| 1606 ;; TeX support | |
| 1607 ;; | |
| 1608 | |
| 1609 (defconst ethio-fidel-to-tex-map | |
| 1610 [ "heG" "huG" "hiG" "haG" "hEG" "hG" "hoG" "" ;; 0 - 7 | |
| 1611 "leG" "luG" "liG" "laG" "lEG" "lG" "loG" "lWaG" ;; 8 | |
| 1612 "HeG" "HuG" "HiG" "HaG" "HEG" "HG" "HoG" "HWaG" ;; 16 | |
| 1613 "meG" "muG" "miG" "maG" "mEG" "mG" "moG" "mWaG" ;; 24 | |
| 1614 "sseG" "ssuG" "ssiG" "ssaG" "ssEG" "ssG" "ssoG" "ssWaG" ;; 32 | |
| 1615 "reG" "ruG" "riG" "raG" "rEG" "rG" "roG" "rWaG" ;; 40 | |
| 1616 "seG" "suG" "siG" "saG" "sEG" "sG" "soG" "sWaG" ;; 48 | |
| 1617 "xeG" "xuG" "xiG" "xaG" "xEG" "xG" "xoG" "xWaG" ;; 56 | |
| 1618 "qeG" "quG" "qiG" "qaG" "qEG" "qG" "qoG" "" ;; 64 | |
| 1619 "qWeG" "" "qWiG" "qWaG" "qWEG" "qWG" "" "" ;; 72 | |
| 1620 "QeG" "QuG" "QiG" "QaG" "QEG" "QG" "QoG" "" ;; 80 | |
| 1621 "QWeG" "" "QWiG" "QWaG" "QWEG" "QWG" "" "" ;; 88 | |
| 1622 "beG" "buG" "biG" "baG" "bEG" "bG" "boG" "bWaG" ;; 96 | |
| 1623 "veG" "vuG" "viG" "vaG" "vEG" "vG" "voG" "vWaG" ;; 104 | |
| 1624 "teG" "tuG" "tiG" "taG" "tEG" "tG" "toG" "tWaG" ;; 112 | |
| 1625 "ceG" "cuG" "ciG" "caG" "cEG" "cG" "coG" "cWaG" ;; 120 | |
| 1626 "hheG" "hhuG" "hhiG" "hhaG" "hhEG" "hhG" "hhoG" "" ;; 128 | |
| 1627 "hWeG" "" "hWiG" "hWaG" "hWEG" "hWG" "" "" ;; 136 | |
| 1628 "neG" "nuG" "niG" "naG" "nEG" "nG" "noG" "nWaG" ;; 144 | |
| 1629 "NeG" "NuG" "NiG" "NaG" "NEG" "NG" "NoG" "NWaG" ;; 152 | |
| 1630 "eG" "uG" "iG" "AG" "EG" "IG" "oG" "eaG" ;; 160 | |
| 1631 "keG" "kuG" "kiG" "kaG" "kEG" "kG" "koG" "" ;; 168 | |
| 1632 "kWeG" "" "kWiG" "kWaG" "kWEG" "kWG" "" "" ;; 176 | |
| 1633 "KeG" "KuG" "KiG" "KaG" "KEG" "KG" "KoG" "" ;; 184 | |
| 1634 "KWeG" "" "KWiG" "KWaG" "KWEG" "KWG" "" "" ;; 192 | |
| 1635 "weG" "wuG" "wiG" "waG" "wEG" "wG" "woG" "" ;; 200 | |
| 1636 "eeG" "uuG" "iiG" "aaG" "EEG" "IIG" "ooG" "" ;; 208 | |
| 1637 "zeG" "zuG" "ziG" "zaG" "zEG" "zG" "zoG" "zWaG" ;; 216 | |
| 1638 "ZeG" "ZuG" "ZiG" "ZaG" "ZEG" "ZG" "ZoG" "ZWaG" ;; 224 | |
| 1639 "yeG" "yuG" "yiG" "yaG" "yEG" "yG" "yoG" "yWaG" ;; 232 | |
| 1640 "deG" "duG" "diG" "daG" "dEG" "dG" "doG" "dWaG" ;; 240 | |
| 1641 "DeG" "DuG" "DiG" "DaG" "DEG" "DG" "DoG" "DWaG" ;; 248 | |
| 1642 "jeG" "juG" "jiG" "jaG" "jEG" "jG" "joG" "jWaG" ;; 256 | |
| 1643 "geG" "guG" "giG" "gaG" "gEG" "gG" "goG" "" ;; 264 | |
| 1644 "gWeG" "" "gWiG" "gWaG" "gWEG" "gWG" "" "" ;; 272 | |
| 1645 "GeG" "GuG" "GiG" "GaG" "GEG" "GG" "GoG" "GWaG" ;; 280 | |
| 1646 "TeG" "TuG" "TiG" "TaG" "TEG" "TG" "ToG" "TWaG" ;; 288 | |
| 1647 "CeG" "CuG" "CiG" "CaG" "CEG" "CG" "CoG" "CWaG" ;; 296 | |
| 1648 "PeG" "PuG" "PiG" "PaG" "PEG" "PG" "PoG" "PWaG" ;; 304 | |
| 1649 "SeG" "SuG" "SiG" "SaG" "SEG" "SG" "SoG" "SWaG" ;; 312 | |
| 1650 "SSeG" "SSuG" "SSiG" "SSaG" "SSEG" "SSG" "SSoG" "" ;; 320 | |
| 1651 "feG" "fuG" "fiG" "faG" "fEG" "fG" "foG" "fWaG" ;; 328 | |
| 1652 "peG" "puG" "piG" "paG" "pEG" "pG" "poG" "pWaG" ;; 336 | |
| 1653 "mYaG" "rYaG" "fYaG" "" "" "" "" "" ;; 344 | |
| 1654 "" "spaceG" "periodG" "commaG" ;; 352 | |
| 1655 "semicolonG" "colonG" "precolonG" "oldqmarkG" ;; 356 | |
| 1656 "pbreakG" "andG" "huletG" "sostG" "aratG" "amstG" "sadstG" "sabatG" ;; 360 | |
| 1657 "smntG" "zeteNG" "asrG" "heyaG" "selasaG" "arbaG" "hemsaG" "slsaG" ;; 368 | |
| 1658 "sebaG" "semanyaG" "zeTanaG" "metoG" "asrxiG" "" "" "" ;; 376 | |
| 1659 "qqeG" "qquG" "qqiG" "qqaG" "qqEG" "qqG" "qqoG" "" ;; 384 | |
| 1660 "mWeG" "bWeG" "GWeG" "fWeG" "pWeG" "" "" "" ;; 392 | |
| 1661 "kkeG" "kkuG" "kkiG" "kkaG" "kkEG" "kkG" "kkoG" "" ;; 400 | |
| 1662 "mWiG" "bWiG" "GWiG" "fWiG" "pWiG" "" "" "" ;; 408 | |
| 1663 "XeG" "XuG" "GXiG" "XaG" "XEG" "XG" "XoG" "" ;; 416 | |
| 1664 "mWEG" "bWEG" "GWEG" "fWEG" "pWEG" "" "" "" ;; 424 | |
| 1665 "ggeG" "gguG" "ggiG" "ggaG" "ggEG" "ggG" "ggoG" "" ;; 432 | |
| 1666 "mWG" "bWG" "GWG" "fWG" "pWG" "" "" "" ;; 440 | |
| 1667 "ornamentG" "flandG" "iflandG" "africaG" ;; 448 | |
| 1668 "iafricaG" "wWeG" "wWiG" "wWaG" ;; 452 | |
| 1669 "wWEG" "wWG" "" "slaqG" "dotG" "lquoteG" "rquoteG" "qmarkG" ]) ;; 456 | |
| 1670 | |
| 1671 ;; | |
| 1672 ;; To make tex-to-fidel mapping. | |
| 1673 ;; The following code makes | |
| 1674 ;; (get 'ethio-tex-command-he 'ethio-fidel-char) ==> ?$(3!!(B | |
| 1675 ;; etc. | |
| 1676 ;; | |
| 1677 | |
| 1678 (let ((i 0) str) | |
| 1679 (while (< i (length ethio-fidel-to-tex-map)) | |
| 1680 (setq str (aref ethio-fidel-to-tex-map i)) | |
| 1681 (if (not (string= str "")) | |
| 1682 (put | |
| 1683 (intern (concat "ethio-tex-command-" (aref ethio-fidel-to-tex-map i))) | |
| 1684 'ethio-fidel-char | |
| 1685 (ethio-ethiocode-to-char i))) | |
| 1686 (setq i (1+ i)))) | |
| 1687 | |
| 1688 ;;;###autoload | |
| 1689 (defun ethio-fidel-to-tex-buffer nil | |
| 1690 "Convert each fidel characters in the current buffer into a fidel-tex command. | |
| 1691 Each command is always surrounded by braces." | |
| 1692 (interactive) | |
| 1693 (let ((buffer-read-only nil)) | |
| 1694 | |
| 1695 ;; Isolated gemination marks need special treatement | |
| 1696 (goto-char (point-min)) | |
| 1697 (while (search-forward "$(3%s(B" nil t) | |
| 1698 (replace-match "\\geminateG{}" t t)) | |
| 1699 | |
| 1700 ;; First, decompose geminations | |
| 1701 ;; Here we assume that each composed character consists of | |
| 1702 ;; one Ethiopic character and the Ethiopic gemination mark. | |
| 1703 (decompose-region (point-min) (point-max)) | |
| 1704 | |
| 1705 ;; Special treatment for geminated characters | |
| 1706 ;; The geminated character (la'') will be "\geminateG{\la}". | |
| 1707 (goto-char (point-min)) | |
| 1708 (while (search-forward "$(3%s(B" nil t) | |
| 1709 (delete-backward-char 1) | |
| 1710 (backward-char 1) | |
| 1711 (insert "\\geminateG") | |
| 1712 (forward-char 1)) | |
| 1713 | |
| 1714 ;; Ethiopic characters to TeX macros | |
| 1715 (goto-char (point-min)) | |
| 1716 (while (re-search-forward "\\ce" nil t) | |
| 1717 (insert | |
| 1718 "{\\" | |
| 1719 (aref ethio-fidel-to-tex-map | |
| 1720 (prog1 (ethio-char-to-ethiocode (preceding-char)) | |
| 1721 (backward-delete-char 1))) | |
| 1722 "}")) | |
| 1723 (goto-char (point-min)) | |
| 1724 (set-buffer-modified-p nil))) | |
| 1725 | |
| 1726 ;;;###autoload | |
| 1727 (defun ethio-tex-to-fidel-buffer nil | |
| 1728 "Convert fidel-tex commands in the current buffer into fidel chars." | |
| 1729 (interactive) | |
| 1730 (let ((buffer-read-only nil) | |
| 1731 (p) (ch)) | |
| 1732 | |
| 1733 ;; Special treatment for gemination | |
| 1734 ;; "\geminateG{\la}" or "\geminateG{{\la}}" will be "\la$(3%s(B" | |
| 1735 ;; "\geminateG{}" remains unchanged. | |
| 1736 (goto-char (point-min)) | |
| 1737 (while (re-search-forward "\\\\geminateG{\\(\\\\[a-zA-Z]+\\)}" nil t) | |
| 1738 (replace-match "\\1$(3%s(B")) | |
| 1739 | |
| 1740 ;; TeX macros to Ethiopic characters | |
| 1741 (goto-char (point-min)) | |
| 1742 (while (search-forward "\\" nil t) | |
| 1743 (setq p (point)) | |
| 1744 (skip-chars-forward "a-zA-Z") | |
| 1745 (setq ch | |
| 1746 (get (intern (concat "ethio-tex-command-" | |
| 1747 (buffer-substring p (point)))) | |
| 1748 'ethio-fidel-char)) | |
| 1749 (if ch | |
| 1750 (progn | |
| 1751 (delete-region (1- p) (point)) ; don't forget the preceding "\" | |
| 1752 (if (and (= (preceding-char) ?{) | |
| 1753 (= (following-char) ?})) | |
| 1754 (progn | |
| 1755 (backward-delete-char 1) | |
| 1756 (delete-char 1))) | |
| 1757 (insert ch)))) | |
| 1758 | |
| 1759 ;; compose geminated characters | |
| 1760 (goto-char (point-min)) | |
| 1761 (while (re-search-forward "\\ce$(3%s(B" nil 0) | |
| 1762 (compose-region | |
| 1763 (save-excursion (backward-char 2) (point)) | |
| 1764 (point))) | |
| 1765 | |
| 1766 ;; Now it's time to convert isolated gemination marks. | |
| 1767 (goto-char (point-min)) | |
| 1768 (while (search-forward "\\geminateG{}" nil t) | |
| 1769 (replace-match "$(3%s(B")) | |
| 1770 | |
| 1771 (goto-char (point-min)) | |
| 1772 (set-buffer-modified-p nil))) | |
| 1773 | |
| 1774 ;; | |
| 1775 ;; Java support | |
| 1776 ;; | |
| 1777 | |
| 1778 ;;;###autoload | |
| 1779 (defun ethio-fidel-to-java-buffer nil | |
| 1780 "Convert Ethiopic characters into the Java escape sequences. | |
| 1781 | |
| 3369 | 1782 Each escape sequence is of the form \\uXXXX, where XXXX is the |
| 771 | 1783 character's codepoint (in hex) in Unicode. |
| 1784 | |
| 1785 If `ethio-java-save-lowercase' is non-nil, use [0-9a-f]. | |
| 1786 Otherwise, [0-9A-F]." | |
| 1787 (let ((ucode)) | |
| 1788 | |
| 1789 ;; first, decompose geminations | |
| 1790 (decompose-region (point-min) (point-max)) | |
| 1791 | |
| 1792 (goto-char (point-min)) | |
| 1793 (while (re-search-forward "\\ce" nil t) | |
| 793 | 1794 (setq ucode (+ #x1200 (ethio-char-to-ethiocode (preceding-char)))) |
| 1795 (if (> ucode #x13bc) | |
| 771 | 1796 (setq ucode (+ ucode 59952))) |
| 1797 (delete-backward-char 1) | |
| 1798 (if ethio-java-save-lowercase | |
| 1799 (insert (format "\\u%4x" ucode)) | |
| 1800 (insert (upcase (format "\\u%4x" ucode))))))) | |
| 1801 | |
| 1802 ;;;###autoload | |
| 1803 (defun ethio-java-to-fidel-buffer nil | |
| 1804 "Convert the Java escape sequences into corresponding Ethiopic characters." | |
| 1805 (let ((ucode)) | |
| 1806 (goto-char (point-min)) | |
| 1807 (while (re-search-forward "\\\\u\\([0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F]\\)" nil t) | |
| 1808 (setq ucode | |
| 1809 (read | |
| 1810 (concat | |
| 793 | 1811 "#x" |
| 771 | 1812 (buffer-substring (match-beginning 1) (match-end 1))))) |
| 1813 (cond | |
| 793 | 1814 ((and (>= ucode #x1200) (<= ucode #x13bc)) |
| 771 | 1815 (replace-match "") |
| 793 | 1816 (insert (ethio-ethiocode-to-char (- ucode #x1200)))) |
| 1817 ((and (>= ucode #xfdf1) (<= ucode #xfdff)) | |
| 771 | 1818 (replace-match "") |
| 1819 (insert (ethio-ethiocode-to-char (- ucode 64560)))) | |
| 1820 (t | |
| 1821 nil))) | |
| 1822 | |
| 1823 ;; gemination | |
| 1824 (goto-char (point-min)) | |
| 1825 (while (re-search-forward "\\ce$(3%s(B" nil 0) | |
| 1826 (compose-region | |
| 1827 (save-excursion (backward-char 2) (point)) | |
| 1828 (point))) | |
| 1829 )) | |
| 1830 | |
| 1831 ;; | |
| 1832 ;; file I/O hooks | |
| 1833 ;; | |
| 1834 | |
| 1835 ;;;###autoload | |
| 1836 (defun ethio-find-file nil | |
| 1837 "Transcribe file content into Ethiopic dependig on filename suffix." | |
| 1838 (cond | |
| 1839 | |
| 1840 ((string-match "\\.sera$" (buffer-file-name)) | |
| 1841 (save-excursion | |
| 1842 (ethio-sera-to-fidel-buffer nil 'force) | |
| 1843 (set-buffer-modified-p nil))) | |
| 1844 | |
| 1845 ((string-match "\\.html$" (buffer-file-name)) | |
| 1846 (let ((sera-being-called-by-w3 t)) | |
| 1847 (save-excursion | |
| 1848 (ethio-sera-to-fidel-marker 'force) | |
| 1849 (goto-char (point-min)) | |
| 1850 (while (re-search-forward "&[lr]aquote;" nil t) | |
| 1851 (if (= (char-after (1+ (match-beginning 0))) ?l) | |
| 1852 (replace-match "$(3%v(B") | |
| 1853 (replace-match "$(3%w(B"))) | |
| 1854 (set-buffer-modified-p nil)))) | |
| 1855 | |
| 1856 ((string-match "\\.tex$" (buffer-file-name)) | |
| 1857 (save-excursion | |
| 1858 (ethio-tex-to-fidel-buffer) | |
| 1859 (set-buffer-modified-p nil))) | |
| 1860 | |
| 1861 ((string-match "\\.java$" (buffer-file-name)) | |
| 1862 (save-excursion | |
| 1863 (ethio-java-to-fidel-buffer) | |
| 1864 (set-buffer-modified-p nil))) | |
| 1865 | |
| 1866 (t | |
| 1867 nil))) | |
| 1868 | |
| 1869 ;;;###autoload | |
| 1870 (defun ethio-write-file nil | |
| 1871 "Transcribe Ethiopic characters in ASCII depending on the file extension." | |
| 1872 (cond | |
| 1873 | |
| 1874 ((string-match "\\.sera$" (buffer-file-name)) | |
| 1875 (save-excursion | |
| 1876 (ethio-fidel-to-sera-buffer nil 'force) | |
| 1877 (goto-char (point-min)) | |
| 1878 (ethio-record-user-preference) | |
| 1879 (set-buffer-modified-p nil))) | |
| 1880 | |
| 1881 ((string-match "\\.html$" (buffer-file-name)) | |
| 1882 (save-excursion | |
| 1883 (let ((sera-being-called-by-w3 t) | |
| 1884 (lq (aref ethio-fidel-to-sera-map 461)) | |
| 1885 (rq (aref ethio-fidel-to-sera-map 462))) | |
| 1886 (aset ethio-fidel-to-sera-map 461 "«te;") | |
| 1887 (aset ethio-fidel-to-sera-map 462 "»te;") | |
| 1888 (ethio-fidel-to-sera-marker 'force) | |
| 1889 (goto-char (point-min)) | |
| 1890 (if (search-forward "<sera>" nil t) | |
| 1891 (ethio-record-user-preference)) | |
| 1892 (aset ethio-fidel-to-sera-map 461 lq) | |
| 1893 (aset ethio-fidel-to-sera-map 462 rq) | |
| 1894 (set-buffer-modified-p nil)))) | |
| 1895 | |
| 1896 ((string-match "\\.tex$" (buffer-file-name)) | |
| 1897 (save-excursion | |
| 1898 (ethio-fidel-to-tex-buffer) | |
| 1899 (set-buffer-modified-p nil))) | |
| 1900 | |
| 1901 ((string-match "\\.java$" (buffer-file-name)) | |
| 1902 (save-excursion | |
| 1903 (ethio-fidel-to-java-buffer) | |
| 1904 (set-buffer-modified-p nil))) | |
| 1905 | |
| 1906 (t | |
| 1907 nil))) | |
| 1908 | |
| 1909 (defun ethio-record-user-preference nil | |
| 1910 (if (looking-at "\\\\~\\(tir?\\|amh?\\) ") | |
| 1911 (goto-char (match-end 0)) | |
| 1912 (insert (if (ethio-prefer-amharic-p) "\\~amh " "\\~tir "))) | |
| 1913 (insert (if ethio-use-colon-for-colon "\\~-: " "\\~`: ") | |
| 1914 (if ethio-use-three-dot-question "\\~`| " "\\~`? "))) | |
| 1915 | |
| 1916 ;; | |
| 1917 ;; Ethiopic word separator vs. ASCII space | |
| 1918 ;; | |
| 1919 | |
| 1920 (defvar ethio-prefer-ascii-space t) | |
| 1921 (make-variable-buffer-local 'ethio-prefer-ascii-space) | |
| 1922 | |
| 1923 (defun ethio-toggle-space nil | |
| 1924 "Toggle ASCII space and Ethiopic separator for keyboard input." | |
| 1925 (interactive) | |
| 1926 (setq ethio-prefer-ascii-space | |
| 1927 (not ethio-prefer-ascii-space)) | |
| 1928 (if (equal current-input-method "ethiopic") | |
| 1929 (setq current-input-method-title (quail-title))) | |
| 1930 (force-mode-line-update)) | |
| 1931 | |
| 1932 (defun ethio-insert-space (arg) | |
| 1933 "Insert ASCII spaces or Ethiopic word separators depending on context. | |
| 1934 | |
| 1935 If the current word separator (indicated in mode-line) is the ASCII space, | |
| 1936 insert an ASCII space. With ARG, insert that many ASCII spaces. | |
| 1937 | |
| 1938 If the current word separator is the colon-like Ethiopic word | |
| 1939 separator and the point is preceded by `an Ethiopic punctuation mark | |
| 1940 followed by zero or more ASCII spaces', then insert also an ASCII | |
| 1941 space. With ARG, insert that many ASCII spaces. | |
| 1942 | |
| 1943 Otherwise, insert a colon-like Ethiopic word separator. With ARG, insert that | |
| 1944 many Ethiopic word separators." | |
| 1945 | |
| 1946 (interactive "*p") | |
| 1947 (cond | |
| 1948 (ethio-prefer-ascii-space | |
| 1949 (insert-char 32 arg)) | |
| 1950 ((save-excursion | |
| 1951 (skip-chars-backward " ") | |
| 1952 (memq (preceding-char) | |
| 1953 '(?$(3$h(B ?$(3$i(B ?$(3$j(B ?$(3$k(B ?$(3$l(B ?$(3$m(B ?$(3$n(B ?$(3$o(B ?$(3%t(B ?$(3%u(B ?$(3%v(B ?$(3%w(B ?$(3%x(B))) | |
| 1954 (insert-char 32 arg)) | |
| 1955 (t | |
| 1956 (insert-char ?$(3$h(B arg)))) | |
| 1957 | |
| 1958 (defun ethio-insert-ethio-space (arg) | |
| 1959 "Insert the Ethiopic word delimiter (the colon-like character). | |
| 1960 With ARG, insert that many delimiters." | |
| 1961 (interactive "*p") | |
| 1962 (insert-char ?$(3$h(B arg)) | |
| 1963 | |
| 1964 ;; | |
| 1965 ;; Ethiopic punctuation vs. ASCII punctuation | |
| 1966 ;; | |
| 1967 | |
| 1968 (defvar ethio-prefer-ascii-punctuation nil) | |
| 1969 (make-variable-buffer-local 'ethio-prefer-ascii-punctuation) | |
| 1970 | |
| 1971 (defun ethio-toggle-punctuation nil | |
| 1972 "Toggle Ethiopic punctuations and ASCII punctuations for keyboard input." | |
| 1973 (interactive) | |
| 1974 (setq ethio-prefer-ascii-punctuation | |
| 1975 (not ethio-prefer-ascii-punctuation)) | |
| 1976 (let* ((keys '("." ".." "..." "," ",," ";" ";;" ":" "::" ":::" "*" "**")) | |
| 1977 (puncs | |
| 1978 (if ethio-prefer-ascii-punctuation | |
| 1979 '(?. [".."] ["..."] ?, [",,"] ?\; [";;"] ?: ["::"] [":::"] ?* ["**"]) | |
| 1980 '(?$(3$i(B ?$(3%u(B ?. ?$(3$j(B ?, ?$(3$k(B ?\; ?$(3$h(B ?$(3$i(B ?: ?* ?$(3$o(B)))) | |
| 1981 (while keys | |
| 1982 (quail-defrule (car keys) (car puncs) "ethiopic") | |
| 1983 (setq keys (cdr keys) | |
| 1984 puncs (cdr puncs))) | |
| 1985 (if (equal current-input-method "ethiopic") | |
| 1986 (setq current-input-method-title (quail-title))) | |
| 1987 (force-mode-line-update))) | |
| 1988 | |
| 1989 ;; | |
| 1990 ;; Gemination | |
| 1991 ;; | |
| 1992 | |
| 1993 (defun ethio-gemination nil | |
| 1994 "Compose the character before the point with the Ethiopic gemination mark. | |
| 1196 | 1995 If the character is already composed, decompose it and remove the gemination |
| 771 | 1996 mark." |
| 1997 (interactive "*") | |
| 1998 (cond | |
| 1999 ((eq (char-charset (preceding-char)) 'ethiopic) | |
| 2000 (insert "$(3%s(B") | |
| 2001 (compose-region | |
| 2002 (save-excursion (backward-char 2) (point)) | |
| 2003 (point)) | |
| 2004 (forward-char 1)) | |
| 2005 ((eq (char-charset (preceding-char)) 'leading-code-composition) | |
| 2006 (decompose-region | |
| 2007 (save-excursion (backward-char 1) (point)) | |
| 2008 (point)) | |
| 2009 (delete-backward-char 1)) | |
| 2010 (t | |
| 2011 (error "")))) | |
| 2012 | |
| 2013 ;; | |
| 2014 (provide 'ethio-util) | |
| 2015 | |
| 2016 ;;; ethio-util.el ends here |