code.delx.au - gnu-emacs/blob - lisp/international/ogonek.el

   1 ;;; ogonek.el --- basic editing commands for Emacs
   2
   3 ;; Copyright (C) 1997 Free Software Foundation, Inc.
   4
   5 ;; Author: W{\l}odek Bzyl, Ryszard Kubiak
   6 ;; Maintainer: rysiek@ipipan.gda.pl (Ryszard Kubiak)
   7 ;; Keywords: i18n
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; To use this library load it using
  29 ;;                 M-x load-library [enter] ogonek
  30 ;;              Then, you may get a short info by calling one of
  31 ;;                 M-x ogonek-jak        -- in Polish
  32 ;;                 M-x ogonek-how        -- in English  "
  33
  34 (defconst ogonek-name-encoding-alist
  35   '(("ascii"      . (?A  ?C  ?E  ?L  ?N  ?O  ?S  ?Z  ?Z
  36                      ?a  ?c  ?e  ?l  ?n  ?o  ?s  ?z  ?z))
  37     ("iso8859-2"  . (161 198 202 163 209 211 166 172 175
  38                      177 230 234 179 241 243 182 188 191))
  39     ("mazovia"    . (143 149 144 156 165 163 152 160 161
  40                      134 141 145 146 164 162 158 166 167))
  41     ("windows-EE" . (165 198 202 163 209 211 140 143 175
  42                      185 230 234 179 241 243 156 159 191))
  43     ("windows-PL" . (165 198 202 163 209 211 140 143 175
  44                      185 230 234 179 241 243 156 159 191))
  45     ("latin-2"    . (164 143 168 157 227 224 151 141 189
  46                      165 134 169 136 228 162 152 171 190))
  47     ("CP852"      . (164 143 168 157 227 224 151 141 189
  48                      165 134 169 136 228 162 152 171 190))
  49     ("MeX"        . (129 130 134 138 139 211 145 153 155
  50                      161 162 166 170 171 243 177 185 187))
  51     ("CorelDraw"  . (197 242 201 163 209 211 255 225 237
  52                      229 236 230 198 241 243 165 170 186))
  53     ("Amiga"      . (194 202 203 206 207 211 212 218 219
  54                      226 234 235 238 239 243 244 250 251))
  55     ("Mac"        . (132 140 162 252 193 238 229 143 251
  56                      136 141 171 184 196 151 230 144 253))
  57  )
  58   "The constant `ogonek-name-encoding-alist' is a list of (NAME.LIST) pairs.
  59 Each LIST contains codes for 18 Polish diacritic characters.
  60 The codes are given in the following order:
  61   Aogonek Cacute Eogonek Lslash Nacute Oacute Sacute Zacute Zdotaccent
  62   aogonek cacute eogonek lslash nacute oacute sacute zacute zdotaccent.")
  63
  64 ; ------ A Little Info in Polish ---------------
  65
  66 (defconst ogonek-informacja
  67   "   FUNKCJE INTERAKCYJNE UDOST/EPNIANE PRZEZ BIBLIOTEK/E `ogonek'
  68
  69 Je/sli czytasz ten tekst, to albo przegl/adasz plik /zr/od/lowy
  70 biblioteki `ogonek.el', albo wywo/la/le/s polecenie `ogonek-jak'.
  71 W drugim przypadku mo/zesz usun/a/c tekst z ekranu, stosuj/ac
  72 polecenie `M-x kill-buffer'.
  73
  74 Niniejsza bibliteka dostarcza funkcji do zmiany kodowania polskich
  75 znak/ow diakrytycznych. Funkcje te mo/zna pogrupowa/c nast/epuj/aco.
  76
  77  1. Funkcje `ogonek-recode-region' oraz `ogonek-recode-buffer'
  78     przekodowu/j/a zaznaczony fragment wzgl/ednie ca/ly buffor.
  79     Po wywo/laniu interakcyjnym funkcji zadawane s/a
  80     pytania o parametry przekodowania, czyli o nazw/e kodowania
  81     w tek/scie /zr/od/lowym i nazw/e kodowania docelowego.
  82     Poni/zsze przyk/lady pokazuj/a, jakich parametr/ow
  83     oczekuj/a wymienione funkcje:
  84
  85       (ogonek-recode-region (poczatek) (koniec)
  86          nazwa-kodowania-w-tekscie-zrodlowym nazwa-kodowania-docelowa)
  87       (ogonek-recode-buffer
  88          nazwa-kodowania-w-tekscie-zrodlowym nazwa-kodowania-docelowa)
  89
  90  2. Funkcje `ogonek-prefixify-region' oraz `ogonek-prefixify-buffer'
  91     do wprowadzania notacji prefiksowej.
  92
  93       (ogonek-prefixify-region (poczatek) (koniec)
  94          nazwa-kodowania-w-tekscie-zrodlowym znak-prefiksu)
  95       (ogonek-prefixify-buffer
  96          nazwa-kodowania-w-tekscie-zrodlowym znak-prefiksu)
  97
  98  3. Funkcje `ogonek-deprefixify-region' oraz `ogonek-deprefixify-buffer'
  99     do usuwania notacji prefiksowej.
 100
 101       (ogonek-deprefixify-region (poczatek) (koniec)
 102          znak-prefiksu nazwa-kodowania-docelowa)
 103       (ogonek-prefixify-buffer
 104          znak-prefiksu nazwa-kodowania-docelowa)
 105
 106  U/zycie klawisza TAB w trybie interakcyjnym powoduje wy/swietlenie
 107  listy dopuszczalnych nazw kod/ow, odczytywanych ze sta/lej
 108  `ogonek-name-encoding-alist'.
 109
 110  Funkcje biblioteki odwo/luj/a si/e do pi/eciu zmiennych, kt/ore
 111  przechowuj/a podpowiedzi do zadawanych pyta/n. Nazwy tych zmiennych
 112  oraz ich warto/sci domy/slne s/a nast/epuj/ace:
 113
 114    ogonek-from-encoding           iso8859-2
 115    ogonek-to-encoding             mazovia
 116    ogonek-prefix-char              /
 117    ogonek-prefix-from-encoding    iso8859-2
 118    ogonek-prefix-to-encoding      iso8859-2
 119
 120  Powy/zsze warto/sci domy/slne mo/zna zmieni/c przez umieszczenie w pliku
 121  konfiguracyjnym `~/.emacs' odpowiednich przypisa/n, na przyk/lad:
 122
 123  (setq ogonek-prefix-char ?/)
 124  (setq ogonek-prefix-to-encoding \"iso8859-2\")
 125
 126  Zamiast wczytywania ca/lej biblioteki `ogonek.el' mo/zna w pliku
 127  `~/.emacs' za/z/ada/c wczytania wybranych funkcji i to dopiero w
 128  chwili ich wywo/lania:
 129
 130  (autoload 'ogonek-jak \"ogonek\")
 131  (autoload 'ogonek-recode-region \"ogonek\")
 132  (autoload 'ogonek-prefixify-region \"ogonek\")
 133  (autoload 'ogonek-deprefixify-region \"ogonek\")
 134
 135  Cz/esto wyst/epuj/ace kombinacje wywo/la/n funkcji mo/zna dla wygody
 136  skr/oci/c i przypisa/c klawiszom. Oto praktyczne przyk/lady:
 137
 138  (defun deprefixify-iso8859-2-region ()
 139    (interactive \"*\")
 140    (ogonek-deprefixify-region
 141     (region-beginning) (region-end) ?/ \"iso8859-2\"))
 142  (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d
 143
 144  (defun mazovia-to-iso8859-2 ()
 145    (interactive \"*\")
 146    (ogonek-recode-region \"mazovia\" \"iso8859-2\"))
 147  (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r
 148
 149  (defun prefixify-iso8859-2-region ()
 150    (interactive \"*\")
 151    (ogonek-prefixify-region
 152     (region-beginning) (region-end) \"iso8859-2\" ?/))
 153  (global-set-key \"\\C-cp\" 'prefixify-iso8859-2-region) ; ctrl-c p
 154
 155  Ka/zd/a operacj/e przekodowania mo/zna w ca/lo/sci odwo/la/c
 156  przez wykonanie polecenia `undo'.")
 157
 158 (defun ogonek-jak ()
 159   "Display the string constant `ogonek-informacja'
 160 by inserting it into an auxiliary *ogonek-jak* buffer."
 161   (interactive)
 162   (set-buffer  (get-buffer-create " *ogonek-jak*"))
 163   (insert ogonek-informacja)
 164   (switch-to-buffer " *ogonek-jak*")
 165   (beginning-of-buffer))
 166
 167 ; ------ A Little Info in English --------
 168
 169 (defconst ogonek-information
 170   "   INTERACTIVE FUNCTIONS PROVIDED BY THE LIBRARY `ogonek'.
 171
 172 If you read this text then you are either looking at the library's
 173 source text or you have called the `ogonek-howto' command. In the
 174 latter case you may remove this text using `M-x kill-buffer'.
 175
 176 The library provides functions for changing the encoding of Polish
 177 diacritic characters, the ones with an `ogonek' below or above them.
 178 The functions come in the following gropus.
 179
 180  1. Functions `ogonek-recode-region' and `ogonek-recode-buffer' to
 181     change between one-character encodings, such as `iso-8859-2',
 182     `mazovia', plain `ascii' or `TeX'. As the names suggest you may
 183     recode either the entire current buffer or just a marked region
 184     of it. You may use these functions interactively as commands. Once
 185     you call a command you will be asked about the code used in
 186     the source text and the target encoding, the one you want to get.
 187     The following examples show a non-interactive use of the functions
 188     in a program. They also illustrtate what parameters the functions
 189     expect:
 190
 191       (ogonek-recode-region (region-beginning) (region-end)
 192                                 from-code-name to-code-name)
 193       (ogonek-recode-buffer from-code-name to-code-name)
 194
 195  2. Functions `ogonek-prefixify-region' and `ogonek-prefixify-buffer'.
 196     for introducing prefix notation:
 197
 198       (ogonek-prefixify-region (region-beginning) (region-end)
 199                                      from-code-name prefix-char)
 200       (ogonek-prefixify-buffer from-code-name prefix-char)
 201
 202  3. Functions  `ogonek-deprefixify-region' and `ogonek-deprefixify-buffer'
 203     for removing prefix notation:
 204
 205       (ogonek-deprefixify-region (region-beginning) (region-end)
 206                                    prefix-char to-code-name)
 207       (ogonek-prefixify-buffer prefix-char to-code-name)
 208
 209  The use of the TAB character in interactive makes `emacs' display
 210  the list of encodings recognized by the library - the code names
 211  are stored in the constant  `ogonek-name-encoding-alist'
 212
 213  The functions of the library refer to five variables that keep
 214  hints to the questions asked. The names of those variables as well
 215  as their default values are:
 216
 217    ogonek-from-encoding           iso8859-2
 218    ogonek-to-encoding             mazovia
 219    ogonek-prefix-char              /
 220    ogonek-prefix-from-encoding    iso8859-2
 221    ogonek-prefix-to-encoding      iso8859-2
 222
 223  The above default values can be changed by placing appropriate settings
 224  in the '~/.emacs' file:
 225
 226  (setq ogonek-prefix-char ?/)
 227  (setq ogonek-prefix-to-encoding \"iso8859-2\")
 228
 229  Instead of loading the whole library `ogonek.el' it may be better to
 230  autoload chosen functions in `~/.emacs':
 231
 232  (autoload 'ogonek-jak \"ogonek\")
 233  (autoload 'ogonek-recode-region \"ogonek\")
 234  (autoload 'ogonek-prefixify-region \"ogonek\")
 235  (autoload 'ogonek-deprefixify-region \"ogonek\")
 236
 237  The most frequent function calls can be abbreviated and assigned to
 238  keyboard keys. Here are a few practical examples:
 239
 240  (setq ogonek-from-code-name \"iso8859-2\")
 241  (setq ogonek-to-code-name \"mazovia\")
 242  (setq ogonek-prefix-char ?/)
 243  (setq ogonek-prefix-from-code-name \"iso8859-2\")
 244  (setq ogonek-prefix-to-code-name \"iso8859-2\")
 245
 246  (defun deprefixify-iso8859-2-region ()
 247    (interactive \"*\")
 248    (ogonek-deprefixify-region
 249     (region-beginning) (region-end) ?/ \"iso8859-2\"))
 250  (global-set-key \"\\C-cd\" 'deprefixify-iso8859-2-region) ; ctrl-c d
 251
 252  (defun mazovia-to-iso8859-2 ()
 253    (interactive \"*\")
 254    (ogonek-recode-region \"mazovia\" \"iso8859-2\"))
 255  (global-set-key \"\\C-cr\" 'mazovia-to-iso8859-2) ; ctrl-c r
 256
 257  (defun prefixify-iso8859-2-region ()
 258    (interactive \"*\")
 259    (ogonek-prefixify-region
 260     (region-beginning) (region-end) \"iso8859-2\" ?/))
 261  (global-set-key \"\\C-cp\" 'prefixify-iso8859-2-region) ; ctrl-c p
 262
 263  Each recoding opertation can be called off by executing the `undo'
 264  command.")
 265
 266 (defun ogonek-how ()
 267   "Display the string constant `ogonek-information'
 268 by inserting it into an auxiliary *recode-help* buffer."
 269   (interactive "*")
 270   (set-buffer  (get-buffer-create " *ogonek-help*"))
 271   (insert ogonek-information)
 272   (switch-to-buffer " *ogonek-help*")
 273   (beginning-of-buffer))
 274
 275 ;; ------ Variables for keeping hints to the questions ---------
 276
 277 (defvar ogonek-from-encoding "iso8859-2"
 278   "*Encoding in the source file of recoding.")
 279 (defvar ogonek-to-encoding "ascii"
 280   "*Encoding in the target file of recoding.")
 281 (defvar ogonek-prefix-char ?/
 282   "*Prefix character for prefix encodings.")
 283 (defvar ogonek-prefix-from-encoding "iso8859-2"
 284   "*Encoding in the source file subject to prefixifation.")
 285 (defvar ogonek-prefix-to-encoding "iso8859-2"
 286   "*Encoding in the target file subject to deprefixifation.")
 287
 288 ;; ------- Utilities for reading function parameters -------------
 289
 290 (defun ogonek-read-encoding (prompt default-name-var)
 291   "Change with completion based on alist `ogonek-name-encoding-alist'."
 292  (let ((encoding
 293         (completing-read
 294          (format "%s (default %s): " prompt (eval default-name-var))
 295          ogonek-name-encoding-alist nil t)))
 296   ; set the new default name to be the one just read
 297    (set default-name-var
 298        (if (string= encoding "") (eval default-name-var) encoding))
 299   ; return the new default as the name you read
 300   (eval default-name-var)))
 301
 302 (defun ogonek-read-prefix (prompt default-prefix-var)
 303   "Change prefix."
 304   (let ((prefix-string
 305          (read-string
 306           (format "%s (default %s): " prompt
 307                   (char-to-string (eval default-prefix-var))))))
 308     (if (> (length prefix-string) 1)
 309         (error "! Only one character expected.")
 310       ; set the default prefix character to the one just read
 311       (set default-prefix-var
 312            (if (string= prefix-string "")
 313              (eval default-prefix-var)
 314            (string-to-char prefix-string)))
 315       ; return the new default prefix as the code you read)
 316       (eval default-prefix-var))))
 317
 318 (defun ogonek-lookup-encoding (encoding)
 319   "Pick up an association for `encoding' in `ogonek-name-encoding-alist'.
 320 Before returning a result test whether it has been properly set
 321 which should be true if the encoding is one of those in
 322 `ogonek-name-encoding-alist'"
 323   (let ((code-list (assoc encoding ogonek-name-encoding-alist)))
 324     (if (null code-list)
 325       (error "! Name `%s' not known in `ogonek-name-encoding-alist'."
 326                encoding)
 327       (cdr code-list))))
 328
 329 ; -------  A utility for zipping two lists -----------
 330
 331 (defun ogonek-zip-lists (xs ys)
 332   "Build a list of pairs with elements from lists `xs' and `ys'.
 333 We assume that `xs' and `ys' are of the same length."
 334   (let ((pairs nil))
 335     (while xs
 336       (setq pairs (cons (cons (car xs) (car ys)) pairs))
 337       (setq xs (cdr xs))
 338       (setq ys (cdr ys)))
 339 ;   `pairs' are the function's result
 340     pairs))
 341
 342 ; -------- Dealing with one-character cencodings -------
 343
 344 (defun ogonek-build-table (recoding-pairs)
 345   "Build a table nedeed by emacs's `translate-region' function.
 346 The  `recoding-pairs' argument is a list of pairs of characters.
 347 By using the built-in `translate-region' function
 348 we gain better performance compared to converting characters
 349 by a hand-written routine as it is done for prefix encodings."
 350   (let ((table (make-string 256 0))
 351         (i 0))
 352     (while (< i 256)
 353       (aset table i i)
 354       (setq i (1+ i)))
 355     ; make changes in `table' according to `recoding-pairs'
 356     (while recoding-pairs
 357       (aset table (car (car recoding-pairs)) (cdr (car recoding-pairs)))
 358       (setq recoding-pairs (cdr recoding-pairs)))
 359     ; return the table just built
 360     table))
 361
 362 (defun ogonek-recode-region (start end from-encoding to-encoding)
 363   "This function recodes text in a region delineated by the current-mark
 364 and the current point according to the defaults set by the variables
 365 `ogonek-from-encoding' and `ogonek-to-encoding'."
 366   (interactive (progn (barf-if-buffer-read-only)
 367                 (list
 368                 (region-beginning)
 369                 (region-end)
 370                 (ogonek-read-encoding "From code" 'ogonek-from-encoding)
 371                 (ogonek-read-encoding "To code" 'ogonek-to-encoding))))
 372   (save-excursion
 373     (translate-region
 374      start end
 375      (ogonek-build-table
 376       (ogonek-zip-lists
 377        (ogonek-lookup-encoding from-encoding)
 378        (ogonek-lookup-encoding to-encoding))))))
 379
 380 (defun ogonek-recode-buffer (from-encoding to-encoding)
 381   "Call `ogonek-region' on the entire buffer."
 382   (interactive (progn (barf-if-buffer-read-only)
 383                 (list
 384                 (ogonek-read-encoding "From code" 'ogonek-from-encoding)
 385                 (ogonek-read-encoding "To code" 'ogonek-to-encoding))))
 386   (ogonek-recode-region
 387    (point-min) (point-max) from-encoding to-encoding))
 388
 389 ; --------------------------------
 390 ; Recoding with prefix notation
 391 ; --------------------------------
 392
 393 (defconst prefix-code '(?A  ?C  ?E  ?L  ?N  ?O  ?S  ?X  ?Z
 394                         ?a  ?c  ?e  ?l  ?n  ?o  ?s  ?x  ?z))
 395
 396 (defun ogonek-prefixify-region (start end from-encoding prefix-char)
 397   "Replace -- in the region delineated by the current-mark
 398 and the point -- each character from `ogonek-from-encoding'
 399 by two characters: `ogonek-prefix-char' and the corresponding
 400 character from the `prefix' list. Double the character
 401 `ogonek-prefix-char'"
 402   (interactive (progn (barf-if-buffer-read-only)
 403     (list
 404     (region-beginning)
 405     (region-end)
 406     (ogonek-read-encoding "From code" 'ogonek-prefix-from-encoding)
 407     (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char))))
 408   (let*
 409       ((from-code (ogonek-lookup-encoding from-encoding))
 410        (to-code prefix-code)
 411        (recoding-pairs  ; we add `ogonek-prefix-char' for doubling
 412         (ogonek-zip-lists
 413          (cons prefix-char from-code)
 414          (cons prefix-char to-code))))
 415     (save-excursion
 416       (goto-char start)
 417       (while (< (point) end)
 418         (let ((pair (assoc (following-char) recoding-pairs)))
 419           (if (null pair)
 420               ; not a Polish character -- skip it
 421               (forward-char 1)
 422             ; Polish character -- replace it by a two characters
 423             (delete-char 1)
 424             (insert ogonek-prefix-char)
 425             (insert (cdr pair))
 426             ; the region is now one character longer
 427             (setq end (1+ end))))))))
 428
 429 (defun ogonek-prefixify-buffer (from-encoding prefix-char)
 430   "Call `ogonek-prefixify-region' on the entire buffer."
 431   (interactive (progn (barf-if-buffer-read-only)
 432     (list
 433      (ogonek-read-encoding "From code" 'ogonek-prefix-from-encoding)
 434      (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char))))
 435   (ogonek-prefixify-region
 436    (point-min) (point-max) from-encoding prefix-char))
 437
 438 (defun ogonek-deprefixify-region (start end prefix-char to-encoding)
 439   "Replace `ogonek-prefix-char' followed by a character from
 440 the `prefix' list or another `ogonek-prefix-char' by
 441 the corresponding character from `ogonek-from-encoding'
 442 or by one `ogonek-prefix-char'."
 443   (interactive (progn (barf-if-buffer-read-only)
 444                 (list (region-beginning)
 445                       (region-end)
 446                       (ogonek-read-prefix
 447                         "Prefix character" 'ogonek-prefix-char)
 448                       (ogonek-read-encoding
 449                        "To code" 'ogonek-prefix-to-encoding))))
 450   (let*
 451       ((from-code prefix-code)
 452        (to-code (ogonek-lookup-encoding to-encoding))
 453        (recoding-pairs
 454         (ogonek-zip-lists
 455           (cons prefix-char from-code)
 456           (cons prefix-char to-code))))
 457     (save-excursion
 458       (goto-char start)
 459       (while (< (point) end)
 460         (forward-char 1)
 461        (if (or (not (= (preceding-char) prefix-char)) (= (point) end))
 462            ; non-prefix character or the end-of-region -- do nothing
 463            ()
 464          ; now, we can check the next character
 465          (let ((pair (assoc (following-char) recoding-pairs)))
 466            (if (null pair)
 467                ; `following-char' is not a Polish character nor it is
 468                ;  `prefix-char' since the one is among `recoding-pairs'
 469                (forward-char 1)
 470            ; else prefix followed by a Polish character has been found
 471            ; replace it by the corresponding Polish character
 472            (backward-char 1)
 473            (delete-char 2)
 474            (insert (cdr pair))
 475            ; the region got shorter by one character
 476            (setq end (1- end)))))))))
 477
 478 (defun ogonek-deprefixify-buffer (prefix-char to-encoding)
 479   "Call `ogonek-deprefixify-region' on the entire buffer."
 480   (interactive (progn (barf-if-buffer-read-only)
 481     (list
 482      (ogonek-read-prefix "Prefix character" 'ogonek-prefix-char)
 483      (ogonek-read-encoding "To code" 'ogonek-prefix-to-encoding))))
 484   (ogonek-deprefixify-region
 485    (point-min) (point-max) prefix-char to-encoding))
 486
 487 (provide 'ogonek)
 488
 489 ;;; ogonek.el ends here