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