* admin/grammars/Makefile.in (bootstrap-clean): Don't delete Makefile,

[bpt/emacs.git] / lisp / composite.el

diff --git a/lisp/composite.el b/lisp/composite.el
index 739ec8b..666d6c9 100644 (file)
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -1,5 +1,7 @@
 ;;; composite.el --- support character composition
 
 ;;; composite.el --- support character composition
 

+;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
+

 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
 ;;   2008, 2009, 2010, 2011
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)
 ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
 ;;   2008, 2009, 2010, 2011
 ;;   National Institute of Advanced Industrial Science and Technology (AIST)


@@ -29,8 +31,6 @@
 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-when-compile (require 'cl))
-

 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)
 (defconst reference-point-alist
   '((tl . 0) (tc . 1) (tr . 2)
     (Bl . 3) (Bc . 4) (Br . 5)


@@ -59,8 +59,8 @@ The meaning of glyph reference point codes is as follows:
     |         |                        7:bc or bottom-center
     6----7----8 <---- descent  8:br or bottom-right
 
     |         |                        7:bc or bottom-center
     6----7----8 <---- descent  8:br or bottom-right
 

-Glyph reference point symbols are to be used to specify composition
-rule of the form \(GLOBAL-REF-POINT . NEW-REF-POINT), where
+Glyph reference point symbols are to be used to specify a composition
+rule of the form (GLOBAL-REF-POINT . NEW-REF-POINT), where

 GLOBAL-REF-POINT is a reference point in the overall glyphs already
 composed, and NEW-REF-POINT is a reference point in the new glyph to
 be added.
 GLOBAL-REF-POINT is a reference point in the overall glyphs already
 composed, and NEW-REF-POINT is a reference point in the new glyph to
 be added.


@@ -73,13 +73,13 @@ follows (the point `*' corresponds to both reference points):
     |       |  |
     | global|  |
     | glyph |  |
     |       |  |
     | global|  |
     | glyph |  |

- -- |       |  |-- <--- baseline \(doesn't change)
+ -- |       |  |-- <--- baseline (doesn't change)

     +----+--*--+
     |    | new |
     |    |glyph|
     +----+-----+ <--- new descent
 
     +----+--*--+
     |    | new |
     |    |glyph|
     +----+-----+ <--- new descent
 

-A composition rule may have the form \(GLOBAL-REF-POINT
+A composition rule may have the form (GLOBAL-REF-POINT

 NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specify how much
 to shift NEW-REF-POINT from GLOBAL-REF-POINT.  In this case, XOFF
 and YOFF are integers in the range -100..100 representing the
 NEW-REF-POINT XOFF YOFF), where XOFF and YOFF specify how much
 to shift NEW-REF-POINT from GLOBAL-REF-POINT.  In this case, XOFF
 and YOFF are integers in the range -100..100 representing the


@@ -211,7 +211,7 @@ or a vector or list of integers and rules.
 If it is a character, it is an alternate character to display instead
 of the text in the region.
 
 If it is a character, it is an alternate character to display instead
 of the text in the region.
 

-If it is a string, the elements are one or more alternate characters.  In
+If it is a string, the elements are alternate characters.  In

 this case, TAB element has a special meaning.  If the first
 character is TAB, the glyphs are displayed with left padding space
 so that no pixel overlaps with the previous column.  If the last
 this case, TAB element has a special meaning.  If the first
 character is TAB, the glyphs are displayed with left padding space
 so that no pixel overlaps with the previous column.  If the last


@@ -234,9 +234,7 @@ text in the composition."
   (let ((modified-p (buffer-modified-p))
        (inhibit-read-only t))
     (if (or (vectorp components) (listp components))
   (let ((modified-p (buffer-modified-p))
        (inhibit-read-only t))
     (if (or (vectorp components) (listp components))

-       (setq components (encode-composition-components components))
-      (if (= (length components) 0)
-         (error "Invalid composition component: %s" components)))
+       (setq components (encode-composition-components components)))

     (compose-region-internal start end components modification-func)
     (restore-buffer-modified-p modified-p)))
 
     (compose-region-internal start end components modification-func)
     (restore-buffer-modified-p modified-p)))
 


@@ -269,9 +267,7 @@ Optional 5th argument MODIFICATION-FUNC is a function to call to
 adjust the composition when it gets invalid because of a change of
 text in the composition."
   (if (or (vectorp components) (listp components))
 adjust the composition when it gets invalid because of a change of
 text in the composition."
   (if (or (vectorp components) (listp components))

-      (setq components (encode-composition-components components))
-    (if (= (length components) 0)
-       (error "Invalid composition component: %s" components)))
+      (setq components (encode-composition-components components)))

   (or start (setq start 0))
   (or end (setq end (length string)))
   (compose-string-internal string start end components modification-func)
   (or start (setq start 0))
   (or end (setq end (length string)))
   (compose-string-internal string start end components modification-func)


@@ -285,8 +281,8 @@ text in the composition."
 (defun compose-chars (&rest args)
   "Return a string from arguments in which all characters are composed.
 For relative composition, arguments are characters.
 (defun compose-chars (&rest args)
   "Return a string from arguments in which all characters are composed.
 For relative composition, arguments are characters.

-For rule-based composition, Mth \(where M is odd) arguments are
-characters, and Nth \(where N is even) arguments are composition rules.
+For rule-based composition, Mth (where M is odd) arguments are
+characters, and Nth (where N is even) arguments are composition rules.

 A composition rule is a cons of glyph reference points of the form
 \(GLOBAL-REF-POINT . NEW-REF-POINT).  See the documentation of
 `reference-point-alist' for more detail."
 A composition rule is a cons of glyph reference points of the form
 \(GLOBAL-REF-POINT . NEW-REF-POINT).  See the documentation of
 `reference-point-alist' for more detail."


@@ -393,7 +389,7 @@ This function is the default value of `compose-chars-after-function'."
 (defun compose-last-chars (args)
   "Compose last characters.
 The argument is a parameterized event of the form
 (defun compose-last-chars (args)
   "Compose last characters.
 The argument is a parameterized event of the form

-       \(compose-last-chars N COMPONENTS),
+       (compose-last-chars N COMPONENTS),

 where N is the number of characters before point to compose,
 COMPONENTS, if non-nil, is the same as the argument to `compose-region'
 \(which see).  If it is nil, `compose-chars-after' is called,
 where N is the number of characters before point to compose,
 COMPONENTS, if non-nil, is the same as the argument to `compose-region'
 \(which see).  If it is nil, `compose-chars-after' is called,


@@ -561,7 +557,11 @@ All non-spacing characters have this function in
                 (rbearing (lglyph-rbearing glyph))
                 (lbearing (lglyph-lbearing glyph))
                 (center (/ (+ lbearing rbearing) 2))
                 (rbearing (lglyph-rbearing glyph))
                 (lbearing (lglyph-lbearing glyph))
                 (center (/ (+ lbearing rbearing) 2))

+                ;; Artificial vertical gap between the glyphs.

                 (gap (round (* (font-get (lgstring-font gstring) :size) 0.1))))
                 (gap (round (* (font-get (lgstring-font gstring) :size) 0.1))))

+           (if (= gap 0)
+               ;; Assure at least 1 pixel vertical gap.
+               (setq gap 1))

            (dotimes (i nchars)
              (setq glyph (lgstring-glyph gstring i))
              (when (> i 0)
            (dotimes (i nchars)
              (setq glyph (lgstring-glyph gstring i))
              (when (> i 0)


@@ -572,8 +572,10 @@ All non-spacing characters have this function in
                       (as (lglyph-ascent glyph))
                       (de (lglyph-descent glyph))
                       (ce (/ (+ lb rb) 2))
                       (as (lglyph-ascent glyph))
                       (de (lglyph-descent glyph))
                       (ce (/ (+ lb rb) 2))

+                      (w (lglyph-width glyph))

                       xoff yoff)
                       xoff yoff)

-                 (when (and class (>= class 200) (<= class 240))
+                 (cond
+                  ((and class (>= class 200) (<= class 240))

                    (setq xoff 0 yoff 0)
                    (cond
                     ((= class 200)
                    (setq xoff 0 yoff 0)
                    (cond
                     ((= class 200)


@@ -627,6 +629,38 @@ All non-spacing characters have this function in
                          rb (+ lb xoff)
                          as (- as yoff)
                          de (+ de yoff)))
                          rb (+ lb xoff)
                          as (- as yoff)
                          de (+ de yoff)))

+                  ((and (= class 0)
+                        (eq (get-char-code-property (lglyph-char glyph)
+                                                    'general-category) 'Me))
+                   ;; Artificially laying out glyphs in an enclosing
+                   ;; mark is difficult.  All we can do is to adjust
+                   ;; the x-offset and width of the base glyph to
+                   ;; align it at the center of the glyph of the
+                   ;; enclosing mark hoping that the enclosing mark
+                   ;; is big enough.  We also have to adjust the
+                   ;; x-offset and width of the mark ifself properly
+                   ;; depending on how the glyph is designed.
+
+                   ;; (non-spacing or not).  For instance, when we
+                   ;; have these glyphs:
+                   ;;   X position  |
+                   ;;   base:       <-*-> lbearing=0 rbearing=5 width=5
+                   ;;   mark: <----------.> lb=-11 rb=2 w=0
+                   ;; we get a correct layout by moving them as this:
+                   ;;   base:           <-*-> XOFF=4 WAD=9
+                   ;;   mark:       <----------.> xoff=2 wad=4
+                   ;; we have moved the base to the left by 4-pixel
+                   ;; and make its width 9-pixel, then move the mark
+                   ;; to the left 2-pixel and make its width 4-pixel.
+                   (let* (;; Adjustment for the base glyph
+                          (XOFF (/ (- rb lb width) 2))
+                          (WAD (+ width XOFF))
+                          ;; Adjustment for the enclosing mark glyph
+                          (xoff (- (+ lb WAD)))
+                          (wad (- rb lb WAD)))
+                     (lglyph-set-adjustment glyph xoff 0 wad)
+                     (setq glyph (lgstring-glyph gstring 0))
+                     (lglyph-set-adjustment glyph XOFF 0 WAD))))

                  (if (< ascent as)
                      (setq ascent as))
                  (if (< descent de)
                  (if (< ascent as)
                      (setq ascent as))
                  (if (< descent de)


@@ -637,16 +671,64 @@ All non-spacing characters have this function in
              (setq i (1+ i))))
          gstring))))))
 
              (setq i (1+ i))))
          gstring))))))
 

-(let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
-            [nil 0 compose-gstring-for-graphic])))
-  (map-char-table
-   #'(lambda (key val)
-       (if (memq val '(Mn Mc Me))
-          (set-char-table-range composition-function-table key elt)))
-   unicode-category-table))
+(defun compose-gstring-for-dotted-circle (gstring)
+  (let* ((dc (lgstring-glyph gstring 0)) ; glyph of dotted-circle
+        (dc-id (lglyph-code dc))
+        (fc (lgstring-glyph gstring 1)) ; glyph of the following char
+        (fc-id (lglyph-code fc))
+        (gstr (and nil (font-shape-gstring gstring))))
+    (if (and gstr
+            (or (= (lgstring-glyph-len gstr) 1)
+                (and (= (lgstring-glyph-len gstr) 2)
+                     (= (lglyph-to (lgstring-glyph gstr 0))
+                        (lglyph-to (lgstring-glyph gstr 1))))))
+       ;; It seems that font-shape-gstring has composed glyphs.
+       gstr
+      ;; Artificially compose the following glyph with the preceding
+      ;; dotted-circle.
+      (setq dc (lgstring-glyph gstring 0)
+           fc (lgstring-glyph gstring 1))
+      (let ((dc-width (lglyph-width dc))
+           (fc-width (- (lglyph-rbearing fc) (lglyph-lbearing fc)))
+           (from (lglyph-from dc))
+           (to (lglyph-to fc))
+           (xoff 0) (yoff 0) (width 0))
+       (if (and (< (lglyph-descent fc) 0)
+                (> (lglyph-ascent dc) (- (lglyph-descent fc))))
+           ;; Set YOFF so that the following glyph is put on top of
+           ;; the dotted-circle.
+           (setq yoff (- (- (lglyph-descent fc)) (lglyph-ascent dc))))
+       (if (> (lglyph-width fc) 0)
+           (setq xoff (- (lglyph-rbearing fc))))
+       (if (< dc-width fc-width)
+           ;; The following glyph is wider, but we don't know how to
+           ;; align both glyphs.  So, try the easiet method;
+           ;; i.e. align left edges of the glyphs.
+           (setq xoff (- xoff (- dc-width) (- (lglyph-lbearing fc )))
+                 width (- fc-width dc-width)))
+       (if (or (/= xoff 0) (/= yoff 0) (/= width 0) (/= (lglyph-width fc) 0))
+           (lglyph-set-adjustment fc xoff yoff width))
+       (lglyph-set-from-to dc from to)
+       (lglyph-set-from-to fc from to))
+      (if (> (lgstring-glyph-len gstring) 2)
+         (lgstring-set-glyph gstring 2 nil))
+      gstring)))
+
+;; Allow for bootstrapping without uni-*.el.
+(when unicode-category-table
+  (let ((elt `([,(purecopy "\\c.\\c^+") 1 compose-gstring-for-graphic]
+              [nil 0 compose-gstring-for-graphic])))
+    (map-char-table
+     #'(lambda (key val)
+        (if (memq val '(Mn Mc Me))
+            (set-char-table-range composition-function-table key elt)))
+     unicode-category-table))
+  ;; for dotted-circle
+  (aset composition-function-table #x25CC
+       `([,(purecopy ".\\c^") 0 compose-gstring-for-dotted-circle])))

 
 (defun compose-gstring-for-terminal (gstring)
 
 (defun compose-gstring-for-terminal (gstring)

-  "Compose glyph string GSTRING for terminal display.
+  "Compose glyph-string GSTRING for terminal display.

 Non-spacing characters are composed with the preceding base
 character.  If the preceding character is not a base character,
 each non-spacing character is composed as a spacing character by
 Non-spacing characters are composed with the preceding base
 character.  If the preceding character is not a base character,
 each non-spacing character is composed as a spacing character by