From: Kenichi Handa <handa@gnu.org>
Date: Sat, 28 Jun 2014 01:34:17 +0000 (+0900)
Subject: Fix Bug#17739.
X-Git-Tag: emacs-25.0.90~2636^2~79
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1fc00e5c9e87c88b4b253692d6ade822f6d74d3e;p=emacs.git

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.
---

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))