;;; chise-subr.el --- basic lisp subroutines for XEmacs CHISE
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;; 2007, 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.
;;; 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
;;;
;;;###autoload
(defun char-attribute-name< (ka kb)
+ "Return t if symbol KA is less than KB in feature-name sorting order."
(cond
((eq '->denotational kb)
t)
;;;###autoload
(defun char-ucs (char)
+ "Return code-point of UCS."
(or (encode-char char '=ucs 'defined-only)
(char-feature char '=>ucs)))
(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
;;;