cwiki-common.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'char-db-util)
   3 (require 'chiset-common)
   4 ;; (require 'concord-images)
   5
   6 (setq file-name-coding-system 'utf-8-mcs-er)
   7
   8 (concord-assign-genre 'code-point "/usr/local/var/chise-ipld/db")
   9 (concord-assign-genre 'coded-character "/usr/local/var/chise-ipld/db")
  10 (concord-assign-genre 'glyph "/usr/local/var/chise-ipld/db")
  11
  12 (concord-assign-genre 'image-resource "/usr/local/var/photo/db")
  13 (concord-assign-genre 'glyph-image "/usr/local/var/photo/db")
  14
  15 (concord-assign-genre 'creator@ruimoku "/usr/local/var/ruimoku/db")
  16 (concord-assign-genre 'person-name@ruimoku "/usr/local/var/ruimoku/db")
  17
  18 (concord-assign-genre 'journal-volume@ruimoku "/usr/local/var/ruimoku/db")
  19 (concord-assign-genre 'article@ruimoku "/usr/local/var/ruimoku/db")
  20 (concord-assign-genre 'book@ruimoku "/usr/local/var/ruimoku/db")
  21
  22 (concord-assign-genre 'classification@ruimoku "/usr/local/var/ruimoku/db")
  23 (concord-assign-genre 'region@ruimoku "/usr/local/var/ruimoku/db")
  24 (concord-assign-genre 'era@ruimoku "/usr/local/var/ruimoku/db")
  25 (concord-assign-genre 'period@ruimoku "/usr/local/var/ruimoku/db")
  26 (concord-assign-genre 'journal@ruimoku "/usr/local/var/ruimoku/db")
  27 (concord-assign-genre 'journal-name@ruimoku "/usr/local/var/ruimoku/db")
  28 (concord-assign-genre 'publisher@ruimoku "/usr/local/var/ruimoku/db")
  29 (concord-assign-genre 'publisher-name@ruimoku "/usr/local/var/ruimoku/db")
  30
  31 (mount-char-attribute-table '*instance@ruimoku/bibliography/title)
  32 ;; (mount-char-attribute-table '*instance@ruimoku/bibliography/content*note)
  33
  34 (concord-assign-genre 'entry@zh-classical "/usr/local/var/kanbun/db")
  35 ;; (concord-assign-genre 'morpheme-entry@zh-classical "/usr/local/var/kanbun/db")
  36 (concord-assign-genre 'word-class@zh-classical "/usr/local/var/kanbun/db")
  37 (concord-assign-genre 'morpheme@zh-classical "/usr/local/var/kanbun/db")
  38 (concord-assign-genre 'sentence@zh-classical "/usr/local/var/kanbun/db")
  39 ;; (concord-assign-genre 'sentence-entry@zh-classical "/usr/local/var/kanbun/db")
  40
  41 (mount-char-attribute-table '*instance@morpheme-entry/zh-classical)
  42
  43 (concord-assign-genre 'ud@zh-classical "/usr/local/var/kanbun/db")
  44
  45
  46 (concord-assign-genre 'hng-card "/usr/local/var/hng-card/db")
  47
  48 (mount-char-attribute-table '->HNG)
  49 (mount-char-attribute-table '<-HNG)
  50 (mount-char-attribute-table '->HNG@CN/manuscript)
  51 (mount-char-attribute-table '<-HNG@CN/manuscript)
  52 (mount-char-attribute-table '->HNG@CN/printed)
  53 (mount-char-attribute-table '<-HNG@CN/printed)
  54 (mount-char-attribute-table '->HNG@JP/manuscript)
  55 (mount-char-attribute-table '<-HNG@JP/manuscript)
  56 (mount-char-attribute-table '->HNG@JP/printed)
  57 (mount-char-attribute-table '<-HNG@JP/printed)
  58 (mount-char-attribute-table '->HNG@KR)
  59 (mount-char-attribute-table '<-HNG@KR)
  60 (mount-char-attribute-table '->HNG@MISC)
  61 (mount-char-attribute-table '<-HNG@MISC)
  62
  63 (mount-char-attribute-table 'abstract-glyph@iwds-1)
  64 (mount-char-attribute-table 'abstract-glyph@iwds-1/confluented)
  65
  66
  67 (defvar est-hide-cgi-mode nil)
  68 (defvar est-view-url-prefix "..")
  69 (defvar chise-wiki-view-url "view.cgi")
  70 (defvar chise-wiki-edit-url "edit.cgi")
  71
  72 (defvar chise-wiki-bitmap-glyph-image-url
  73   "https://image.chise.org/glyphs")
  74
  75 (defvar chise-wiki-legacy-bitmap-glyphs-url
  76   "https://www.chise.org/glyphs")
  77
  78 (defvar chise-wiki-hng-bitmap-glyphs-url
  79   "https://image.hng-data.org/glyphs/HNG")
  80
  81 (defvar chise-wiki-daijiten-bitmap-glyphs-url
  82   "https://image.hng-data.org/glyphs/daijiten")
  83
  84 (defvar chise-wiki-glyphwiki-glyph-image-url
  85   "https://glyphwiki.org/glyph")
  86
  87 (defvar chise-wiki-glyph-cgi-url
  88   "https://www.chise.org/chisewiki/glyph.cgi")
  89
  90 (defvar chise-wiki-displayed-features nil)
  91
  92 (defvar est-coded-charset-priority-list
  93   '(; =ucs
  94     =cns11643-1 =cns11643-2 =cns11643-3
  95     =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
  96     =gb2312 =gb12345
  97     =jis-x0208 =jis-x0208@1990
  98     =jis-x0213-2
  99     =jis-x0212
 100     =adobe-japan1
 101     =cbeta =jef-china3
 102     =jis-x0213-1@2000 =jis-x0213-1@2004
 103     =jis-x0208@1983 =jis-x0208@1978
 104     =zinbun-oracle =>zinbun-oracle
 105     =daikanwa
 106     =gt =gt-k
 107     ==adobe-japan1
 108     ==jis-x0208 ==jis-x0213-1 ==jis-x0213-2
 109     =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
 110     =>>adobe-japan1
 111     =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
 112     =+>jis-x0208@1978
 113     =+>adobe-japan1
 114     =>jis-x0208 =>jis-x0213-1
 115     =>>gt
 116     =>ucs@iso =>ucs@unicode
 117     =>ucs@jis =>ucs@cns =>ucs@ks
 118     =+>ucs@iso =+>ucs@unicode
 119     =>>ucs@iso =>>ucs@unicode
 120     =>>ucs@jis =>>ucs@cns =>>ucs@ks
 121     ==ucs@iso ==ucs@unicode
 122     ==ucs@jis ==ucs@cns ==ucs@ks
 123     ===ucs@iso
 124     =ruimoku-v6
 125     =big5
 126     =big5-cdp
 127     =>cbeta
 128     =mj
 129     ==mj
 130     ===mj
 131     =ucs-itaiji-001
 132     =ucs-itaiji-002
 133     =ucs-itaiji-003
 134     =ucs-itaiji-004
 135     =ucs-itaiji-005
 136     =ucs-itaiji-006
 137     =ucs-itaiji-007
 138     =ucs-itaiji-008
 139     =ucs-itaiji-009
 140     =ucs-itaiji-010
 141     =ucs-itaiji-011
 142     =ucs-itaiji-084
 143     =ucs-var-001
 144     =ucs-var-002
 145     =ucs-var-003
 146     =ucs-var-004
 147     =ucs-var-010
 148     =ucs@unicode
 149     ==ucs@unicode
 150     ===ucs@unicode
 151     ==>daijiten
 152     ==>ucs@bucs
 153     ===daikanwa/+p
 154     ===gt
 155     =>ucs@iwds-1
 156     =>ucs@component
 157     =>ucs@cognate
 158     =>ucs-itaiji-001
 159     =>ucs-itaiji-002
 160     =>ucs-itaiji-003
 161     =>ucs-itaiji-004
 162     =>ucs-itaiji-005
 163     =>ucs-itaiji-006
 164     =>ucs-itaiji-007
 165     =>ucs-itaiji-008
 166     ===adobe-japan1
 167     ===cns11643-1 ===cns11643-2 ===cns11643-3
 168     ===cns11643-4 ===cns11643-5 ===cns11643-6 ===cns11643-7
 169     ))
 170
 171 (defun decode-uri-string (string &optional coding-system)
 172   (if (> (length string) 0)
 173       (let ((i 0)
 174             dest)
 175         (setq string
 176               (mapconcat (lambda (char)
 177                            (if (eq char ?+)
 178                                " "
 179                              (char-to-string char)))
 180                          string ""))
 181         (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
 182           (setq dest (concat dest
 183                              (substring string i (match-beginning 0))
 184                              (char-to-string
 185                               (int-char
 186                                (string-to-int (match-string 1 string) 16))))
 187                 i (match-end 0)))
 188         (decode-coding-string
 189          (concat dest (substring string i))
 190          coding-system))))
 191
 192 (defun www-feature-type (feature-name)
 193   (or (char-feature-property feature-name 'type)
 194       (let ((str (symbol-name feature-name)))
 195         (cond
 196          ((string-match "\\*note\\(@[^*]+\\)?$" str)
 197           'stext)
 198          ((string-match "\\*sources\\(@[^*]+\\)?$" str)
 199           'domain-list)
 200          ((string-match "\\*" str)
 201           nil)
 202          ((string-match "^\\(->\\|<-\\)" str)
 203           'relation)
 204          ((string-match "^ideographic-structure\\(@\\|$\\)" str)
 205           'structure)
 206          ))))
 207
 208 (defun www-feature-format (feature-name)
 209   (or (char-feature-property feature-name 'presentation-format)
 210       (char-feature-property feature-name 'format)
 211       (let (fn parent ret)
 212         (setq fn feature-name)
 213         (while (and (setq parent (char-feature-name-parent fn))
 214                     (null (setq ret
 215                                 (char-feature-property
 216                                  parent 'format))))
 217           (setq fn parent))
 218         ret)
 219       '((name) " : " (value))))
 220
 221 (defun www-feature-value-format (feature-name)
 222   (or (char-feature-property feature-name 'value-presentation-format)
 223       (char-feature-property feature-name 'value-format)
 224       (let (fn parent ret)
 225         (setq fn feature-name)
 226         (while (and (setq parent (char-feature-name-parent fn))
 227                     (null (setq ret
 228                                 (or (char-feature-property
 229                                      parent 'value-presentation-format)
 230                                     (char-feature-property
 231                                      parent 'value-format)))))
 232           (setq fn parent))
 233         ret)
 234       (let ((type (www-feature-type feature-name)))
 235         (cond ((eq type 'relation)
 236                'space-separated)
 237               ((eq type 'structure)
 238                'space-separated-ids)
 239               ((eq type 'stext)
 240                'wiki-text)
 241               ))
 242       (if (find-charset feature-name)
 243           (if (and (= (charset-dimension feature-name) 2)
 244                    (= (charset-chars feature-name) 94))
 245               '("0x" (HEX)
 246                 " (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char))
 247             '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))
 248       'space-separated))
 249
 250 (defun char-feature-name-at-domain (feature-name domain)
 251   (if domain
 252       (let ((name (symbol-name feature-name)))
 253         (cond
 254          ((string-match "@[^*]+$" name)
 255           (intern (format "%s/%s" name domain))
 256           )
 257          (t
 258           (intern (format "%s@%s" name domain))
 259           )))
 260     feature-name))
 261
 262 (defun char-feature-name-parent (feature-name)
 263   (let ((name (symbol-name feature-name)))
 264     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
 265         (intern (substring name 0 (car (last (match-data) 2)))))))
 266
 267 (defun char-feature-name-domain (feature-name)
 268   (let ((name (symbol-name feature-name)))
 269     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
 270         (intern (substring name (1+ (match-beginning 0)))))))
 271
 272 (defun char-feature-name-sans-versions (feature)
 273   (let ((feature-name (symbol-name feature)))
 274     (if (string-match "[@/]\\$rev=latest$" feature-name)
 275         (intern (substring feature-name 0 (match-beginning 0)))
 276       feature)))
 277
 278 (defun est-object-genre (object)
 279   (if (characterp object)
 280       'character
 281     (concord-object-genre object)))
 282
 283 (defun www-get-feature-value (object feature)
 284   (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
 285     (cond
 286      ((characterp object)
 287       (mount-char-attribute-table latest-feature)
 288       (or (char-feature object latest-feature)
 289           (char-feature object feature))
 290       )
 291      (t
 292       (or (condition-case nil
 293               (concord-object-get object latest-feature)
 294             (error nil))
 295           (condition-case nil
 296               (concord-object-get object feature)
 297             (error nil)))
 298       ))))
 299
 300 (defun get-previous-code-point (ccs code)
 301   (let ((chars (charset-chars ccs))
 302         (dim (charset-dimension ccs))
 303         (i 0)
 304         mask byte-min byte-max
 305         bytes dest)
 306     (cond
 307      ((= chars 94)
 308       (setq mask #x7F
 309             byte-min 33
 310             byte-max 126)
 311       )
 312      ((= chars 96)
 313       (setq mask #x7F
 314             byte-min 32
 315             byte-max 127)
 316       )
 317      ((= chars 128)
 318       (setq mask #x7F
 319             byte-min 0
 320             byte-max #xFF)
 321       )
 322      (t ; (= chars 256)
 323       (setq mask #xFF
 324             byte-min 0
 325             byte-max #xFF)
 326       ))
 327     (setq bytes (make-vector dim 0))
 328     (while (< i dim)
 329       (aset bytes i (logand (lsh code (* i -8)) mask))
 330       (setq i (1+ i)))
 331     (setq i 0)
 332     (while (and (< i dim)
 333                 (progn
 334                   (aset bytes i (1- (aref bytes i)))
 335                   (< (aref bytes i) byte-min)))
 336       (aset bytes i byte-max)
 337       (setq i (1+ i)))
 338     (when (< i dim)
 339       (setq dest (aref bytes 0)
 340             i 1)
 341       (while (< i dim)
 342         (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
 343               i (1+ i)))
 344       dest)))
 345
 346 (defun get-next-code-point (ccs code)
 347   (let ((chars (charset-chars ccs))
 348         (dim (charset-dimension ccs))
 349         (i 0)
 350         mask byte-min byte-max
 351         bytes dest)
 352     (cond
 353      ((= chars 94)
 354       (setq mask #x7F
 355             byte-min 33
 356             byte-max 126)
 357       )
 358      ((= chars 96)
 359       (setq mask #x7F
 360             byte-min 32
 361             byte-max 127)
 362       )
 363      ((= chars 128)
 364       (setq mask #x7F
 365             byte-min 0
 366             byte-max #xFF)
 367       )
 368      (t ; (= chars 256)
 369       (setq mask #xFF
 370             byte-min 0
 371             byte-max #xFF)
 372       ))
 373     (setq bytes (make-vector dim 0))
 374     (while (< i dim)
 375       (aset bytes i (logand (lsh code (* i -8)) mask))
 376       (setq i (1+ i)))
 377     (setq i 0)
 378     (while (and (< i dim)
 379                 (progn
 380                   (aset bytes i (1+ (aref bytes i)))
 381                   (> (aref bytes i) byte-max)))
 382       (aset bytes i byte-min)
 383       (setq i (1+ i)))
 384     (when (< i dim)
 385       (setq dest (aref bytes 0)
 386             i 1)
 387       (while (< i dim)
 388         (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
 389               i (1+ i)))
 390       dest)))
 391
 392 (defun find-previous-defined-code-point (ccs code)
 393   (let ((i (get-previous-code-point ccs code))
 394         char)
 395     (cond
 396      ((eq ccs '=jis-x0208)
 397       (setq ccs '=jis-x0208@1990))
 398      ((eq ccs '=jis-x0213-1)
 399       (setq ccs '=jis-x0213-1@2004)))
 400     (while (and i
 401                 (>= i 0)
 402                 (null (setq char (decode-char ccs i
 403                                               (unless (eq ccs '=ucs)
 404                                                 'defined-only)))))
 405       (setq i (get-previous-code-point ccs i)))
 406     char))
 407
 408 (defun find-next-defined-code-point (ccs code)
 409   (let ((i (get-next-code-point ccs code))
 410         max char)
 411     (setq max (+ code 1000))
 412     (cond
 413      ((eq ccs '=jis-x0208)
 414       (setq ccs '=jis-x0208@1990))
 415      ((eq ccs '=jis-x0213-1)
 416       (setq ccs '=jis-x0213-1@2004)))
 417     (while (and i
 418                 (<= i max)
 419                 (null (setq char (decode-char ccs i
 420                                               (unless (eq ccs '=ucs)
 421                                                 'defined-only)))))
 422       (setq i (get-next-code-point ccs i)))
 423     char))
 424
 425
 426 ;;; @ URI representation
 427 ;;;
 428
 429 ;; (defun est-uri-decode-feature-name-body (uri-feature)
 430 ;;   (let ((len (length uri-feature))
 431 ;;         (i 0)
 432 ;;         ch dest)
 433 ;;     (while (< i len)
 434 ;;       (setq dest
 435 ;;             (concat
 436 ;;              dest
 437 ;;              (if (eq (aref uri-feature i) ?\.)
 438 ;;                  (if (and (< (+ i 2) len)
 439 ;;                           (eq (aref uri-feature (+ i 2)) ?\.))
 440 ;;                      (prog1
 441 ;;                          (cond
 442 ;;                           ((eq (setq ch (aref uri-feature (1+ i))) ?\.)
 443 ;;                            "/")
 444 ;;                           ((eq ch ?-)
 445 ;;                            "*")
 446 ;;                           ((eq ch ?_)
 447 ;;                            "+")
 448 ;;                           (t
 449 ;;                            (substring uri-feature i (+ i 3))
 450 ;;                            ))
 451 ;;                        (setq i (+ i 3)))
 452 ;;                    (setq i (1+ i))
 453 ;;                    ".")
 454 ;;                (prog1
 455 ;;                    (char-to-string (aref uri-feature i))
 456 ;;                  (setq i (1+ i)))))))
 457 ;;     dest))
 458
 459 ;; (defun est-uri-encode-feature-name-body (feature)
 460 ;;   (mapconcat (lambda (c)
 461 ;;                (cond ((eq c ?*)
 462 ;;                       ".-.")
 463 ;;                      ((eq c ?/)
 464 ;;                       "...")
 465 ;;                      ((eq c ?+)
 466 ;;                       "._.")
 467 ;;                      (t (char-to-string c))))
 468 ;;              feature ""))
 469
 470 ;; (defun www-uri-decode-feature-name (uri-feature)
 471 ;;   (let (feature)
 472 ;;     (setq uri-feature (decode-uri-string uri-feature 'utf-8-mcs-er))
 473 ;;     (cond
 474 ;;      ((string-match "^from\\." uri-feature)
 475 ;;       (intern (format "<-%s"
 476 ;;                       (est-uri-decode-feature-name-body
 477 ;;                        (substring uri-feature (match-end 0)))))
 478 ;;       )
 479 ;;      ((string-match "^to\\." uri-feature)
 480 ;;       (intern (format "->%s"
 481 ;;                       (est-uri-decode-feature-name-body
 482 ;;                        (substring uri-feature (match-end 0)))))
 483 ;;       )
 484 ;;      ((string-match "^rep\\." uri-feature)
 485 ;;       (intern (format "=%s"
 486 ;;                       (est-uri-decode-feature-name-body
 487 ;;                        (substring uri-feature (match-end 0)))))
 488 ;;       )
 489 ;;      ((string-match "^rep[2i]\\." uri-feature)
 490 ;;       (intern (format "===%s"
 491 ;;                       (est-uri-decode-feature-name-body
 492 ;;                        (substring uri-feature (match-end 0)))))
 493 ;;       )
 494 ;;      ((string-match "^g\\." uri-feature)
 495 ;;       (intern (format "=>>%s"
 496 ;;                       (est-uri-decode-feature-name-body
 497 ;;                        (substring uri-feature (match-end 0)))))
 498 ;;       )
 499 ;;      ((string-match "^g[i2]\\." uri-feature)
 500 ;;       (intern (format "==%s"
 501 ;;                       (est-uri-decode-feature-name-body
 502 ;;                        (substring uri-feature (match-end 0)))))
 503 ;;       )
 504 ;;      ((string-match "^gi\\([0-9]+\\)\\." uri-feature)
 505 ;;       (intern (format "=>>%s%s"
 506 ;;                       (make-string (string-to-int
 507 ;;                                     (match-string 1 uri-feature))
 508 ;;                                    ?>)
 509 ;;                       (est-uri-decode-feature-name-body
 510 ;;                        (substring uri-feature (match-end 0)))))
 511 ;;       )
 512 ;;      ((string-match "^o\\." uri-feature)
 513 ;;       (intern (format "=+>%s"
 514 ;;                       (est-uri-decode-feature-name-body
 515 ;;                        (substring uri-feature (match-end 0)))))
 516 ;;       )
 517 ;;      ((string-match "^a\\." uri-feature)
 518 ;;       (intern (format "=>%s"
 519 ;;                       (est-uri-decode-feature-name-body
 520 ;;                        (substring uri-feature (match-end 0)))))
 521 ;;       )
 522 ;;      ((string-match "^a\\([0-9]+\\)\\." uri-feature)
 523 ;;       (intern (format "%s>%s"
 524 ;;                       (make-string (string-to-int
 525 ;;                                     (match-string 1 uri-feature))
 526 ;;                                    ?=)
 527 ;;                       (est-uri-decode-feature-name-body
 528 ;;                        (substring uri-feature (match-end 0)))))
 529 ;;       )
 530 ;;      ((and (setq uri-feature (est-uri-decode-feature-name-body uri-feature))
 531 ;;            (setq feature (intern (format "=>%s" uri-feature)))
 532 ;;            (find-charset feature))
 533 ;;       feature)
 534 ;;      ((and (setq feature (intern (format "=>>%s" uri-feature)))
 535 ;;            (find-charset feature))
 536 ;;       feature)
 537 ;;      ((and (setq feature (intern (format "=>>>%s" uri-feature)))
 538 ;;            (find-charset feature))
 539 ;;       feature)
 540 ;;      ((and (setq feature (intern (format "=%s" uri-feature)))
 541 ;;            (find-charset feature))
 542 ;;       feature)
 543 ;;      (t (intern uri-feature)))))
 544
 545 ;; (defun www-uri-encode-feature-name (feature-name)
 546 ;;   (setq feature-name (symbol-name feature-name))
 547 ;;   (cond
 548 ;;    ((string-match "^=\\+>\\([^=>]+\\)" feature-name)
 549 ;;     (concat "o."
 550 ;;             (est-uri-encode-feature-name-body
 551 ;;              (substring feature-name (match-beginning 1))))
 552 ;;     )
 553 ;;    ((string-match "^=\\([^=>]+\\)" feature-name)
 554 ;;     (concat "rep."
 555 ;;             (est-uri-encode-feature-name-body
 556 ;;              (substring feature-name (match-beginning 1))))
 557 ;;     )
 558 ;;    ((string-match "^==\\([^=>]+\\)" feature-name)
 559 ;;     (concat "g2."
 560 ;;             (est-uri-encode-feature-name-body
 561 ;;              (substring feature-name (match-beginning 1))))
 562 ;;     )
 563 ;;    ((string-match "^===\\([^=>]+\\)" feature-name)
 564 ;;     (concat "repi."
 565 ;;             (est-uri-encode-feature-name-body
 566 ;;              (substring feature-name (match-beginning 1))))
 567 ;;     )
 568 ;;    ((string-match "^=>>\\([^=>]+\\)" feature-name)
 569 ;;     (concat "g."
 570 ;;             (est-uri-encode-feature-name-body
 571 ;;              (substring feature-name (match-beginning 1))))
 572 ;;     )
 573 ;;    ((string-match "^=>>>\\([^=>]+\\)" feature-name)
 574 ;;     (concat "gi."
 575 ;;             (est-uri-encode-feature-name-body
 576 ;;              (substring feature-name (match-beginning 1))))
 577 ;;     )
 578 ;;    ((string-match "^=>>\\(>+\\)" feature-name)
 579 ;;     (format "gi%d.%s"
 580 ;;             (length (match-string 1 feature-name))
 581 ;;             (est-uri-encode-feature-name-body
 582 ;;              (substring feature-name (match-end 1))))
 583 ;;     )
 584 ;;    ((string-match "^=>\\([^=>]+\\)" feature-name)
 585 ;;     (concat "a."
 586 ;;             (est-uri-encode-feature-name-body
 587 ;;              (substring feature-name (match-beginning 1))))
 588 ;;     )
 589 ;;    ((string-match "^\\(=+\\)>" feature-name)
 590 ;;     (format "a%d.%s"
 591 ;;             (length (match-string 1 feature-name))
 592 ;;             (est-uri-encode-feature-name-body
 593 ;;              (substring feature-name (match-end 0))))
 594 ;;     )
 595 ;;    ((string-match "^->" feature-name)
 596 ;;     (concat "to."
 597 ;;             (est-uri-encode-feature-name-body
 598 ;;              (substring feature-name (match-end 0))))
 599 ;;     )
 600 ;;    ((string-match "^<-" feature-name)
 601 ;;     (concat "from."
 602 ;;             (est-uri-encode-feature-name-body
 603 ;;              (substring feature-name (match-end 0))))
 604 ;;     )
 605 ;;    (t (est-uri-encode-feature-name-body feature-name))))
 606
 607 (defun www-uri-make-feature-name-url (uri-genre uri-feature-name uri-object)
 608   (if est-hide-cgi-mode
 609       (format "../feature/%s&%s/%s"
 610               uri-feature-name uri-genre uri-object)
 611     (format "%s?feature=%s&%s=%s"
 612             chise-wiki-view-url uri-feature-name uri-genre uri-object)))
 613
 614 (defun www-uri-decode-object (genre char-rep)
 615   (let (ccs cpos)
 616     (cond
 617      ((string-match (if est-hide-cgi-mode
 618                         "\\(%3D\\|=\\|%3A\\|:\\)"
 619                       "\\(%3A\\|:\\)") char-rep)
 620       (setq ccs (substring char-rep 0 (match-beginning 0))
 621             cpos (substring char-rep (match-end 0)))
 622       (setq ccs (www-uri-decode-feature-name ccs))
 623       (setq cpos (est-uri-decode-feature-name-body cpos))
 624       (cond
 625        ((string-match "^0x" cpos)
 626         (setq cpos
 627               (string-to-number (substring cpos (match-end 0)) 16))
 628         )
 629        (t
 630         (setq cpos (car (read-from-string
 631                          (decode-uri-string
 632                           cpos file-name-coding-system))))
 633         ))
 634       (if (and (eq genre 'character)
 635                (numberp cpos))
 636           (decode-char ccs cpos)
 637         (concord-decode-object ccs cpos genre))
 638       )
 639      (t
 640       (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
 641       (cond
 642        ((eq genre 'character)
 643         (when (= (length char-rep) 1)
 644           (aref char-rep 0))
 645         )
 646        ((eq genre 'feature)
 647         (concord-decode-object
 648          '=id (www-uri-decode-feature-name char-rep) 'feature)
 649         )
 650        (t
 651         (concord-decode-object
 652          '=id (car (read-from-string char-rep)) genre)
 653         ))))))
 654
 655 (defun www-uri-encode-object (object)
 656   (if (characterp object)
 657       (if (encode-char object '=ucs)
 658           (mapconcat
 659            (lambda (byte)
 660              (format "%%%02X" byte))
 661            (encode-coding-string (char-to-string object) 'utf-8-mcs-er)
 662            "")
 663         (let ((ccs-list est-coded-charset-priority-list)
 664               ccs ret)
 665           (while (and ccs-list
 666                       (setq ccs (pop ccs-list))
 667                       (not (setq ret (encode-char object ccs 'defined-only)))))
 668           (cond (ret
 669                  (format (if est-hide-cgi-mode
 670                              "%s=0x%X"
 671                            "%s:0x%X")
 672                          (www-uri-encode-feature-name ccs)
 673                          ret))
 674                 ((and (setq ccs (car (split-char object)))
 675                       (setq ret (encode-char object ccs)))
 676                  (format (if est-hide-cgi-mode
 677                              "%s=0x%X"
 678                            "%s:0x%X")
 679                          (www-uri-encode-feature-name ccs)
 680                          ret))
 681                 (t
 682                  (format (if est-hide-cgi-mode
 683                              "system-char-id=0x%X"
 684                            "system-char-id:0x%X")
 685                          (encode-char object 'system-char-id))
 686                  ))))
 687     (format (if est-hide-cgi-mode
 688                 "rep.id=%s"
 689               "rep.id:%s")
 690             (www-uri-encode-feature-name
 691              (concord-object-id object)))))
 692
 693 (defun est-format-object (object &optional readable)
 694   (if (characterp object)
 695       (char-to-string object)
 696     (let ((ret (or (if readable
 697                        (or (concord-object-get object 'name)
 698                            (concord-object-get object '=name)
 699                            (concord-object-get object 'title)))
 700                    (concord-object-id object))))
 701       (format "%s" ret))))
 702
 703 (defun www-uri-make-object-url (object &optional uri-object)
 704   (if est-hide-cgi-mode
 705       (format "%s/%s/%s"
 706               est-view-url-prefix
 707               (est-object-genre object)
 708               (or uri-object
 709                   (www-uri-encode-object object)))
 710     (format "%s?%s=%s"
 711             chise-wiki-view-url
 712             (est-object-genre object)
 713             (or uri-object
 714                 (www-uri-encode-object object)))))
 715
 716
 717 ;;; @ Feature name presentation
 718 ;;;
 719
 720 (defun www-format-feature-name-default (feature-name)
 721   (mapconcat
 722    #'capitalize
 723    (split-string
 724     (symbol-name feature-name)
 725     "-")
 726    " "))
 727
 728 (defun www-format-feature-name-as-metadata (feature-name &optional lang)
 729   (let ((str (symbol-name feature-name))
 730         base meta)
 731     (cond
 732      ((string-match "\\*[^*]+$" str)
 733       (setq base (substring str 0 (match-beginning 0))
 734             meta (substring str (match-beginning 0)))
 735       (concat (www-format-feature-name* (intern base) lang)
 736               meta))
 737      (t
 738       (www-format-feature-name-default feature-name)
 739       ))))
 740
 741 (defun www-format-feature-name-as-rel-to (feature-name)
 742   (concat "\u2192" (substring (symbol-name feature-name) 2)))
 743
 744 (defun www-format-feature-name-as-rel-from (feature-name)
 745   (concat "\u2190" (substring (symbol-name feature-name) 2)))
 746
 747 (defun www-format-feature-name-as-CCS (feature-name)
 748   (let* ((rest
 749           (split-string
 750            (symbol-name feature-name)
 751            "-"))
 752          (dest (upcase (pop rest))))
 753     (when (string-match "^=+>*" dest)
 754       (setq dest (concat (substring dest 0 (match-end 0))
 755                          " "
 756                          (substring dest (match-end 0)))))
 757     (cond
 758      (rest
 759       (while (cdr rest)
 760         (setq dest (concat dest " " (upcase (pop rest)))))
 761       (if (string-match "^[0-9]+$" (car rest))
 762           (concat dest "-" (car rest))
 763         (concat dest " " (upcase (car rest))))
 764       )
 765      (t dest))))
 766
 767 (defun www-format-feature-name* (feature-name &optional lang)
 768   (let (name fn parent ret)
 769     (cond
 770      ((or (and lang
 771                (char-feature-property
 772                 feature-name
 773                 (intern (format "name@%s" lang))))
 774           (char-feature-property
 775            feature-name 'name)))
 776      ((and (setq name (symbol-name feature-name))
 777            (string-match "\\*" name))
 778       (www-format-feature-name-as-metadata feature-name lang))
 779      (t
 780       (setq fn feature-name)
 781       (while (and (setq parent (char-feature-name-parent fn))
 782                   (null (setq ret
 783                               (or (and lang
 784                                        (char-feature-property
 785                                         parent
 786                                         (intern (format "name@%s" lang))))
 787                                   (char-feature-property
 788                                    parent 'name)))))
 789         (setq fn parent))
 790       (cond
 791        (ret
 792         (concat ret (substring (symbol-name feature-name)
 793                                (length (symbol-name parent)))))
 794        ((find-charset feature-name)
 795         (www-format-feature-name-as-CCS feature-name))
 796        ((string-match "^\\(->\\)" name)
 797         (www-format-feature-name-as-rel-to feature-name))
 798        ((string-match "^\\(<-\\)" name)
 799         (www-format-feature-name-as-rel-from feature-name))
 800        (t
 801         (www-format-feature-name-default feature-name)
 802         ))
 803       ))))
 804
 805 (defun www-format-feature-name (feature-name &optional lang)
 806   (www-format-encode-string
 807    (www-format-feature-name* feature-name lang)))
 808
 809
 810 ;;; @ HTML generator
 811 ;;;
 812
 813 (defvar www-format-char-img-style "vertical-align:bottom;")
 814
 815 (defun www-format-encode-string (string &optional without-tags as-body)
 816   (with-temp-buffer
 817     (insert string)
 818     (let (plane code subcode start end char variants ret rret)
 819       (when as-body
 820         (goto-char (point-min))
 821         (while (search-forward "&" nil t)
 822           (replace-match "&amp;" nil t)))
 823       (goto-char (point-min))
 824       (while (search-forward "<" nil t)
 825         (replace-match "&lt;" nil t))
 826       (goto-char (point-min))
 827       (while (search-forward ">" nil t)
 828         (replace-match "&gt;" nil t))
 829       (if without-tags
 830           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 831         (let ((coded-charset-entity-reference-alist
 832                (list*
 833                 '(=gt                   "GT-" 5 d)
 834                 '(=mj                    "MJ" 6 d)
 835                 '(=hanyo-denshi/ja   "HD-JA-" 4 X)
 836                 '(=hanyo-denshi/jb   "HD-JB-" 4 X)
 837                 '(=hanyo-denshi/jc   "HD-JC-" 4 X)
 838                 '(=hanyo-denshi/jd   "HD-JD-" 4 X)
 839                 '(=hanyo-denshi/ft   "HD-FT-" 4 X)
 840                 '(=hanyo-denshi/ia   "HD-IA-" 4 X)
 841                 '(=hanyo-denshi/ib   "HD-IB-" 4 X)
 842                 '(=hanyo-denshi/hg   "HD-HG-" 4 X)
 843                 '(=hanyo-denshi/ip   "HD-IP-" 4 X)
 844                 '(=hanyo-denshi/jt   "HD-JT-" 4 X)
 845                 '(=hanyo-denshi/ks   "HD-KS-" 6 d)
 846                 '(=>>hanyo-denshi/ja "G-HD-JA-" 4 X)
 847                 '(=>>hanyo-denshi/jb "G-HD-JB-" 4 X)
 848                 '(=>>hanyo-denshi/jc "G-HD-JC-" 4 X)
 849                 '(=>>hanyo-denshi/jd "G-HD-JD-" 4 X)
 850                 '(=>>hanyo-denshi/ft "G-HD-FT-" 4 X)
 851                 '(=>>hanyo-denshi/ia "G-HD-IA-" 4 X)
 852                 '(=>>hanyo-denshi/ib "G-HD-IB-" 4 X)
 853                 '(=>>hanyo-denshi/hg "G-HD-HG-" 4 X)
 854                 '(=>>hanyo-denshi/ip "G-HD-IP-" 4 X)
 855                 '(=>>hanyo-denshi/jt "G-HD-JT-" 4 X)
 856                 '(=>>hanyo-denshi/ks "G-HD-KS-" 6 d)
 857                 '(==mj                  "g2-MJ" 6 d)
 858                 '(==hanyo-denshi/ja "g2-HD-JA-" 4 X)
 859                 '(==hanyo-denshi/jb "g2-HD-JB-" 4 X)
 860                 '(==hanyo-denshi/jc "g2-HD-JC-" 4 X)
 861                 '(==hanyo-denshi/jd "g2-HD-JD-" 4 X)
 862                 '(==hanyo-denshi/ft "g2-HD-FT-" 4 X)
 863                 '(==hanyo-denshi/ia "g2-HD-IA-" 4 X)
 864                 '(==hanyo-denshi/ib "g2-HD-IB-" 4 X)
 865                 '(==hanyo-denshi/hg "g2-HD-HG-" 4 X)
 866                 '(==hanyo-denshi/ip "g2-HD-IP-" 4 X)
 867                 '(==hanyo-denshi/jt "g2-HD-JT-" 4 X)
 868                 '(==hanyo-denshi/ks "g2-HD-KS-" 6 d)
 869                 '(==daijiten          "g2-DJT-" 5 d)
 870                 '(=cns11643-1           "C1-" 4 X)
 871                 '(=cns11643-2           "C2-" 4 X)
 872                 '(=cns11643-3           "C3-" 4 X)
 873                 '(=cns11643-4           "C4-" 4 X)
 874                 '(=cns11643-5           "C5-" 4 X)
 875                 '(=cns11643-6           "C6-" 4 X)
 876                 '(=cns11643-7           "C7-" 4 X)
 877                 '(=adobe-japan1-6       "AJ1-" 5 d)
 878                 '(=big5-cdp             "CDP-" 4 X)
 879                 '(=>big5-cdp          "A-CDP-" 4 X)
 880                 '(=gb2312               "G0-" 4 X)
 881                 '(=gb12345              "G1-" 4 X)
 882                 '(=jis-x0208@1990       "J90-" 4 X)
 883                 '(=jis-x0212            "JSP-" 4 X)
 884                 '(=cbeta                "CB" 5 d)
 885                 '(=jis-x0208@1997       "J97-" 4 X)
 886                 '(=jis-x0208@1978       "J78-" 4 X)
 887                 '(=jis-x0208@1983       "J83-" 4 X)
 888                 '(=ruimoku-v6           "RUI6-" 4 X)
 889                 '(=zinbun-oracle        "ZOB-" 4 d)
 890                 '(=daijiten             "DJT-" 5 d)
 891                 '(=jef-china3           "JC3-" 4 X)
 892                 '(=ucs@unicode          "UU+" 4 X)
 893                 '(=ucs@JP/hanazono  "hanaJU+" 4 X)
 894                 '(==cns11643-1        "R-C1-" 4 X)
 895                 '(==cns11643-2        "R-C2-" 4 X)
 896                 '(==cns11643-3        "R-C3-" 4 X)
 897                 '(==cns11643-4        "R-C4-" 4 X)
 898                 '(==cns11643-5        "R-C5-" 4 X)
 899                 '(==cns11643-6        "R-C6-" 4 X)
 900                 '(==cns11643-7        "R-C7-" 4 X)
 901                 '(=hanziku-1         "HZK01-" 4 X)
 902                 '(=hanziku-2         "HZK02-" 4 X)
 903                 '(=hanziku-3         "HZK03-" 4 X)
 904                 '(=hanziku-4         "HZK04-" 4 X)
 905                 '(=hanziku-5         "HZK05-" 4 X)
 906                 '(=hanziku-6         "HZK06-" 4 X)
 907                 '(=hanziku-7         "HZK07-" 4 X)
 908                 '(=hanziku-8         "HZK08-" 4 X)
 909                 '(=hanziku-9         "HZK09-" 4 X)
 910                 '(=hanziku-10        "HZK10-" 4 X)
 911                 '(=hanziku-11        "HZK11-" 4 X)
 912                 '(=hanziku-12        "HZK12-" 4 X)
 913                 '(==>daijiten       "A2-DJT-" 5 d)
 914                 '(==cbeta               "CB" 5 d)
 915                 '(=big5                  "B-" 4 X)
 916                 '(=daikanwa              "M-" 5 d)
 917                 '(=>>daikanwa          "G-M-" 5 d)
 918                 '(===ucs@ks           "R-KU+" 4 X)
 919                 coded-charset-entity-reference-alist)))
 920           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 921
 922           (goto-char (point-min))
 923           (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?CB\\([0-9]+\\);" nil t)
 924             (setq code (string-to-int (match-string 2)))
 925             (replace-match
 926              (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\"
 927 style=\"%s\">"
 928                      code
 929                      chise-wiki-legacy-bitmap-glyphs-url
 930                      (/ code 1000) code
 931                      www-format-char-img-style)
 932              t 'literal))
 933
 934           (goto-char (point-min))
 935           (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)
 936             (setq plane (match-string 2)
 937                   code (string-to-int (match-string 3) 16))
 938             (replace-match
 939              (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\"
 940 style=\"%s\">"
 941                      plane code
 942                      chise-wiki-legacy-bitmap-glyphs-url
 943                      plane
 944                      (- (lsh code -8) 32)
 945                      (- (logand code 255) 32)
 946                      www-format-char-img-style)
 947              t 'literal))
 948
 949           (goto-char (point-min))
 950           (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?J0-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 951             (setq code (string-to-int (match-string 2) 16))
 952             (replace-match
 953              (format "<img alt=\"J0-%04X\" src=\"%s/JIS-90/%02d-%02d.gif\"
 954 style=\"%s\">"
 955                      code
 956                      chise-wiki-legacy-bitmap-glyphs-url
 957                      (- (lsh code -8) 32)
 958                      (- (logand code 255) 32)
 959                      www-format-char-img-style)
 960              t 'literal))
 961
 962           (goto-char (point-min))
 963           (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)
 964             (setq plane (match-string 2)
 965                   code (string-to-int (match-string 3) 16))
 966             (replace-match
 967              (format "<img alt=\"HD-%s-%04X\" src=\"%s/IVD/HanyoDenshi/%s%02d%02d.png\"
 968 style=\"%s\">"
 969                      plane code
 970                      chise-wiki-legacy-bitmap-glyphs-url
 971                      plane
 972                      (- (lsh code -8) 32)
 973                      (- (logand code 255) 32)
 974                      www-format-char-img-style)
 975              t 'literal))
 976
 977           (goto-char (point-min))
 978           (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)
 979             (setq plane (match-string 2)
 980                   code (string-to-int (match-string 3) 16))
 981             (replace-match
 982              (format "<img alt=\"HD-%s-%04X\" src=\"%s/IVD/HanyoDenshi/%s%04X.png\"
 983 style=\"%s\">"
 984                      plane code
 985                      chise-wiki-legacy-bitmap-glyphs-url
 986                      plane code
 987                      www-format-char-img-style)
 988              t 'literal))
 989
 990           (goto-char (point-min))
 991           (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-KS-\\([0-9]+\\);" nil t)
 992             (setq code (string-to-int (match-string 2)))
 993             (replace-match
 994              (format "<img alt=\"HD-KS%06d\" src=\"%s/IVD/HanyoDenshi/KS%06d.png\"
 995 style=\"vertical-align:middle\">"
 996                      code
 997                      chise-wiki-legacy-bitmap-glyphs-url
 998                      code
 999                      www-format-char-img-style)
1000              t 'literal))
1001
1002           (goto-char (point-min))
1003           (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?HD-TK-\\([0-9]+\\);" nil t)
1004             (setq code (string-to-int (match-string 2)))
1005             (replace-match
1006              (format "<img alt=\"HD-KS%06d\" src=\"%s/IVD/HanyoDenshi/TK%08d.png\"
1007 style=\"vertical-align:middle\">"
1008                      code
1009                      chise-wiki-legacy-bitmap-glyphs-url
1010                      code
1011                      www-format-char-img-style)
1012              t 'literal))
1013
1014           (goto-char (point-min))
1015           (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1016             (setq plane (string-to-int (match-string 1))
1017                   code (string-to-int (match-string 2) 16))
1018             (replace-match
1019              (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\"
1020 style=\"%s\">"
1021                      plane code
1022                      chise-wiki-legacy-bitmap-glyphs-url
1023                      plane
1024                      (- (lsh code -8) 32)
1025                      (- (logand code 255) 32)
1026                      www-format-char-img-style)
1027              t 'literal))
1028
1029           (goto-char (point-min))
1030           (while (re-search-forward "&\\(R-\\)?C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1031             (setq plane (string-to-int (match-string 2))
1032                   code (string-to-int (match-string 3) 16))
1033             (replace-match
1034              (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\"
1035 style=\"%s\">"
1036                      plane code
1037                      chise-wiki-legacy-bitmap-glyphs-url
1038                      plane code
1039                      www-format-char-img-style)
1040              t 'literal))
1041
1042           (goto-char (point-min))
1043           (while (re-search-forward "&\\(R-\\)?JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
1044             (setq code (string-to-int (match-string 2) 16))
1045             (replace-match
1046              (format "<img alt=\"JC3-%04X\" src=\"%s/JEF-CHINA3/%04X.png\">"
1047                      code chise-wiki-bitmap-glyph-image-url code)
1048              t 'literal))
1049
1050           (goto-char (point-min))
1051           (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
1052             (setq code (string-to-int (match-string 2)))
1053             (replace-match
1054              (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\"
1055 style=\"vertical-align:middle\">"
1056                      code
1057                      chise-wiki-legacy-bitmap-glyphs-url
1058                      code
1059                      www-format-char-img-style)
1060              t 'literal))
1061
1062           (goto-char (point-min))
1063           (while (re-search-forward "&\\(A2-\\|g2-\\|R-\\)?DJT-\\([0-9]+\\);" nil t)
1064             (setq code (string-to-int (match-string 2)))
1065             (replace-match
1066              (format "<img alt=\"DJT-%05d\" src=\"%s/%05d.png\"
1067 style=\"vertical-align:middle; width: auto; max-height: 60px\">"
1068                      code
1069                      chise-wiki-daijiten-bitmap-glyphs-url
1070                      code
1071                      www-format-char-img-style)
1072              t 'literal))
1073
1074           (goto-char (point-min))
1075           (while (re-search-forward "&SW-JIGUGE\\([45]?\\)-\\([0-9]+\\);" nil t)
1076             (setq subcode (match-string 1)
1077                   code (string-to-int (match-string 2)))
1078             (setq plane
1079                   (if (string= subcode "")
1080                       "5"
1081                     subcode))
1082             (replace-match
1083              (format "<div class=\"tooltip\"><img alt=\"SW-JIGUGE%s-%05d\" src=\"%s/ShuoWen/Jiguge%s/%05d.png\"
1084 style=\"vertical-align:middle; width: auto; max-height: 80px\"><span
1085 class=\"tooltiptext\">%s</span></div>"
1086                      plane code
1087                      chise-wiki-legacy-bitmap-glyphs-url
1088                      plane code
1089                      (charset-description
1090                       (if (string= subcode "")
1091                           '=shuowen-jiguge
1092                         (intern (format "===shuowen-jiguge%s" subcode)))))
1093              t 'literal))
1094
1095           (goto-char (point-min))
1096           (while (re-search-forward "&HNG\\([0-9]+\\)-\\([0-9][0-9][0-9][0-9]\\)\\([0-9]\\);" nil t)
1097             (setq plane (match-string 1)
1098                   code (string-to-int (match-string 2))
1099                   subcode (string-to-int (match-string 3)))
1100             (setq subcode
1101                   (if (eq subcode 0)
1102                       ""
1103                     (char-to-string (decode-char 'ascii (+ 96 subcode)))))
1104             (replace-match
1105              (format
1106               "<div class=\"tooltip\"><img alt=\"HNG%s-%04d%s\" src=\"%s/%s/%04d%s.png\" style=\"
1107 vertical-align:middle; width: auto; max-height: 60px\"><span
1108 class=\"tooltiptext\">%s</span></div>"
1109               plane code subcode
1110               chise-wiki-hng-bitmap-glyphs-url
1111               plane code subcode
1112               (charset-description
1113                (car (find (format "HNG%s-" plane)
1114                           coded-charset-entity-reference-alist
1115                           :test (lambda (key cell)
1116                                   (string= key (nth 1 cell))))))
1117               )
1118              t 'literal))
1119
1120           (goto-char (point-min))
1121           (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?AJ1-\\([0-9]+\\);" nil t)
1122             (setq code (string-to-int (match-string 2)))
1123             (replace-match
1124              (format "<img alt=\"AJ1-%05d\" src=\"%s/IVD/AdobeJapan1/CID+%d.png\"
1125 style=\"vertical-align:middle\">"
1126                      code
1127                      chise-wiki-legacy-bitmap-glyphs-url
1128                      code
1129                      www-format-char-img-style)
1130              t 'literal))
1131
1132           (goto-char (point-min))
1133           (while (re-search-forward "&\\(A-\\|o-\\|G-\\|g2-\\|R-\\)?MJ\\([0-9]+\\);" nil t)
1134             (setq code (string-to-int (match-string 2)))
1135             (replace-match
1136              (format "<img alt=\"MJ%06d\" src=\"https://mojikiban.ipa.go.jp/MJ%06d.png\"
1137 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1138                      code
1139                      code
1140                      www-format-char-img-style)
1141              t 'literal))
1142
1143           (goto-char (point-min))
1144           (while (re-search-forward "&\\(o-\\|G-\\|g2-\\)?IU[+-]\\([0-9A-F]+\\);" nil t)
1145             (setq code (string-to-int (match-string 2) 16))
1146             (replace-match
1147              (format "<img alt=\"u%04x\" src=\"%s/u%04x.svg\"
1148 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1149                      code
1150                      chise-wiki-glyphwiki-glyph-image-url
1151                      code
1152                      www-format-char-img-style)
1153              t 'literal))
1154
1155           (goto-char (point-min))
1156           (while (re-search-forward "&\\(o-\\|G-\\|g2-\\|R-\\)?KU[+-]\\([0-9A-F]+\\);" nil t)
1157             (setq code (string-to-int (match-string 2) 16))
1158             (replace-match
1159              (format "<img alt=\"u%04x-k\" src=\"%s/u%04x-k.svg\"
1160 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1161                      code
1162                      chise-wiki-glyphwiki-glyph-image-url
1163                      code
1164                      www-format-char-img-style)
1165              t 'literal))
1166
1167           (goto-char (point-min))
1168           (while (re-search-forward "&A-\\(comp\\|cgn\\)U[+-]\\([0-9A-F]+\\);" nil t)
1169             (setq code (string-to-int (match-string 2) 16))
1170             (replace-match
1171              (format "<img alt=\"u%04x\" src=\"%s/u%04x.svg\"
1172 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1173                      code
1174                      chise-wiki-glyphwiki-glyph-image-url
1175                      code
1176                      www-format-char-img-style)
1177              t 'literal))
1178
1179           (goto-char (point-min))
1180           (while (re-search-forward
1181                   "&\\(A-\\|g2-\\)?U-i\\([0-9]+\\)\\+\\([0-9A-F]+\\);"
1182                   nil t)
1183             (setq plane (string-to-int (match-string 2))
1184                   code (string-to-int (match-string 3) 16))
1185             (replace-match
1186              (format "<img alt=\"u%04x-itaiji-%03d\" src=\"%s/u%04x-itaiji-%03d.svg\"
1187 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1188                      code
1189                      plane
1190                      chise-wiki-glyphwiki-glyph-image-url
1191                      code
1192                      plane
1193                      www-format-char-img-style)
1194              t 'literal))
1195
1196           (goto-char (point-min))
1197           (while (re-search-forward "&A-IWDSU\\+\\([0-9A-F]+\\);" nil t)
1198             (setq code (string-to-int (match-string 1) 16))
1199             (replace-match
1200              (format "<img alt=\"A-IWDSU+%04x\" src=\"%s/u%04x.svg\"
1201 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1202                      code
1203                      chise-wiki-glyphwiki-glyph-image-url
1204                      code
1205                      www-format-char-img-style)
1206              t 'literal))
1207
1208           (goto-char (point-min))
1209           (while (re-search-forward
1210                   "&\\(A-\\)?CDP-i\\([0-9]+\\)-\\([0-9A-F]+\\);"
1211                   nil t)
1212             (setq plane (string-to-int (match-string 2))
1213                   code (string-to-int (match-string 3) 16))
1214             (replace-match
1215              (format "<img alt=\"cdp-%04x-itaiji-%03d\" src=\"%s/cdp-%04x-itaiji-%03d.svg\"
1216 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1217                      code
1218                      plane
1219                      chise-wiki-glyphwiki-glyph-image-url
1220                      code
1221                      plane
1222                      www-format-char-img-style)
1223              t 'literal))
1224
1225           (goto-char (point-min))
1226           (while (re-search-forward
1227                   "&\\(A-\\)?CDP-v\\([0-9]+\\)-\\([0-9A-F]+\\);"
1228                   nil t)
1229             (setq plane (string-to-int (match-string 2))
1230                   code (string-to-int (match-string 3) 16))
1231             (replace-match
1232              (format "<img alt=\"cdp-%04x-var-%03d\" src=\"%s/cdp-%04x-var-%03d.svg\"
1233 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1234                      code
1235                      plane
1236                      chise-wiki-glyphwiki-glyph-image-url
1237                      code
1238                      plane
1239                      www-format-char-img-style)
1240              t 'literal))
1241
1242           (goto-char (point-min))
1243           (while (re-search-forward
1244                   "&\\(A-\\|G-\\|g2-\\|R-\\)?M-\\([0-9]+\\);"
1245                   nil t)
1246             (setq code (string-to-int (match-string 2)))
1247             (replace-match
1248              (format "<img alt=\"dkw-%05d\" src=\"%s/dkw-%05d.svg\"
1249 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1250                      code
1251                      chise-wiki-glyphwiki-glyph-image-url
1252                      code
1253                      www-format-char-img-style)
1254              t 'literal))
1255
1256           (goto-char (point-min))
1257           (while (re-search-forward "&\\(g2-\\)?U-v\\([0-9]+\\)\\+\\([0-9A-F]+\\);" nil t)
1258             (setq plane (string-to-int (match-string 2))
1259                   code (string-to-int (match-string 3) 16))
1260             (replace-match
1261              (format "<img alt=\"u%04x-var-%03d\" src=\"%s/u%04x-var-%03d.svg\"
1262 style=\"vertical-align:middle; width: 48px; height: 48px\">"
1263                      code
1264                      plane
1265                      chise-wiki-glyphwiki-glyph-image-url
1266                      code
1267                      plane
1268                      www-format-char-img-style)
1269              t 'literal))
1270
1271           (goto-char (point-min))
1272           (while (re-search-forward "&\\(A-\\|G-\\|R-\\|g2-\\)?GT-\\([0-9]+\\);" nil t)
1273             (setq code (string-to-int (match-string 2)))
1274             (replace-match
1275              (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\"
1276 style=\"%s\">"
1277                      code
1278                      chise-wiki-glyph-cgi-url
1279                      code
1280                      www-format-char-img-style)
1281              t 'literal))
1282
1283           (goto-char (point-min))
1284           (while (re-search-forward "&\\(A-\\|G-\\|g2-\\)?GT-K\\([0-9]+\\);" nil t)
1285             (setq code (string-to-int (match-string 2)))
1286             (replace-match
1287              (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\"
1288 style=\"%s\">"
1289                      code
1290                      chise-wiki-glyph-cgi-url
1291                      code
1292                      www-format-char-img-style)
1293              t 'literal))
1294
1295           (goto-char (point-min))
1296           (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
1297             (setq code (string-to-int (match-string 1) 16))
1298             (replace-match
1299              (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\"
1300 style=\"%s\">"
1301                      code
1302                      chise-wiki-glyph-cgi-url
1303                      code
1304                      www-format-char-img-style)
1305              t 'literal))
1306
1307           (goto-char (point-min))
1308           (while (re-search-forward
1309                   "&\\(A-\\|G-\\|g2-\\|R-\\)?CDP-\\([0-9A-F]+\\);" nil t)
1310             (setq code (string-to-int (match-string 2) 16))
1311             (replace-match
1312              (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\"
1313 style=\"%s\">"
1314                      code
1315                      chise-wiki-glyph-cgi-url
1316                      code
1317                      www-format-char-img-style)
1318              t 'literal))
1319
1320           (goto-char (point-min))
1321           (while (re-search-forward
1322                   "&\\(I-\\)?HZK\\(0[1-9]\\|1[0-2]\\)-\\([0-9A-F]+\\);" nil t)
1323             (setq plane (match-string 2)
1324                   code (string-to-int (match-string 3) 16))
1325             (replace-match
1326              (format "<img alt=\"HZK%s-%04X\" src=\"%s?char=HZK%s-%04X\"
1327 style=\"%s\">"
1328                      plane
1329                      code
1330                      chise-wiki-glyph-cgi-url
1331                      plane
1332                      code
1333                      www-format-char-img-style)
1334              t 'literal))
1335
1336           (goto-char (point-min))
1337           (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?RUI6-\\([0-9A-F]+\\);" nil t)
1338             (setq code (string-to-int (match-string 2) 16))
1339             (replace-match
1340              (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\"
1341 style=\"vertical-align:middle\">"
1342                      code
1343                      chise-wiki-glyph-cgi-url
1344                      code
1345                      www-format-char-img-style)
1346              t 'literal))
1347
1348           (goto-char (point-min))
1349           (while (re-search-forward "&hanaJU\\+\\([0-9A-F]+\\);" nil t)
1350             (setq code (string-to-int (match-string 1) 16))
1351             (replace-match
1352              (format "<img alt=\"hanaJU+%04X\" src=\"%s?char=hana-JU+%04X\"
1353 style=\"vertical-align:middle\">"
1354                      code
1355                      chise-wiki-glyph-cgi-url
1356                      code
1357                      www-format-char-img-style)
1358              t 'literal))
1359
1360           (goto-char (point-min))
1361           (while (re-search-forward "&\\(A-\\|G-\\|g2-\\|R-\\)?\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
1362             (setq code (string-to-int (match-string 3) 16))
1363             (replace-match
1364              (format "<img alt=\"UU+%04X\" src=\"https://www.unicode.org/cgi-bin/refglyph?24-%04X\"
1365 style=\"vertical-align:middle\">"
1366                      code
1367                      code
1368                      www-format-char-img-style)
1369              t 'literal))
1370
1371           (goto-char (point-min))
1372           (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
1373             (setq code (string-to-int (match-string 1) 16))
1374             (setq start (match-beginning 0)
1375                   end (match-end 0))
1376             (setq char (decode-char 'system-char-id code))
1377             (cond
1378              ((and (setq variants
1379                          (or (www-get-feature-value char '->subsumptive)
1380                              (www-get-feature-value char '->denotational)))
1381                    (progn
1382                      (if (characterp variants)
1383                          (setq variants (list variants)))
1384                      (while (and variants
1385                                  (setq ret (www-format-encode-string
1386                                             (char-to-string (car variants))))
1387                                  (string-match "&MCS-\\([0-9A-F]+\\);" ret))
1388                        (setq variants (cdr variants)))
1389                      ret))
1390               (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
1391                 (goto-char start)
1392                 (delete-region start end)
1393                 (insert ret))
1394               )
1395              ((setq ret (or (www-get-feature-value char 'ideographic-combination)
1396                             (www-get-feature-value char 'ideographic-structure)))
1397               (setq ret
1398                     (mapconcat
1399                      (lambda (ch)
1400                        (if (listp ch)
1401                            (if (characterp (setq rret (find-char ch)))
1402                                (setq ch rret)))
1403                        (if (characterp ch)
1404                            (www-format-encode-string
1405                             (char-to-string ch) without-tags)
1406                          (www-format-encode-string
1407                           (format "%S" ch) without-tags)))
1408                      ret ""))
1409               (when ret
1410                 (goto-char start)
1411                 (delete-region start end)
1412                 (insert ret))
1413               )))
1414           ))
1415       ;; (goto-char (point-min))
1416       ;; (while (search-forward "&GT-" nil t)
1417       ;;   (replace-match "&amp;GT-" t 'literal))
1418       (buffer-string))))
1419
1420 (defun www-html-display-text (text)
1421   (princ
1422    (with-temp-buffer
1423      (insert text)
1424      (goto-char (point-min))
1425      (while (search-forward "<" nil t)
1426        (replace-match "&lt;" nil t))
1427      (goto-char (point-min))
1428      (while (search-forward ">" nil t)
1429        (replace-match "&gt;" nil t))
1430      (goto-char (point-min))
1431      (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t)
1432        (replace-match
1433         (format "<a href=\"%s\">%s</a>"
1434                 (match-string 2)
1435                 (match-string 1))
1436         nil t))
1437      (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
1438      (goto-char (point-min))
1439      (while (search-forward "&GT-" nil t)
1440        (replace-match "&amp;GT-" nil t))
1441      (buffer-string))))
1442
1443 (defun www-html-display-paragraph (text)
1444   (princ "<p>")
1445   (www-html-display-text text)
1446   (princ "</p>\n"))
1447
1448
1449 ;;; @ for GlyphWiki
1450 ;;;
1451
1452 (defvar coded-charset-GlyphWiki-id-alist
1453   '((===adobe-japan1-0  "aj1-"  5 d nil)
1454     (===adobe-japan1-1  "aj1-"  5 d nil)
1455     (===adobe-japan1-2  "aj1-"  5 d nil)
1456     (===adobe-japan1-3  "aj1-"  5 d nil)
1457     (===adobe-japan1-4  "aj1-"  5 d nil)
1458     (===adobe-japan1-5  "aj1-"  5 d nil)
1459     (===adobe-japan1-6  "aj1-"  5 d nil)
1460     (===mj              "jmj-"  6 d nil)
1461     (===ucs@jis         "u"     4 x "-j")
1462     (===daikanwa        "dkw-"  5 d nil)
1463     (===ucs@ks          "u"     4 x "-k")
1464     (===jis-x0208@1978  "j78-"  4 x nil)
1465     (==ucs-itaiji-005   "u"     4 x "-itaiji-005")
1466     (=ucs-var-001       "u"     4 x "-var-001")
1467     (=ucs-var-002       "u"     4 x "-var-002")
1468     (=ucs-var-003       "u"     4 x "-var-003")
1469     (=ucs-var-004       "u"     4 x "-var-004")
1470     (=ucs-var-006       "u"     4 x "-var-006")
1471     (=ucs-var-010       "u"     4 x "-var-010")
1472     (=ucs-itaiji-001    "u"     4 x "-itaiji-001")
1473     (=ucs-itaiji-002    "u"     4 x "-itaiji-002")
1474     (=ucs-itaiji-003    "u"     4 x "-itaiji-003")
1475     (=ucs-itaiji-004    "u"     4 x "-itaiji-004")
1476     (=ucs-itaiji-005    "u"     4 x "-itaiji-005")
1477     (=ucs-itaiji-006    "u"     4 x "-itaiji-006")
1478     (=ucs-itaiji-007    "u"     4 x "-itaiji-007")
1479     (=ucs-itaiji-008    "u"     4 x "-itaiji-008")
1480     (=ucs-itaiji-084    "u"     4 x "-itaiji-084")
1481     (=>ucs-itaiji-001   "u"     4 x "-itaiji-001")
1482     (=>ucs-itaiji-002   "u"     4 x "-itaiji-002")
1483     (=>ucs-itaiji-003   "u"     4 x "-itaiji-003")
1484     (=>ucs-itaiji-004   "u"     4 x "-itaiji-004")
1485     (=>ucs-itaiji-005   "u"     4 x "-itaiji-005")
1486     (=>ucs-itaiji-006   "u"     4 x "-itaiji-006")
1487     (=>ucs-itaiji-007   "u"     4 x "-itaiji-007")
1488     (=>ucs-itaiji-008   "u"     4 x "-itaiji-008")
1489     (==adobe-japan1-0   "aj1-"  5 d nil)
1490     (==adobe-japan1-1   "aj1-"  5 d nil)
1491     (==adobe-japan1-2   "aj1-"  5 d nil)
1492     (==adobe-japan1-3   "aj1-"  5 d nil)
1493     (==adobe-japan1-4   "aj1-"  5 d nil)
1494     (==adobe-japan1-5   "aj1-"  5 d nil)
1495     (==adobe-japan1-6   "aj1-"  5 d nil)
1496     (==mj               "jmj-"  6 d nil)
1497     (==ucs@jis          "u"     4 x "-j")
1498     (==ucs@iso          "u"     4 x nil)
1499     ;; (==ucs@cns          "u"     4 x "-t")
1500     (==ucs@unicode      "u"     4 x "-us")
1501     (==ucs@JP/hanazono  "u"     4 x "-jv")
1502     (==gt               "gt-"   5 d nil)
1503     (==gt-k             "gt-k"  5 d nil)
1504     (==daikanwa         "dkw-"  5 d nil)
1505     (==ucs@ks           "u"     4 x "-k")
1506     (==jis-x0208@1978   "j78-"  4 x nil)
1507     (==jis-x0208        "j90-"  4 x nil)
1508     (==jis-x0208@1990   "j90-"  4 x nil)
1509     (==jis-x0208@1983   "j83-"  4 x nil)
1510     (==cbeta           "cbeta-" 5 d nil)
1511     (=>>hanyo-denshi/ks "koseki-" 6 d nil)
1512     (=>>jis-x0208@1978  "j78-"  4 x nil)
1513     (=>>big5-cdp        "cdp-"  4 x nil)
1514     (=>>adobe-japan1-0  "aj1-"  5 d nil)
1515     (=>>adobe-japan1-1  "aj1-"  5 d nil)
1516     (=>>adobe-japan1-2  "aj1-"  5 d nil)
1517     (=>>adobe-japan1-3  "aj1-"  5 d nil)
1518     (=>>adobe-japan1-4  "aj1-"  5 d nil)
1519     (=>>adobe-japan1-5  "aj1-"  5 d nil)
1520     (=>>adobe-japan1-6  "aj1-"  5 d nil)
1521     (=>>jis-x0208       "j90-"  4 x nil)
1522     (=>>jis-x0208@1990  "j90-"  4 x nil)
1523     (=>>jis-x0208@1983  "j83-"  4 x nil)
1524     (=>>daikanwa        "dkw-"  5 d nil)
1525     (=adobe-japan1-0    "aj1-"  5 d nil)
1526     (=adobe-japan1-1    "aj1-"  5 d nil)
1527     (=adobe-japan1-2    "aj1-"  5 d nil)
1528     (=adobe-japan1-3    "aj1-"  5 d nil)
1529     (=adobe-japan1-4    "aj1-"  5 d nil)
1530     (=adobe-japan1-5    "aj1-"  5 d nil)
1531     (=adobe-japan1-6    "aj1-"  5 d nil)
1532     (=hanyo-denshi/ks   "koseki-" 6 d nil)
1533     (=mj                "jmj-"  6 d nil)
1534     (=decomposition@cid)
1535     (=decomposition@hanyo-denshi)
1536     (=koseki            "koseki-" 6 d nil)
1537     (=hanyo-denshi/tk   "toki-"   8 d nil)
1538     (=ucs@jis           "u"     4 x "-j")
1539     ;; (=ucs@cns           "u"     4 x "-t")
1540     (=ucs@ks            "u"     4 x "-k")
1541     (=ucs@JP            "u"     4 x "-jv")
1542     (=ucs@JP/hanazono   "u"     4 x "-jv")
1543     (=ucs@gb            "u"     4 x "-g")
1544     (=big5-cdp          "cdp-"  4 x nil)
1545     (=>big5-cdp         "cdp-"  4 x nil)
1546     (=+>big5-cdp        "cdp-"  4 x nil)
1547     (=>big5-cdp@iwds-1  "cdp-"  4 x nil)
1548     (=cbeta            "cbeta-" 5 d nil)
1549     (=>cbeta           "cbeta-" 5 d nil)
1550     (=big5-cdp-var-001  "cdp-"  4 x "-var-001")
1551     (=big5-cdp-var-003  "cdp-"  4 x "-var-003")
1552     (=big5-cdp-var-005  "cdp-"  4 x "-var-005")
1553     (=big5-cdp-itaiji-001 "cdp-" 4 x "-itaiji-001")
1554     (=big5-cdp-itaiji-002 "cdp-" 4 x "-itaiji-002")
1555     (=big5-cdp-itaiji-003 "cdp-" 4 x "-itaiji-003")
1556     (=>big5-cdp-itaiji-001 "cdp-" 4 x "-itaiji-001")
1557     (=>big5-cdp-itaiji-002 "cdp-" 4 x "-itaiji-002")
1558     (=>big5-cdp-itaiji-003 "cdp-" 4 x "-itaiji-003")
1559     (=jef-china3        "jc3-"  4 x nil)
1560     (=jis-x0212         "jsp-"  4 x nil)
1561     (=jis-x0213-1@2000  "jx1-2000-" 4 x nil)
1562     (=jis-x0213-1@2004  "jx1-2004-" 4 x nil)
1563     (=jis-x0213-2       "jx2-"  4 x nil)
1564     (=gt                "gt-"   5 d nil)
1565     (=gt-k              "gt-k"  5 d nil)
1566     (=>gt-k             "gt-k"  5 d nil)
1567     (=daikanwa          "dkw-"  5 d nil)
1568     (=ruimoku-v6        "rui6-" 4 x nil)
1569     (=>ruimoku-v6       "rui6-" 4 x nil)
1570     (=ucs@iso           "u"     4 x "-u")
1571     (=ucs@unicode       "u"     4 x "-us")
1572     (=jis-x0208@1978/1pr "j78-" 4 x nil)
1573     (=jis-x0208@1978/-4pr "j78-" 4 x nil)
1574     (=jis-x0208@1978    "j78-"  4 x nil)
1575     (=+>jis-x0208@1978  "j78-"  4 x nil)
1576     (=+>jis-x0208       "j90-"  4 x nil)
1577     (=+>jis-x0208@1990  "j90-"  4 x nil)
1578     (=+>jis-x0208@1983  "j83-"  4 x nil)
1579     (=ucs               "u"     4 x nil)
1580     (=big5              "b-"    4 x nil)
1581     (=ks-x1001          "k0-"   4 x nil)
1582     ;; (=cns11643-1        "c1-"   4 x nil)
1583     ;; (=cns11643-2        "c2-"   4 x nil)
1584     ;; (=cns11643-3        "c3-"   4 x nil)
1585     ;; (=cns11643-4        "c4-"   4 x nil)
1586     ;; (=cns11643-5        "c5-"   4 x nil)
1587     ;; (=cns11643-6        "c6-"   4 x nil)
1588     ;; (=cns11643-7        "c7-"   4 x nil)
1589     (=jis-x0208         "j90-"  4 x nil)
1590     (=jis-x0208@1990    "j90-"  4 x nil)
1591     (=jis-x0208@1983    "j83-"  4 x nil)
1592     ))
1593
1594 (defun char-GlyphWiki-id (char)
1595   (let ((rest coded-charset-GlyphWiki-id-alist)
1596         spec ret code)
1597     (while (and rest
1598                 (setq spec (pop rest))
1599                 (null (setq ret (get-char-attribute char (car spec))))))
1600     (when ret
1601       (or
1602        (and (listp ret)
1603             (mapconcat #'char-GlyphWiki-id ret "-"))
1604        (and (memq (car spec) '(=ucs@unicode '=ucs@iso))
1605             (cond
1606              ((and (or (encode-char char '=jis-x0208@1990)
1607                        (encode-char char '=jis-x0212)
1608                        (encode-char char '=jis-x0213-1)
1609                        (encode-char char '=jis-x0213-2))
1610                    (setq code (encode-char char '=ucs@jis)))
1611               (format "u%04x-j" code)
1612               )
1613              ((and (or (encode-char char '=gb2312)
1614                        (encode-char char '=gb12345))
1615                    (setq code (encode-char char '=ucs@gb)))
1616               (format "u%04x-g" code)
1617               )
1618              ;; ((and (or (encode-char char '=cns11643-1)
1619              ;;           (encode-char char '=cns11643-2)
1620              ;;           (encode-char char '=cns11643-3)
1621              ;;           (encode-char char '=cns11643-4)
1622              ;;           (encode-char char '=cns11643-5)
1623              ;;           (encode-char char '=cns11643-6)
1624              ;;           (encode-char char '=cns11643-7))
1625              ;;       (setq code (encode-char char '=ucs@cns)))
1626              ;;  (format "u%04x-t" code)
1627              ;;  )
1628              ((and (encode-char char '=ks-x1001)
1629                    (setq code (encode-char char '=ucs@ks)))
1630               (format "u%04x-k" code)
1631               )))
1632        (format (format "%s%%0%d%s%s"
1633                        (nth 1 spec)
1634                        (nth 2 spec)
1635                        (nth 3 spec)
1636                        (or (nth 4 spec) ""))
1637                ret)))))
1638
1639
1640 ;;; @ End.
1641 ;;;
1642
1643 (provide 'cwiki-common)
1644
1645 ;;; cwiki-common.el ends here