;; -*- coding: utf-8-mcs-er -*-
(require 'char-db-util)

(setq file-name-coding-system 'utf-8-mcs-er)


(concord-assign-genre 'creator@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'person-name@ruimoku "/usr/local/var/ruimoku/db")

(concord-assign-genre 'journal-volume@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'article@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'book@ruimoku "/usr/local/var/ruimoku/db")

(concord-assign-genre 'classification@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'region@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'era@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'period@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'journal@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'journal-name@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'publisher@ruimoku "/usr/local/var/ruimoku/db")
(concord-assign-genre 'publisher-name@ruimoku "/usr/local/var/ruimoku/db")

(mount-char-attribute-table '*instance@ruimoku/bibliography/title)
;; (mount-char-attribute-table '*instance@ruimoku/bibliography/content*note)

(concord-assign-genre 'entry@zh-classical "/usr/local/var/kanbun/db")
;; (concord-assign-genre 'morpheme-entry@zh-classical "/usr/local/var/kanbun/db")
(concord-assign-genre 'word-class@zh-classical "/usr/local/var/kanbun/db")
(concord-assign-genre 'morpheme@zh-classical "/usr/local/var/kanbun/db")
(concord-assign-genre 'sentence@zh-classical "/usr/local/var/kanbun/db")
;; (concord-assign-genre 'sentence-entry@zh-classical "/usr/local/var/kanbun/db")

(mount-char-attribute-table '*instance@morpheme-entry/zh-classical)


(mount-char-attribute-table '->HNG)
(mount-char-attribute-table '<-HNG)


(defvar est-hide-cgi-mode nil)
(defvar est-view-url-prefix "..")
(defvar chise-wiki-view-url "view.cgi")
(defvar chise-wiki-edit-url "edit.cgi")

(defvar chise-wiki-bitmap-glyphs-url
  "http://www.chise.org/glyphs")

(defvar chise-wiki-hng-bitmap-glyphs-url
  "http://hng.chise.org/glyphs/HNG")

(defvar chise-wiki-glyph-cgi-url
  "http://www.chise.org/chisewiki/glyph.cgi")

(defvar chise-wiki-displayed-features nil)

(defvar est-coded-charset-priority-list
  '(; =ucs
    =cns11643-1 =cns11643-2 =cns11643-3
    =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
    =gb2312 =gb12345
    =jis-x0208 =jis-x0208@1990
    =jis-x0213-2
    =jis-x0212
    =adobe-japan1
    =cbeta =jef-china3
    =jis-x0213-1@2000 =jis-x0213-1@2004
    =jis-x0208@1983 =jis-x0208@1978
    =zinbun-oracle =>zinbun-oracle
    =daikanwa
    =gt =gt-k
    =>>>adobe-japan1
    =>>>jis-x0208 =>>>jis-x0213-1 =>>>jis-x0213-2
    =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
    =>>adobe-japan1
    =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
    =+>jis-x0208@1978
    =+>adobe-japan1
    =>jis-x0208 =>jis-x0213-1
    =>>gt
    =>ucs@iso =>ucs@unicode
    =>ucs@jis =>ucs@cns =>ucs@ks
    =>>ucs@iso =>>ucs@unicode
    =>>ucs@jis =>>ucs@cns =>>ucs@ks
    =>>>ucs@iso =>>>ucs@unicode
    =>>>ucs@jis =>>>ucs@cns =>>>ucs@ks
    ===ucs@iso
    =ruimoku-v6
    =big5
    =big5-cdp
    =>cbeta
    =mj
    ==mj
    ===mj
    =ucs-itaiji-001
    =ucs-itaiji-002
    =ucs-itaiji-003
    =ucs@unicode
    ==ucs@unicode
    ===ucs@unicode
    ==>ucs@bucs
    ===daikanwa/+p
    ===gt))

(defun decode-uri-string (string &optional coding-system)
  (if (> (length string) 0)
      (let ((i 0)
	    dest)
	(setq string
	      (mapconcat (lambda (char)
			   (if (eq char ?+)
			       " "
			     (char-to-string char)))
			 string ""))
	(while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
	  (setq dest (concat dest
			     (substring string i (match-beginning 0))
			     (char-to-string
			      (int-char
			       (string-to-int (match-string 1 string) 16))))
		i (match-end 0)))
	(decode-coding-string
	 (concat dest (substring string i))
	 coding-system))))

(defun www-feature-type (feature-name)
  (or (char-feature-property feature-name 'type)
      (let ((str (symbol-name feature-name)))
	(cond
	 ((string-match "\\*note\\(@[^*]+\\)?$" str)
	  'stext)
	 ((string-match "\\*sources\\(@[^*]+\\)?$" str)
	  'domain-list)
	 ((string-match "\\*" str)
	  nil)
	 ((string-match "^\\(->\\|<-\\)" str)
	  'relation)
	 ((string-match "^ideographic-structure\\(@\\|$\\)" str)
	  'structure)
	 ))))

(defun www-feature-format (feature-name)
  (or (char-feature-property feature-name 'presentation-format)
      (char-feature-property feature-name 'format)
      (let (fn parent ret)
	(setq fn feature-name)
	(while (and (setq parent (char-feature-name-parent fn))
		    (null (setq ret
				(char-feature-property
				 parent 'format))))
	  (setq fn parent))
	ret)
      '((name) " : " (value))))

(defun www-feature-value-format (feature-name)
  (or (char-feature-property feature-name 'value-presentation-format)
      (char-feature-property feature-name 'value-format)
      (let (fn parent ret)
	(setq fn feature-name)
	(while (and (setq parent (char-feature-name-parent fn))
		    (null (setq ret
				(or (char-feature-property
				     parent 'value-presentation-format)
				    (char-feature-property
				     parent 'value-format)))))
	  (setq fn parent))
	ret)
      (let ((type (www-feature-type feature-name)))
	(cond ((eq type 'relation)
	       'space-separated)
	      ((eq type 'structure)
	       'space-separated-ids)
	      ((eq type 'stext)
	       'wiki-text)
	      ))
      (if (find-charset feature-name)
	  (if (and (= (charset-dimension feature-name) 2)
		   (= (charset-chars feature-name) 94))
	      '("0x" (HEX)
		" (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char))
	    '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))
      'space-separated))

(defun char-feature-name-at-domain (feature-name domain)
  (if domain
      (let ((name (symbol-name feature-name)))
	(cond
	 ((string-match "@[^*]+$" name)
	  (intern (format "%s/%s" name domain))
	  )
	 (t
	  (intern (format "%s@%s" name domain))
	  )))
    feature-name))

(defun char-feature-name-parent (feature-name)
  (let ((name (symbol-name feature-name)))
    (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
	(intern (substring name 0 (car (last (match-data) 2)))))))

(defun char-feature-name-domain (feature-name)
  (let ((name (symbol-name feature-name)))
    (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
	(intern (substring name (1+ (match-beginning 0)))))))

(defun char-feature-name-sans-versions (feature)
  (let ((feature-name (symbol-name feature)))
    (if (string-match "[@/]\\$rev=latest$" feature-name)
	(intern (substring feature-name 0 (match-beginning 0)))
      feature)))

(defun est-object-genre (object)
  (if (characterp object)
      'character
    (concord-object-genre object)))

(defun www-get-feature-value (object feature)
  (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
    (cond
     ((characterp object)
      (mount-char-attribute-table latest-feature)
      (or (char-feature object latest-feature)
	  (char-feature object feature))
      )
     (t
      (or (condition-case nil
	      (concord-object-get object latest-feature)
	    (error nil))
	  (condition-case nil
	      (concord-object-get object feature)
	    (error nil)))
      ))))

(defun get-previous-code-point (ccs code)
  (let ((chars (charset-chars ccs))
	(dim (charset-dimension ccs))
	(i 0)
	mask byte-min byte-max
	bytes dest)
    (cond
     ((= chars 94)
      (setq mask #x7F
	    byte-min 33
	    byte-max 126)
      )
     ((= chars 96)
      (setq mask #x7F
	    byte-min 32
	    byte-max 127)
      )
     ((= chars 128)
      (setq mask #x7F
	    byte-min 0
	    byte-max #xFF)
      )
     (t ; (= chars 256)
      (setq mask #xFF
	    byte-min 0
	    byte-max #xFF)
      ))
    (setq bytes (make-vector dim 0))
    (while (< i dim)
      (aset bytes i (logand (lsh code (* i -8)) mask))
      (setq i (1+ i)))
    (setq i 0)
    (while (and (< i dim)
		(progn
		  (aset bytes i (1- (aref bytes i)))
		  (< (aref bytes i) byte-min)))
      (aset bytes i byte-max)
      (setq i (1+ i)))
    (when (< i dim)
      (setq dest (aref bytes 0)
	    i 1)
      (while (< i dim)
	(setq dest (logior dest (lsh (aref bytes i) (* i 8)))
	      i (1+ i)))
      dest)))

(defun get-next-code-point (ccs code)
  (let ((chars (charset-chars ccs))
	(dim (charset-dimension ccs))
	(i 0)
	mask byte-min byte-max
	bytes dest)
    (cond
     ((= chars 94)
      (setq mask #x7F
	    byte-min 33
	    byte-max 126)
      )
     ((= chars 96)
      (setq mask #x7F
	    byte-min 32
	    byte-max 127)
      )
     ((= chars 128)
      (setq mask #x7F
	    byte-min 0
	    byte-max #xFF)
      )
     (t ; (= chars 256)
      (setq mask #xFF
	    byte-min 0
	    byte-max #xFF)
      ))
    (setq bytes (make-vector dim 0))
    (while (< i dim)
      (aset bytes i (logand (lsh code (* i -8)) mask))
      (setq i (1+ i)))
    (setq i 0)
    (while (and (< i dim)
		(progn
		  (aset bytes i (1+ (aref bytes i)))
		  (> (aref bytes i) byte-max)))
      (aset bytes i byte-min)
      (setq i (1+ i)))
    (when (< i dim)
      (setq dest (aref bytes 0)
	    i 1)
      (while (< i dim)
	(setq dest (logior dest (lsh (aref bytes i) (* i 8)))
	      i (1+ i)))
      dest)))

(defun find-previous-defined-code-point (ccs code)
  (let ((i (get-previous-code-point ccs code))
	char)
    (cond
     ((eq ccs '=jis-x0208)
      (setq ccs '=jis-x0208@1990))
     ((eq ccs '=jis-x0213-1)
      (setq ccs '=jis-x0213-1@2004)))
    (while (and i
		(>= i 0)
		(null (setq char (decode-char ccs i
					      (unless (eq ccs '=ucs)
						'defined-only)))))
      (setq i (get-previous-code-point ccs i)))
    char))

(defun find-next-defined-code-point (ccs code)
  (let ((i (get-next-code-point ccs code))
	max char)
    (setq max (+ code 1000))
    (cond
     ((eq ccs '=jis-x0208)
      (setq ccs '=jis-x0208@1990))
     ((eq ccs '=jis-x0213-1)
      (setq ccs '=jis-x0213-1@2004)))
    (while (and i
		(<= i max)
		(null (setq char (decode-char ccs i
					      (unless (eq ccs '=ucs)
						'defined-only)))))
      (setq i (get-next-code-point ccs i)))
    char))


;;; @ URI representation
;;;

(defun est-uri-decode-feature-name-body (uri-feature)
  (let ((len (length uri-feature))
	(i 0)
	ch dest)
    (while (< i len)
      (setq dest
	    (concat
	     dest
	     (if (eq (aref uri-feature i) ?\.)
		 (if (and (< (+ i 2) len)
			  (eq (aref uri-feature (+ i 2)) ?\.))
		     (prog1
			 (cond
			  ((eq (setq ch (aref uri-feature (1+ i))) ?\.)
			   "/")
			  ((eq ch ?-)
			   "*")
			  (t
			   (substring uri-feature i (+ i 3))
			   ))
		       (setq i (+ i 3)))
		   (setq i (1+ i))
		   ".")
	       (prog1
		   (char-to-string (aref uri-feature i))
		 (setq i (1+ i)))))))
    dest))

(defun est-uri-encode-feature-name-body (feature)
  (mapconcat (lambda (c)
	       (cond ((eq c ?*)
		      ".-.")
		     ((eq c ?/)
		      "...")
		     (t (char-to-string c))))
	     feature ""))

(defun www-uri-decode-feature-name (uri-feature)
  (let (feature)
    (setq uri-feature (decode-uri-string uri-feature 'utf-8-mcs-er))
    (cond
     ((string-match "^from\\." uri-feature)
      (intern (format "<-%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^to\\." uri-feature)
      (intern (format "->%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^rep\\." uri-feature)
      (intern (format "=%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^rep[2i]\\." uri-feature)
      (intern (format "===%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^g\\." uri-feature)
      (intern (format "=>>%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^g[i2]\\." uri-feature)
      (intern (format "==%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^gi\\([0-9]+\\)\\." uri-feature)
      (intern (format "=>>%s%s"
		      (make-string (string-to-int
				    (match-string 1 uri-feature))
				   ?>)
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^o\\." uri-feature)
      (intern (format "=+>%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^a\\." uri-feature)
      (intern (format "=>%s"
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((string-match "^a\\([0-9]+\\)\\." uri-feature)
      (intern (format "%s>%s"
		      (make-string (string-to-int
				    (match-string 1 uri-feature))
				   ?=)
		      (est-uri-decode-feature-name-body
		       (substring uri-feature (match-end 0)))))
      )
     ((and (setq uri-feature (est-uri-decode-feature-name-body uri-feature))
	   (setq feature (intern (format "=>%s" uri-feature)))
	   (find-charset feature))
      feature)
     ((and (setq feature (intern (format "=>>%s" uri-feature)))
	   (find-charset feature))
      feature)
     ((and (setq feature (intern (format "=>>>%s" uri-feature)))
	   (find-charset feature))
      feature)
     ((and (setq feature (intern (format "=%s" uri-feature)))
	   (find-charset feature))
      feature)
     (t (intern uri-feature)))))

(defun www-uri-encode-feature-name (feature-name)
  (setq feature-name (symbol-name feature-name))
  (cond
   ((string-match "^=\\+>\\([^=>]+\\)" feature-name)
    (concat "o."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^=\\([^=>]+\\)" feature-name)
    (concat "rep."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^==\\([^=>]+\\)" feature-name)
    (concat "g2."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^===\\([^=>]+\\)" feature-name)
    (concat "repi."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^=>>\\([^=>]+\\)" feature-name)
    (concat "g."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^=>>>\\([^=>]+\\)" feature-name)
    (concat "gi."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^=>>\\(>+\\)" feature-name)
    (format "gi%d.%s"
	    (length (match-string 1 feature-name))
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-end 1))))
    )
   ((string-match "^=>\\([^=>]+\\)" feature-name)
    (concat "a."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-beginning 1))))
    )
   ((string-match "^\\(=+\\)>" feature-name)
    (format "a%d.%s"
	    (length (match-string 1 feature-name))
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-end 0))))
    )
   ((string-match "^->" feature-name)
    (concat "to."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-end 0))))
    )
   ((string-match "^<-" feature-name)
    (concat "from."
	    (est-uri-encode-feature-name-body
	     (substring feature-name (match-end 0))))
    )
   (t (est-uri-encode-feature-name-body feature-name))))

(defun www-uri-make-feature-name-url (uri-genre uri-feature-name uri-object)
  (if est-hide-cgi-mode
      (format "../feature/%s&%s/%s"
	      uri-feature-name uri-genre uri-object)
    (format "%s?feature=%s&%s=%s"
	    chise-wiki-view-url uri-feature-name uri-genre uri-object)))

(defun www-uri-decode-object (genre char-rep)
  (let (ccs cpos)
    (cond
     ((string-match (if est-hide-cgi-mode
			"\\(%3D\\|=\\|%3A\\|:\\)"
		      "\\(%3A\\|:\\)") char-rep)
      (setq ccs (substring char-rep 0 (match-beginning 0))
	    cpos (substring char-rep (match-end 0)))
      (setq ccs (www-uri-decode-feature-name ccs))
      (setq cpos (est-uri-decode-feature-name-body cpos))
      (cond
       ((string-match "^0x" cpos)
	(setq cpos
	      (string-to-number (substring cpos (match-end 0)) 16))
	)
       (t
	(setq cpos (car (read-from-string
			 (decode-uri-string
			  cpos file-name-coding-system))))
	))
      (if (and (eq genre 'character)
	       (numberp cpos))
	  (decode-char ccs cpos)
	(concord-decode-object ccs cpos genre))
      )
     (t
      (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
      (cond
       ((eq genre 'character)
	(when (= (length char-rep) 1)
	  (aref char-rep 0))
	)
       ((eq genre 'feature)
	(concord-decode-object
	 '=id (www-uri-decode-feature-name char-rep) 'feature)
	)
       (t
	(concord-decode-object
	 '=id (car (read-from-string char-rep)) genre)
	))))))

(defun www-uri-encode-object (object)
  (if (characterp object)
      (if (encode-char object '=ucs)
	  (mapconcat
	   (lambda (byte)
	     (format "%%%02X" byte))
	   (encode-coding-string (char-to-string object) 'utf-8-mcs-er)
	   "")
	(let ((ccs-list est-coded-charset-priority-list)
	      ccs ret)
	  (while (and ccs-list
		      (setq ccs (pop ccs-list))
		      (not (setq ret (encode-char object ccs 'defined-only)))))
	  (cond (ret
		 (format (if est-hide-cgi-mode
			     "%s=0x%X"
			   "%s:0x%X")
			 (www-uri-encode-feature-name ccs)
			 ret))
		((and (setq ccs (car (split-char object)))
		      (setq ret (encode-char object ccs)))
		 (format (if est-hide-cgi-mode
			     "%s=0x%X"
			   "%s:0x%X")
			 (www-uri-encode-feature-name ccs)
			 ret))
		(t
		 (format (if est-hide-cgi-mode
			     "system-char-id=0x%X"
			   "system-char-id:0x%X")
			 (encode-char object 'system-char-id))
		 ))))
    (format (if est-hide-cgi-mode
		"rep.id=%s"
	      "rep.id:%s")
	    (est-uri-encode-feature-name-body
	     (format "%s" (concord-object-id object))))))

(defun est-format-object (object &optional readable)
  (if (characterp object)
      (char-to-string object)
    (let ((ret (or (if readable
		       (or (concord-object-get object 'name)
			   (concord-object-get object '=name)
			   (concord-object-get object 'title)))
		   (concord-object-id object))))
      (format "%s" ret))))

(defun www-uri-make-object-url (object &optional uri-object)
  (if est-hide-cgi-mode
      (format "%s/%s/%s"
	      est-view-url-prefix
	      (est-object-genre object)
	      (or uri-object
		  (www-uri-encode-object object)))
    (format "%s?%s=%s"
	    chise-wiki-view-url
	    (est-object-genre object)
	    (or uri-object
		(www-uri-encode-object object)))))


;;; @ Feature name presentation
;;;

(defun www-format-feature-name-default (feature-name)
  (mapconcat
   #'capitalize
   (split-string
    (symbol-name feature-name)
    "-")
   " "))

(defun www-format-feature-name-as-metadata (feature-name &optional lang)
  (let ((str (symbol-name feature-name))
	base meta)
    (cond
     ((string-match "\\*[^*]+$" str)
      (setq base (substring str 0 (match-beginning 0))
	    meta (substring str (match-beginning 0)))
      (concat (www-format-feature-name* (intern base) lang)
	      meta))
     (t
      (www-format-feature-name-default feature-name)
      ))))

(defun www-format-feature-name-as-rel-to (feature-name)
  (concat "\u2192" (substring (symbol-name feature-name) 2)))

(defun www-format-feature-name-as-rel-from (feature-name)
  (concat "\u2190" (substring (symbol-name feature-name) 2)))

(defun www-format-feature-name-as-CCS (feature-name)
  (let* ((rest
	  (split-string
	   (symbol-name feature-name)
	   "-"))
	 (dest (upcase (pop rest))))
    (when (string-match "^=+>*" dest)
      (setq dest (concat (substring dest 0 (match-end 0))
			 " "
			 (substring dest (match-end 0)))))
    (cond
     (rest
      (while (cdr rest)
	(setq dest (concat dest " " (upcase (pop rest)))))
      (if (string-match "^[0-9]+$" (car rest))
	  (concat dest "-" (car rest))
	(concat dest " " (upcase (car rest))))
      )
     (t dest))))

(defun www-format-feature-name* (feature-name &optional lang)
  (let (name fn parent ret)
    (cond
     ((or (and lang
	       (char-feature-property
		feature-name
		(intern (format "name@%s" lang))))
	  (char-feature-property
	   feature-name 'name)))
     ((and (setq name (symbol-name feature-name))
	   (string-match "\\*" name))
      (www-format-feature-name-as-metadata feature-name lang))
     (t
      (setq fn feature-name)
      (while (and (setq parent (char-feature-name-parent fn))
		  (null (setq ret
			      (or (and lang
				       (char-feature-property
					parent
					(intern (format "name@%s" lang))))
				  (char-feature-property
				   parent 'name)))))
	(setq fn parent))
      (cond
       (ret
	(concat ret (substring (symbol-name feature-name)
			       (length (symbol-name parent)))))
       ((find-charset feature-name)
	(www-format-feature-name-as-CCS feature-name))
       ((string-match "^\\(->\\)" name)
	(www-format-feature-name-as-rel-to feature-name))
       ((string-match "^\\(<-\\)" name)
	(www-format-feature-name-as-rel-from feature-name))
       (t
	(www-format-feature-name-default feature-name)
	))
      ))))

(defun www-format-feature-name (feature-name &optional lang)
  (www-format-encode-string
   (www-format-feature-name* feature-name lang)))


;;; @ HTML generator
;;;

(defvar www-format-char-img-style "vertical-align:bottom;")

(defun www-format-encode-string (string &optional without-tags as-body)
  (with-temp-buffer
    (insert string)
    (let (plane code subcode start end char variants ret rret)
      (when as-body
	(goto-char (point-min))
	(while (search-forward "&" nil t)
	  (replace-match "&amp;" nil t)))
      (goto-char (point-min))
      (while (search-forward "<" nil t)
	(replace-match "&lt;" nil t))
      (goto-char (point-min))
      (while (search-forward ">" nil t)
	(replace-match "&gt;" nil t))
      (if without-tags
	  (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
	(let ((coded-charset-entity-reference-alist
	       (list*
		'(=gt			"GT-" 5 d)
		'(=mj			 "MJ" 6 d)
		'(=hanyo-denshi/ja   "HD-JA-" 4 X)
		'(=hanyo-denshi/jb   "HD-JB-" 4 X)
		'(=hanyo-denshi/jc   "HD-JC-" 4 X)
		'(=hanyo-denshi/jd   "HD-JD-" 4 X)
		'(=hanyo-denshi/ft   "HD-FT-" 4 X)
		'(=hanyo-denshi/ia   "HD-IA-" 4 X)
		'(=hanyo-denshi/ib   "HD-IB-" 4 X)
		'(=hanyo-denshi/hg   "HD-HG-" 4 X)
		'(=hanyo-denshi/ip   "HD-IP-" 4 X)
		'(=hanyo-denshi/jt   "HD-JT-" 4 X)
		'(=hanyo-denshi/ks   "HD-KS-" 6 d)
		'(=>>hanyo-denshi/ja "G-HD-JA-" 4 X)
		'(=>>hanyo-denshi/jb "G-HD-JB-" 4 X)
		'(=>>hanyo-denshi/jc "G-HD-JC-" 4 X)
		'(=>>hanyo-denshi/jd "G-HD-JD-" 4 X)
		'(=>>hanyo-denshi/ft "G-HD-FT-" 4 X)
		'(=>>hanyo-denshi/ia "G-HD-IA-" 4 X)
		'(=>>hanyo-denshi/ib "G-HD-IB-" 4 X)
		'(=>>hanyo-denshi/hg "G-HD-HG-" 4 X)
		'(=>>hanyo-denshi/ip "G-HD-IP-" 4 X)
		'(=>>hanyo-denshi/jt "G-HD-JT-" 4 X)
		'(=>>hanyo-denshi/ks "G-HD-KS-" 6 d)
		'(==mj			"g2-MJ" 6 d)
		'(==hanyo-denshi/ja "g2-HD-JA-" 4 X)
		'(==hanyo-denshi/jb "g2-HD-JB-" 4 X)
		'(==hanyo-denshi/jc "g2-HD-JC-" 4 X)
		'(==hanyo-denshi/jd "g2-HD-JD-" 4 X)
		'(==hanyo-denshi/ft "g2-HD-FT-" 4 X)
		'(==hanyo-denshi/ia "g2-HD-IA-" 4 X)
		'(==hanyo-denshi/ib "g2-HD-IB-" 4 X)
		'(==hanyo-denshi/hg "g2-HD-HG-" 4 X)
		'(==hanyo-denshi/ip "g2-HD-IP-" 4 X)
		'(==hanyo-denshi/jt "g2-HD-JT-" 4 X)
		'(==hanyo-denshi/ks "g2-HD-KS-" 6 d)
		'(=cns11643-1		"C1-" 4 X)
		'(=cns11643-2		"C2-" 4 X)
		'(=cns11643-3		"C3-" 4 X)
		'(=cns11643-4		"C4-" 4 X)
		'(=cns11643-5		"C5-" 4 X)
		'(=cns11643-6		"C6-" 4 X)
		'(=cns11643-7		"C7-" 4 X)
		'(=adobe-japan1-6	"AJ1-" 5 d)
		'(=big5-cdp	        "CDP-" 4 X)
		'(=gb2312		"G0-" 4 X)
		'(=gb12345		"G1-" 4 X)
		'(=jis-x0208@1990	"J90-" 4 X)
		'(=jis-x0212		"JSP-" 4 X)
		'(=cbeta		"CB" 5 d)
		'(=jis-x0208@1997	"J97-" 4 X)
		'(=jis-x0208@1978	"J78-" 4 X)
		'(=jis-x0208@1983	"J83-" 4 X)
		'(=ruimoku-v6		"RUI6-" 4 X)
		'(=zinbun-oracle	"ZOB-" 4 d)
		'(=jef-china3		"JC3-" 4 X)
		'(=ucs@unicode	        "UU+" 4 X)
		'(=ucs@JP/hanazono  "hanaJU+" 4 X)
		'(==cns11643-1	      "R-C1-" 4 X)
		'(==cns11643-2	      "R-C2-" 4 X)
		'(==cns11643-3	      "R-C3-" 4 X)
		'(==cns11643-4	      "R-C4-" 4 X)
		'(==cns11643-5	      "R-C5-" 4 X)
		'(==cns11643-6	      "R-C6-" 4 X)
		'(==cns11643-7	      "R-C7-" 4 X)
		'(=hanziku-1	     "HZK01-" 4 X)
		'(=hanziku-2	     "HZK02-" 4 X)
		'(=hanziku-3	     "HZK03-" 4 X)
		'(=hanziku-4	     "HZK04-" 4 X)
		'(=hanziku-5	     "HZK05-" 4 X)
		'(=hanziku-6	     "HZK06-" 4 X)
		'(=hanziku-7	     "HZK07-" 4 X)
		'(=hanziku-8	     "HZK08-" 4 X)
		'(=hanziku-9	     "HZK09-" 4 X)
		'(=hanziku-10	     "HZK10-" 4 X)
		'(=hanziku-11	     "HZK11-" 4 X)
		'(=hanziku-12	     "HZK12-" 4 X)
		'(=big5			 "B-" 4 X)
		'(=daikanwa		 "M-" 5 d)
		coded-charset-entity-reference-alist)))
	  (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(A-\\|G-\\|g2-\\)?CB\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\"
style=\"%s\">"
		     code
		     chise-wiki-bitmap-glyphs-url
		     (/ code 1000) code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq plane (match-string 2)
		  code (string-to-int (match-string 3) 16))
	    (replace-match
	     (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\"
style=\"%s\">"
		     plane code
		     chise-wiki-bitmap-glyphs-url
		     plane
		     (- (lsh code -8) 32)
		     (- (logand code 255) 32)
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"J0-%04X\" src=\"%s/JIS-90/%02d-%02d.gif\"
style=\"%s\">"
		     code
		     chise-wiki-bitmap-glyphs-url
		     (- (lsh code -8) 32)
		     (- (logand code 255) 32)
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-\\(JA\\|JB\\|JC\\|JD\\|FT\\|IA\\|IB\\|HG\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq plane (match-string 2)
		  code (string-to-int (match-string 3) 16))
	    (replace-match
	     (format "<img alt=\"HD-%s-%04X\" src=\"%s/IVD/HanyoDenshi/%s%02d%02d.png\"
style=\"%s\">"
		     plane code
		     chise-wiki-bitmap-glyphs-url
		     plane
		     (- (lsh code -8) 32)
		     (- (logand code 255) 32)
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-\\(IP\\|JT\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq plane (match-string 2)
		  code (string-to-int (match-string 3) 16))
	    (replace-match
	     (format "<img alt=\"HD-%s-%04X\" src=\"%s/IVD/HanyoDenshi/%s%04X.png\"
style=\"%s\">"
		     plane code
		     chise-wiki-bitmap-glyphs-url
		     plane code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-KS-\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"HD-KS%06d\" src=\"%s/IVD/HanyoDenshi/KS%06d.png\"
style=\"vertical-align:middle\">"
		     code
		     chise-wiki-bitmap-glyphs-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq plane (string-to-int (match-string 1))
		  code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\"
style=\"%s\">"
		     plane code
		     chise-wiki-bitmap-glyphs-url
		     plane
		     (- (lsh code -8) 32)
		     (- (logand code 255) 32)
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(R-\\)?C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq plane (string-to-int (match-string 2))
		  code (string-to-int (match-string 3) 16))
	    (replace-match
	     (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\"
style=\"%s\">"
		     plane code
		     chise-wiki-bitmap-glyphs-url
		     plane code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(R-\\)?JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
	    (setq code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"JC3-%04X\" src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/%04x.gif\">"
		     code code)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\"
style=\"vertical-align:middle\">"
		     code
		     chise-wiki-bitmap-glyphs-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&HNG\\([0-9]+\\)-\\([0-9][0-9][0-9][0-9]\\)\\([0-9]\\);" nil t)
	    (setq plane (match-string 1)
		  code (string-to-int (match-string 2))
		  subcode (string-to-int (match-string 3)))
	    (setq subcode
		  (if (eq subcode 0)
		      ""
		    (char-to-string (decode-char 'ascii (+ 96 subcode)))))
	    (replace-match
	     (format
	      "<img alt=\"HNG%s-%04d%s\" src=\"%s/%s/%04d%s.png\"
style=\"vertical-align:middle; width: 48px; height: 48px\">"
	      plane code subcode
	      chise-wiki-hng-bitmap-glyphs-url
	      plane code subcode
	      www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?AJ1-\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"AJ1-%05d\" src=\"%s/IVD/AdobeJapan1/CID+%d.png\"
style=\"vertical-align:middle\">"
		     code
		     chise-wiki-bitmap-glyphs-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?MJ\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"MJ%06d\" src=\"http://mojikiban.ipa.go.jp/search/MJ%06d\"
style=\"vertical-align:middle; width: 48px; height: 48px\">"
		     code
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(o-\\|G-\\|g2-\\)?IU[+-]\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"u%04x\" src=\"http://glyphwiki.org/glyph/u%04x.100px.png\"
style=\"vertical-align:middle; width: 48px; height: 48px\">"
		     code
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&U-i\\([0-9]+\\)\\+\\([0-9A-F]+\\);" nil t)
	    (setq plane (string-to-int (match-string 1))
		  code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"u%04x-itaiji-%03d\" src=\"http://glyphwiki.org/glyph/u%04x-itaiji-%03d.100px.png\"
style=\"vertical-align:middle; width: 48px; height: 48px\">"
		     code
		     plane
		     code
		     plane
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&A-IWDSU\\+\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 1) 16))
	    (replace-match
	     (format "<img alt=\"A-IWDSU+%04x\" src=\"http://glyphwiki.org/glyph/u%04x.100px.png\"
style=\"vertical-align:middle; width: 48px; height: 48px\">"
		     code
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&U-v\\([0-9]+\\)\\+\\([0-9A-F]+\\);" nil t)
	    (setq plane (string-to-int (match-string 1))
		  code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"u%04x-itaiji-%03d\" src=\"http://glyphwiki.org/glyph/u%04x-var-%03d.100px.png\"
style=\"vertical-align:middle; width: 48px; height: 48px\">"
		     code
		     plane
		     code
		     plane
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(A-\\|G-\\|R-\\|g2-\\)?GT-\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\"
style=\"%s\">"
		     code
		     chise-wiki-glyph-cgi-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(G-\\)?GT-K\\([0-9]+\\);" nil t)
	    (setq code (string-to-int (match-string 2)))
	    (replace-match
	     (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\"
style=\"%s\">"
		     code
		     chise-wiki-glyph-cgi-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 1) 16))
	    (replace-match
	     (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\"
style=\"%s\">"
		     code
		     chise-wiki-glyph-cgi-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(G-\\|g2-\\|R-\\)?CDP-\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 2) 16))
	    (replace-match
	     (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\"
style=\"%s\">"
		     code
		     chise-wiki-glyph-cgi-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward
		  "&\\(I-\\)?HZK\\(0[1-9]\\|1[0-2]\\)-\\([0-9A-F]+\\);" nil t)
	    (setq plane (match-string 2)
		  code (string-to-int (match-string 3) 16))
	    (replace-match
	     (format "<img alt=\"HZK%s-%04X\" src=\"%s?char=HZK%s-%04X\"
style=\"%s\">"
		     plane
		     code
		     chise-wiki-glyph-cgi-url
		     plane
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&RUI6-\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 1) 16))
	    (replace-match
	     (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\"
style=\"vertical-align:middle\">"
		     code
		     chise-wiki-glyph-cgi-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&hanaJU\\+\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 1) 16))
	    (replace-match
	     (format "<img alt=\"hanaJU+%04X\" src=\"%s?char=hana-JU+%04X\"
style=\"vertical-align:middle\">"
		     code
		     chise-wiki-glyph-cgi-url
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 3) 16))
	    (replace-match
	     (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\"
style=\"vertical-align:middle\">"
		     code
		     code
		     www-format-char-img-style)
	     t 'literal))

	  (goto-char (point-min))
	  (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
	    (setq code (string-to-int (match-string 1) 16))
	    (setq start (match-beginning 0)
		  end (match-end 0))
	    (setq char (decode-char 'system-char-id code))
	    (cond
	     ((and (setq variants
			 (or (www-get-feature-value char '->subsumptive)
			     (www-get-feature-value char '->denotational)))
		   (progn
		     (while (and variants
				 (setq ret (www-format-encode-string
					    (char-to-string (car variants))))
				 (string-match "&MCS-\\([0-9A-F]+\\);" ret))
		       (setq variants (cdr variants)))
		     ret))
	      (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
		(goto-char start)
		(delete-region start end)
		(insert ret))
	      )
	     ((setq ret (or (www-get-feature-value char 'ideographic-combination)
			    (www-get-feature-value char 'ideographic-structure)))
	      (setq ret
		    (mapconcat
		     (lambda (ch)
		       (if (listp ch)
			   (if (characterp (setq rret (find-char ch)))
			       (setq ch rret)))
		       (if (characterp ch)
			   (www-format-encode-string
			    (char-to-string ch) without-tags)
			 (www-format-encode-string
			  (format "%S" ch) without-tags)))
		     ret ""))
	      (when ret
		(goto-char start)
		(delete-region start end)
		(insert ret))
	      )))
	  ))
      ;; (goto-char (point-min))
      ;; (while (search-forward "&GT-" nil t)
      ;;   (replace-match "&amp;GT-" t 'literal))
      (buffer-string))))

(defun www-html-display-text (text)
  (princ
   (with-temp-buffer
     (insert text)
     (goto-char (point-min))
     (while (search-forward "<" nil t)
       (replace-match "&lt;" nil t))
     (goto-char (point-min))
     (while (search-forward ">" nil t)
       (replace-match "&gt;" nil t))
     (goto-char (point-min))
     (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t)
       (replace-match
	(format "<a href=\"%s\">%s</a>"
		(match-string 2)
		(match-string 1))
	nil t))
     (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
     (goto-char (point-min))
     (while (search-forward "&GT-" nil t)
       (replace-match "&amp;GT-" nil t))
     (buffer-string))))

(defun www-html-display-paragraph (text)
  (princ "<p>")
  (www-html-display-text text)
  (princ "</p>\n"))


;;; @ for GlyphWiki
;;;

(defvar coded-charset-GlyphWiki-id-alist
  '((===adobe-japan1-0	"aj1-"	5 d nil)
    (===adobe-japan1-1	"aj1-"	5 d nil)
    (===adobe-japan1-2	"aj1-"	5 d nil)
    (===adobe-japan1-3	"aj1-"	5 d nil)
    (===adobe-japan1-4	"aj1-"	5 d nil)
    (===adobe-japan1-5	"aj1-"	5 d nil)
    (===adobe-japan1-6	"aj1-"	5 d nil)
    (===ucs@jis		"u"	4 x nil)
    (===daikanwa	"dkw-"	5 d nil)
    (===ucs@ks		"u"	4 x "-k")
    (=ucs-var-001	"u"	4 x "-var-001")
    (=ucs-var-002	"u"	4 x "-var-002")
    (=ucs-var-003	"u"	4 x "-var-003")
    (=ucs-itaiji-001	"u"	4 x "-itaiji-001")
    (=ucs-itaiji-002	"u"	4 x "-itaiji-002")
    (=ucs-itaiji-003	"u"	4 x "-itaiji-003")
    (=ucs-itaiji-084	"u"	4 x "-itaiji-084")
    (==adobe-japan1-0	"aj1-"	5 d nil)
    (==adobe-japan1-1	"aj1-"	5 d nil)
    (==adobe-japan1-2	"aj1-"	5 d nil)
    (==adobe-japan1-3	"aj1-"	5 d nil)
    (==adobe-japan1-4	"aj1-"	5 d nil)
    (==adobe-japan1-5	"aj1-"	5 d nil)
    (==adobe-japan1-6	"aj1-"	5 d nil)
    (==ucs@jis		"u"	4 x nil)
    (==ucs@iso		"u"	4 x nil)
    (==ucs@cns		"u"	4 x "-t")
    (==ucs@unicode	"u"	4 x "-us")
    (==daikanwa		"dkw-"	5 d nil)
    (==ucs@ks		"u"	4 x "-k")
    (==jis-x0208@1978	"j78-"	4 x nil)
    (==jis-x0208	"j90-"	4 x nil)
    (==jis-x0208@1990	"j90-"	4 x nil)
    (==jis-x0208@1983	"j83-"	4 x nil)
    (==cbeta	       "cbeta-" 5 d nil)
    (=>>hanyo-denshi/ks	"koseki-" 6 d nil)
    (=>>jis-x0208@1978	"j78-"	4 x nil)
    (=>>big5-cdp	"cdp-"	4 x nil)
    (=>>jis-x0208	"j90-"	4 x nil)
    (=>>jis-x0208@1990	"j90-"	4 x nil)
    (=>>jis-x0208@1983	"j83-"	4 x nil)
    (=>>daikanwa	"dkw-"	5 d nil)
    (=adobe-japan1-0	"aj1-"	5 d nil)
    (=adobe-japan1-1	"aj1-"	5 d nil)
    (=adobe-japan1-2	"aj1-"	5 d nil)
    (=adobe-japan1-3	"aj1-"	5 d nil)
    (=adobe-japan1-4	"aj1-"	5 d nil)
    (=adobe-japan1-5	"aj1-"	5 d nil)
    (=adobe-japan1-6	"aj1-"	5 d nil)
    (=decomposition@cid)
    (=decomposition@hanyo-denshi)
    (=hanyo-denshi/ks	"koseki-" 6 d nil)
    (=koseki		"koseki-" 6 d nil)
    (=ucs@jis		"u"	4 x nil)
    (=ucs@cns		"u"	4 x "-t")
    (=ucs@ks		"u"	4 x "-k")
    (=ucs@JP		"u"	4 x nil)
    (=ucs@gb		"u"	4 x "-g")
    (=ucs@iso		"u"	4 x "-u")
    (=ucs@unicode	"u"	4 x "-us")
    (=big5-cdp		"cdp-"	4 x nil)
    (=cbeta	       "cbeta-"	5 d nil)
    (=big5-cdp-var-3	"cdp-"	4 x "-var-3")
    (=big5-cdp-var-5	"cdp-"	4 x "-var-5")
    (=jef-china3	"jc3-"	4 x nil)
    (=jis-x0212		"jsp-"	4 x nil)
    (=jis-x0213-1@2000	"jx1-2000-" 4 x nil)
    (=jis-x0213-1@2004	"jx1-2004-" 4 x nil)
    (=jis-x0213-2	"jx2-"	4 x nil)
    (=gt-k		"gt-k"	5 d nil)
    (=jis-x0208@1978/1pr "j78-"	4 x nil)
    (=jis-x0208@1978/-4pr "j78-" 4 x nil)
    (=jis-x0208@1978	"j78-"	4 x nil)
    (=+>jis-x0208@1978	"j78-"	4 x nil)
    (=+>jis-x0208	"j90-"	4 x nil)
    (=+>jis-x0208@1990	"j90-"	4 x nil)
    (=+>jis-x0208@1983	"j83-"	4 x nil)
    (=ucs		"u"	4 x nil)
    (=big5		"b-"	4 x nil)
    (=daikanwa		"dkw-"	5 d nil)
    (=gt		"gt-"	5 d nil)
    (=ks-x1001		"k0-"	4 x nil)
    (=cns11643-1	"c1-"	4 x nil)
    (=cns11643-2	"c2-"	4 x nil)
    (=cns11643-3	"c3-"	4 x nil)
    (=cns11643-4	"c4-"	4 x nil)
    (=cns11643-5	"c5-"	4 x nil)
    (=cns11643-6	"c6-"	4 x nil)
    (=cns11643-7	"c7-"	4 x nil)
    (=jis-x0208		"j90-"	4 x nil)
    (=jis-x0208@1990	"j90-"	4 x nil)
    (=jis-x0208@1983	"j83-"	4 x nil)
    ))

(defun char-GlyphWiki-id (char)
  (let ((rest coded-charset-GlyphWiki-id-alist)
	spec ret code)
    (while (and rest
		(setq spec (pop rest))
		(null (setq ret (char-feature char (car spec))))))
    (when ret
      (or
       (and (listp ret)
	    (mapconcat #'char-GlyphWiki-id ret "-"))
       (and (memq (car spec) '(=ucs@unicode '=ucs@iso))
	    (cond
	     ((and (or (encode-char char '=jis-x0208@1990)
		       (encode-char char '=jis-x0212)
		       (encode-char char '=jis-x0213-1)
		       (encode-char char '=jis-x0213-2))
		   (setq code (encode-char char '=ucs@jis)))
	      (format "u%04x" code)
	      )
	     ((and (or (encode-char char '=gb2312)
		       (encode-char char '=gb12345))
		   (setq code (encode-char char '=ucs@gb)))
	      (format "u%04x-g" code)
	      )
	     ((and (or (encode-char char '=cns11643-1)
		       (encode-char char '=cns11643-2)
		       (encode-char char '=cns11643-3)
		       (encode-char char '=cns11643-4)
		       (encode-char char '=cns11643-5)
		       (encode-char char '=cns11643-6)
		       (encode-char char '=cns11643-7))
		   (setq code (encode-char char '=ucs@cns)))
	      (format "u%04x-t" code)
	      )
	     ((and (encode-char char '=ks-x1001)
		   (setq code (encode-char char '=ucs@ks)))
	      (format "u%04x-k" code)
	      )))
       (format (format "%s%%0%d%s%s"
		       (nth 1 spec)
		       (nth 2 spec)
		       (nth 3 spec)
		       (or (nth 4 spec) ""))
	       ret)))))


;;; @ End.
;;;

(provide 'cwiki-common)

;;; cwiki-common.el ends here