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