lisp/language/misc-lang.el

   1 ;;; misc-lang.el --- support for miscellaneous languages (characters)
   2
   3 ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007, 2008, 2009, 2010, 2011
   5 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
   6 ;;   Registration Number H14PRO021
   7
   8 ;; Keywords: multilingual, character set, coding system
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs 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 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs 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 GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  30 ;;; IPA (International Phonetic Alphabet)
  31 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32
  33 (set-language-info-alist
  34  "IPA" '((charset . (ipa))
  35          (coding-priority utf-8)
  36          (coding-system utf-8)
  37          (input-method . "ipa")
  38          (nonascii-translation . ipa)
  39          (documentation . "\
  40 IPA is International Phonetic Alphabet for English, French, German
  41 and Italian.")))
  42
  43 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  44 ;; Arabic
  45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46
  47 (define-coding-system 'iso-8859-6
  48   "ISO-8859-6 based encoding (MIME:ISO-8859-6)."
  49   :coding-type 'charset
  50   :mnemonic ?6
  51   :charset-list '(iso-8859-6)
  52   :mime-charset 'iso-8859-6)
  53
  54 (define-coding-system 'windows-1256
  55   "windows-1256 (Arabic) encoding (MIME: WINDOWS-1256)"
  56   :coding-type 'charset
  57   :mnemonic ?A
  58   :charset-list '(windows-1256)
  59   :mime-charset 'windows-1256)
  60 (define-coding-system-alias 'cp1256 'windows-1256)
  61
  62 (set-language-info-alist
  63  "Arabic" '((charset unicode)
  64             (coding-system utf-8 iso-8859-6 windows-1256)
  65             (coding-priority utf-8 iso-8859-6 windows-1256)
  66             (input-method . "arabic")
  67             (sample-text . "Arabic      السّلام عليكم")
  68             (documentation . "Bidirectional editing is supported.")))
  69
  70 (set-language-info-alist
  71  "Persian" '((charset unicode)
  72             (coding-system utf-8 iso-8859-6 windows-1256)
  73             (coding-priority utf-8 iso-8859-6 windows-1256)
  74             (input-method . "farsi-transliterate-banan")
  75             (sample-text . "Persian     فارسی")
  76             (documentation . "Bidirectional editing is supported.")))
  77
  78 (defcustom arabic-shaper-ZWNJ-handling nil
  79   "How to handle ZWMJ in Arabic text rendering.
  80 This variable controls the way to handle a glyph for ZWNJ
  81 returned by the underling shaping engine.
  82
  83 The default value is nil, which means that the ZWNJ glyph is
  84 displayed as is.
  85
  86 If the value is `absorb', ZWNJ is absorbed into the previous
  87 grapheme cluster, and not displayed.
  88
  89 If the value is `as-space', the glyph is displayed by a
  90 thin (i.e. 1-dot width) space."
  91   :group 'mule
  92   :version "26.1"
  93   :type '(choice
  94           (const :tag "default" nil)
  95           (const :tag "as space" as-space)
  96           (const :tag "absorb" absorb))
  97   :set (lambda (sym val)
  98          (set-default sym val)
  99          (clear-composition-cache)))
 100
 101 ;; Record error in arabic-change-gstring.
 102 (defvar arabic-shape-log nil)
 103
 104 (defun arabic-shape-gstring (gstring)
 105   (setq gstring (font-shape-gstring gstring))
 106   (condition-case err
 107       (when arabic-shaper-ZWNJ-handling
 108         (let ((font (lgstring-font gstring))
 109               (i 1)
 110               (len (lgstring-glyph-len gstring))
 111               (modified nil))
 112           (while (< i len)
 113             (let ((glyph (lgstring-glyph gstring i)))
 114               (when (eq (lglyph-char glyph) #x200c)
 115                 (cond
 116                  ((eq arabic-shaper-ZWNJ-handling 'as-space)
 117                   (if (> (- (lglyph-rbearing glyph) (lglyph-lbearing glyph)) 0)
 118                       (let ((space-glyph (aref (font-get-glyphs font 0 1 " ") 0)))
 119                         (when space-glyph
 120                           (lglyph-set-code glyph (aref space-glyph 3))
 121                           (lglyph-set-width glyph (aref space-glyph 4)))))
 122                   (lglyph-set-adjustment glyph 0 0 1)
 123                   (setq modified t))
 124                  ((eq arabic-shaper-ZWNJ-handling 'absorb)
 125                   (let ((prev (lgstring-glyph gstring (1- i))))
 126                     (lglyph-set-from-to prev (lglyph-from prev) (lglyph-to glyph))
 127                     (setq gstring (lgstring-remove-glyph gstring i))
 128                     (setq len (1- len)))
 129                   (setq modified t)))))
 130             (setq i (1+ i)))
 131           (if modified
 132               (lgstring-set-id gstring nil))))
 133     (error (push err arabic-shape-log)))
 134   gstring)
 135
 136 (set-char-table-range
 137  composition-function-table
 138  '(#x600 . #x74F)
 139  (list (vector "[\u0600-\u074F\u200C\u200D]+" 0
 140                'arabic-shape-gstring)
 141        (vector "[\u200C\u200D][\u0600-\u074F\u200C\u200D]+" 1
 142                'arabic-shape-gstring)))
 143
 144 (provide 'misc-lang)
 145
 146 ;;; misc-lang.el ends here