comparison lisp/international/ogonek.el @ 49598:0d8b17d428b5

Trailing whitepace deleted.
author Juanma Barranquero <lekktu@gmail.com>
date Tue, 04 Feb 2003 13:24:35 +0000
parents 64274328203b
children 695cf19ef79e d7ddb3e565de
comparison
equal deleted inserted replaced
49597:e88404e8f2cf 49598:0d8b17d428b5
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; To use this library load it using 28 ;; To use this library load it using
29 ;; M-x load-library [enter] ogonek 29 ;; M-x load-library [enter] ogonek
30 ;; Then, you may get a short info by calling one of 30 ;; Then, you may get a short info by calling one of
31 ;; M-x ogonek-jak -- in Polish 31 ;; M-x ogonek-jak -- in Polish
32 ;; M-x ogonek-how -- in English " 32 ;; M-x ogonek-how -- in English "
33 33
34 ;;; Code: 34 ;;; Code:
35 35
36 (defgroup ogonek nil 36 (defgroup ogonek nil
37 "Change the encoding of Polish diacritic characters." 37 "Change the encoding of Polish diacritic characters."
38 :prefix "ogonek-" 38 :prefix "ogonek-"
39 :group 'i18n) 39 :group 'i18n)
40 40
41 (defconst ogonek-name-encoding-alist 41 (defconst ogonek-name-encoding-alist
42 '(("ascii" . (?A ?C ?E ?L ?N ?O ?S ?Z ?Z 42 '(("ascii" . (?A ?C ?E ?L ?N ?O ?S ?Z ?Z
43 ?a ?c ?e ?l ?n ?o ?s ?z ?z)) 43 ?a ?c ?e ?l ?n ?o ?s ?z ?z))
44 ("iso8859-2" . (161 198 202 163 209 211 166 172 175 44 ("iso8859-2" . (161 198 202 163 209 211 166 172 175
45 177 230 234 179 241 243 182 188 191)) 45 177 230 234 179 241 243 182 188 191))
46 ("mazovia" . (143 149 144 156 165 163 152 160 161 46 ("mazovia" . (143 149 144 156 165 163 152 160 161
47 134 141 145 146 164 162 158 166 167)) 47 134 141 145 146 164 162 158 166 167))
48 ("windows-EE" . (165 198 202 163 209 211 140 143 175 48 ("windows-EE" . (165 198 202 163 209 211 140 143 175
49 185 230 234 179 241 243 156 159 191)) 49 185 230 234 179 241 243 156 159 191))
50 ("windows-PL" . (165 198 202 163 209 211 140 143 175 50 ("windows-PL" . (165 198 202 163 209 211 140 143 175
51 185 230 234 179 241 243 156 159 191)) 51 185 230 234 179 241 243 156 159 191))
52 ("latin-2" . (164 143 168 157 227 224 151 141 189 52 ("latin-2" . (164 143 168 157 227 224 151 141 189
53 165 134 169 136 228 162 152 171 190)) 53 165 134 169 136 228 162 152 171 190))
54 ("CP852" . (164 143 168 157 227 224 151 141 189 54 ("CP852" . (164 143 168 157 227 224 151 141 189
55 165 134 169 136 228 162 152 171 190)) 55 165 134 169 136 228 162 152 171 190))
56 ("MeX" . (129 130 134 138 139 211 145 153 155 56 ("MeX" . (129 130 134 138 139 211 145 153 155
57 161 162 166 170 171 243 177 185 187)) 57 161 162 166 170 171 243 177 185 187))
58 ("CorelDraw" . (197 242 201 163 209 211 255 225 237 58 ("CorelDraw" . (197 242 201 163 209 211 255 225 237
59 229 236 230 198 241 243 165 170 186)) 59 229 236 230 198 241 243 165 170 186))
60 ("Amiga" . (194 202 203 206 207 211 212 218 219 60 ("Amiga" . (194 202 203 206 207 211 212 218 219
61 226 234 235 238 239 243 244 250 251)) 61 226 234 235 238 239 243 244 250 251))
62 ("Mac" . (132 140 162 252 193 238 229 143 251 62 ("Mac" . (132 140 162 252 193 238 229 143 251
63 136 141 171 184 196 151 230 144 253)) 63 136 141 171 184 196 151 230 144 253))
64 ) 64 )
65 "The constant `ogonek-name-encoding-alist' is a list of (NAME.LIST) pairs. 65 "The constant `ogonek-name-encoding-alist' is a list of (NAME.LIST) pairs.
66 Each LIST contains codes for 18 Polish diacritic characters. The codes 66 Each LIST contains codes for 18 Polish diacritic characters. The codes
67 are given in the following order: 67 are given in the following order:
68 Aogonek Cacute Eogonek Lslash Nacute Oacute Sacute Zacute Zdotaccent 68 Aogonek Cacute Eogonek Lslash Nacute Oacute Sacute Zacute Zdotaccent
69 aogonek cacute eogonek lslash nacute oacute sacute zacute zdotaccent.") 69 aogonek cacute eogonek lslash nacute oacute sacute zacute zdotaccent.")
72 72
73 (defconst ogonek-informacja 73 (defconst ogonek-informacja
74 " FUNKCJE INTERAKCYJNE UDOST/EPNIANE PRZEZ BIBLIOTEK/E `ogonek'. 74 " FUNKCJE INTERAKCYJNE UDOST/EPNIANE PRZEZ BIBLIOTEK/E `ogonek'.
75 75
76 Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy 76 Je/sli czytasz ten tekst, to albo przegl/adasz plik /xr/od/lowy
77 biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'. 77 biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'.
78 W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac 78 W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac
79 polecenie `M-x kill-buffer'. 79 polecenie `M-x kill-buffer'.
80 80
81 Niniejsza biblioteka dostarcza funkcji do zmiany kodowania polskich 81 Niniejsza biblioteka dostarcza funkcji do zmiany kodowania polskich
82 znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco. 82 znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
83 83
84 1. `ogonek-recode-region' oraz `ogonek-recode-buffer' 84 1. `ogonek-recode-region' oraz `ogonek-recode-buffer'
85 przekodowuj/a zaznaczony fragment wzgl/ednie ca/ly buffor. 85 przekodowuj/a zaznaczony fragment wzgl/ednie ca/ly buffor.
86 Po wywo/laniu interakcyjnym funkcji zadawane s/a 86 Po wywo/laniu interakcyjnym funkcji zadawane s/a
87 pytania o parametry przekodowania: nazw/e kodowania 87 pytania o parametry przekodowania: nazw/e kodowania
88 w tek/scie /xr/od/lowym i nazw/e kodowania docelowego. 88 w tek/scie /xr/od/lowym i nazw/e kodowania docelowego.
89 Poni/zsze przyk/lady powinny wyja/sni/c, jakich parametr/ow 89 Poni/zsze przyk/lady powinny wyja/sni/c, jakich parametr/ow
90 oczekuj/a wymienione funkcje: 90 oczekuj/a wymienione funkcje:
91 91
92 (ogonek-recode-region (poczatek-fragmentu) (koniec-fragmentu) 92 (ogonek-recode-region (poczatek-fragmentu) (koniec-fragmentu)
93 nazwa-kodowania-w-tekscie-zrodlowym nazwa-kodowania-docelowa) 93 nazwa-kodowania-w-tekscie-zrodlowym nazwa-kodowania-docelowa)
94 (ogonek-recode-buffer 94 (ogonek-recode-buffer
95 nazwa-kodowania-w-tekscie-zrodlowym nazwa-kodowania-docelowa) 95 nazwa-kodowania-w-tekscie-zrodlowym nazwa-kodowania-docelowa)
96 96
97 2. `ogonek-prefixify-region' oraz `ogonek-prefixify-buffer' 97 2. `ogonek-prefixify-region' oraz `ogonek-prefixify-buffer'
98 s/lu/z/a do wprowadzania notacji prefiksowej. 98 s/lu/z/a do wprowadzania notacji prefiksowej.
99 99
100 (ogonek-prefixify-region (poczatek-fragmentu) (koniec-fragmentu) 100 (ogonek-prefixify-region (poczatek-fragmentu) (koniec-fragmentu)
101 nazwa-kodowania-w-tekscie-zrodlowym znak-prefiksu) 101 nazwa-kodowania-w-tekscie-zrodlowym znak-prefiksu)
102 (ogonek-prefixify-buffer 102 (ogonek-prefixify-buffer
103 nazwa-kodowania-w-tekscie-zrodlowym znak-prefiksu) 103 nazwa-kodowania-w-tekscie-zrodlowym znak-prefiksu)
104 104
105 3. `ogonek-deprefixify-region' oraz `ogonek-deprefixify-buffer' 105 3. `ogonek-deprefixify-region' oraz `ogonek-deprefixify-buffer'
106 s/lu/z/a do usuwania notacji prefiksowej. 106 s/lu/z/a do usuwania notacji prefiksowej.
107 107
108 (ogonek-deprefixify-region (poczatek-fragmentu) (koniec-fragmentu) 108 (ogonek-deprefixify-region (poczatek-fragmentu) (koniec-fragmentu)
109 znak-prefiksu nazwa-kodowania-docelowa) 109 znak-prefiksu nazwa-kodowania-docelowa)
110 (ogonek-prefixify-buffer 110 (ogonek-prefixify-buffer
111 znak-prefiksu nazwa-kodowania-docelowa) 111 znak-prefiksu nazwa-kodowania-docelowa)
112 112
113 U/zycie klawisza TAB w trybie interakcyjnym powoduje wy/swietlenie 113 U/zycie klawisza TAB w trybie interakcyjnym powoduje wy/swietlenie
114 listy dopuszczalnych nazw kod/ow, pami/etanych w sta/lej 114 listy dopuszczalnych nazw kod/ow, pami/etanych w sta/lej
115 `ogonek-name-encoding-alist'. 115 `ogonek-name-encoding-alist'.
116 116
117 Funkcje biblioteki odwo/luj/a si/e do pi/eciu zmiennych, kt/ore 117 Funkcje biblioteki odwo/luj/a si/e do pi/eciu zmiennych, kt/ore
118 przechowuj/a podpowiedzi do zadawanych pyta/n. Nazwy tych zmiennych 118 przechowuj/a podpowiedzi do zadawanych pyta/n. Nazwy tych zmiennych
119 oraz ich warto/sci domy/slne s/a nast/epuj/ace: 119 oraz ich warto/sci domy/slne s/a nast/epuj/ace:
120 120
121 ogonek-from-encoding iso8859-2 121 ogonek-from-encoding iso8859-2
122 ogonek-to-encoding ascii 122 ogonek-to-encoding ascii
123 ogonek-prefix-char / 123 ogonek-prefix-char /
124 ogonek-prefix-from-encoding iso8859-2 124 ogonek-prefix-from-encoding iso8859-2
129 129
130 (setq ogonek-prefix-char ?/) 130 (setq ogonek-prefix-char ?/)
131 (setq ogonek-prefix-to-encoding \"iso8859-2\") 131 (setq ogonek-prefix-to-encoding \"iso8859-2\")
132 132
133 Zamiast wczytywania ca/lej biblioteki `ogonek.el' mo/zna w pliku 133 Zamiast wczytywania ca/lej biblioteki `ogonek.el' mo/zna w pliku
134 `~/.emacs' za/z/ada/c wczytania wybranych funkcji, na dodatek dopiero 134 `~/.emacs' za/z/ada/c wczytania wybranych funkcji, na dodatek dopiero
135 w chwili ich rzeczywistego u/zycia: 135 w chwili ich rzeczywistego u/zycia:
136 136
137 (autoload 'ogonek-jak \"ogonek\") 137 (autoload 'ogonek-jak \"ogonek\")
138 (autoload 'ogonek-recode-region \"ogonek\") 138 (autoload 'ogonek-recode-region \"ogonek\")
139 (autoload 'ogonek-prefixify-region \"ogonek\") 139 (autoload 'ogonek-prefixify-region \"ogonek\")
145 (defun deprefixify-iso8859-2-region (start end) 145 (defun deprefixify-iso8859-2-region (start end)
146 (interactive \"*r\") 146 (interactive \"*r\")
147 (ogonek-deprefixify-region start end ?/ \"iso8859-2\")) 147 (ogonek-deprefixify-region start end ?/ \"iso8859-2\"))
148 (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d 148 (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d
149 149
150 (defun mazovia-to-iso8859-2 (start end) 150 (defun mazovia-to-iso8859-2 (start end)
151 (interactive \"*r\") 151 (interactive \"*r\")
152 (ogonek-recode-region start end \"mazovia\" \"iso8859-2\")) 152 (ogonek-recode-region start end \"mazovia\" \"iso8859-2\"))
153 (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r 153 (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r
154 154
155 (defun prefixify-iso8859-2-region (start end) 155 (defun prefixify-iso8859-2-region (start end)
180 The library provides functions for changing the encoding of Polish 180 The library provides functions for changing the encoding of Polish
181 diacritic characters, the ones with an `ogonek' below or above them. 181 diacritic characters, the ones with an `ogonek' below or above them.
182 The functions come in the following groups. 182 The functions come in the following groups.
183 183
184 1. `ogonek-recode-region' and `ogonek-recode-buffer' to change 184 1. `ogonek-recode-region' and `ogonek-recode-buffer' to change
185 between one-character encodings, such as `iso-8859-2', `mazovia', 185 between one-character encodings, such as `iso-8859-2', `mazovia',
186 plain `ascii' or `TeX'. As the names suggest you may recode 186 plain `ascii' or `TeX'. As the names suggest you may recode
187 either the entire current buffer or just a marked region 187 either the entire current buffer or just a marked region
188 in it. You may use the functions interactively as commands. 188 in it. You may use the functions interactively as commands.
189 Once you call a command you will be asked about the code 189 Once you call a command you will be asked about the code
190 currently used in your text and the target encoding, the one 190 currently used in your text and the target encoding, the one
191 you want to get. The following example shows a non-interactive 191 you want to get. The following example shows a non-interactive
192 use of the functions in a program. This also illustrates what 192 use of the functions in a program. This also illustrates what
193 type of parameters the functions expect to be called with: 193 type of parameters the functions expect to be called with:
194 194
195 (ogonek-recode-region 195 (ogonek-recode-region
196 (region-beginning) (region-end) from-code-name to-code-name) 196 (region-beginning) (region-end) from-code-name to-code-name)
197 (ogonek-recode-buffer from-code-name to-code-name) 197 (ogonek-recode-buffer from-code-name to-code-name)
198 198
199 2. `ogonek-prefixify-region' and `ogonek-prefixify-buffer' for 199 2. `ogonek-prefixify-region' and `ogonek-prefixify-buffer' for
200 introducing prefix notation: 200 introducing prefix notation:
201 201
202 (ogonek-prefixify-region 202 (ogonek-prefixify-region
203 (region-beginning) (region-end) from-code-name prefix-char) 203 (region-beginning) (region-end) from-code-name prefix-char)
204 (ogonek-prefixify-buffer from-code-name prefix-char) 204 (ogonek-prefixify-buffer from-code-name prefix-char)
205 205
206 3. `ogonek-deprefixify-region' and `ogonek-deprefixify-buffer' for 206 3. `ogonek-deprefixify-region' and `ogonek-deprefixify-buffer' for
207 removing prefix notation: 207 removing prefix notation:
208 208
209 (ogonek-deprefixify-region 209 (ogonek-deprefixify-region
210 (region-beginning) (region-end) prefix-char to-code-name) 210 (region-beginning) (region-end) prefix-char to-code-name)
211 (ogonek-prefixify-buffer prefix-char to-code-name) 211 (ogonek-prefixify-buffer prefix-char to-code-name)
212 212
213 The TAB character used in interactive mode makes `emacs' 213 The TAB character used in interactive mode makes `emacs'
214 display the list of encodings recognized by the library. The list 214 display the list of encodings recognized by the library. The list
215 is stored in the constant `ogonek-name-encoding-alist'. 215 is stored in the constant `ogonek-name-encoding-alist'.
216 216
217 The `ogonek' functions refer to five variables in which the suggested 217 The `ogonek' functions refer to five variables in which the suggested
218 answers to dialogue questions are stored. The variables and their 218 answers to dialogue questions are stored. The variables and their
219 default values are: 219 default values are:
220 220
221 ogonek-from-encoding iso8859-2 221 ogonek-from-encoding iso8859-2
222 ogonek-to-encoding ascii 222 ogonek-to-encoding ascii
223 ogonek-prefix-char / 223 ogonek-prefix-char /
224 ogonek-prefix-from-encoding iso8859-2 224 ogonek-prefix-from-encoding iso8859-2
225 ogonek-prefix-to-encoding iso8859-2 225 ogonek-prefix-to-encoding iso8859-2
226 226
227 The above default values can be changed by placing appropriate settings 227 The above default values can be changed by placing appropriate settings
228 in the '~/.emacs' file: 228 in the '~/.emacs' file:
229 229
230 (setq ogonek-prefix-char ?/) 230 (setq ogonek-prefix-char ?/)
231 (setq ogonek-prefix-to-encoding \"iso8859-2\") 231 (setq ogonek-prefix-to-encoding \"iso8859-2\")
232 232
244 (defun deprefixify-iso8859-2-region (start end) 244 (defun deprefixify-iso8859-2-region (start end)
245 (interactive \"*r\") 245 (interactive \"*r\")
246 (ogonek-deprefixify-region start end ?/ \"iso8859-2\")) 246 (ogonek-deprefixify-region start end ?/ \"iso8859-2\"))
247 (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d 247 (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d
248 248
249 (defun mazovia-to-iso8859-2 (start end) 249 (defun mazovia-to-iso8859-2 (start end)
250 (interactive \"*r\") 250 (interactive \"*r\")
251 (ogonek-recode-region start end \"mazovia\" \"iso8859-2\")) 251 (ogonek-recode-region start end \"mazovia\" \"iso8859-2\"))
252 (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r 252 (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r
253 253
254 (defun prefixify-iso8859-2-region (start end) 254 (defun prefixify-iso8859-2-region (start end)
266 (switch-to-buffer " *ogonek-how*") 266 (switch-to-buffer " *ogonek-how*")
267 (beginning-of-buffer)) 267 (beginning-of-buffer))
268 268
269 ;; ---- Variables keeping the suggested answers to dialogue questions ----- 269 ;; ---- Variables keeping the suggested answers to dialogue questions -----
270 (defvar ogonek-encoding-choices 270 (defvar ogonek-encoding-choices
271 (cons 'choice 271 (cons 'choice
272 (mapcar (lambda (x) (list 'const (car x))) 272 (mapcar (lambda (x) (list 'const (car x)))
273 ogonek-name-encoding-alist)) 273 ogonek-name-encoding-alist))
274 "List of ogonek encodings. Used only for customization.") 274 "List of ogonek encodings. Used only for customization.")
275 (defcustom ogonek-from-encoding "iso8859-2" 275 (defcustom ogonek-from-encoding "iso8859-2"
276 "*Encoding in the source file of recoding." 276 "*Encoding in the source file of recoding."
297 297
298 (defun ogonek-read-encoding (prompt default-name-var) 298 (defun ogonek-read-encoding (prompt default-name-var)
299 "Read encoding name with completion based on `ogonek-name-encoding-alist'. 299 "Read encoding name with completion based on `ogonek-name-encoding-alist'.
300 Store the name in the parameter-variable DEFAULT-NAME-VAR. 300 Store the name in the parameter-variable DEFAULT-NAME-VAR.
301 PROMPT is a string to be shown when the user is asked for a name." 301 PROMPT is a string to be shown when the user is asked for a name."
302 (let ((encoding 302 (let ((encoding
303 (completing-read 303 (completing-read
304 (format "%s (default %s): " prompt (eval default-name-var)) 304 (format "%s (default %s): " prompt (eval default-name-var))
305 ogonek-name-encoding-alist nil t))) 305 ogonek-name-encoding-alist nil t)))
306 ;; change the default name to the one just read 306 ;; change the default name to the one just read
307 (set default-name-var 307 (set default-name-var
308 (if (string= encoding "") (eval default-name-var) encoding)) 308 (if (string= encoding "") (eval default-name-var) encoding))
309 ;; return the new default as the name you read 309 ;; return the new default as the name you read
310 (eval default-name-var))) 310 (eval default-name-var)))
311 311
312 (defun ogonek-read-prefix (prompt default-prefix-var) 312 (defun ogonek-read-prefix (prompt default-prefix-var)
313 "Read a prefix character for prefix notation. 313 "Read a prefix character for prefix notation.
314 The result is stored in the variable DEFAULT-PREFIX-VAR. 314 The result is stored in the variable DEFAULT-PREFIX-VAR.
315 PROMPT is a string to be shown when the user is asked for a new prefix." 315 PROMPT is a string to be shown when the user is asked for a new prefix."
316 (let ((prefix-string 316 (let ((prefix-string
317 (read-string 317 (read-string
318 (format "%s (default %s): " prompt 318 (format "%s (default %s): " prompt
319 (char-to-string (eval default-prefix-var)))))) 319 (char-to-string (eval default-prefix-var))))))
320 (if (> (length prefix-string) 1) 320 (if (> (length prefix-string) 1)
321 (error "! Only one character expected") 321 (error "! Only one character expected")
322 ;; set the default prefix character to the one just read 322 ;; set the default prefix character to the one just read
323 (set default-prefix-var 323 (set default-prefix-var
324 (if (string= prefix-string "") 324 (if (string= prefix-string "")
325 (eval default-prefix-var) 325 (eval default-prefix-var)
326 (string-to-char prefix-string))) 326 (string-to-char prefix-string)))
327 ;; the new default prefix is the function's result: 327 ;; the new default prefix is the function's result:
328 (eval default-prefix-var)))) 328 (eval default-prefix-var))))
329 329
330 (defun ogonek-lookup-encoding (encoding) 330 (defun ogonek-lookup-encoding (encoding)
331 "Pick up an association for ENCODING in `ogonek-name-encoding-alist'. 331 "Pick up an association for ENCODING in `ogonek-name-encoding-alist'.
332 Before returning a result test whether the string ENCODING is in 332 Before returning a result test whether the string ENCODING is in
333 the list `ogonek-name-encoding-alist'" 333 the list `ogonek-name-encoding-alist'"
334 (let ((code-list (assoc encoding ogonek-name-encoding-alist))) 334 (let ((code-list (assoc encoding ogonek-name-encoding-alist)))
335 (if (null code-list) 335 (if (null code-list)
336 (error "! Name `%s' not known in `ogonek-name-encoding-alist'" 336 (error "! Name `%s' not known in `ogonek-name-encoding-alist'"
337 encoding) 337 encoding)
338 (cdr code-list)))) 338 (cdr code-list))))
339 339
340 ;; ---- An auxiliary function for zipping two lists of equal length ---- 340 ;; ---- An auxiliary function for zipping two lists of equal length ----
341 341
342 (defun ogonek-zip-lists (xs ys) 342 (defun ogonek-zip-lists (xs ys)
343 "Build a list of pairs from lists XS and YS of the same length." 343 "Build a list of pairs from lists XS and YS of the same length."
344 (let ((pairs nil)) 344 (let ((pairs nil))
345 (while xs 345 (while xs
346 (setq pairs (cons (cons (car xs) (car ys)) pairs)) 346 (setq pairs (cons (cons (car xs) (car ys)) pairs))
347 (setq xs (cdr xs)) 347 (setq xs (cdr xs))
348 (setq ys (cdr ys))) 348 (setq ys (cdr ys)))
349 ;; `pairs' are the function's result 349 ;; `pairs' are the function's result
350 pairs)) 350 pairs))
351 351
352 ;; ---- An auxiliary function building a one-to-one recoding table ----- 352 ;; ---- An auxiliary function building a one-to-one recoding table -----
353 353
354 (defun ogonek-build-table (recoding-pairs) 354 (defun ogonek-build-table (recoding-pairs)
355 "Build a table required by Emacs's `translate-region' function. 355 "Build a table required by Emacs's `translate-region' function.
356 RECODING-PAIRS is a list of character pairs for which recoding 356 RECODING-PAIRS is a list of character pairs for which recoding
357 is not an identity. 357 is not an identity.
358 By using the built-in `translate-region' function 358 By using the built-in `translate-region' function
359 we gain better performance compared to converting characters 359 we gain better performance compared to converting characters
360 by a hand-written routine as it is done for prefix encodings." 360 by a hand-written routine as it is done for prefix encodings."
361 (let ((table (make-string 256 0)) 361 (let ((table (make-string 256 0))
362 (i 0)) 362 (i 0))
363 (while (< i 256) 363 (while (< i 256)
364 (aset table i i) 364 (aset table i i)
365 (setq i (1+ i))) 365 (setq i (1+ i)))
366 ;; make changes in `table' according to `recoding-pairs' 366 ;; make changes in `table' according to `recoding-pairs'
367 (while recoding-pairs 367 (while recoding-pairs
368 (aset table (car (car recoding-pairs)) (cdr (car recoding-pairs))) 368 (aset table (car (car recoding-pairs)) (cdr (car recoding-pairs)))
369 (setq recoding-pairs (cdr recoding-pairs))) 369 (setq recoding-pairs (cdr recoding-pairs)))
370 ;; return the table just built 370 ;; return the table just built
371 table)) 371 table))
372 372
373 ;; ---- Commands for one-to-one recoding ------------------------------- 373 ;; ---- Commands for one-to-one recoding -------------------------------
374 374
375 (defun ogonek-recode-region (start end from-encoding to-encoding) 375 (defun ogonek-recode-region (start end from-encoding to-encoding)
376 "Recode text in a marked region in one-to-one manner. 376 "Recode text in a marked region in one-to-one manner.
377 When called interactively ask the user for the names of the FROM- 377 When called interactively ask the user for the names of the FROM-
378 and TO- encodings." 378 and TO- encodings."
379 (interactive (progn (barf-if-buffer-read-only) 379 (interactive (progn (barf-if-buffer-read-only)
380 (list 380 (list
381 (region-beginning) 381 (region-beginning)
382 (region-end) 382 (region-end)
383 (ogonek-read-encoding "From code" 'ogonek-from-encoding) 383 (ogonek-read-encoding "From code" 'ogonek-from-encoding)
384 (ogonek-read-encoding "To code" 'ogonek-to-encoding)))) 384 (ogonek-read-encoding "To code" 'ogonek-to-encoding))))
385 (save-excursion 385 (save-excursion
386 (translate-region 386 (translate-region
387 start end 387 start end
388 (ogonek-build-table 388 (ogonek-build-table
389 (ogonek-zip-lists 389 (ogonek-zip-lists
390 (ogonek-lookup-encoding from-encoding) 390 (ogonek-lookup-encoding from-encoding)
391 (ogonek-lookup-encoding to-encoding)))))) 391 (ogonek-lookup-encoding to-encoding))))))
392 392
393 (defun ogonek-recode-buffer (from-encoding to-encoding) 393 (defun ogonek-recode-buffer (from-encoding to-encoding)
394 "Call `ogonek-recode-region' on the entire buffer. 394 "Call `ogonek-recode-region' on the entire buffer.
395 When called interactively ask the user for the names of the FROM- 395 When called interactively ask the user for the names of the FROM-
396 and TO- encodings." 396 and TO- encodings."
397 (interactive (progn (barf-if-buffer-read-only) 397 (interactive (progn (barf-if-buffer-read-only)
398 (list 398 (list
399 (ogonek-read-encoding "From code" 'ogonek-from-encoding) 399 (ogonek-read-encoding "From code" 'ogonek-from-encoding)
400 (ogonek-read-encoding "To code" 'ogonek-to-encoding)))) 400 (ogonek-read-encoding "To code" 'ogonek-to-encoding))))
401 (ogonek-recode-region 401 (ogonek-recode-region
402 (point-min) (point-max) from-encoding to-encoding)) 402 (point-min) (point-max) from-encoding to-encoding))
403 403
404 ;; ---- Recoding with prefix notation ------------------------------- 404 ;; ---- Recoding with prefix notation -------------------------------
405 405
406 (defconst ogonek-prefix-code '(?A ?C ?E ?L ?N ?O ?S ?X ?Z 406 (defconst ogonek-prefix-code '(?A ?C ?E ?L ?N ?O ?S ?X ?Z
407 ?a ?c ?e ?l ?n ?o ?s ?x ?z)) 407 ?a ?c ?e ?l ?n ?o ?s ?x ?z))
408 408
409 (defun ogonek-prefixify-region (start end from-encoding prefix-char) 409 (defun ogonek-prefixify-region (start end from-encoding prefix-char)
410 "In a region, replace FROM-encoded Polish characters with PREFIX pairs. 410 "In a region, replace FROM-encoded Polish characters with PREFIX pairs.
411 A PREFIX pair generated consists of PREFIX-CHAR and the respective 411 A PREFIX pair generated consists of PREFIX-CHAR and the respective
412 character listed in the `ogonek-prefix-code' constant. 412 character listed in the `ogonek-prefix-code' constant.
413 PREFIX-CHAR itself gets doubled." 413 PREFIX-CHAR itself gets doubled."
414 (interactive (progn (barf-if-buffer-read-only) 414 (interactive (progn (barf-if-buffer-read-only)
415 (list 415 (list
416 (region-beginning) 416 (region-beginning)
417 (region-end) 417 (region-end)
418 (ogonek-read-encoding "From code" 'ogonek-prefix-from-encoding) 418 (ogonek-read-encoding "From code" 'ogonek-prefix-from-encoding)
419 (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char)))) 419 (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char))))
420 (let* 420 (let*
421 ((from-code (ogonek-lookup-encoding from-encoding)) 421 ((from-code (ogonek-lookup-encoding from-encoding))
422 (to-code ogonek-prefix-code) 422 (to-code ogonek-prefix-code)
423 (recoding-pairs ; `ogonek-prefix-char' added for doubling 423 (recoding-pairs ; `ogonek-prefix-char' added for doubling
424 (ogonek-zip-lists 424 (ogonek-zip-lists
425 (cons prefix-char from-code) 425 (cons prefix-char from-code)
426 (cons prefix-char to-code)))) 426 (cons prefix-char to-code))))
427 (save-excursion 427 (save-excursion
428 (goto-char start) 428 (goto-char start)
429 (while (< (point) end) 429 (while (< (point) end)
430 (let ((pair (assoc (following-char) recoding-pairs))) 430 (let ((pair (assoc (following-char) recoding-pairs)))
439 (setq end (1+ end)))))))) 439 (setq end (1+ end))))))))
440 440
441 (defun ogonek-prefixify-buffer (from-encoding prefix-char) 441 (defun ogonek-prefixify-buffer (from-encoding prefix-char)
442 "Call `ogonek-prefixify-region' on the entire buffer." 442 "Call `ogonek-prefixify-region' on the entire buffer."
443 (interactive (progn (barf-if-buffer-read-only) 443 (interactive (progn (barf-if-buffer-read-only)
444 (list 444 (list
445 (ogonek-read-encoding "From code" 'ogonek-prefix-from-encoding) 445 (ogonek-read-encoding "From code" 'ogonek-prefix-from-encoding)
446 (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char)))) 446 (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char))))
447 (ogonek-prefixify-region 447 (ogonek-prefixify-region
448 (point-min) (point-max) from-encoding prefix-char)) 448 (point-min) (point-max) from-encoding prefix-char))
449 449
450 (defun ogonek-deprefixify-region (start end prefix-char to-encoding) 450 (defun ogonek-deprefixify-region (start end prefix-char to-encoding)
451 "In a region, replace PREFIX pairs with their corresponding TO-encodings. 451 "In a region, replace PREFIX pairs with their corresponding TO-encodings.
452 PREFIX-CHAR followed by a Polish character from the `ogonek-prefix-code' 452 PREFIX-CHAR followed by a Polish character from the `ogonek-prefix-code'
453 list is replaced with the corresponding TO-encoded character. A doubled 453 list is replaced with the corresponding TO-encoded character. A doubled
454 PREFIX-CHAR gets replaced with a single one. A combination of PREFIX-CHAR 454 PREFIX-CHAR gets replaced with a single one. A combination of PREFIX-CHAR
455 followed by a non-Polish character, that is one not listed in the 455 followed by a non-Polish character, that is one not listed in the
456 `ogonek-prefix-code' constant, is left unchanged." 456 `ogonek-prefix-code' constant, is left unchanged."
457 (interactive (progn (barf-if-buffer-read-only) 457 (interactive (progn (barf-if-buffer-read-only)
458 (list (region-beginning) 458 (list (region-beginning)
459 (region-end) 459 (region-end)
460 (ogonek-read-prefix 460 (ogonek-read-prefix
461 "Prefix character" 'ogonek-prefix-char) 461 "Prefix character" 'ogonek-prefix-char)
462 (ogonek-read-encoding 462 (ogonek-read-encoding
463 "To code" 'ogonek-prefix-to-encoding)))) 463 "To code" 'ogonek-prefix-to-encoding))))
464 (let* 464 (let*
465 ((from-code ogonek-prefix-code) 465 ((from-code ogonek-prefix-code)
466 (to-code (ogonek-lookup-encoding to-encoding)) 466 (to-code (ogonek-lookup-encoding to-encoding))
467 (recoding-pairs 467 (recoding-pairs
468 (ogonek-zip-lists 468 (ogonek-zip-lists
469 (cons prefix-char from-code) 469 (cons prefix-char from-code)
470 (cons prefix-char to-code)))) 470 (cons prefix-char to-code))))
471 (save-excursion 471 (save-excursion
472 (goto-char start) 472 (goto-char start)
473 (while (< (point) end) 473 (while (< (point) end)
474 (forward-char 1) 474 (forward-char 1)
475 (if (or (not (= (preceding-char) prefix-char)) (= (point) end)) 475 (if (or (not (= (preceding-char) prefix-char)) (= (point) end))
476 ;; non-prefix character or the end-of-region -- do nothing 476 ;; non-prefix character or the end-of-region -- do nothing
477 () 477 ()
478 ;; now, we can check the next character 478 ;; now, we can check the next character
479 (let ((pair (assoc (following-char) recoding-pairs))) 479 (let ((pair (assoc (following-char) recoding-pairs)))
480 (if (null pair) 480 (if (null pair)
481 ;; `following-char' is not a Polish character nor it is 481 ;; `following-char' is not a Polish character nor it is
482 ;; `prefix-char' since the one is among `recoding-pairs' 482 ;; `prefix-char' since the one is among `recoding-pairs'
483 (forward-char 1) 483 (forward-char 1)
484 ;; else prefix followed by a Polish character has been found 484 ;; else prefix followed by a Polish character has been found
485 ;; replace it by the corresponding Polish character 485 ;; replace it by the corresponding Polish character
486 (backward-char 1) 486 (backward-char 1)
487 (delete-char 2) 487 (delete-char 2)
488 (insert (cdr pair)) 488 (insert (cdr pair))
490 (setq end (1- end))))))))) 490 (setq end (1- end)))))))))
491 491
492 (defun ogonek-deprefixify-buffer (prefix-char to-encoding) 492 (defun ogonek-deprefixify-buffer (prefix-char to-encoding)
493 "Call `ogonek-deprefixify-region' on the entire buffer." 493 "Call `ogonek-deprefixify-region' on the entire buffer."
494 (interactive (progn (barf-if-buffer-read-only) 494 (interactive (progn (barf-if-buffer-read-only)
495 (list 495 (list
496 (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char) 496 (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char)
497 (ogonek-read-encoding "To code" 'ogonek-prefix-to-encoding)))) 497 (ogonek-read-encoding "To code" 'ogonek-prefix-to-encoding))))
498 (ogonek-deprefixify-region 498 (ogonek-deprefixify-region
499 (point-min) (point-max) prefix-char to-encoding)) 499 (point-min) (point-max) prefix-char to-encoding))
500 500
501 (provide 'ogonek) 501 (provide 'ogonek)
502 502
503 ;;; ogonek.el ends here 503 ;;; ogonek.el ends here