Fix Bug#17739.

* composite.el: Setup composition-function-table for dotted circle.
(compose-gstring-for-dotted-circle): New function.

* international/characters.el: Add category "^" to all
non-spacing characters.

3 files changed, 64 insertions, 6 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c243c6ea3ef..2c0f9814b4d 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2014-06-28  K. Handa  <handa@gnu.org>
+
+        Fix Bug#17739.
+
+        * composite.el: Setup composition-function-table for dotted circle.
+        (compose-gstring-for-dotted-circle): New function.
+
+        * international/characters.el: Add category "^" to all
+        non-spacing characters.
+
 2014-06-15  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * ses.el: Miscellaneous cleanups; use lexical-binding; avoid
diff --git a/lisp/composite.el b/lisp/composite.el
index b46d41a0aa4..666d6c9dd91 100644
--- a/lisp/composite.el
+++ b/lisp/composite.el
@@ -671,6 +671,49 @@ All non-spacing characters have this function in
               (setq i (1+ i))))
           gstring))))))
 
+(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]
@@ -679,7 +722,10 @@ All non-spacing characters have this function in
      #'(lambda (key val)
          (if (memq val '(Mn Mc Me))
              (set-char-table-range composition-function-table key elt)))
-     unicode-category-table)))
+     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)
   "Compose glyph-string GSTRING for terminal display.
diff --git a/lisp/international/characters.el b/lisp/international/characters.el
index 63b2b4f0eda..03b55c1eb5f 100644
--- a/lisp/international/characters.el
+++ b/lisp/international/characters.el
@@ -1359,11 +1359,13 @@ Setup char-width-table appropriate for non-CJK language environment."
 (when (setq unicode-category-table
             (unicode-property-table-internal 'general-category))
   (map-char-table #'(lambda (key val)
-                      (if (and val
-                               (or (and (/= (aref (symbol-name val) 0) ?M)
-                                        (/= (aref (symbol-name val) 0) ?C))
-                                   (eq val 'Zs)))
-                          (modify-category-entry key ?.)))
+                      (if val
+                          (cond ((or (and (/= (aref (symbol-name val) 0) ?M)
+                                          (/= (aref (symbol-name val) 0) ?C))
+                                     (eq val 'Zs))
+                                 (modify-category-entry key ?.))
+                                ((eq val 'Mn)
+                                 (modify-category-entry key ?^)))))
                   unicode-category-table))
 
 (optimize-char-table (standard-category-table))