cwiki-common.el

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