From: tomo <tomo>
Date: Tue, 19 Apr 2011 23:49:12 +0000 (+0000)
Subject: Sync up with r21-4-22-chise-0_25-8.
X-Git-Tag: r21-4-22-u2km-0_25-8
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=6e154acd48f85d47903b112c1de0d6fff2c7462a;p=chise%2Fxemacs-chise.git

Sync up with r21-4-22-chise-0_25-8.
---

diff --git a/lisp/utf-2000/ChangeLog b/lisp/utf-2000/ChangeLog
index aceaf5f..fae7fd0 100644
--- a/lisp/utf-2000/ChangeLog
+++ b/lisp/utf-2000/ChangeLog
@@ -1,5 +1,10 @@
 2011-04-19  MORIOKA Tomohiko  <tomo@zinbun.kyoto-u.ac.jp>
 
+	* chise-subr.el (define-char-before): New function.
+	(define-char-after): New function.
+
+2011-04-19  MORIOKA Tomohiko  <tomo@zinbun.kyoto-u.ac.jp>
+
 	* ruimoku6.el: Don't omit `<-subsumptive' features of
 	`=ruimoku-v6' characters.
 
diff --git a/lisp/utf-2000/auto-autoloads.el b/lisp/utf-2000/auto-autoloads.el
index 646b634..2e1655f 100644
--- a/lisp/utf-2000/auto-autoloads.el
+++ b/lisp/utf-2000/auto-autoloads.el
@@ -7,7 +7,7 @@
 
 ;;;***
 
-;;;### (autoloads (chise-string< map-char-family char-id char-ucs char-attribute-name< expand-char-feature-name) "chise-subr" "utf-2000/chise-subr.el")
+;;;### (autoloads (chise-string< define-char-after define-char-before map-char-family char-id char-ucs char-attribute-name< expand-char-feature-name) "chise-subr" "utf-2000/chise-subr.el")
 
 (autoload 'expand-char-feature-name "chise-subr" nil nil nil)
 
@@ -21,6 +21,12 @@ Return code-point of UCS." nil nil)
 
 (autoload 'map-char-family "chise-subr" nil nil nil)
 
+(autoload 'define-char-before "chise-subr" "\
+Define CHAR-SPEC and insert it before NEXT-CHAR." nil nil)
+
+(autoload 'define-char-after "chise-subr" "\
+Define CHAR-SPEC and insert it after PREV-CHAR." nil nil)
+
 (autoload 'chise-string< "chise-subr" nil nil nil)
 
 ;;;***
diff --git a/lisp/utf-2000/chise-subr.el b/lisp/utf-2000/chise-subr.el
index 6101120..79484cd 100644
--- a/lisp/utf-2000/chise-subr.el
+++ b/lisp/utf-2000/chise-subr.el
@@ -1,7 +1,7 @@
 ;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
 
 ;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009,
-;;   2010 MORIOKA Tomohiko.
+;;   2010, 2011 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
@@ -148,6 +148,45 @@
 	(setq rest (cdr rest))))))
 
 
+;;;###autoload
+(defun define-char-before (char-spec next-char)
+  "Define CHAR-SPEC and insert it before NEXT-CHAR." 
+  (let (mother sisters rest)
+    (when (and (or (characterp next-char)
+		   (setq next-char (find-char next-char)))
+	       (setq mother (get-char-attribute next-char '<-subsumptive))
+	       (setq mother (car mother))
+	       (setq sisters (get-char-attribute mother '->subsumptive)))
+      (if (eq (car sisters) next-char)
+	  (setq sisters (cons (define-char char-spec) sisters))
+	(setq rest sisters)
+	(while (and (cdr rest)
+		    (not (eq (nth 1 rest) next-char)))
+	  (setq rest (cdr rest)))
+	(if (null rest)
+	    (setq sisters (cons (define-char char-spec) sisters))
+	  (setcdr rest (cons (define-char char-spec) (cdr rest)))))
+      (put-char-attribute mother '->subsumptive sisters))))
+
+;;;###autoload
+(defun define-char-after (prev-char char-spec)
+  "Define CHAR-SPEC and insert it after PREV-CHAR." 
+  (let (mother sisters rest)
+    (when (and (or (characterp prev-char)
+		   (setq prev-char (find-char prev-char)))
+	       (setq mother (get-char-attribute prev-char '<-subsumptive))
+	       (setq mother (car mother))
+	       (setq sisters (get-char-attribute mother '->subsumptive)))
+      (setq rest sisters)
+      (while (and rest
+		  (not (eq (car rest) prev-char)))
+	(setq rest (cdr rest)))
+      (if (null rest)
+	  (setq sisters (cons (define-char char-spec) sisters))
+	(setcdr rest (cons (define-char char-spec) (cdr rest))))
+      (put-char-attribute mother '->subsumptive sisters))))
+
+
 ;;; @ string
 ;;;