X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Futf-2000%2Fchise-subr.el;h=c62e042aebe45f6860d15ec4988e6c4c90d44642;hb=782af0719af2595da7e1433d160586ee834dc49b;hp=dd1153d26968ec94f22bbcf701a6383630082c0f;hpb=47bf6172ffbc1f38ce6bc2e02c98e6f945fb4170;p=chise%2Fxemacs-chise.git-

diff --git a/lisp/utf-2000/chise-subr.el b/lisp/utf-2000/chise-subr.el
index dd1153d..c62e042 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, 2008, 2009, 2010
-;;   MORIOKA Tomohiko.
+;; Copyright (C) 1999, 2001, 2002, 2003, 2004, 2005, 2007, 2008, 2009,
+;;   2010, 2011, 2012 MORIOKA Tomohiko.
 
 ;; Author: MORIOKA Tomohiko <tomo@kanji.zinbun.kyoto-u.ac.jp>
 ;; Keywords: CHISE, Character Database, ISO/IEC 10646, UCS, Unicode, MULE.
@@ -25,6 +25,24 @@
 
 ;;; Code:
 
+(defvar char-db-feature-domains
+  ;; (let (dest str len ret domain)
+  ;;   (dolist (fn (char-attribute-list))
+  ;;     (setq str (symbol-name fn))
+  ;;     (when (string-match "^ideographic-radical@\\([^*]+\\)$" str)
+  ;;       (setq domain (substring str (match-beginning 1)))
+  ;;       (when (> (setq len (length domain)) 0)
+  ;;         (setq ret (read-from-string domain))
+  ;;         (when (= (cdr ret) len)
+  ;;           (setq domain (car ret))
+  ;;           (unless (memq domain dest)
+  ;;             (push domain dest))))))
+  ;;   (sort dest #'string<))
+  '(ucs ucs/compat daikanwa cns gt jis jis/alt jis/a jis/b
+	jis-x0212 jis-x0213 cdp shinjigen
+	r030 r140 misc unknown))
+
+
 ;;; @ feature name
 ;;;
 
@@ -143,6 +161,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
 ;;;