;;; Code:
(require 'char-db-util)
-(require 'cwiki-common)
+(require 'chiset-common)
(require 'isd-turtle)
(require 'ideograph-util)
===daikanwa/ho
))
-(defvar chise-turtle-ccs-prefix-alist nil)
-
+(defvar chise-turtle-feature-domains)
(setq chise-turtle-feature-domains
(append char-db-feature-domains
(let (dest domain)
(setq dest (cons domain dest)))))
(sort dest #'string<))))
-(defun charset-code-point-format-spec (ccs)
- (cond ((memq ccs '(=ucs))
- "0x%04X")
- (t
- (let ((ccs-name (symbol-name ccs)))
- (cond
- ((string-match
- "\\(shinjigen\\|daikanwa/ho\\|=>iwds-1\\)"
- ccs-name)
- "%04d")
- ((string-match
- "\\(gt\\|daikanwa\\|adobe-japan1\\|cbeta\\|zinbun-oracle\\|hng\\)"
- ccs-name)
- "%05d")
- ((string-match "\\(hanyo-denshi/ks\\|koseki\\|mj\\)" ccs-name)
- "%06d")
- ((string-match "hanyo-denshi/tk" ccs-name)
- "%08d")
- (t
- "0x%X"))))))
-
-(defun chise-turtle-uri-decode-feature-name (uri-feature)
- (cond ((string= "a.ucs" uri-feature)
- '=ucs)
- ((string= "a.big5" uri-feature)
- '=big5)
- (t
- (www-uri-decode-feature-name uri-feature))))
-
-(defun chise-turtle-uri-encode-ccs-name (feature-name)
- (cond
- ((eq '=ucs feature-name)
- "a.ucs")
- ((eq '=big5 feature-name)
- "a.big5")
- ((eq '==>ucs@bucs feature-name)
- "bucs")
- (t
- (mapconcat (lambda (c)
- (cond
- ((eq c ?@)
- "_")
- ((eq c ?+)
- "._.")
- ((eq c ?=)
- ".:.")
- ((eq c ?|)
- "._cmp_.")
- (t
- (char-to-string c))))
- (www-uri-encode-feature-name feature-name)
- ""))))
-
(defun chise-turtle-uri-encode-feature-name (feature-name)
(cond
((eq '->subsumptive feature-name)
(t
(concat ":" (chise-turtle-uri-encode-ccs-name feature-name)))))
-(defun chise-turtle-format-ccs-code-point (ccs code-point)
- (let ((ccs-uri (chise-turtle-uri-encode-ccs-name ccs)))
- (unless (assoc ccs-uri chise-turtle-ccs-prefix-alist)
- (setq chise-turtle-ccs-prefix-alist
- (cons (cons ccs-uri ccs)
- chise-turtle-ccs-prefix-alist)))
- (format "%s:%s"
- ccs-uri
- (format (charset-code-point-format-spec ccs)
- code-point))))
-
-(defun chise-turtle-encode-char (object)
- (let (spec cell dest
- ccs ret ret2)
- (if (setq ret (encode-char object '=ucs))
- (chise-turtle-format-ccs-code-point '=ucs ret)
- (setq spec (char-attribute-alist object))
- (while (and spec
- (setq cell (pop spec)))
- (if (and (find-charset (car cell))
- (setq ret (cdr cell)))
- (setq dest (cons cell dest))))
- (setq ret (car (sort dest (lambda (a b)
- (char-attribute-name< (car a)(car b)))))
- ccs (car ret)
- ret (cdr ret))
- (cond (ret
- (chise-turtle-format-ccs-code-point ccs ret)
- )
- ((and (setq ccs (car (split-char object)))
- (setq ret (encode-char object ccs)))
- (chise-turtle-format-ccs-code-point ccs ret)
- )
- ((setq ret (get-char-attribute object 'ideographic-combination))
- (format "ideocomb:%s"
- (mapconcat (lambda (cell)
- (cond ((characterp cell)
- (char-to-string cell)
- )
- ((setq ret2 (find-char cell))
- (char-to-string ret2)
- )
- (t
- (format "%S" cell)
- )))
- ret ""))
- )
- (t
- (format (if est-hide-cgi-mode
- "system-char-id=0x%X"
- "system-char-id:0x%X")
- (encode-char object 'system-char-id))
- )))))
-
(defun concord-turtle-encode-object (obj)
(cond ((characterp obj)
(chise-turtle-encode-char obj)