cgit.sxemacs.org Git - packages/blob - mule-packages/latin-euro-standards/latin-euro-latin7.el

   1 ;;; latin-euro-latin7.el --- Define language environment -*- coding: iso-2022-7 -*-
   2
   3 ;; Copyright (C) 2002 Free Software Foundation, Inc
   4
   5 ;; Author: Stephen J. Turnbull
   6 ;; Keywords: mule, charsets
   7 ;; Created: 2002 March 7 (as latin-unity-latin7.el)
   8 ;; Last-modified: 2005 February 7
   9
  10 ;; This file is part of XEmacs.
  11
  12 ;; XEmacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XEmacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27
  28 ;;; Commentary:
  29
  30 ;; Provides the latin-7 language environment, character set, and coding
  31 ;; system.
  32
  33 ;;; Code:
  34
  35 (defvar latin-euro-recognize-safe-charsets
  36   (condition-case nil
  37       (progn
  38         (coding-system-property (find-coding-system 'iso-8859-1-unix)
  39                                 'safe-charsets)
  40         t)
  41     (error nil))
  42   "t if this XEmacs understands the `safe-charsets' coding-system property.")
  43
  44 ;; define ISO-8859-13 for XEmacs 21.4 and earlier
  45 (unless (find-charset 'latin-iso8859-13)
  46   ;; Create character set
  47   (make-charset
  48    'latin-iso8859-13 "ISO8859-13 (Latin 7)"
  49    '(short-name "Latin-7"
  50      long-name "ISO8859-13 (Latin 7)"
  51      registry "iso8859-13"
  52      dimension 1
  53      columns 1
  54      chars 96
  55      final ?Y
  56      graphic 1
  57      direction l2r))
  58
  59   ;; For syntax of Latin-7 characters.
  60   (loop for c from 64 to 127            ; from '\e,A@\e(B' to '\e,A\7f\e(B'
  61     do (modify-syntax-entry (make-char 'latin-iso8859-13 c) "w"))
  62   (loop for c in '(#xA8 #xAA #xAF #xB8 #xBA #xBF)
  63     do (modify-syntax-entry (make-char 'latin-iso8859-13 c) "w"))
  64   (modify-syntax-entry (make-char 'latin-iso8859-13 32) "w") ; no-break space
  65   (modify-syntax-entry (make-char 'latin-iso8859-13 87) "_") ; multiply
  66   (modify-syntax-entry (make-char 'latin-iso8859-13 119) "_") ; divide
  67   (modify-syntax-entry (make-char 'latin-iso8859-13 127) ".")) ; right squote
  68
  69 (let ((table (standard-case-table)))
  70   (mapc (lambda (pair)
  71           (put-case-table-pair (make-char 'latin-iso8859-13 (car pair))
  72                                (make-char 'latin-iso8859-13 (cdr pair))
  73                                table))
  74         '((#xA8 . #xB8) (#xAA . #xBA) (#xAF . #xBF)))
  75   (let ((i #xC0))
  76     (while (< i #xDF)
  77       (unless (= i #xD7)
  78         (put-case-table-pair (make-char 'latin-iso8859-13 i)
  79                              (make-char 'latin-iso8859-13 (+ i #x20))
  80                              table))
  81       (setq i (1+ i)))))
  82
  83 (unless (find-coding-system 'iso-8859-13)
  84   ;; Create coding system
  85   (make-coding-system
  86    'iso-8859-13 'iso2022 "MIME ISO-8859-13"
  87    `(charset-g0 ascii
  88      charset-g1 latin-iso8859-13
  89      charset-g2 t                       ; grrr
  90      charset-g3 t                       ; grrr
  91      mnemonic "MIME/Ltn-7"
  92      ,@(if latin-euro-recognize-safe-charsets
  93            '(safe-charsets (ascii control-1 latin-iso8859-13))))))
  94
  95 (unless (assoc "Latin-7" language-info-alist)
  96   (defun setup-latin7-environment ()
  97     "Set up multilingual environment (MULE) for Baltic Rim Latin-7 users."
  98     (interactive)
  99     (set-language-environment "Latin-7"))
 100
 101   (set-language-info-alist "Latin-7"
 102                            `((charset ascii latin-iso8859-13)
 103                              (coding-system iso-8859-13)
 104                              (coding-priority iso-8859-13)
 105                              (input-method . "latin-7-prefix")
 106                              (sample-text . ,(format "\
 107 Hello, Hej, Tere, Hei, Bonjour, Gr%c%c Gott, Ciao, %cHola!"
 108                                                      ;; SMALL U WITH UMLAUT
 109                                                      (make-char
 110                                                       'latin-iso8859-13 #x7C)
 111                                                      ;; GERMAN SHARP S
 112                                                      (make-char
 113                                                       'latin-iso8859-13 #x5F)
 114                                                      ;; INVERTED EXCLAMATION
 115                                                      ;; MARK
 116                                                      (make-char
 117                                                       'latin-iso8859-13 #x21)))
 118                              (documentation . "\
 119 This is a generic language environment for Latin-7 (ISO-8859-13).  It
 120 supports the Baltic Rim languages."))
 121                            '("Baltic Rim")))
 122
 123 (provide 'latin-euro-latin7)
 124
 125 ;;; end of latin-euro-latin7.el