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/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 (defun decode-uri-string (string &optional coding-system)
  14   (if (> (length string) 0)
  15       (let ((i 0)
  16             dest)
  17         (setq string
  18               (mapconcat (lambda (char)
  19                            (if (eq char ?+)
  20                                " "
  21                              (char-to-string char)))
  22                          string ""))
  23         (while (string-match "%\\([0-9A-F][0-9A-F]\\)" string i)
  24           (setq dest (concat dest
  25                              (substring string i (match-beginning 0))
  26                              (char-to-string
  27                               (int-char
  28                                (string-to-int (match-string 1 string) 16))))
  29                 i (match-end 0)))
  30         (decode-coding-string
  31          (concat dest (substring string i))
  32          coding-system))))
  33
  34 (defun www-feature-type (feature-name)
  35   (or (char-feature-property feature-name 'type)
  36       (let ((str (symbol-name feature-name)))
  37         (cond
  38          ((string-match "^\\(->\\|<-\\)" str)
  39           'relation)
  40          ((string-match "^ideographic-structure\\(@\\|$\\)" str)
  41           'structure)
  42          ))))
  43
  44 (defun www-feature-value-format (feature-name)
  45   (or (char-feature-property feature-name 'value-format)
  46       (let ((type (www-feature-type feature-name)))
  47         (cond ((eq type 'relation)
  48                'space-separated-char-list)
  49               ((eq type 'structure)
  50                'space-separated-ids)))
  51       (if (find-charset feature-name)
  52           (if (and (= (charset-dimension feature-name) 2)
  53                    (= (charset-chars feature-name) 94))
  54               '("0x" (HEX)
  55                 " (" (decimal) ") <" (ku-ten) ">")
  56             '("0x" (HEX) " (" (decimal) ")")))))
  57
  58
  59 ;;; @ URI representation
  60 ;;;
  61
  62 (defun www-uri-decode-feature-name (uri-feature)
  63   (let (feature)
  64     (cond
  65      ((string-match "^from\\." uri-feature)
  66       (intern (format "<-%s" (substring uri-feature (match-end 0))))
  67       )
  68      ((string-match "^to\\." uri-feature)
  69       (intern (format "->%s" (substring uri-feature (match-end 0))))
  70       )
  71      ((string-match "^rep\\." uri-feature)
  72       (intern (format "=%s" (substring uri-feature (match-end 0))))
  73       )
  74      ((string-match "^g\\." uri-feature)
  75       (intern (format "=>>%s" (substring uri-feature (match-end 0))))
  76       )
  77      ((string-match "^gi\\." uri-feature)
  78       (intern (format "=>>>%s" (substring uri-feature (match-end 0))))
  79       )
  80      ((string-match "^gi\\([0-9]+\\)\\." uri-feature)
  81       (intern (format "=>>%s%s"
  82                       (make-string (string-to-int
  83                                     (match-string 1 uri-feature))
  84                                    ?>)
  85                       (substring uri-feature (match-end 0))))
  86       )
  87      ((string-match "^a\\." uri-feature)
  88       (intern (format "=>%s" (substring uri-feature (match-end 0))))
  89       )
  90      ((string-match "^a\\([0-9]+\\)\\." uri-feature)
  91       (intern (format "%s>%s"
  92                       (make-string (string-to-int
  93                                     (match-string 1 uri-feature))
  94                                    ?=)
  95                       (substring uri-feature (match-end 0))))
  96       )
  97      ((and (setq feature (intern (format "=>%s" uri-feature)))
  98            (find-charset feature))
  99       feature)
 100      ((and (setq feature (intern (format "=>>%s" uri-feature)))
 101            (find-charset feature))
 102       feature)
 103      ((and (setq feature (intern (format "=>>>%s" uri-feature)))
 104            (find-charset feature))
 105       feature)
 106      ((and (setq feature (intern (format "=%s" uri-feature)))
 107            (find-charset feature))
 108       feature)
 109      (t (intern uri-feature)))))
 110
 111 (defun www-uri-encode-feature-name (feature-name)
 112   (setq feature-name (symbol-name feature-name))
 113   (cond
 114    ((string-match "^=\\([^=>]+\\)" feature-name)
 115     (concat "rep." (substring feature-name (match-beginning 1)))
 116     )
 117    ((string-match "^=>>\\([^=>]+\\)" feature-name)
 118     (concat "g." (substring feature-name (match-beginning 1)))
 119     )
 120    ((string-match "^=>>>\\([^=>]+\\)" feature-name)
 121     (concat "gi." (substring feature-name (match-beginning 1)))
 122     )
 123    ((string-match "^=>>\\(>+\\)" feature-name)
 124     (format "gi%d.%s"
 125             (length (match-string 1 feature-name))
 126             (substring feature-name (match-end 1)))
 127     )
 128    ((string-match "^=>\\([^=>]+\\)" feature-name)
 129     (concat "a." (substring feature-name (match-beginning 1)))
 130     )
 131    ((string-match "^\\(=+\\)>" feature-name)
 132     (format "a%d.%s"
 133             (length (match-string 1 feature-name))
 134             (substring feature-name (match-end 0)))
 135     )
 136    ((string-match "^->" feature-name)
 137     (concat "to." (substring feature-name (match-end 0)))
 138     )
 139    ((string-match "^<-" feature-name)
 140     (concat "from." (substring feature-name (match-end 0)))
 141     )
 142    (t feature-name)))
 143
 144 (defun www-uri-decode-char (char-rep)
 145   (let (ccs cpos)
 146     (cond
 147      ((string-match "\\(%3A\\|:\\)" char-rep)
 148       (setq ccs (substring char-rep 0 (match-beginning 0))
 149             cpos (substring char-rep (match-end 0)))
 150       (setq ccs (www-uri-decode-feature-name ccs))
 151       (cond
 152        ((string-match "^0x" cpos)
 153         (setq cpos
 154               (string-to-number (substring cpos (match-end 0)) 16))
 155         )
 156        (t
 157         (setq cpos (string-to-number cpos))
 158         ))
 159       (if (numberp cpos)
 160           (decode-char ccs cpos))
 161       )
 162      (t
 163       (setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
 164       (when (= (length char-rep) 1)
 165         (aref char-rep 0))
 166       ))))
 167
 168 (defun www-uri-encode-char (char)
 169   (if (encode-char char '=ucs)
 170       (mapconcat
 171        (lambda (byte)
 172          (format "%%%02X" byte))
 173        (encode-coding-string (char-to-string char) 'utf-8-mcs-er)
 174        "")
 175     (let ((ccs-list '(; =ucs
 176                       =cns11643-1 =cns11643-2 =cns11643-3
 177                       =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
 178                       =gb2312 =gb12345
 179                       =jis-x0208 =jis-x0208@1990
 180                       =jis-x0212
 181                       =cbeta =jef-china3
 182                       =jis-x0213-1@2000 =jis-x0213-1@2004
 183                       =jis-x0208@1983 =jis-x0208@1978
 184                       =zinbun-oracle
 185                       =daikanwa
 186                       =gt =gt-k
 187                       =>>jis-x0208 =>>jis-x0213-1
 188                       =>jis-x0208 =>jis-x0213-1
 189                       =>>gt
 190                       =big5
 191                       =big5-cdp))
 192           ccs ret)
 193       (while (and ccs-list
 194                   (setq ccs (pop ccs-list))
 195                   (not (setq ret (encode-char char ccs 'defined-only)))))
 196       (cond (ret
 197              (format "%s:0x%X"
 198                      (www-uri-encode-feature-name ccs)
 199                      ret))
 200             ((and (setq ccs (car (split-char char)))
 201                   (setq ret (encode-char char ccs)))
 202              (format "%s:0x%X"
 203                      (www-uri-encode-feature-name ccs)
 204                      ret))
 205             (t
 206              (format "system-char-id:0x%X"
 207                      (encode-char char 'system-char-id))
 208              )))))
 209
 210
 211 ;;; @ Feature name presentation
 212 ;;;
 213
 214 (defun www-format-feature-name-default (feature-name)
 215   (mapconcat
 216    #'capitalize
 217    (split-string
 218     (symbol-name feature-name)
 219     "-")
 220    " "))
 221
 222 (defun www-format-feature-name-as-rel-to (feature-name)
 223   (concat "\u2192" (substring (symbol-name feature-name) 2)))
 224
 225 (defun www-format-feature-name-as-rel-from (feature-name)
 226   (concat "\u2190" (substring (symbol-name feature-name) 2)))
 227
 228 (defun www-format-feature-name-as-CCS (feature-name)
 229   (let* ((rest
 230           (split-string
 231            (symbol-name feature-name)
 232            "-"))
 233          (dest (upcase (pop rest))))
 234     (when (string-match "^=+>*" dest)
 235       (setq dest (concat (substring dest 0 (match-end 0))
 236                          " "
 237                          (substring dest (match-end 0)))))
 238     (cond
 239      (rest
 240       (while (cdr rest)
 241         (setq dest (concat dest " " (upcase (pop rest)))))
 242       (if (string-match "^[0-9]+$" (car rest))
 243           (concat dest "-" (car rest))
 244         (concat dest " " (upcase (car rest))))
 245       )
 246      (t dest))))
 247
 248 (defun www-format-feature-name* (feature-name &optional lang)
 249   (let (name)
 250     (cond
 251      ((or (and lang
 252                (char-feature-property
 253                 feature-name
 254                 (intern (format "name@%s" lang))))
 255           (char-feature-property
 256            feature-name 'name)))
 257      ((find-charset feature-name)
 258       (www-format-feature-name-as-CCS feature-name))
 259      ((and (setq name (symbol-name feature-name))
 260            (string-match "^\\(->\\)" name))
 261       (www-format-feature-name-as-rel-to feature-name))
 262      ((string-match "^\\(<-\\)" name)
 263       (www-format-feature-name-as-rel-from feature-name))
 264      (t
 265       (www-format-feature-name-default feature-name)))))
 266
 267 (defun www-format-feature-name (feature-name &optional lang)
 268   (www-format-encode-string
 269    (www-format-feature-name* feature-name lang)))
 270
 271
 272 ;;; @ Feature value presentation
 273 ;;;
 274
 275 (defun www-format-value-as-kuten (value)
 276   (format "%02d-%02d"
 277           (- (lsh value -8) 32)
 278           (- (logand value 255) 32)))
 279
 280 (defun www-format-value-as-char-list (value &optional without-tags)
 281   (if (listp value)
 282       (mapconcat
 283        (if without-tags
 284            (lambda (unit)
 285              (www-format-encode-string
 286               (format (if (characterp unit)
 287                           "%c"
 288                         "%s")
 289                       unit)
 290               'without-tags))
 291          (lambda (unit)
 292            (if (characterp unit)
 293                (format "<a href=\"%s?char=%s\">%s</a>"
 294                        chise-wiki-view-url
 295                        (www-uri-encode-char unit)
 296                        (www-format-encode-string (char-to-string unit)))
 297              (www-format-encode-string (format "%s" unit)))))
 298        value " ")
 299     (www-format-encode-string (format "%s" value) without-tags)))
 300
 301 (defun www-format-value-as-ids (value &optional without-tags)
 302   (if (listp value)
 303       (mapconcat
 304        (if without-tags
 305            (lambda (unit)
 306              (www-format-encode-string
 307               (format (if (characterp unit)
 308                           "%c"
 309                         "%s")
 310                       unit)
 311               'without-tags))
 312          (lambda (unit)
 313            (if (characterp unit)
 314                (format "<a href=\"%s?char=%s\">%s</a>"
 315                        chise-wiki-view-url
 316                        (www-uri-encode-char unit)
 317                        (www-format-encode-string (char-to-string unit)))
 318              (www-format-encode-string (format "%s" unit)))))
 319        (ideographic-structure-to-ids value) " ")
 320     (www-format-encode-string (format "%s" value) without-tags)))
 321
 322 (defun www-format-value-as-S-exp (value &optional without-tags)
 323   (www-format-encode-string (format "%S" value) without-tags))
 324
 325 (defun www-format-value-as-HEX (value)
 326   (if (integerp value)
 327       (format "%X" value)
 328     (www-format-value-as-S-exp value)))
 329
 330 (defun www-format-value-as-CCS-default (value)
 331   (if (integerp value)
 332       (format "0x%s (%d)"
 333               (www-format-value-as-HEX value)
 334               value)
 335     (www-format-value-as-S-exp value)))
 336
 337 (defun www-format-value-as-CCS-94x94 (value)
 338   (if (integerp value)
 339       (format "0x%s [%s] (%d)"
 340               (www-format-value-as-HEX value)
 341               (www-format-value-as-kuten value)
 342               value)
 343     (www-format-value-as-S-exp value)))
 344
 345 (defun www-format-value (value &optional feature-name format without-tags)
 346   ;; (cond
 347   ;;  ((find-charset feature-name)
 348   ;;   (cond
 349   ;;    ((and (= (charset-chars feature-name) 94)
 350   ;;          (= (charset-dimension feature-name) 2))
 351   ;;     (www-format-value-as-CCS-94x94 value))
 352   ;;    (t
 353   ;;     (www-format-value-as-CCS-default value)))
 354   ;;   )
 355   ;;  (t
 356   ;;   (www-format-value-as-S-exp value)))
 357   (www-format-apply-value format nil value nil nil without-tags)
 358   )
 359
 360
 361 ;;; @ format evaluator
 362 ;;;
 363
 364 (defun www-format-encode-string (string &optional without-tags)
 365   (with-temp-buffer
 366     (insert string)
 367     (let (plane code start end char variants ret)
 368       (goto-char (point-min))
 369       (while (search-forward "<" nil t)
 370         (replace-match "&lt;" nil t))
 371       (goto-char (point-min))
 372       (while (search-forward ">" nil t)
 373         (replace-match "&gt;" nil t))
 374       (if without-tags
 375           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 376         (let ((coded-charset-entity-reference-alist
 377                (list*
 378                 '(=cns11643-1           "C1-" 4 X)
 379                 '(=cns11643-2           "C2-" 4 X)
 380                 '(=cns11643-3           "C3-" 4 X)
 381                 '(=cns11643-4           "C4-" 4 X)
 382                 '(=cns11643-5           "C5-" 4 X)
 383                 '(=cns11643-6           "C6-" 4 X)
 384                 '(=cns11643-7           "C7-" 4 X)
 385                 '(=gb2312               "G0-" 4 X)
 386                 '(=gb12345              "G1-" 4 X)
 387                 '(=jis-x0208@1990       "J90-" 4 X)
 388                 '(=jis-x0212            "JSP-" 4 X)
 389                 '(=cbeta                "CB" 5 d)
 390                 '(=jis-x0208@1997       "J97-" 4 X)
 391                 '(=jis-x0208@1978       "J78-" 4 X)
 392                 '(=jis-x0208@1983       "J83-" 4 X)
 393                 '(=gt                   "GT-" 5 d)
 394                 '(=zinbun-oracle        "ZOB-" 4 d)
 395                 '(=jef-china3           "JC3-" 4 X)
 396                 '(=daikanwa             "M-" 5 d)
 397                 coded-charset-entity-reference-alist)))
 398           (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 399
 400           (goto-char (point-min))
 401           (while (re-search-forward "&CB\\([0-9]+\\);" nil t)
 402             (setq code (string-to-int (match-string 1)))
 403             (replace-match
 404              (format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\">"
 405                      code
 406                      chise-wiki-bitmap-glyphs-url
 407                      (/ code 1000) code)
 408              t 'literal))
 409
 410           (goto-char (point-min))
 411           (while (re-search-forward "&J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 412             (setq plane (match-string 1)
 413                   code (string-to-int (match-string 2) 16))
 414             (replace-match
 415              (format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\">"
 416                      plane code
 417                      chise-wiki-bitmap-glyphs-url
 418                      plane
 419                      (- (lsh code -8) 32)
 420                      (- (logand code 255) 32))
 421              t 'literal))
 422
 423           (goto-char (point-min))
 424           (while (re-search-forward "&G\\([01]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 425             (setq plane (string-to-int (match-string 1))
 426                   code (string-to-int (match-string 2) 16))
 427             (replace-match
 428              (format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\">"
 429                      plane code
 430                      chise-wiki-bitmap-glyphs-url
 431                      plane
 432                      (- (lsh code -8) 32)
 433                      (- (logand code 255) 32))
 434              t 'literal))
 435
 436           (goto-char (point-min))
 437           (while (re-search-forward "&C\\([1-7]\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 438             (setq plane (string-to-int (match-string 1))
 439                   code (string-to-int (match-string 2) 16))
 440             (replace-match
 441              (format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\">"
 442                      plane code
 443                      chise-wiki-bitmap-glyphs-url
 444                      plane code)
 445              t 'literal))
 446
 447           (goto-char (point-min))
 448           (while (re-search-forward "&JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
 449             (setq code (string-to-int (match-string 1) 16))
 450             (replace-match
 451              (format "<img alt=\"JC3-%04X\" src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/%04x.gif\">"
 452                      code code)
 453              t 'literal))
 454
 455           (goto-char (point-min))
 456           (while (re-search-forward "&ZOB-\\([0-9]+\\);" nil t)
 457             (setq code (string-to-int (match-string 1)))
 458             (replace-match
 459              (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\">"
 460                      code
 461                      chise-wiki-bitmap-glyphs-url
 462                      code)
 463              t 'literal))
 464
 465           (goto-char (point-min))
 466           (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
 467             (setq code (string-to-int (match-string 2)))
 468             (replace-match
 469              (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\">"
 470                      code
 471                      chise-wiki-glyph-cgi-url
 472                      code)
 473              t 'literal))
 474
 475           (goto-char (point-min))
 476           (while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
 477             (setq code (string-to-int (match-string 1) 16))
 478             (replace-match
 479              (format "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\">"
 480                      code
 481                      chise-wiki-glyph-cgi-url
 482                      code)
 483              t 'literal))
 484
 485           (goto-char (point-min))
 486           (while (re-search-forward "&CDP-\\([0-9A-F]+\\);" nil t)
 487             (setq code (string-to-int (match-string 1) 16))
 488             (replace-match
 489              (format "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\">"
 490                      code
 491                      chise-wiki-glyph-cgi-url
 492                      code)
 493              t 'literal))
 494
 495           (goto-char (point-min))
 496           (while (re-search-forward "&UU\\+\\([0-9A-F]+\\);" nil t)
 497             (setq code (string-to-int (match-string 1) 16))
 498             (replace-match
 499              (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\">"
 500                      code
 501                      code)
 502              t 'literal))
 503
 504           (goto-char (point-min))
 505           (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
 506             (setq code (string-to-int (match-string 1) 16))
 507             (setq start (match-beginning 0)
 508                   end (match-end 0))
 509             (setq char (decode-char 'system-char-id code))
 510             (setq variants (or (char-feature char '->subsumptive)
 511                                (char-feature char '->denotational)))
 512             (while (and variants
 513                         (setq ret (www-format-encode-string
 514                                    (char-to-string (car variants))))
 515                         (string-match "&MCS-\\([0-9A-F]+\\);" ret))
 516               (setq variants (cdr variants)))
 517             (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
 518               (goto-char start)
 519               (delete-region start end)
 520               (insert ret)))
 521           ))
 522       ;; (goto-char (point-min))
 523       ;; (while (search-forward "&GT-" nil t)
 524       ;;   (replace-match "&amp;GT-" t 'literal))
 525       (buffer-string))))
 526
 527 (defun www-format-props-to-string (props &optional format)
 528   (unless format
 529     (setq format (plist-get props :format)))
 530   (concat "%"
 531           (plist-get props :flag)
 532           (if (plist-get props :zero-padding)
 533               "0")
 534           (if (plist-get props :len)
 535               (format "%d" (plist-get props :len)))
 536           (cond
 537            ((eq format 'decimal) "d")
 538            ((eq format 'hex) "x")
 539            ((eq format 'HEX) "X")
 540            ((eq format 'S-exp) "S")
 541            (t "s"))))
 542
 543 (defun www-format-apply-value (format props value
 544                                       &optional uri-char uri-feature
 545                                       without-tags)
 546   (let (ret)
 547     (setq ret
 548           (cond
 549            ((memq format '(decimal hex HEX))
 550             (if (integerp value)
 551                 (format (www-format-props-to-string props format)
 552                         value)
 553               (www-format-encode-string
 554                (format "%s" value)
 555                without-tags))
 556             )
 557            ((eq format 'S-exp)
 558             (www-format-encode-string
 559              (format (www-format-props-to-string props format)
 560                      value)
 561              without-tags))
 562            ((eq format 'ku-ten)
 563             (www-format-value-as-kuten value))
 564            ((eq format 'space-separated-char-list)
 565             (www-format-value-as-char-list value without-tags))
 566            ((eq format 'space-separated-ids)
 567             (www-format-value-as-ids value without-tags))
 568            (t
 569             (setq format 'default)
 570             (www-format-encode-string
 571              (format (www-format-props-to-string props 'default)
 572                      value)
 573              without-tags))))
 574     (if (or without-tags (eq (plist-get props :mode) 'peek))
 575         ret
 576       (format "%s <a href=\"%s?char=%s&feature=%s&format=%s\"
 577 ><input type=\"submit\" value=\"edit\" /></a>"
 578               ret
 579               chise-wiki-edit-url
 580               uri-char uri-feature format))))
 581
 582 (defun www-format-eval-feature-value (char
 583                                       feature-name
 584                                       &optional format lang uri-char value)
 585   (unless value
 586     (setq value (char-feature char feature-name)))
 587   (unless format
 588     (setq format (www-feature-value-format feature-name)))
 589   (cond
 590    ((symbolp format)
 591     (www-format-apply-value
 592      format nil value
 593      uri-char (www-uri-encode-feature-name feature-name))
 594     )
 595    ((consp format)
 596     (cond ((null (cdr format))
 597            (setq format (car format))
 598            (www-format-apply-value
 599             (car format) (nth 1 format) value
 600             uri-char (www-uri-encode-feature-name feature-name))
 601            )
 602           (t
 603            (www-format-eval-list format char feature-name lang uri-char)
 604            )))))
 605
 606 (defun www-format-eval-unit (exp char feature-name
 607                                  &optional lang uri-char value)
 608   (unless value
 609     (setq value (char-feature char feature-name)))
 610   (unless uri-char
 611     (setq uri-char (www-uri-encode-char char)))
 612   (cond
 613    ((stringp exp) (www-format-encode-string exp))
 614    ((null exp) "")
 615    ((consp exp)
 616     (cond
 617      ((memq (car exp) '(value decimal hex HEX ku-ten S-exp default))
 618       (if (eq (car exp) 'value)
 619           (www-format-eval-feature-value char feature-name
 620                                          (plist-get (nth 1 exp) :format)
 621                                          lang uri-char value)
 622         (www-format-apply-value
 623          (car exp) (nth 1 exp) value
 624          uri-char (www-uri-encode-feature-name feature-name)))
 625       )
 626      ((eq (car exp) 'name)
 627       (format "<a href=\"%s?feature=%s&char=%s\">%s</a>"
 628               chise-wiki-view-url
 629               (www-uri-encode-feature-name feature-name)
 630               uri-char
 631               (www-format-feature-name feature-name lang))
 632       )
 633      ((eq (car exp) 'link)
 634       (format "<a
 635  href=\"%s\"
 636 >%s</a
 637 >"
 638               (www-format-eval-list (plist-get (nth 1 exp) :ref)
 639                                     char feature-name lang uri-char)
 640               (www-format-eval-list (nthcdr 2 exp)
 641                                     char feature-name lang uri-char)))
 642      (t
 643       (format "<%s
 644 >%s</%s
 645 >"
 646               (car exp)
 647               (www-format-eval-list (nthcdr 2 exp) char feature-name
 648                                     lang uri-char)
 649               (car exp)))))))
 650
 651 (defun www-format-eval-list (format-list char feature-name
 652                                          &optional lang uri-char)
 653   (if (consp format-list)
 654       (mapconcat
 655        (lambda (exp)
 656          (www-format-eval-unit exp char feature-name lang uri-char))
 657        format-list "")
 658     (www-format-eval-unit format-list char feature-name lang uri-char)))
 659
 660
 661 ;;; @ HTML generator
 662 ;;;
 663
 664 (defun www-html-display-text (text)
 665   (princ
 666    (with-temp-buffer
 667      (insert text)
 668      (goto-char (point-min))
 669      (while (search-forward "<" nil t)
 670        (replace-match "&lt;" nil t))
 671      (goto-char (point-min))
 672      (while (search-forward ">" nil t)
 673        (replace-match "&gt;" nil t))
 674      (goto-char (point-min))
 675      (while (re-search-forward "\\[\\[\\([^]|[]+\\)|\\([^][]+\\)\\]\\]" nil t)
 676        (replace-match
 677         (format "<a href=\"%s\">%s</a>"
 678                 (match-string 2)
 679                 (match-string 1))
 680         nil t))
 681      (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
 682      (goto-char (point-min))
 683      (while (search-forward "&GT-" nil t)
 684        (replace-match "&amp;GT-" nil t))
 685      (buffer-string))))
 686
 687 (defun www-html-display-paragraph (text)
 688   (princ "<p>")
 689   (www-html-display-text text)
 690   (princ "</p>\n"))
 691
 692 (provide 'cwiki-common)