cwiki-common.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'char-db-util)
   3
   4 (defvar chise-wiki-view-url "view.cgi")
   5 (defvar chise-wiki-edit-url "edit.cgi")
   6
   7 (defvar chise-wiki-bitmap-glyphs-url
   8   "http://chise.zinbun.kyoto-u.ac.jp/glyphs")
   9
  10 (defvar chise-wiki-glyph-cgi-url
  11   "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
  12
  13 (defvar chise-wiki-displayed-features nil)
  14
  15 (defun decode-uri-string (string &optional coding-system)
  16   (if (> (length string) 0)
  17       (let ((i 0)
  18             dest)
  19         (setq string
  20               (mapconcat (lambda (char)
  21                            (if (eq char ?+)
  22                                " "
  23                              (char-to-string char)))
  24                          string ""))
  25         (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
  26           (setq dest (concat dest
  27                              (substring string i (match-beginning 0))
  28                              (char-to-string
  29                               (int-char
  30                                (string-to-int (match-string 1 string) 16))))
  31                 i (match-end 0)))
  32         (decode-coding-string
  33          (concat dest (substring string i))
  34          coding-system))))
  35
  36 (defun www-feature-type (feature-name)
  37   (or (char-feature-property feature-name 'type)
  38       (let ((str (symbol-name feature-name)))
  39         (cond
  40          ((string-match "\\*note\\(@[^*]+\\)?$" str)
  41           'stext)
  42          ((string-match "\\*sources\\(@[^*]+\\)?$" str)
  43           'domain-list)
  44          ((string-match "\\*" str)
  45           nil)
  46          ((string-match "^\\(->\\|<-\\)" str)
  47           'relation)
  48          ((string-match "^ideographic-structure\\(@\\|$\\)" str)
  49           'structure)
  50          ))))
  51
  52 (defun www-feature-format (feature-name)
  53   (or (char-feature-property feature-name 'format)
  54       (let (fn parent ret)
  55         (setq fn feature-name)
  56         (while (and (setq parent (char-feature-name-parent fn))
  57                     (null (setq ret
  58                                 (char-feature-property
  59                                  parent 'format))))
  60           (setq fn parent))
  61         ret)
  62       '((name) " : " (value))))
  63
  64 (defun www-feature-value-format (feature-name)
  65   (or (char-feature-property feature-name 'value-format)
  66       (let (fn parent ret)
  67         (setq fn feature-name)
  68         (while (and (setq parent (char-feature-name-parent fn))
  69                     (null (setq ret
  70                                 (char-feature-property
  71                                  parent 'value-format))))
  72           (setq fn parent))
  73         ret)
  74       (let ((type (www-feature-type feature-name)))
  75         (cond ((eq type 'relation)
  76                'space-separated-char-list)
  77               ((eq type 'structure)
  78                'space-separated-ids)
  79               ((eq type 'stext)
  80                'wiki-text)
  81               ))
  82       (if (find-charset feature-name)
  83           (if (and (= (charset-dimension feature-name) 2)
  84                    (= (charset-chars feature-name) 94))
  85               '("0x" (HEX)
  86                 " (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char))
  87             '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))))
  88
  89 (defun char-feature-name-at-domain (feature-name domain)
  90   (if domain
  91       (let ((name (symbol-name feature-name)))
  92         (cond
  93          ((string-match "@[^*]+$" name)
  94           (intern (format "%s/%s" name domain))
  95           )
  96          (t
  97           (intern (format "%s@%s" name domain))
  98           )))
  99     feature-name))
 100
 101 (defun char-feature-name-parent (feature-name)
 102   (let ((name (symbol-name feature-name)))
 103     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
 104         (intern (substring name 0 (car (last (match-data) 2)))))))
 105
 106 (defun char-feature-name-domain (feature-name)
 107   (let ((name (symbol-name feature-name)))
 108     (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
 109         (intern (substring name (1+ (match-beginning 0)))))))
 110
 111 (defun char-feature-name-sans-versions (feature)
 112   (let ((feature-name (symbol-name feature)))
 113     (if (string-match "[@/]\\$rev=latest$" feature-name)
 114         (intern (substring feature-name 0 (match-beginning 0)))
 115       feature)))
 116
 117 (defun www-char-feature (character feature)
 118   (let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
 119     (mount-char-attribute-table latest-feature)
 120     (or (char-feature character latest-feature)
 121         (char-feature character feature))))
 122
 123 (defun get-previous-code-point (ccs code)
 124   (let ((chars (charset-chars ccs))
 125         (dim (charset-dimension ccs))
 126         (i 0)
 127         mask byte-min byte-max
 128         bytes dest)
 129     (cond
 130      ((= chars 94)
 131       (setq mask #x7F
 132             byte-min 33
 133             byte-max 126)
 134       )
 135      ((= chars 96)
 136       (setq mask #x7F
 137             byte-min 32
 138             byte-max 127)
 139       )
 140      ((= chars 128)
 141       (setq mask #x7F
 142             byte-min 0
 143             byte-max #xFF)
 144       )
 145      (t ; (= chars 256)
 146       (setq mask #xFF
 147             byte-min 0
 148             byte-max #xFF)
 149       ))
 150     (setq bytes (make-vector dim 0))
 151     (while (< i dim)
 152       (aset bytes i (logand (lsh code (* i -8)) mask))
 153       (setq i (1+ i)))
 154     (setq i 0)
 155     (while (and (< i dim)
 156                 (progn
 157                   (aset bytes i (1- (aref bytes i)))
 158                   (< (aref bytes i) byte-min)))
 159       (aset bytes i byte-max)
 160       (setq i (1+ i)))
 161     (when (< i dim)
 162       (setq dest (aref bytes 0)
 163             i 1)
 164       (while (< i dim)
 165         (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
 166               i (1+ i)))
 167       dest)))
 168
 169 (defun get-next-code-point (ccs code)
 170   (let ((chars (charset-chars ccs))
 171         (dim (charset-dimension ccs))
 172         (i 0)
 173         mask byte-min byte-max
 174         bytes dest)
 175     (cond
 176      ((= chars 94)
 177       (setq mask #x7F
 178             byte-min 33
 179             byte-max 126)
 180       )
 181      ((= chars 96)
 182       (setq mask #x7F
 183             byte-min 32
 184             byte-max 127)
 185       )
 186      ((= chars 128)
 187       (setq mask #x7F
 188             byte-min 0
 189             byte-max #xFF)
 190       )
 191      (t ; (= chars 256)
 192       (setq mask #xFF
 193             byte-min 0
 194             byte-max #xFF)
 195       ))
 196     (setq bytes (make-vector dim 0))
 197     (while (< i dim)
 198       (aset bytes i (logand (lsh code (* i -8)) mask))
 199       (setq i (1+ i)))
 200     (setq i 0)
 201     (while (and (< i dim)
 202                 (progn
 203                   (aset bytes i (1+ (aref bytes i)))
 204                   (> (aref bytes i) byte-max)))
 205       (aset bytes i byte-min)
 206       (setq i (1+ i)))
 207     (when (< i dim)
 208       (setq dest (aref bytes 0)
 209             i 1)
 210       (while (< i dim)
 211         (setq dest (logior dest (lsh (aref bytes i) (* i 8)))
 212               i (1+ i)))
 213       dest)))
 214
 215 (defun find-previous-defined-code-point (ccs code)
 216   (let ((i (get-previous-code-point ccs code))
 217         char)
 218     (cond
 219      ((eq ccs '=jis-x0208)
 220       (setq ccs '=jis-x0208@1990))
 221      ((eq ccs '=jis-x0213-1)
 222       (setq ccs '=jis-x0213-1@2004)))
 223     (while (and i
 224                 (>= i 0)
 225                 (null (setq char (decode-char ccs i
 226                                               (unless (eq ccs '=ucs)
 227                                                 'defined-only)))))
 228       (setq i (get-previous-code-point ccs i)))
 229     char))
 230
 231 (defun find-next-defined-code-point (ccs code)
 232   (let ((i (get-next-code-point ccs code))
 233         max char)
 234     (setq max (+ code 1000))
 235     (cond
 236      ((eq ccs '=jis-x0208)
 237       (setq ccs '=jis-x0208@1990))
 238      ((eq ccs '=jis-x0213-1)
 239       (setq ccs '=jis-x0213-1@2004)))
 240     (while (and i
 241                 (<= i max)
 242                 (null (setq char (decode-char ccs i
 243                                               (unless (eq ccs '=ucs)
 244                                                 'defined-only)))))
 245       (setq i (get-next-code-point ccs i)))
 246     char))
 247
 248
 249 ;;; @ URI representation
 250 ;;;
 251
 252 (defun www-uri-decode-feature-name (uri-feature)
 253   (let (feature)
 254     (cond
 255      ((string-match "^from\\." uri-feature)
 256       (intern (format "<-%s" (substring uri-feature (match-end 0))))
 257       )
 258      ((string-match "^to\\." uri-feature)
 259       (intern (format "->%s" (substring uri-feature (match-end 0))))
 260       )
 261      ((string-match "^rep\\." uri-feature)
 262       (intern (format "=%s" (substring uri-feature (match-end 0))))
 263       )
 264      ((string-match "^g\\." uri-feature)
 265       (intern (format "=>>%s" (substring uri-feature (match-end 0))))
 266       )
 267      ((string-match "^gi\\." uri-feature)
 268       (intern (format "=>>>%s" (substring uri-feature (match-end 0))))
 269       )
 270      ((string-match "^gi\\([0-9]+\\)\\." uri-feature)
 271       (intern (format "=>>%s%s"
 272                       (make-string (string-to-int
 273                                     (match-string 1 uri-feature))
 274                                    ?>)
 275                       (substring uri-feature (match-end 0))))
 276       )
 277      ((string-match "^a\\." uri-feature)
 278       (intern (format "=>%s" (substring uri-feature (match-end 0))))
 279       )
 280      ((string-match "^a\\([0-9]+\\)\\." uri-feature)
 281       (intern (format "%s>%s"
 282                       (make-string (string-to-int
 283                                     (match-string 1 uri-feature))
 284                                    ?=)
 285                       (substring uri-feature (match-end 0))))
 286       )
 287      ((and (setq feature (intern (format "=>%s" uri-feature)))
 288            (find-charset feature))
 289       feature)
 290      ((and (setq feature (intern (format "=>>%s" uri-feature)))
 291            (find-charset feature))
 292       feature)
 293      ((and (setq feature (intern (format "=>>>%s" uri-feature)))
 294            (find-charset feature))
 295       feature)
 296      ((and (setq feature (intern (format "=%s" uri-feature)))
 297            (find-charset feature))
 298       feature)
 299      (t (intern uri-feature)))))
 300
 301 (defun www-uri-encode-feature-name (feature-name)
 302   (setq feature-name (symbol-name feature-name))
 303   (cond
 304    ((string-match "^=\\([^=>]+\\)" feature-name)
 305     (concat "rep." (substring feature-name (match-beginning 1)))
 306     )
 307    ((string-match "^=>>\\([^=>]+\\)" feature-name)
 308     (concat "g." (substring feature-name (match-beginning 1)))
 309     )
 310    ((string-match "^=>>>\\([^=>]+\\)" feature-name)
 311     (concat "gi." (substring feature-name (match-beginning 1)))
 312     )
 313    ((string-match "^=>>\\(>+\\)" feature-name)
 314     (format "gi%d.%s"
 315             (length (match-string 1 feature-name))
 316             (substring feature-name (match-end 1)))
 317     )
 318    ((string-match "^=>\\([^=>]+\\)" feature-name)
 319     (concat "a." (substring feature-name (match-beginning 1)))
 320     )
 321    ((string-match "^\\(=+\\)>" feature-name)
 322     (format "a%d.%s"
 323             (length (match-string 1 feature-name))
 324             (substring feature-name (match-end 0)))
 325     )
 326    ((string-match "^->" feature-name)
 327     (concat "to." (substring feature-name (match-end 0)))
 328     )
 329    ((string-match "^<-" feature-name)
 330     (concat "from." (substring feature-name (match-end 0)))
 331     )
 332    (t feature-name)))
 333
 334 (defun www-uri-make-feature-name-url (uri-feature-name uri-char)
 335   (format "%s?feature=%s&char=%s"
 336           chise-wiki-view-url uri-feature-name uri-char))
 337
 338 (defun www-uri-decode-char (char-rep)
 339   (let (ccs cpos)
 340     (cond
 341      ((string-match "\\(%3A\\|:\\)" char-rep)
 342       (setq ccs (substring char-rep 0 (match-beginning 0))
 343             cpos (substring char-rep (match-end 0)))
 344       (setq ccs (www-uri-decode-feature-name ccs))
 345       (cond
 346        ((string-match "^0x" cpos)
 347         (setq cpos
 348               (string-to-number (substring cpos (match-end 0)) 16))
 349         )
 350        (t
 351         (setq cpos (string-to-number cpos))
 352         ))
 353       (if (numberp cpos)
 354           (decode-char ccs cpos))
 355       )
 356      (t
 357       (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
 358       (when (= (length char-rep) 1)
 359         (aref char-rep 0))
 360       ))))
 361
 362 (defun www-uri-encode-char (char)
 363   (if (encode-char char '=ucs)
 364       (mapconcat
 365        (lambda (byte)
 366          (format "%%%02X" byte))
 367        (encode-coding-string (char-to-string char) 'utf-8-mcs-er)
 368        "")
 369     (let ((ccs-list '(; =ucs
 370                       =cns11643-1 =cns11643-2 =cns11643-3
 371                       =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
 372                       =gb2312 =gb12345
 373                       =jis-x0208 =jis-x0208@1990
 374                       =jis-x0212
 375                       =cbeta =jef-china3
 376                       =jis-x0213-1@2000 =jis-x0213-1@2004
 377                       =jis-x0208@1983 =jis-x0208@1978
 378                       =zinbun-oracle =>zinbun-oracle
 379                       =daikanwa
 380                       =gt =gt-k
 381                       =>>jis-x0208 =>>jis-x0213-1
 382                       =>jis-x0208 =>jis-x0213-1
 383                       =>>gt
 384                       =ruimoku-v6
 385                       =big5
 386                       =big5-cdp))
 387           ccs ret)
 388       (while (and ccs-list
 389                   (setq ccs (pop ccs-list))
 390                   (not (setq ret (encode-char char ccs 'defined-only)))))
 391       (cond (ret
 392              (format "%s:0x%X"
 393                      (www-uri-encode-feature-name ccs)
 394                      ret))
 395             ((and (setq ccs (car (split-char char)))
 396                   (setq ret (encode-char char ccs)))
 397              (format "%s:0x%X"
 398                      (www-uri-encode-feature-name ccs)
 399                      ret))
 400             (t
 401              (format "system-char-id:0x%X"
 402                      (encode-char char 'system-char-id))
 403              )))))
 404
 405
 406 ;;; @ Feature name presentation
 407 ;;;
 408
 409 (defun www-format-feature-name-default (feature-name)
 410   (mapconcat
 411    #'capitalize
 412    (split-string
 413     (symbol-name feature-name)
 414     "-")
 415    " "))
 416
 417 (defun www-format-feature-name-as-metadata (feature-name &optional lang)
 418   (let ((str (symbol-name feature-name))
 419         base meta)
 420     (cond
 421      ((string-match "\\*[^*]+$" str)
 422       (setq base (substring str 0 (match-beginning 0))
 423             meta (substring str (match-beginning 0)))
 424       (concat (www-format-feature-name* (intern base) lang)
 425               meta))
 426      (t
 427       (www-format-feature-name-default feature-name)
 428       ))))
 429
 430 (defun www-format-feature-name-as-rel-to (feature-name)
 431   (concat "\u2192" (substring (symbol-name feature-name) 2)))
 432
 433 (defun www-format-feature-name-as-rel-from (feature-name)
 434   (concat "\u2190" (substring (symbol-name feature-name) 2)))
 435
 436 (defun www-format-feature-name-as-CCS (feature-name)
 437   (let* ((rest
 438           (split-string
 439            (symbol-name feature-name)
 440            "-"))
 441          (dest (upcase (pop rest))))
 442     (when (string-match "^=+>*" dest)
 443       (setq dest (concat (substring dest 0 (match-end 0))
 444                          " "
 445                          (substring dest (match-end 0)))))
 446     (cond
 447      (rest
 448       (while (cdr rest)
 449         (setq dest (concat dest " " (upcase (pop rest)))))
 450       (if (string-match "^[0-9]+$" (car rest))
 451           (concat dest "-" (car rest))
 452         (concat dest " " (upcase (car rest))))
 453       )
 454      (t dest))))
 455
 456 (defun www-format-feature-name* (feature-name &optional lang)
 457   (let (name fn parent ret)
 458     (cond
 459      ((or (and lang
 460                (char-feature-property
 461                 feature-name
 462                 (intern (format "name@%s" lang))))
 463           (char-feature-property
 464            feature-name 'name)))
 465      ((and (setq name (symbol-name feature-name))
 466            (string-match "\\*" name))
 467       (www-format-feature-name-as-metadata feature-name lang))
 468      (t
 469       (setq fn feature-name)
 470       (while (and (setq parent (char-feature-name-parent fn))
 471                   (null (setq ret
 472                               (or (and lang
 473                                        (char-feature-property
 474                                         parent
 475                                         (intern (format "name@%s" lang))))
 476                                   (char-feature-property
 477                                    parent 'name)))))
 478         (setq fn parent))
 479       (cond
 480        (ret
 481         (concat ret (substring (symbol-name feature-name)
 482                                (length (symbol-name parent)))))
 483        ((find-charset feature-name)
 484         (www-format-feature-name-as-CCS feature-name))
 485        ((string-match "^\\(->\\)" name)
 486         (www-format-feature-name-as-rel-to feature-name))
 487        ((string-match "^\\(<-\\)" name)
 488         (www-format-feature-name-as-rel-from feature-name))
 489        (t
 490         (www-format-feature-name-default feature-name)
 491         ))
 492       ))))
 493
 494 (defun www-format-feature-name (feature-name &optional lang)
 495   (www-format-encode-string
 496    (www-format-feature-name* feature-name lang)))
 497
 498
 499 ;;; @ Feature value presentation
 500 ;;;
 501
 502 (defun www-format-value-as-kuten (value)
 503   (format "%02d-%02d"
 504           (- (lsh value -8) 32)
 505           (- (logand value 255) 32)))
 506
 507 (defun www-format-value-default (value &optional without-tags)
 508   (if (listp value)
 509       (mapconcat
 510        (lambda (unit)
 511          (www-format-encode-string
 512           (format "%S" unit)
 513           without-tags))
 514        value " ")
 515     (www-format-encode-string (format "%S" value) without-tags)))
 516
 517 (defun www-format-value-as-char-list (value &optional without-tags)
 518   (if (listp value)
 519       (mapconcat
 520        (if without-tags
 521            (lambda (unit)
 522              (www-format-encode-string
 523               (format (if (characterp unit)
 524                           "%c"
 525                         "%s")
 526                       unit)
 527               'without-tags))
 528          (lambda (unit)
 529            (if (characterp unit)
 530                (format "<a href=\"%s?char=%s\">%s</a>"
 531                        chise-wiki-view-url
 532                        (www-uri-encode-char unit)
 533                        (www-format-encode-string (char-to-string unit)))
 534              (www-format-encode-string (format "%s" unit)))))
 535        value " ")
 536     (www-format-encode-string (format "%s" value) without-tags)))
 537
 538 (defun www-format-value-as-domain-list (value &optional without-tags)
 539   (let (name source0 source num dest rest unit start end ddest)
 540     (if (listp value)
 541         (if without-tags
 542             (mapconcat
 543              (lambda (unit)
 544                (format "%s" unit))
 545              value " ")
 546           (setq rest value)
 547           (while rest
 548             (setq unit (pop rest))
 549             (if (symbolp unit)
 550                 (setq name (symbol-name unit)))
 551             (setq dest
 552                   (concat
 553                    dest
 554                    (cond
 555                     ((string-match "^zob1968=" name)
 556                      (setq source (intern (substring name 0 (match-end 0)))
 557                            num (substring name (match-end 0)))
 558                      (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
 559                          (setq start (string-to-number
 560                                       (match-string 1 num))
 561                                end (string-to-number
 562                                     (match-string 2 num)))
 563                        (setq start (string-to-number num)
 564                              end start))
 565                      (setq ddest
 566                            (if (eq source source0)
 567                                (format
 568                                 ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
 569                                 start start)
 570                              (setq source0 source)
 571                              (format
 572                               " <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/\">%s</a>=<a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
 573                               (www-format-encode-string "\u4EAC大人\u6587研甲\u9AA8")
 574                               start start)))
 575                      (setq start (1+ start))
 576                      (while (<= start end)
 577                        (setq ddest
 578                              (concat
 579                               ddest
 580                               (format
 581                                ", <a href=\"http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d\">%04d</a>"
 582                                start start)))
 583                        (setq start (1+ start)))
 584                      ddest)
 585                     (t
 586                      (setq source unit)
 587                      (if (eq source source0)
 588                          ""
 589                        (setq source0 source)
 590                        (concat " " name))
 591                      )))))
 592           dest)
 593       (www-format-encode-string (format "%s" value) without-tags))))
 594
 595 (defun www-format-value-as-ids (value &optional without-tags)
 596   (if (listp value)
 597       (mapconcat
 598        (if without-tags
 599            (lambda (unit)
 600              (www-format-encode-string
 601               (format (if (characterp unit)
 602                           "%c"
 603                         "%s")
 604                       unit)
 605               'without-tags))
 606          (lambda (unit)
 607            (if (characterp unit)
 608                (format "<a href=\"%s?char=%s\">%s</a>"
 609                        chise-wiki-view-url
 610                        (www-uri-encode-char unit)
 611                        (www-format-encode-string (char-to-string unit)))
 612              (www-format-encode-string (format "%s" unit)))))
 613        (ideographic-structure-to-ids value) " ")
 614     (www-format-encode-string (format "%s" value) without-tags)))
 615
 616 (defun www-format-value-as-S-exp (value &optional without-tags)
 617   (www-format-encode-string (format "%S" value) without-tags))
 618
 619 (defun www-format-value-as-HEX (value)
 620   (if (integerp value)
 621       (format "%X" value)
 622     (www-format-value-as-S-exp value)))
 623
 624 (defun www-format-value-as-CCS-default (value)
 625   (if (integerp value)
 626       (format "0x%s (%d)"
 627               (www-format-value-as-HEX value)
 628               value)
 629     (www-format-value-as-S-exp value)))
 630
 631 (defun www-format-value-as-CCS-94x94 (value)
 632   (if (integerp value)
 633       (format "0x%s [%s] (%d)"
 634               (www-format-value-as-HEX value)
 635               (www-format-value-as-kuten value)
 636               value)
 637     (www-format-value-as-S-exp value)))
 638
 639 (defun www-format-value-as-kangxi-radical (value)
 640   (if (and (integerp value)
 641            (<= 0 value)
 642            (<= value 214))
 643       (www-format-encode-string
 644        (format "%c" (ideographic-radical value)))
 645     (www-format-value-as-S-exp value)))
 646
 647 (defun www-format-value (object feature-name
 648                                 &optional value format
 649                                 without-tags without-edit)
 650   (unless value
 651     (setq value (www-char-feature object feature-name)))
 652   (www-format-apply-value object feature-name
 653                           format nil value nil nil
 654                           without-tags without-edit)
 655   )
 656
 657
 658 ;;; @ format evaluator
 659 ;;;
 660
 661 (defun www-format-encode-string (string &optional without-tags)
 662   (with-temp-buffer
 663     (insert string)
 664     (let (plane code start end char variants ret rret)
 665       (goto-char (point-min))
 666       (while (search-forward "<" nil t)
 667         (replace-match "&lt;" nil t))
 668       (goto-char (point-min))
 669       (while (search-forward ">" nil t)
 670         (replace-match "&gt;" nil t))
 671       (if without-tags
 672           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 673         (let ((coded-charset-entity-reference-alist
 674                (list*
 675                 '(=gt                   "GT-" 5 d)
 676                 '(=cns11643-1           "C1-" 4 X)
 677                 '(=cns11643-2           "C2-" 4 X)
 678                 '(=cns11643-3           "C3-" 4 X)
 679                 '(=cns11643-4           "C4-" 4 X)
 680                 '(=cns11643-5           "C5-" 4 X)
 681                 '(=cns11643-6           "C6-" 4 X)
 682                 '(=cns11643-7           "C7-" 4 X)
 683                 '(=gb2312               "G0-" 4 X)
 684                 '(=gb12345              "G1-" 4 X)
 685                 '(=jis-x0208@1990       "J90-" 4 X)
 686                 '(=jis-x0212            "JSP-" 4 X)
 687                 '(=cbeta                "CB" 5 d)
 688                 '(=jis-x0208@1997       "J97-" 4 X)
 689                 '(=jis-x0208@1978       "J78-" 4 X)
 690                 '(=jis-x0208@1983       "J83-" 4 X)
 691                 '(=ruimoku-v6           "RUI6-" 4 X)
 692                 '(=zinbun-oracle        "ZOB-" 4 d)
 693                 '(=jef-china3           "JC3-" 4 X)
 694                 '(=daikanwa             "M-" 5 d)
 695                 coded-charset-entity-reference-alist)))
 696           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 697
 698           (goto-char (point-min))
 699           (while (re-search-forward "&CB\\([0-9]+\\);" nil t)
 700             (setq code (string-to-int (match-string 1)))
 701             (replace-match
 702              (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\">"
 703                      code
 704                      chise-wiki-bitmap-glyphs-url
 705                      (/ code 1000) code)
 706              t 'literal))
 707
 708           (goto-char (point-min))
 709           (while (re-search-forward "&J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 710             (setq plane (match-string 1)
 711                   code (string-to-int (match-string 2) 16))
 712             (replace-match
 713              (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\">"
 714                      plane code
 715                      chise-wiki-bitmap-glyphs-url
 716                      plane
 717                      (- (lsh code -8) 32)
 718                      (- (logand code 255) 32))
 719              t 'literal))
 720
 721           (goto-char (point-min))
 722           (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 723             (setq plane (string-to-int (match-string 1))
 724                   code (string-to-int (match-string 2) 16))
 725             (replace-match
 726              (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\">"
 727                      plane code
 728                      chise-wiki-bitmap-glyphs-url
 729                      plane
 730                      (- (lsh code -8) 32)
 731                      (- (logand code 255) 32))
 732              t 'literal))
 733
 734           (goto-char (point-min))
 735           (while (re-search-forward "&C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 736             (setq plane (string-to-int (match-string 1))
 737                   code (string-to-int (match-string 2) 16))
 738             (replace-match
 739              (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\">"
 740                      plane code
 741                      chise-wiki-bitmap-glyphs-url
 742                      plane code)
 743              t 'literal))
 744
 745           (goto-char (point-min))
 746           (while (re-search-forward "&JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 747             (setq code (string-to-int (match-string 1) 16))
 748             (replace-match
 749              (format "<img alt=\"JC3-%04X\" src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/%04x.gif\">"
 750                      code code)
 751              t 'literal))
 752
 753           (goto-char (point-min))
 754           (while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
 755             (setq code (string-to-int (match-string 2)))
 756             (replace-match
 757              (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\">"
 758                      code
 759                      chise-wiki-bitmap-glyphs-url
 760                      code)
 761              t 'literal))
 762
 763           (goto-char (point-min))
 764           (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
 765             (setq code (string-to-int (match-string 2)))
 766             (replace-match
 767              (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\">"
 768                      code
 769                      chise-wiki-glyph-cgi-url
 770                      code)
 771              t 'literal))
 772
 773           (goto-char (point-min))
 774           (while (re-search-forward "&\\(G-\\)?GT-K\\([0-9]+\\);" nil t)
 775             (setq code (string-to-int (match-string 2)))
 776             (replace-match
 777              (format "<img alt=\"GT-K%05d\" src=\"%s?char=GT-K%05d\">"
 778                      code
 779                      chise-wiki-glyph-cgi-url
 780                      code)
 781              t 'literal))
 782
 783           (goto-char (point-min))
 784           (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
 785             (setq code (string-to-int (match-string 1) 16))
 786             (replace-match
 787              (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\">"
 788                      code
 789                      chise-wiki-glyph-cgi-url
 790                      code)
 791              t 'literal))
 792
 793           (goto-char (point-min))
 794           (while (re-search-forward "&CDP-\\([0-9A-F]+\\);" nil t)
 795             (setq code (string-to-int (match-string 1) 16))
 796             (replace-match
 797              (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\">"
 798                      code
 799                      chise-wiki-glyph-cgi-url
 800                      code)
 801              t 'literal))
 802
 803           (goto-char (point-min))
 804           (while (re-search-forward "&RUI6-\\([0-9A-F]+\\);" nil t)
 805             (setq code (string-to-int (match-string 1) 16))
 806             (replace-match
 807              (format "<img alt=\"RUI6-%04X\" src=\"%s?char=RUI6-%04X\">"
 808                      code
 809                      chise-wiki-glyph-cgi-url
 810                      code)
 811              t 'literal))
 812
 813           (goto-char (point-min))
 814           (while (re-search-forward "&\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
 815             (setq code (string-to-int (match-string 2) 16))
 816             (replace-match
 817              (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\">"
 818                      code
 819                      code)
 820              t 'literal))
 821
 822           (goto-char (point-min))
 823           (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
 824             (setq code (string-to-int (match-string 1) 16))
 825             (setq start (match-beginning 0)
 826                   end (match-end 0))
 827             (setq char (decode-char 'system-char-id code))
 828             (cond
 829              ((and (setq variants
 830                          (or (www-char-feature char '->subsumptive)
 831                              (www-char-feature char '->denotational)))
 832                    (progn
 833                      (while (and variants
 834                                  (setq ret (www-format-encode-string
 835                                             (char-to-string (car variants))))
 836                                  (string-match "&MCS-\\([0-9A-F]+\\);" ret))
 837                        (setq variants (cdr variants)))
 838                      ret))
 839               (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
 840                 (goto-char start)
 841                 (delete-region start end)
 842                 (insert ret))
 843               )
 844              ((setq ret (or (www-char-feature char 'ideographic-combination)
 845                             (www-char-feature char 'ideographic-structure)))
 846               (setq ret
 847                     (mapconcat
 848                      (lambda (ch)
 849                        (if (listp ch)
 850                            (if (characterp (setq rret (find-char ch)))
 851                                (setq ch rret)))
 852                        (if (characterp ch)
 853                            (www-format-encode-string
 854                             (char-to-string ch) without-tags)
 855                          (www-format-encode-string
 856                           (format "%S" ch) without-tags)))
 857                      ret ""))
 858               (when ret
 859                 (goto-char start)
 860                 (delete-region start end)
 861                 (insert ret))
 862               )))
 863           ))
 864       ;; (goto-char (point-min))
 865       ;; (while (search-forward "&GT-" nil t)
 866       ;;   (replace-match "&amp;GT-" t 'literal))
 867       (buffer-string))))
 868
 869 (defun www-format-props-to-string (props &optional format)
 870   (unless format
 871     (setq format (plist-get props :format)))
 872   (concat "%"
 873           (plist-get props :flag)
 874           ;; (if (plist-get props :zero-padding)
 875           ;;     "0")
 876           (if (plist-get props :len)
 877               (format "0%d"
 878                       (let ((ret (plist-get props :len)))
 879                         (if (stringp ret)
 880                             (string-to-int ret)
 881                           ret))))
 882           (cond
 883            ((eq format 'decimal) "d")
 884            ((eq format 'hex) "x")
 885            ((eq format 'HEX) "X")
 886            ((eq format 'S-exp) "S")
 887            (t "s"))))
 888
 889 (defun www-format-apply-value (object feature-name
 890                                       format props value
 891                                       &optional uri-char uri-feature
 892                                       without-tags without-edit)
 893   (let (ret)
 894     (setq ret
 895           (cond
 896            ((memq format '(decimal hex HEX))
 897             (if (integerp value)
 898                 (format (www-format-props-to-string props format)
 899                         value)
 900               (www-format-encode-string
 901                (format "%s" value)
 902                without-tags))
 903             )
 904            ((eq format 'wiki-text)
 905             (if without-tags
 906                 (www-xml-format-list value)
 907               (www-format-eval-list value object feature-name nil uri-char
 908                                     without-tags without-edit))
 909             )
 910            ((eq format 'S-exp)
 911             (www-format-encode-string
 912              (format (www-format-props-to-string props format)
 913                      value)
 914              without-tags))
 915            ((eq format 'ku-ten)
 916             (www-format-value-as-kuten value))
 917            ((eq format 'kangxi-radical)
 918             (www-format-value-as-kangxi-radical value))
 919            ((eq format 'space-separated-char-list)
 920             (www-format-value-as-char-list value without-tags))
 921            ((eq format 'space-separated-ids)
 922             (www-format-value-as-ids value without-tags))
 923            ((eq format 'space-separated-domain-list)
 924             (www-format-value-as-domain-list value without-tags))
 925            ((eq format 'string)
 926             (www-format-encode-string (format "%s" value) without-tags)
 927             )
 928            (t
 929             (www-format-value-default value without-tags)
 930             ))
 931           )
 932     (if (or without-tags
 933             without-edit
 934             (eq (plist-get props :mode) 'peek))
 935         ret
 936       (format "%s <a href=\"%s?char=%s&feature=%s&format=%s\"
 937 ><input type=\"submit\" value=\"edit\" /></a>"
 938               ret
 939               chise-wiki-edit-url
 940               uri-char uri-feature format))))
 941
 942 (defun www-format-eval-feature-value (char
 943                                       feature-name
 944                                       &optional format lang uri-char value
 945                                       without-tags without-edit)
 946   (unless value
 947     (setq value (www-char-feature char feature-name)))
 948   (unless format
 949     (setq format (www-feature-value-format feature-name)))
 950   (cond
 951    ((symbolp format)
 952     (www-format-apply-value
 953      char feature-name
 954      format nil value
 955      uri-char (www-uri-encode-feature-name feature-name)
 956      without-tags without-edit)
 957     )
 958    ((consp format)
 959     (cond ((null (cdr format))
 960            (setq format (car format))
 961            (www-format-apply-value
 962             char feature-name
 963             (car format) (nth 1 format) value
 964             uri-char (www-uri-encode-feature-name feature-name)
 965             without-tags without-edit)
 966            )
 967           (t
 968            (www-format-eval-list format char feature-name lang uri-char
 969                                  without-tags without-edit)
 970            )))))
 971
 972 (defun www-format-eval-unit (exp char feature-name
 973                                  &optional lang uri-char value
 974                                  without-tags without-edit)
 975   (unless value
 976     (setq value (www-char-feature char feature-name)))
 977   (unless uri-char
 978     (setq uri-char (www-uri-encode-char char)))
 979   (cond
 980    ((stringp exp) (www-format-encode-string exp))
 981    ((null exp) "")
 982    ((consp exp)
 983     (cond
 984      ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
 985                               S-exp string default))
 986       (let ((fn (plist-get (nth 1 exp) :feature))
 987             domain domain-fn ret)
 988         (when fn
 989           (when (stringp fn)
 990             (setq fn (intern fn)))
 991           (setq domain (char-feature-name-domain feature-name))
 992           (setq domain-fn (char-feature-name-at-domain fn domain))
 993           (if (setq ret (www-char-feature char domain-fn))
 994               (setq feature-name domain-fn
 995                     value ret)
 996             (setq feature-name fn
 997                   value (www-char-feature char fn)))
 998           (push feature-name chise-wiki-displayed-features)
 999           ))
1000       (if (eq (car exp) 'value)
1001           (www-format-eval-feature-value char feature-name
1002                                          (plist-get (nth 1 exp) :format)
1003                                          lang uri-char value
1004                                          without-tags without-edit)
1005         (www-format-apply-value
1006          char feature-name
1007          (car exp) (nth 1 exp) value
1008          uri-char (www-uri-encode-feature-name feature-name)
1009          without-tags without-edit))
1010       )
1011      ((eq (car exp) 'name)
1012       (let ((fn (plist-get (nth 1 exp) :feature))
1013             domain domain-fn)
1014         (when fn
1015           (setq domain (char-feature-name-domain feature-name))
1016           (when (stringp fn)
1017             (setq fn (intern fn)))
1018           (setq domain-fn (char-feature-name-at-domain fn domain))
1019           (setq feature-name domain-fn)))
1020       (if without-tags
1021           (www-format-feature-name feature-name lang)
1022         (format "<a href=\"%s\">%s</a>"
1023                 (www-uri-make-feature-name-url
1024                  (www-uri-encode-feature-name feature-name)
1025                  uri-char)
1026                 (www-format-feature-name feature-name lang))
1027         )
1028       )
1029      ((eq (car exp) 'name-url)
1030       (let ((fn (plist-get (nth 1 exp) :feature))
1031             domain domain-fn)
1032         (when fn
1033           (setq domain (char-feature-name-domain feature-name))
1034           (when (stringp fn)
1035             (setq fn (intern fn)))
1036           (setq domain-fn (char-feature-name-at-domain fn domain))
1037           (setq feature-name domain-fn)))
1038       (www-uri-make-feature-name-url
1039        (www-uri-encode-feature-name feature-name)
1040        uri-char)
1041       )
1042      ((eq (car exp) 'domain-name)
1043       (let ((domain (char-feature-name-domain feature-name)))
1044         (if domain
1045             (format "@%s" domain))))
1046      ((eq (car exp) 'prev-char)
1047       (if without-tags
1048           ""
1049         (let ((prev-char (find-previous-defined-code-point
1050                           feature-name value)))
1051           (if prev-char
1052               (format "\n<a href=\"%s?char=%s\">%s</a>"
1053                       chise-wiki-view-url
1054                       (www-uri-encode-char prev-char)
1055                       "<input type=\"submit\" value=\"-\" />"
1056                       ;; (www-format-encode-string
1057                       ;;  (char-to-string prev-char))
1058                       )
1059             "")))
1060       )
1061      ((eq (car exp) 'next-char)
1062       (if without-tags
1063           ""
1064         (let ((next-char (find-next-defined-code-point
1065                           feature-name value)))
1066           (if next-char
1067               (format "<a href=\"%s?char=%s\">%s</a>"
1068                       chise-wiki-view-url
1069                       (www-uri-encode-char next-char)
1070                       "<input type=\"submit\" value=\"+\" />"
1071                       ;; (www-format-encode-string
1072                       ;;  (char-to-string next-char))
1073                       )
1074             "")))
1075       )
1076      ((eq (car exp) 'link)
1077       (if without-tags
1078           (www-format-eval-list (nthcdr 2 exp)
1079                                 char feature-name lang uri-char
1080                                 without-tags without-edit)
1081         (format "<a
1082  href=\"%s\"
1083 >%s</a
1084 >"
1085                 (www-format-eval-list (plist-get (nth 1 exp) :ref)
1086                                       char feature-name lang uri-char
1087                                       'without-tags 'without-edit)
1088                 (www-format-eval-list (nthcdr 2 exp)
1089                                       char feature-name lang uri-char
1090                                       without-tags without-edit)))
1091       )
1092      (t
1093       (format "<%s
1094 >%s</%s
1095 >"
1096               (car exp)
1097               (www-format-eval-list (nthcdr 2 exp) char feature-name
1098                                     lang uri-char
1099                                     without-tags without-edit)
1100               (car exp)))))))
1101
1102 (defun www-format-eval-list (format-list char feature-name
1103                                          &optional lang uri-char
1104                                          without-tags without-edit)
1105   (if (consp format-list)
1106       (mapconcat
1107        (lambda (exp)
1108          (www-format-eval-unit exp char feature-name lang uri-char
1109                                nil without-tags without-edit))
1110        format-list "")
1111     (www-format-eval-unit format-list char feature-name lang uri-char
1112                           nil without-tags without-edit)))
1113
1114
1115 ;;; @ XML generator
1116 ;;;
1117
1118 (defun www-xml-format-props (props)
1119   (let ((dest "")
1120         key val)
1121     (while props
1122       (setq key (pop props)
1123             val (pop props))
1124       (if (symbolp key)
1125           (setq key (symbol-name key)))
1126       (if (eq (aref key 0) ?:)
1127           (setq key (substring key 1)))
1128       (setq dest
1129             (format "%s %s=\"%s\""
1130                     dest key
1131                     (www-format-encode-string
1132                      (format "%s" val) 'without-tags))))
1133     dest))
1134
1135 (defun www-xml-format-unit (format-unit)
1136   (let (name props children ret)
1137     (cond
1138      ((stringp format-unit)
1139       (mapconcat (lambda (c)
1140                    (cond
1141                     ((eq c ?&) "&amp;")
1142                     ;; ((eq c ?<) "&amp;lt;")
1143                     ;; ((eq c ?>) "&amp;gt;")
1144                     (t
1145                      (char-to-string c))))
1146                  (www-format-encode-string format-unit 'without-tags)
1147                  "")
1148       )
1149      ((consp format-unit)
1150       (setq name (car format-unit)
1151             props (nth 1 format-unit)
1152             children (nthcdr 2 format-unit))
1153       (when (eq name 'link)
1154         (setq ret (plist-get props :ref))
1155         (unless (stringp ret)
1156           (setq props (plist-remprop (copy-list props) :ref))
1157           (setq children
1158                 (cons (list* 'ref nil ret)
1159                       children))))
1160       (if children
1161           (format "<%s%s>%s</%s>"
1162                   name
1163                   (if props
1164                       (www-xml-format-props props)
1165                     "")
1166                   (www-xml-format-list children)
1167                   name)
1168         (format "<%s%s/>"
1169                 name (www-xml-format-props props)))
1170       )
1171      (t
1172       (format "%s" format-unit)))))
1173
1174 (defun www-xml-format-list (format-list)
1175   (if (atom format-list)
1176       (www-xml-format-unit format-list)
1177     (mapconcat #'www-xml-format-unit
1178                format-list "")))
1179
1180
1181 ;;; @ HTML generator
1182 ;;;
1183
1184 (defun www-html-display-text (text)
1185   (princ
1186    (with-temp-buffer
1187      (insert text)
1188      (goto-char (point-min))
1189      (while (search-forward "<" nil t)
1190        (replace-match "&lt;" nil t))
1191      (goto-char (point-min))
1192      (while (search-forward ">" nil t)
1193        (replace-match "&gt;" nil t))
1194      (goto-char (point-min))
1195      (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t)
1196        (replace-match
1197         (format "<a href=\"%s\">%s</a>"
1198                 (match-string 2)
1199                 (match-string 1))
1200         nil t))
1201      (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
1202      (goto-char (point-min))
1203      (while (search-forward "&GT-" nil t)
1204        (replace-match "&amp;GT-" nil t))
1205      (buffer-string))))
1206
1207 (defun www-html-display-paragraph (text)
1208   (princ "<p>")
1209   (www-html-display-text text)
1210   (princ "</p>\n"))
1211
1212
1213 ;;; @ for GlyphWiki
1214 ;;;
1215
1216 (defvar coded-charset-GlyphWiki-id-alist
1217   '((=ucs               "u"     4 x nil)
1218     (=ucs@JP            "u"     4 x nil)
1219     (=ucs@jis           "u"     4 x nil)
1220     (=ucs@gb            "u"     4 x "-g")
1221     (=ucs@cns           "u"     4 x "-t")
1222     (=ucs@ks            "u"     4 x "-k")
1223     (=ucs@iso           "u"     4 x "-u")
1224     (=ucs@unicode       "u"     4 x "-us")
1225     (=adobe-japan1-6    "aj1-"  5 d nil)
1226     (=gt                "gt-"   5 d nil)
1227     (=big5-cdp          "cdp-"  4 x nil)
1228     (=cbeta             "cb"    5 d nil)
1229     (=jis-x0208@1978/1pr "j78-" 4 x nil)
1230     (=jis-x0208@1978/-4pr "j78-" 4 x nil)
1231     (=jis-x0208@1978    "j78-"  4 x nil)
1232     (=jis-x0208@1983    "j83-"  4 x nil)
1233     (=jis-x0208@1990    "j90-"  4 x nil)
1234     (=jis-x0212         "jsp-"  4 x nil)
1235     (=jis-x0213-1@2000  "jx1-2000-" 4 x nil)
1236     (=jis-x0213-1@2004  "jx1-2004-" 4 x nil)
1237     (=jis-x0213-2       "jx2-"  4 x nil)
1238     (=cns11643-1        "c1-"   4 x nil)
1239     (=cns11643-2        "c2-"   4 x nil)
1240     (=cns11643-3        "c3-"   4 x nil)
1241     (=cns11643-4        "c4-"   4 x nil)
1242     (=cns11643-5        "c5-"   4 x nil)
1243     (=cns11643-6        "c6-"   4 x nil)
1244     (=cns11643-7        "c7-"   4 x nil)
1245     (=daikanwa          "dkw-"  5 d nil)
1246     (=gt-k              "gt-k"  5 d nil)
1247     (=jef-china3        "jc3-"  4 x nil)
1248     (=big5              "b-"    4 x nil)
1249     (=ks-x1001          "k0-"   4 x nil)
1250     ))
1251
1252 (defun char-GlyphWiki-id (char)
1253   (let ((rest coded-charset-GlyphWiki-id-alist)
1254         spec ret code)
1255     (while (and rest
1256                 (setq spec (pop rest))
1257                 (null (setq ret (char-feature char (car spec))))))
1258     (when ret
1259       (or
1260        (and (memq (car spec) '(=ucs@unicode '=ucs@iso))
1261             (cond
1262              ((and (or (encode-char char '=jis-x0208@1990)
1263                        (encode-char char '=jis-x0212)
1264                        (encode-char char '=jis-x0213-1))
1265                    (setq code (encode-char char '=ucs@jis)))
1266               (format "u%04x" code)
1267               )
1268              ((and (or (encode-char char '=gb2312)
1269                        (encode-char char '=gb12345))
1270                    (setq code (encode-char char '=ucs@gb)))
1271               (format "u%04x-g" code)
1272               )
1273              ((and (or (encode-char char '=cns11643-1)
1274                        (encode-char char '=cns11643-2)
1275                        (encode-char char '=cns11643-3)
1276                        (encode-char char '=cns11643-4)
1277                        (encode-char char '=cns11643-5)
1278                        (encode-char char '=cns11643-6)
1279                        (encode-char char '=cns11643-7))
1280                    (setq code (encode-char char '=ucs@cns)))
1281               (format "u%04x-t" code)
1282               )
1283              ((and (encode-char char '=ks-x1001)
1284                    (setq code (encode-char char '=ucs@ks)))
1285               (format "u%04x-k" code)
1286               )))
1287        (format (format "%s%%0%d%s%s"
1288                        (nth 1 spec)
1289                        (nth 2 spec)
1290                        (nth 3 spec)
1291                        (or (nth 4 spec) ""))
1292                ret)))))
1293
1294
1295 ;;; @ End.
1296 ;;;
1297
1298 (provide 'cwiki-common)
1299
1300 ;;; cwiki-common.el ends here