cwiki-common.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'char-db-util)
   3
   4 (setq file-name-coding-system 'utf-8-mcs-er)
   5
   6
   7 (concord-assign-genre 'creator@ruimoku "/usr/local/var/ruimoku/db")
   8
   9 (concord-assign-genre 'journal-volume@ruimoku "/usr/local/var/ruimoku/db")
  10 (concord-assign-genre 'article@ruimoku "/usr/local/var/ruimoku/db")
  11 (concord-assign-genre 'book@ruimoku "/usr/local/var/ruimoku/db")
  12
  13 (concord-assign-genre 'classification@ruimoku "/usr/local/var/ruimoku/db")
  14 (concord-assign-genre 'region@ruimoku "/usr/local/var/ruimoku/db")
  15 (concord-assign-genre 'era@ruimoku "/usr/local/var/ruimoku/db")
  16 (concord-assign-genre 'period@ruimoku "/usr/local/var/ruimoku/db")
  17 (concord-assign-genre 'journal@ruimoku "/usr/local/var/ruimoku/db")
  18
  19
  20 (defvar chise-wiki-view-url "view.cgi")
  21 (defvar chise-wiki-edit-url "edit.cgi")
  22
  23 (defvar chise-wiki-bitmap-glyphs-url
  24   "http://chise.zinbun.kyoto-u.ac.jp/glyphs")
  25
  26 (defvar chise-wiki-glyph-cgi-url
  27   "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
  28
  29 (defvar chise-wiki-displayed-features nil)
  30
  31 (defun decode-uri-string (string &optional coding-system)
  32   (if (> (length string) 0)
  33       (let ((i 0)
  34             dest)
  35         (setq string
  36               (mapconcat (lambda (char)
  37                            (if (eq char ?+)
  38                                " "
  39                              (char-to-string char)))
  40                          string ""))
  41         (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
  42           (setq dest (concat dest
  43                              (substring string i (match-beginning 0))
  44                              (char-to-string
  45                               (int-char
  46                                (string-to-int (match-string 1 string) 16))))
  47                 i (match-end 0)))
  48         (decode-coding-string
  49          (concat dest (substring string i))
  50          coding-system))))
  51
  52 (defun www-feature-type (feature-name)
  53   (or (char-feature-property feature-name 'type)
  54       (let ((str (symbol-name feature-name)))
  55         (cond
  56          ((string-match "\\*note\\(@[^*]+\\)?$" str)
  57           'stext)
  58          ((string-match "\\*sources\\(@[^*]+\\)?$" str)
  59           'domain-list)
  60          ((string-match "\\*" str)
  61           nil)
  62          ((string-match "^\\(->\\|<-\\)" str)
  63           'relation)
  64          ((string-match "^ideographic-structure\\(@\\|$\\)" str)
  65           'structure)
  66          ))))
  67
  68 (defun www-feature-format (feature-name)
  69   (or (char-feature-property feature-name 'format)
  70       (let (fn parent ret)
  71         (setq fn feature-name)
  72         (while (and (setq parent (char-feature-name-parent fn))
  73                     (null (setq ret
  74                                 (char-feature-property
  75                                  parent 'format))))
  76           (setq fn parent))
  77         ret)
  78       '((name) " : " (value))))
  79
  80 (defun www-feature-value-format (feature-name)
  81   (or (char-feature-property feature-name 'value-format)
  82       (let (fn parent ret)
  83         (setq fn feature-name)
  84         (while (and (setq parent (char-feature-name-parent fn))
  85                     (null (setq ret
  86                                 (char-feature-property
  87                                  parent 'value-format))))
  88           (setq fn parent))
  89         ret)
  90       (let ((type (www-feature-type feature-name)))
  91         (cond ((eq type 'relation)
  92                'space-separated-char-list)
  93               ((eq type 'structure)
  94                'space-separated-ids)
  95               ((eq type 'stext)
  96                'wiki-text)
  97               ))
  98       (if (find-charset feature-name)
  99           (if (and (= (charset-dimension feature-name) 2)
 100                    (= (charset-chars feature-name) 94))
 101               '("0x" (HEX)
 102                 " (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char))
 103             '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))))
 104
 105 (defun char-feature-name-at-domain (feature-name domain)
 106   (if domain
 107       (let ((name (symbol-name feature-name)))
 108         (cond
 109          ((string-match "@[^*]+$" name)
 110           (intern (format "%s/%s" name domain))
 111           )
 112          (t
 113           (intern (format "%s@%s" name domain))
 114           )))
 115     feature-name))
 116
 117 (defun char-feature-name-parent (feature-name)
 118   (let ((name (symbol-name feature-name)))
 119     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
 120         (intern (substring name 0 (car (last (match-data) 2)))))))
 121
 122 (defun char-feature-name-domain (feature-name)
 123   (let ((name (symbol-name feature-name)))
 124     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
 125         (intern (substring name (1+ (match-beginning 0)))))))
 126
 127 (defun char-feature-name-sans-versions (feature)
 128   (let ((feature-name (symbol-name feature)))
 129     (if (string-match "[@/]\\$rev=latest$" feature-name)
 130         (intern (substring feature-name 0 (match-beginning 0)))
 131       feature)))
 132
 133 (defun www-get-feature-value (object feature)
 134   (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
 135     (cond
 136      ((characterp object)
 137       (mount-char-attribute-table latest-feature)
 138       (or (char-feature object latest-feature)
 139           (char-feature object feature))
 140       )
 141      (t
 142       (or (condition-case nil
 143               (concord-object-get object latest-feature)
 144             (error nil))
 145           (condition-case nil
 146               (concord-object-get object feature)
 147             (error nil)))
 148       ))))
 149
 150 (defun get-previous-code-point (ccs code)
 151   (let ((chars (charset-chars ccs))
 152         (dim (charset-dimension ccs))
 153         (i 0)
 154         mask byte-min byte-max
 155         bytes dest)
 156     (cond
 157      ((= chars 94)
 158       (setq mask #x7F
 159             byte-min 33
 160             byte-max 126)
 161       )
 162      ((= chars 96)
 163       (setq mask #x7F
 164             byte-min 32
 165             byte-max 127)
 166       )
 167      ((= chars 128)
 168       (setq mask #x7F
 169             byte-min 0
 170             byte-max #xFF)
 171       )
 172      (t ; (= chars 256)
 173       (setq mask #xFF
 174             byte-min 0
 175             byte-max #xFF)
 176       ))
 177     (setq bytes (make-vector dim 0))
 178     (while (< i dim)
 179       (aset bytes i (logand (lsh code (* i -8)) mask))
 180       (setq i (1+ i)))
 181     (setq i 0)
 182     (while (and (< i dim)
 183                 (progn
 184                   (aset bytes i (1- (aref bytes i)))
 185                   (< (aref bytes i) byte-min)))
 186       (aset bytes i byte-max)
 187       (setq i (1+ i)))
 188     (when (< i dim)
 189       (setq dest (aref bytes 0)
 190             i 1)
 191       (while (< i dim)
 192         (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
 193               i (1+ i)))
 194       dest)))
 195
 196 (defun get-next-code-point (ccs code)
 197   (let ((chars (charset-chars ccs))
 198         (dim (charset-dimension ccs))
 199         (i 0)
 200         mask byte-min byte-max
 201         bytes dest)
 202     (cond
 203      ((= chars 94)
 204       (setq mask #x7F
 205             byte-min 33
 206             byte-max 126)
 207       )
 208      ((= chars 96)
 209       (setq mask #x7F
 210             byte-min 32
 211             byte-max 127)
 212       )
 213      ((= chars 128)
 214       (setq mask #x7F
 215             byte-min 0
 216             byte-max #xFF)
 217       )
 218      (t ; (= chars 256)
 219       (setq mask #xFF
 220             byte-min 0
 221             byte-max #xFF)
 222       ))
 223     (setq bytes (make-vector dim 0))
 224     (while (< i dim)
 225       (aset bytes i (logand (lsh code (* i -8)) mask))
 226       (setq i (1+ i)))
 227     (setq i 0)
 228     (while (and (< i dim)
 229                 (progn
 230                   (aset bytes i (1+ (aref bytes i)))
 231                   (> (aref bytes i) byte-max)))
 232       (aset bytes i byte-min)
 233       (setq i (1+ i)))
 234     (when (< i dim)
 235       (setq dest (aref bytes 0)
 236             i 1)
 237       (while (< i dim)
 238         (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
 239               i (1+ i)))
 240       dest)))
 241
 242 (defun find-previous-defined-code-point (ccs code)
 243   (let ((i (get-previous-code-point ccs code))
 244         char)
 245     (cond
 246      ((eq ccs '=jis-x0208)
 247       (setq ccs '=jis-x0208@1990))
 248      ((eq ccs '=jis-x0213-1)
 249       (setq ccs '=jis-x0213-1@2004)))
 250     (while (and i
 251                 (>= i 0)
 252                 (null (setq char (decode-char ccs i
 253                                               (unless (eq ccs '=ucs)
 254                                                 'defined-only)))))
 255       (setq i (get-previous-code-point ccs i)))
 256     char))
 257
 258 (defun find-next-defined-code-point (ccs code)
 259   (let ((i (get-next-code-point ccs code))
 260         max char)
 261     (setq max (+ code 1000))
 262     (cond
 263      ((eq ccs '=jis-x0208)
 264       (setq ccs '=jis-x0208@1990))
 265      ((eq ccs '=jis-x0213-1)
 266       (setq ccs '=jis-x0213-1@2004)))
 267     (while (and i
 268                 (<= i max)
 269                 (null (setq char (decode-char ccs i
 270                                               (unless (eq ccs '=ucs)
 271                                                 'defined-only)))))
 272       (setq i (get-next-code-point ccs i)))
 273     char))
 274
 275
 276 ;;; @ URI representation
 277 ;;;
 278
 279 (defun www-uri-decode-feature-name (uri-feature)
 280   (let (feature)
 281     (cond
 282      ((string-match "^from\\." uri-feature)
 283       (intern (format "<-%s" (substring uri-feature (match-end 0))))
 284       )
 285      ((string-match "^to\\." uri-feature)
 286       (intern (format "->%s" (substring uri-feature (match-end 0))))
 287       )
 288      ((string-match "^rep\\." uri-feature)
 289       (intern (format "=%s" (substring uri-feature (match-end 0))))
 290       )
 291      ((string-match "^g\\." uri-feature)
 292       (intern (format "=>>%s" (substring uri-feature (match-end 0))))
 293       )
 294      ((string-match "^gi\\." uri-feature)
 295       (intern (format "=>>>%s" (substring uri-feature (match-end 0))))
 296       )
 297      ((string-match "^gi\\([0-9]+\\)\\." uri-feature)
 298       (intern (format "=>>%s%s"
 299                       (make-string (string-to-int
 300                                     (match-string 1 uri-feature))
 301                                    ?>)
 302                       (substring uri-feature (match-end 0))))
 303       )
 304      ((string-match "^a\\." uri-feature)
 305       (intern (format "=>%s" (substring uri-feature (match-end 0))))
 306       )
 307      ((string-match "^a\\([0-9]+\\)\\." uri-feature)
 308       (intern (format "%s>%s"
 309                       (make-string (string-to-int
 310                                     (match-string 1 uri-feature))
 311                                    ?=)
 312                       (substring uri-feature (match-end 0))))
 313       )
 314      ((and (setq feature (intern (format "=>%s" uri-feature)))
 315            (find-charset feature))
 316       feature)
 317      ((and (setq feature (intern (format "=>>%s" uri-feature)))
 318            (find-charset feature))
 319       feature)
 320      ((and (setq feature (intern (format "=>>>%s" uri-feature)))
 321            (find-charset feature))
 322       feature)
 323      ((and (setq feature (intern (format "=%s" uri-feature)))
 324            (find-charset feature))
 325       feature)
 326      (t (intern uri-feature)))))
 327
 328 (defun www-uri-encode-feature-name (feature-name)
 329   (setq feature-name (symbol-name feature-name))
 330   (cond
 331    ((string-match "^=\\([^=>]+\\)" feature-name)
 332     (concat "rep." (substring feature-name (match-beginning 1)))
 333     )
 334    ((string-match "^=>>\\([^=>]+\\)" feature-name)
 335     (concat "g." (substring feature-name (match-beginning 1)))
 336     )
 337    ((string-match "^=>>>\\([^=>]+\\)" feature-name)
 338     (concat "gi." (substring feature-name (match-beginning 1)))
 339     )
 340    ((string-match "^=>>\\(>+\\)" feature-name)
 341     (format "gi%d.%s"
 342             (length (match-string 1 feature-name))
 343             (substring feature-name (match-end 1)))
 344     )
 345    ((string-match "^=>\\([^=>]+\\)" feature-name)
 346     (concat "a." (substring feature-name (match-beginning 1)))
 347     )
 348    ((string-match "^\\(=+\\)>" feature-name)
 349     (format "a%d.%s"
 350             (length (match-string 1 feature-name))
 351             (substring feature-name (match-end 0)))
 352     )
 353    ((string-match "^->" feature-name)
 354     (concat "to." (substring feature-name (match-end 0)))
 355     )
 356    ((string-match "^<-" feature-name)
 357     (concat "from." (substring feature-name (match-end 0)))
 358     )
 359    (t feature-name)))
 360
 361 (defun www-uri-make-feature-name-url (uri-feature-name uri-char)
 362   (format "%s?feature=%s&char=%s"
 363           chise-wiki-view-url uri-feature-name uri-char))
 364
 365 (defun www-uri-decode-object (genre char-rep)
 366   (let (ccs cpos)
 367     (cond
 368      ((string-match "\\(%3A\\|:\\)" char-rep)
 369       (setq ccs (substring char-rep 0 (match-beginning 0))
 370             cpos (substring char-rep (match-end 0)))
 371       (setq ccs (www-uri-decode-feature-name ccs))
 372       (cond
 373        ((string-match "^0x" cpos)
 374         (setq cpos
 375               (string-to-number (substring cpos (match-end 0)) 16))
 376         )
 377        (t
 378         (setq cpos (car (read-from-string cpos)))
 379         ))
 380       (if (and (eq genre 'character)
 381                (numberp cpos))
 382           (decode-char ccs cpos)
 383         (concord-decode-object ccs cpos genre))
 384       )
 385      (t
 386       (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
 387       (cond
 388        ((eq genre 'character)
 389         (when (= (length char-rep) 1)
 390           (aref char-rep 0))
 391         )
 392        ((eq genre 'feature)
 393         (concord-decode-object
 394          '=id (www-uri-decode-feature-name char-rep) 'feature)
 395         )
 396        (t
 397         (concord-decode-object
 398          '=id (car (read-from-string char-rep)) genre)
 399         ))))))
 400
 401 (defun www-uri-encode-object (object)
 402   (if (characterp object)
 403       (if (encode-char object '=ucs)
 404           (mapconcat
 405            (lambda (byte)
 406              (format "%%%02X" byte))
 407            (encode-coding-string (char-to-string object) 'utf-8-mcs-er)
 408            "")
 409         (let ((ccs-list '(; =ucs
 410                           =cns11643-1 =cns11643-2 =cns11643-3
 411                           =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
 412                           =gb2312 =gb12345
 413                           =jis-x0208 =jis-x0208@1990
 414                           =jis-x0212
 415                           =cbeta =jef-china3
 416                           =jis-x0213-1@2000 =jis-x0213-1@2004
 417                           =jis-x0208@1983 =jis-x0208@1978
 418                           =zinbun-oracle =>zinbun-oracle
 419                           =daikanwa
 420                           =gt =gt-k
 421                           =>>jis-x0208 =>>jis-x0213-1
 422                           =>jis-x0208 =>jis-x0213-1
 423                           =>>gt
 424                           =ruimoku-v6
 425                           =big5
 426                           =big5-cdp))
 427               ccs ret)
 428           (while (and ccs-list
 429                       (setq ccs (pop ccs-list))
 430                       (not (setq ret (encode-char object ccs 'defined-only)))))
 431           (cond (ret
 432                  (format "%s:0x%X"
 433                          (www-uri-encode-feature-name ccs)
 434                          ret))
 435                 ((and (setq ccs (car (split-char object)))
 436                       (setq ret (encode-char object ccs)))
 437                  (format "%s:0x%X"
 438                          (www-uri-encode-feature-name ccs)
 439                          ret))
 440                 (t
 441                  (format "system-char-id:0x%X"
 442                          (encode-char object 'system-char-id))
 443                  ))))
 444     (format "rep.id:%s" (concord-object-id object))))
 445
 446 (defun est-format-object (object)
 447   (if (characterp object)
 448       (char-to-string object)
 449     (format "%s" (concord-object-id object))))
 450
 451
 452 ;;; @ Feature name presentation
 453 ;;;
 454
 455 (defun www-format-feature-name-default (feature-name)
 456   (mapconcat
 457    #'capitalize
 458    (split-string
 459     (symbol-name feature-name)
 460     "-")
 461    " "))
 462
 463 (defun www-format-feature-name-as-metadata (feature-name &optional lang)
 464   (let ((str (symbol-name feature-name))
 465         base meta)
 466     (cond
 467      ((string-match "\\*[^*]+$" str)
 468       (setq base (substring str 0 (match-beginning 0))
 469             meta (substring str (match-beginning 0)))
 470       (concat (www-format-feature-name* (intern base) lang)
 471               meta))
 472      (t
 473       (www-format-feature-name-default feature-name)
 474       ))))
 475
 476 (defun www-format-feature-name-as-rel-to (feature-name)
 477   (concat "\u2192" (substring (symbol-name feature-name) 2)))
 478
 479 (defun www-format-feature-name-as-rel-from (feature-name)
 480   (concat "\u2190" (substring (symbol-name feature-name) 2)))
 481
 482 (defun www-format-feature-name-as-CCS (feature-name)
 483   (let* ((rest
 484           (split-string
 485            (symbol-name feature-name)
 486            "-"))
 487          (dest (upcase (pop rest))))
 488     (when (string-match "^=+>*" dest)
 489       (setq dest (concat (substring dest 0 (match-end 0))
 490                          " "
 491                          (substring dest (match-end 0)))))
 492     (cond
 493      (rest
 494       (while (cdr rest)
 495         (setq dest (concat dest " " (upcase (pop rest)))))
 496       (if (string-match "^[0-9]+$" (car rest))
 497           (concat dest "-" (car rest))
 498         (concat dest " " (upcase (car rest))))
 499       )
 500      (t dest))))
 501
 502 (defun www-format-feature-name* (feature-name &optional lang)
 503   (let (name fn parent ret)
 504     (cond
 505      ((or (and lang
 506                (char-feature-property
 507                 feature-name
 508                 (intern (format "name@%s" lang))))
 509           (char-feature-property
 510            feature-name 'name)))
 511      ((and (setq name (symbol-name feature-name))
 512            (string-match "\\*" name))
 513       (www-format-feature-name-as-metadata feature-name lang))
 514      (t
 515       (setq fn feature-name)
 516       (while (and (setq parent (char-feature-name-parent fn))
 517                   (null (setq ret
 518                               (or (and lang
 519                                        (char-feature-property
 520                                         parent
 521                                         (intern (format "name@%s" lang))))
 522                                   (char-feature-property
 523                                    parent 'name)))))
 524         (setq fn parent))
 525       (cond
 526        (ret
 527         (concat ret (substring (symbol-name feature-name)
 528                                (length (symbol-name parent)))))
 529        ((find-charset feature-name)
 530         (www-format-feature-name-as-CCS feature-name))
 531        ((string-match "^\\(->\\)" name)
 532         (www-format-feature-name-as-rel-to feature-name))
 533        ((string-match "^\\(<-\\)" name)
 534         (www-format-feature-name-as-rel-from feature-name))
 535        (t
 536         (www-format-feature-name-default feature-name)
 537         ))
 538       ))))
 539
 540 (defun www-format-feature-name (feature-name &optional lang)
 541   (www-format-encode-string
 542    (www-format-feature-name* feature-name lang)))
 543
 544
 545 ;;; @ Feature value presentation
 546 ;;;
 547
 548 (defun www-format-value-as-kuten (value)
 549   (format "%02d-%02d"
 550           (- (lsh value -8) 32)
 551           (- (logand value 255) 32)))
 552
 553 (defun www-format-value-default (value &optional without-tags)
 554   (if (listp value)
 555       (mapconcat
 556        (lambda (unit)
 557          (www-format-encode-string
 558           (format "%S" unit)
 559           without-tags))
 560        value " ")
 561     (www-format-encode-string (format "%S" value) without-tags)))
 562
 563 (defun www-format-value-as-char-list (value &optional without-tags)
 564   (if (listp value)
 565       (mapconcat
 566        (if without-tags
 567            (lambda (unit)
 568              (www-format-encode-string
 569               (format (if (characterp unit)
 570                           "%c"
 571                         "%s")
 572                       unit)
 573               'without-tags))
 574          (let (genre-o name-f ret)
 575            (lambda (unit)
 576              (if (characterp unit)
 577                  (format "<a href=\"%s?char=%s\">%s</a>"
 578                          chise-wiki-view-url
 579                          (www-uri-encode-object unit)
 580                          (www-format-encode-string (char-to-string unit)))
 581                (format "<a href=\"%s?%s=%s\">%s</a>"
 582                        chise-wiki-view-url
 583                        (concord-object-genre unit)
 584                        (concord-object-id unit)
 585                        (cond
 586                         ((setq ret
 587                                (www-get-feature-value
 588                                 unit
 589                                 (setq name-f
 590                                       (if (setq genre-o
 591                                                 (concord-decode-object
 592                                                  '=id
 593                                                  (concord-object-genre unit)
 594                                                  'genre))
 595                                           (www-get-feature-value
 596                                            genre-o
 597                                            'object-representation-format)
 598                                         'name))))
 599                          (www-format-eval-feature-value
 600                           unit name-f nil nil nil ret
 601                           'without-tags 'without-edit)
 602                          )
 603                         (t
 604                          (www-format-encode-string
 605                           (format "%S" unit))
 606                          ))
 607                        unit)))))
 608        value " ")
 609     (www-format-encode-string (format "%s" value) without-tags)))
 610
 611 (defun www-format-value-as-domain-list (value &optional without-tags)
 612   (let (name source0 source num dest rest unit start end ddest)
 613     (if (listp value)
 614         (if without-tags
 615             (mapconcat
 616              (lambda (unit)
 617                (format "%s" unit))
 618              value " ")
 619           (setq rest value)
 620           (while rest
 621             (setq unit (pop rest))
 622             (if (symbolp unit)
 623                 (setq name (symbol-name unit)))
 624             (setq dest
 625                   (concat
 626                    dest
 627                    (cond
 628                     ((string-match "^zob1968=" name)
 629                      (setq source (intern (substring name 0 (match-end 0)))
 630                            num (substring name (match-end 0)))
 631                      (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
 632                          (setq start (string-to-number
 633                                       (match-string 1 num))
 634                                end (string-to-number
 635                                     (match-string 2 num)))
 636                        (setq start (string-to-number num)
 637                              end start))
 638                      (setq ddest
 639                            (if (eq source source0)
 640                                (format
 641                                 ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
 642                                 start start)
 643                              (setq source0 source)
 644                              (format
 645                               " <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/\">%s</a>=<a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
 646                               (www-format-encode-string "\u4EAC大人\u6587研甲\u9AA8")
 647                               start start)))
 648                      (setq start (1+ start))
 649                      (while (<= start end)
 650                        (setq ddest
 651                              (concat
 652                               ddest
 653                               (format
 654                                ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
 655                                start start)))
 656                        (setq start (1+ start)))
 657                      ddest)
 658                     (t
 659                      (setq source unit)
 660                      (if (eq source source0)
 661                          ""
 662                        (setq source0 source)
 663                        (concat " " name))
 664                      )))))
 665           dest)
 666       (www-format-encode-string (format "%s" value) without-tags))))
 667
 668 (defun www-format-value-as-ids (value &optional without-tags)
 669   (if (listp value)
 670       (mapconcat
 671        (if without-tags
 672            (lambda (unit)
 673              (www-format-encode-string
 674               (format (if (characterp unit)
 675                           "%c"
 676                         "%s")
 677                       unit)
 678               'without-tags))
 679          (lambda (unit)
 680            (if (characterp unit)
 681                (format "<a href=\"%s?char=%s\">%s</a>"
 682                        chise-wiki-view-url
 683                        (www-uri-encode-object unit)
 684                        (www-format-encode-string (char-to-string unit)))
 685              (www-format-encode-string (format "%s" unit)))))
 686        (ideographic-structure-to-ids value) " ")
 687     (www-format-encode-string (format "%s" value) without-tags)))
 688
 689 (defun www-format-value-as-S-exp (value &optional without-tags)
 690   (www-format-encode-string (format "%S" value) without-tags))
 691
 692 (defun www-format-value-as-HEX (value)
 693   (if (integerp value)
 694       (format "%X" value)
 695     (www-format-value-as-S-exp value)))
 696
 697 (defun www-format-value-as-CCS-default (value)
 698   (if (integerp value)
 699       (format "0x%s (%d)"
 700               (www-format-value-as-HEX value)
 701               value)
 702     (www-format-value-as-S-exp value)))
 703
 704 (defun www-format-value-as-CCS-94x94 (value)
 705   (if (integerp value)
 706       (format "0x%s [%s] (%d)"
 707               (www-format-value-as-HEX value)
 708               (www-format-value-as-kuten value)
 709               value)
 710     (www-format-value-as-S-exp value)))
 711
 712 (defun www-format-value-as-kangxi-radical (value)
 713   (if (and (integerp value)
 714            (<= 0 value)
 715            (<= value 214))
 716       (www-format-encode-string
 717        (format "%c" (ideographic-radical value)))
 718     (www-format-value-as-S-exp value)))
 719
 720 (defun www-format-value (object feature-name
 721                                 &optional value format
 722                                 without-tags without-edit)
 723   (unless value
 724     (setq value (www-get-feature-value object feature-name)))
 725   (www-format-apply-value object feature-name
 726                           format nil value nil nil
 727                           without-tags without-edit)
 728   )
 729
 730
 731 ;;; @ format evaluator
 732 ;;;
 733
 734 (defun www-format-encode-string (string &optional without-tags)
 735   (with-temp-buffer
 736     (insert string)
 737     (let (plane code start end char variants ret rret)
 738       (goto-char (point-min))
 739       (while (search-forward "<" nil t)
 740         (replace-match "&lt;" nil t))
 741       (goto-char (point-min))
 742       (while (search-forward ">" nil t)
 743         (replace-match "&gt;" nil t))
 744       (if without-tags
 745           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 746         (let ((coded-charset-entity-reference-alist
 747                (list*
 748                 '(=gt                   "GT-" 5 d)
 749                 '(=cns11643-1           "C1-" 4 X)
 750                 '(=cns11643-2           "C2-" 4 X)
 751                 '(=cns11643-3           "C3-" 4 X)
 752                 '(=cns11643-4           "C4-" 4 X)
 753                 '(=cns11643-5           "C5-" 4 X)
 754                 '(=cns11643-6           "C6-" 4 X)
 755                 '(=cns11643-7           "C7-" 4 X)
 756                 '(=gb2312               "G0-" 4 X)
 757                 '(=gb12345              "G1-" 4 X)
 758                 '(=jis-x0208@1990       "J90-" 4 X)
 759                 '(=jis-x0212            "JSP-" 4 X)
 760                 '(=cbeta                "CB" 5 d)
 761                 '(=jis-x0208@1997       "J97-" 4 X)
 762                 '(=jis-x0208@1978       "J78-" 4 X)
 763                 '(=jis-x0208@1983       "J83-" 4 X)
 764                 '(=ruimoku-v6           "RUI6-" 4 X)
 765                 '(=zinbun-oracle        "ZOB-" 4 d)
 766                 '(=jef-china3           "JC3-" 4 X)
 767                 '(=daikanwa             "M-" 5 d)
 768                 coded-charset-entity-reference-alist)))
 769           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 770
 771           (goto-char (point-min))
 772           (while (re-search-forward "&CB\\([0-9]+\\);" nil t)
 773             (setq code (string-to-int (match-string 1)))
 774             (replace-match
 775              (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\">"
 776                      code
 777                      chise-wiki-bitmap-glyphs-url
 778                      (/ code 1000) code)
 779              t 'literal))
 780
 781           (goto-char (point-min))
 782           (while (re-search-forward "&J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 783             (setq plane (match-string 1)
 784                   code (string-to-int (match-string 2) 16))
 785             (replace-match
 786              (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\">"
 787                      plane code
 788                      chise-wiki-bitmap-glyphs-url
 789                      plane
 790                      (- (lsh code -8) 32)
 791                      (- (logand code 255) 32))
 792              t 'literal))
 793
 794           (goto-char (point-min))
 795           (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 796             (setq plane (string-to-int (match-string 1))
 797                   code (string-to-int (match-string 2) 16))
 798             (replace-match
 799              (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\">"
 800                      plane code
 801                      chise-wiki-bitmap-glyphs-url
 802                      plane
 803                      (- (lsh code -8) 32)
 804                      (- (logand code 255) 32))
 805              t 'literal))
 806
 807           (goto-char (point-min))
 808           (while (re-search-forward "&C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 809             (setq plane (string-to-int (match-string 1))
 810                   code (string-to-int (match-string 2) 16))
 811             (replace-match
 812              (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\">"
 813                      plane code
 814                      chise-wiki-bitmap-glyphs-url
 815                      plane code)
 816              t 'literal))
 817
 818           (goto-char (point-min))
 819           (while (re-search-forward "&JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 820             (setq code (string-to-int (match-string 1) 16))
 821             (replace-match
 822              (format "<img alt=\"JC3-%04X\" src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/%04x.gif\">"
 823                      code code)
 824              t 'literal))
 825
 826           (goto-char (point-min))
 827           (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
 828             (setq code (string-to-int (match-string 2)))
 829             (replace-match
 830              (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\">"
 831                      code
 832                      chise-wiki-bitmap-glyphs-url
 833                      code)
 834              t 'literal))
 835
 836           (goto-char (point-min))
 837           (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
 838             (setq code (string-to-int (match-string 2)))
 839             (replace-match
 840              (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\">"
 841                      code
 842                      chise-wiki-glyph-cgi-url
 843                      code)
 844              t 'literal))
 845
 846           (goto-char (point-min))
 847           (while (re-search-forward "&\\(G-\\)?GT-K\\([0-9]+\\);" nil t)
 848             (setq code (string-to-int (match-string 2)))
 849             (replace-match
 850              (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\">"
 851                      code
 852                      chise-wiki-glyph-cgi-url
 853                      code)
 854              t 'literal))
 855
 856           (goto-char (point-min))
 857           (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
 858             (setq code (string-to-int (match-string 1) 16))
 859             (replace-match
 860              (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\">"
 861                      code
 862                      chise-wiki-glyph-cgi-url
 863                      code)
 864              t 'literal))
 865
 866           (goto-char (point-min))
 867           (while (re-search-forward "&CDP-\\([0-9A-F]+\\);" nil t)
 868             (setq code (string-to-int (match-string 1) 16))
 869             (replace-match
 870              (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\">"
 871                      code
 872                      chise-wiki-glyph-cgi-url
 873                      code)
 874              t 'literal))
 875
 876           (goto-char (point-min))
 877           (while (re-search-forward "&RUI6-\\([0-9A-F]+\\);" nil t)
 878             (setq code (string-to-int (match-string 1) 16))
 879             (replace-match
 880              (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\">"
 881                      code
 882                      chise-wiki-glyph-cgi-url
 883                      code)
 884              t 'literal))
 885
 886           (goto-char (point-min))
 887           (while (re-search-forward "&\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
 888             (setq code (string-to-int (match-string 2) 16))
 889             (replace-match
 890              (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\">"
 891                      code
 892                      code)
 893              t 'literal))
 894
 895           (goto-char (point-min))
 896           (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
 897             (setq code (string-to-int (match-string 1) 16))
 898             (setq start (match-beginning 0)
 899                   end (match-end 0))
 900             (setq char (decode-char 'system-char-id code))
 901             (cond
 902              ((and (setq variants
 903                          (or (www-get-feature-value char '->subsumptive)
 904                              (www-get-feature-value char '->denotational)))
 905                    (progn
 906                      (while (and variants
 907                                  (setq ret (www-format-encode-string
 908                                             (char-to-string (car variants))))
 909                                  (string-match "&MCS-\\([0-9A-F]+\\);" ret))
 910                        (setq variants (cdr variants)))
 911                      ret))
 912               (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
 913                 (goto-char start)
 914                 (delete-region start end)
 915                 (insert ret))
 916               )
 917              ((setq ret (or (www-get-feature-value char 'ideographic-combination)
 918                             (www-get-feature-value char 'ideographic-structure)))
 919               (setq ret
 920                     (mapconcat
 921                      (lambda (ch)
 922                        (if (listp ch)
 923                            (if (characterp (setq rret (find-char ch)))
 924                                (setq ch rret)))
 925                        (if (characterp ch)
 926                            (www-format-encode-string
 927                             (char-to-string ch) without-tags)
 928                          (www-format-encode-string
 929                           (format "%S" ch) without-tags)))
 930                      ret ""))
 931               (when ret
 932                 (goto-char start)
 933                 (delete-region start end)
 934                 (insert ret))
 935               )))
 936           ))
 937       ;; (goto-char (point-min))
 938       ;; (while (search-forward "&GT-" nil t)
 939       ;;   (replace-match "&amp;GT-" t 'literal))
 940       (buffer-string))))
 941
 942 (defun www-format-props-to-string (props &optional format)
 943   (unless format
 944     (setq format (plist-get props :format)))
 945   (concat "%"
 946           (plist-get props :flag)
 947           ;; (if (plist-get props :zero-padding)
 948           ;;     "0")
 949           (if (plist-get props :len)
 950               (format "0%d"
 951                       (let ((ret (plist-get props :len)))
 952                         (if (stringp ret)
 953                             (string-to-int ret)
 954                           ret))))
 955           (cond
 956            ((eq format 'decimal) "d")
 957            ((eq format 'hex) "x")
 958            ((eq format 'HEX) "X")
 959            ((eq format 'S-exp) "S")
 960            (t "s"))))
 961
 962 (defun www-format-apply-value (object feature-name
 963                                       format props value
 964                                       &optional uri-object uri-feature
 965                                       without-tags without-edit)
 966   (let (ret)
 967     (setq ret
 968           (cond
 969            ((memq format '(decimal hex HEX))
 970             (if (integerp value)
 971                 (format (www-format-props-to-string props format)
 972                         value)
 973               (www-format-encode-string
 974                (format "%s" value)
 975                without-tags))
 976             )
 977            ((eq format 'wiki-text)
 978             (if without-tags
 979                 (www-xml-format-list value)
 980               (www-format-eval-list value object feature-name nil uri-object
 981                                     without-tags without-edit))
 982             )
 983            ((eq format 'S-exp)
 984             (www-format-encode-string
 985              (format (www-format-props-to-string props format)
 986                      value)
 987              without-tags))
 988            ((eq format 'ku-ten)
 989             (www-format-value-as-kuten value))
 990            ((eq format 'kangxi-radical)
 991             (www-format-value-as-kangxi-radical value))
 992            ((eq format 'space-separated-char-list)
 993             (www-format-value-as-char-list value without-tags))
 994            ((eq format 'space-separated-ids)
 995             (www-format-value-as-ids value without-tags))
 996            ((eq format 'space-separated-domain-list)
 997             (www-format-value-as-domain-list value without-tags))
 998            ((eq format 'string)
 999             (www-format-encode-string (format "%s" value) without-tags)
1000             )
1001            (t
1002             (www-format-value-default value without-tags)
1003             ))
1004           )
1005     (if (or without-tags
1006             without-edit
1007             (eq (plist-get props :mode) 'peek))
1008         ret
1009       (format "%s <a href=\"%s?%s=%s&feature=%s&format=%s\"
1010 ><input type=\"submit\" value=\"edit\" /></a>"
1011               ret
1012               chise-wiki-edit-url
1013               (concord-object-genre object)
1014               uri-object uri-feature format))))
1015
1016 (defun www-format-eval-feature-value (object
1017                                       feature-name
1018                                       &optional format lang uri-object value
1019                                       without-tags without-edit)
1020   (unless value
1021     (setq value (www-get-feature-value object feature-name)))
1022   (unless format
1023     (setq format (www-feature-value-format feature-name)))
1024   (cond
1025    ((symbolp format)
1026     (www-format-apply-value
1027      object feature-name
1028      format nil value
1029      uri-object (www-uri-encode-feature-name feature-name)
1030      without-tags without-edit)
1031     )
1032    ((consp format)
1033     (cond ((null (cdr format))
1034            (setq format (car format))
1035            (www-format-apply-value
1036             object feature-name
1037             (car format) (nth 1 format) value
1038             uri-object (www-uri-encode-feature-name feature-name)
1039             without-tags without-edit)
1040            )
1041           (t
1042            (www-format-eval-list format object feature-name lang uri-object
1043                                  without-tags without-edit)
1044            )))))
1045
1046 (defun www-format-eval-unit (exp object feature-name
1047                                  &optional lang uri-object value
1048                                  without-tags without-edit)
1049   (unless value
1050     (setq value (www-get-feature-value object feature-name)))
1051   (unless uri-object
1052     (setq uri-object (www-uri-encode-object object)))
1053   (cond
1054    ((stringp exp) (www-format-encode-string exp))
1055    ((null exp) "")
1056    ((consp exp)
1057     (cond
1058      ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
1059                               S-exp string default))
1060       (let ((fn (plist-get (nth 1 exp) :feature))
1061             domain domain-fn ret)
1062         (when fn
1063           (when (stringp fn)
1064             (setq fn (intern fn)))
1065           (setq domain (char-feature-name-domain feature-name))
1066           (setq domain-fn (char-feature-name-at-domain fn domain))
1067           (if (setq ret (www-get-feature-value object domain-fn))
1068               (setq feature-name domain-fn
1069                     value ret)
1070             (setq feature-name fn
1071                   value (www-get-feature-value object fn)))
1072           (push feature-name chise-wiki-displayed-features)
1073           ))
1074       (if (eq (car exp) 'value)
1075           (www-format-eval-feature-value object feature-name
1076                                          (plist-get (nth 1 exp) :format)
1077                                          lang uri-object value
1078                                          without-tags without-edit)
1079         (www-format-apply-value
1080          object feature-name
1081          (car exp) (nth 1 exp) value
1082          uri-object (www-uri-encode-feature-name feature-name)
1083          without-tags without-edit))
1084       )
1085      ((eq (car exp) 'name)
1086       (let ((fn (plist-get (nth 1 exp) :feature))
1087             domain domain-fn)
1088         (when fn
1089           (setq domain (char-feature-name-domain feature-name))
1090           (when (stringp fn)
1091             (setq fn (intern fn)))
1092           (setq domain-fn (char-feature-name-at-domain fn domain))
1093           (setq feature-name domain-fn)))
1094       (if without-tags
1095           (www-format-feature-name feature-name lang)
1096         (format "<a href=\"%s\">%s</a>"
1097                 (www-uri-make-feature-name-url
1098                  (www-uri-encode-feature-name feature-name)
1099                  uri-object)
1100                 (www-format-feature-name feature-name lang))
1101         )
1102       )
1103      ((eq (car exp) 'name-url)
1104       (let ((fn (plist-get (nth 1 exp) :feature))
1105             domain domain-fn)
1106         (when fn
1107           (setq domain (char-feature-name-domain feature-name))
1108           (when (stringp fn)
1109             (setq fn (intern fn)))
1110           (setq domain-fn (char-feature-name-at-domain fn domain))
1111           (setq feature-name domain-fn)))
1112       (www-uri-make-feature-name-url
1113        (www-uri-encode-feature-name feature-name)
1114        uri-object)
1115       )
1116      ((eq (car exp) 'domain-name)
1117       (let ((domain (char-feature-name-domain feature-name)))
1118         (if domain
1119             (format "@%s" domain))))
1120      ((eq (car exp) 'prev-char)
1121       (if without-tags
1122           ""
1123         (let ((prev-char (find-previous-defined-code-point
1124                           feature-name value)))
1125           (if prev-char
1126               (format "\n<a href=\"%s?char=%s\">%s</a>"
1127                       chise-wiki-view-url
1128                       (www-uri-encode-object prev-char)
1129                       "<input type=\"submit\" value=\"-\" />"
1130                       ;; (www-format-encode-string
1131                       ;;  (char-to-string prev-char))
1132                       )
1133             "")))
1134       )
1135      ((eq (car exp) 'next-char)
1136       (if without-tags
1137           ""
1138         (let ((next-char (find-next-defined-code-point
1139                           feature-name value)))
1140           (if next-char
1141               (format "<a href=\"%s?char=%s\">%s</a>"
1142                       chise-wiki-view-url
1143                       (www-uri-encode-object next-char)
1144                       "<input type=\"submit\" value=\"+\" />"
1145                       ;; (www-format-encode-string
1146                       ;;  (char-to-string next-char))
1147                       )
1148             "")))
1149       )
1150      ((eq (car exp) 'link)
1151       (if without-tags
1152           (www-format-eval-list (nthcdr 2 exp)
1153                                 object feature-name lang uri-object
1154                                 without-tags without-edit)
1155         (format "<a
1156  href=\"%s\"
1157 >%s</a
1158 >"
1159                 (www-format-eval-list (plist-get (nth 1 exp) :ref)
1160                                       object feature-name lang uri-object
1161                                       'without-tags 'without-edit)
1162                 (www-format-eval-list (nthcdr 2 exp)
1163                                       object feature-name lang uri-object
1164                                       without-tags without-edit)))
1165       )
1166      (t
1167       (format "<%s
1168 >%s</%s
1169 >"
1170               (car exp)
1171               (www-format-eval-list (nthcdr 2 exp) object feature-name
1172                                     lang uri-object
1173                                     without-tags without-edit)
1174               (car exp)))))))
1175
1176 (defun www-format-eval-list (format-list object feature-name
1177                                          &optional lang uri-object
1178                                          without-tags without-edit)
1179   (if (consp format-list)
1180       (mapconcat
1181        (lambda (exp)
1182          (www-format-eval-unit exp object feature-name lang uri-object
1183                                nil without-tags without-edit))
1184        format-list "")
1185     (www-format-eval-unit format-list object feature-name lang uri-object
1186                           nil without-tags without-edit)))
1187
1188
1189 ;;; @ XML generator
1190 ;;;
1191
1192 (defun www-xml-format-props (props)
1193   (let ((dest "")
1194         key val)
1195     (while props
1196       (setq key (pop props)
1197             val (pop props))
1198       (if (symbolp key)
1199           (setq key (symbol-name key)))
1200       (if (eq (aref key 0) ?:)
1201           (setq key (substring key 1)))
1202       (setq dest
1203             (format "%s %s=\"%s\""
1204                     dest key
1205                     (www-format-encode-string
1206                      (format "%s" val) 'without-tags))))
1207     dest))
1208
1209 (defun www-xml-format-unit (format-unit)
1210   (let (name props children ret)
1211     (cond
1212      ((stringp format-unit)
1213       (mapconcat (lambda (c)
1214                    (cond
1215                     ((eq c ?&) "&amp;")
1216                     ;; ((eq c ?<) "&amp;lt;")
1217                     ;; ((eq c ?>) "&amp;gt;")
1218                     (t
1219                      (char-to-string c))))
1220                  (www-format-encode-string format-unit 'without-tags)
1221                  "")
1222       )
1223      ((consp format-unit)
1224       (setq name (car format-unit)
1225             props (nth 1 format-unit)
1226             children (nthcdr 2 format-unit))
1227       (when (eq name 'link)
1228         (setq ret (plist-get props :ref))
1229         (unless (stringp ret)
1230           (setq props (plist-remprop (copy-list props) :ref))
1231           (setq children
1232                 (cons (list* 'ref nil ret)
1233                       children))))
1234       (if children
1235           (format "<%s%s>%s</%s>"
1236                   name
1237                   (if props
1238                       (www-xml-format-props props)
1239                     "")
1240                   (www-xml-format-list children)
1241                   name)
1242         (format "<%s%s/>"
1243                 name (www-xml-format-props props)))
1244       )
1245      (t
1246       (format "%s" format-unit)))))
1247
1248 (defun www-xml-format-list (format-list)
1249   (if (atom format-list)
1250       (www-xml-format-unit format-list)
1251     (mapconcat #'www-xml-format-unit
1252                format-list "")))
1253
1254
1255 ;;; @ HTML generator
1256 ;;;
1257
1258 (defun www-html-display-text (text)
1259   (princ
1260    (with-temp-buffer
1261      (insert text)
1262      (goto-char (point-min))
1263      (while (search-forward "<" nil t)
1264        (replace-match "&lt;" nil t))
1265      (goto-char (point-min))
1266      (while (search-forward ">" nil t)
1267        (replace-match "&gt;" nil t))
1268      (goto-char (point-min))
1269      (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t)
1270        (replace-match
1271         (format "<a href=\"%s\">%s</a>"
1272                 (match-string 2)
1273                 (match-string 1))
1274         nil t))
1275      (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
1276      (goto-char (point-min))
1277      (while (search-forward "&GT-" nil t)
1278        (replace-match "&amp;GT-" nil t))
1279      (buffer-string))))
1280
1281 (defun www-html-display-paragraph (text)
1282   (princ "<p>")
1283   (www-html-display-text text)
1284   (princ "</p>\n"))
1285
1286
1287 ;;; @ for GlyphWiki
1288 ;;;
1289
1290 (defvar coded-charset-GlyphWiki-id-alist
1291   '((=ucs               "u"     4 x nil)
1292     (=ucs@JP            "u"     4 x nil)
1293     (=ucs@jis           "u"     4 x nil)
1294     (=ucs@gb            "u"     4 x "-g")
1295     (=ucs@cns           "u"     4 x "-t")
1296     (=ucs@ks            "u"     4 x "-k")
1297     (=ucs@iso           "u"     4 x "-u")
1298     (=ucs@unicode       "u"     4 x "-us")
1299     (=adobe-japan1-6    "aj1-"  5 d nil)
1300     (=gt                "gt-"   5 d nil)
1301     (=big5-cdp          "cdp-"  4 x nil)
1302     (=cbeta             "cb"    5 d nil)
1303     (=jis-x0208@1978/1pr "j78-" 4 x nil)
1304     (=jis-x0208@1978/-4pr "j78-" 4 x nil)
1305     (=jis-x0208@1978    "j78-"  4 x nil)
1306     (=jis-x0208@1983    "j83-"  4 x nil)
1307     (=jis-x0208@1990    "j90-"  4 x nil)
1308     (=jis-x0212         "jsp-"  4 x nil)
1309     (=jis-x0213-1@2000  "jx1-2000-" 4 x nil)
1310     (=jis-x0213-1@2004  "jx1-2004-" 4 x nil)
1311     (=jis-x0213-2       "jx2-"  4 x nil)
1312     (=cns11643-1        "c1-"   4 x nil)
1313     (=cns11643-2        "c2-"   4 x nil)
1314     (=cns11643-3        "c3-"   4 x nil)
1315     (=cns11643-4        "c4-"   4 x nil)
1316     (=cns11643-5        "c5-"   4 x nil)
1317     (=cns11643-6        "c6-"   4 x nil)
1318     (=cns11643-7        "c7-"   4 x nil)
1319     (=daikanwa          "dkw-"  5 d nil)
1320     (=gt-k              "gt-k"  5 d nil)
1321     (=jef-china3        "jc3-"  4 x nil)
1322     (=big5              "b-"    4 x nil)
1323     (=ks-x1001          "k0-"   4 x nil)
1324     ))
1325
1326 (defun char-GlyphWiki-id (char)
1327   (let ((rest coded-charset-GlyphWiki-id-alist)
1328         spec ret code)
1329     (while (and rest
1330                 (setq spec (pop rest))
1331                 (null (setq ret (char-feature char (car spec))))))
1332     (when ret
1333       (or
1334        (and (memq (car spec) '(=ucs@unicode '=ucs@iso))
1335             (cond
1336              ((and (or (encode-char char '=jis-x0208@1990)
1337                        (encode-char char '=jis-x0212)
1338                        (encode-char char '=jis-x0213-1))
1339                    (setq code (encode-char char '=ucs@jis)))
1340               (format "u%04x" code)
1341               )
1342              ((and (or (encode-char char '=gb2312)
1343                        (encode-char char '=gb12345))
1344                    (setq code (encode-char char '=ucs@gb)))
1345               (format "u%04x-g" code)
1346               )
1347              ((and (or (encode-char char '=cns11643-1)
1348                        (encode-char char '=cns11643-2)
1349                        (encode-char char '=cns11643-3)
1350                        (encode-char char '=cns11643-4)
1351                        (encode-char char '=cns11643-5)
1352                        (encode-char char '=cns11643-6)
1353                        (encode-char char '=cns11643-7))
1354                    (setq code (encode-char char '=ucs@cns)))
1355               (format "u%04x-t" code)
1356               )
1357              ((and (encode-char char '=ks-x1001)
1358                    (setq code (encode-char char '=ucs@ks)))
1359               (format "u%04x-k" code)
1360               )))
1361        (format (format "%s%%0%d%s%s"
1362                        (nth 1 spec)
1363                        (nth 2 spec)
1364                        (nth 3 spec)
1365                        (or (nth 4 spec) ""))
1366                ret)))))
1367
1368
1369 ;;; @ End.
1370 ;;;
1371
1372 (provide 'cwiki-common)
1373
1374 ;;; cwiki-common.el ends here