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