est-eval.el

   1 ;; -*- coding: utf-8-mcs-er -*-
   2 (require 'cwiki-common)
   3
   4 (defvar est-eval-list-feature-items-limit 20)
   5
   6 (defun ruimoku-format-volume (spec value year lang)
   7   (when (stringp spec)
   8     (setq spec (car (read-from-string spec))))
   9   (cond ((eq spec 'YY) (if (eq lang 'cjk)
  10                                  (format "%d年" year)
  11                                (format "%d" year)))
  12         ((eq spec 00) value)
  13         ((eq spec 01) (concat value "期"))
  14         ((eq spec 02) (concat value "巻"))
  15         ((eq spec 03) (concat value "号"))
  16         ((eq spec 04) (concat value "編"))
  17         ((eq spec 05) (concat value "&HD-JA-4A53;"))
  18         ((eq spec 06) (concat value "集"))
  19         ((eq spec 07) (concat value "輯"))
  20         ((eq spec 08) (concat value "&GT-53119;"))
  21         ((eq spec 09) (concat value "&GT-53119;分"))
  22         ((eq spec 10) (concat value "冊"))
  23         ((eq spec 11) (concat value "分冊"))
  24         ((eq spec 12) (concat value "&HD-JA-3C21;"))
  25         ((eq spec 13) (concat value "&MJ013520;号"))
  26         ((eq spec 14) (concat value "特&GT-56392;号"))
  27         ((eq spec 15) (concat value "本"))
  28         ((eq spec 16) (concat value "分"))
  29         ((eq spec 51) (concat "Vol." value))
  30         ((eq spec 52) (concat "No." value))
  31         ((eq spec 53) (concat "Part " value))
  32         ((eq spec 54) (concat "Issue " value))
  33         ((eq spec 55) (concat "Tome " value))
  34         ((eq spec 56) (concat "Tomo " value))
  35         ((eq spec 57) (concat "Tomus " value))
  36         ((eq spec 58) (concat "Fasc." value))
  37         ((eq spec 59) (concat "Livre " value))
  38         ((eq spec 60) (concat "Année " value))
  39         ((eq spec 61) (concat "Bd." value))
  40         ((eq spec 62) (concat "Heft " value))
  41         ((eq spec 63) (concat "Nr." value))
  42         ((eq spec 64) (concat "Jahrg." value))
  43         ((eq spec 65) (concat "Jaarg." value))
  44         ((eq spec 66) (concat "Trimestre" value))
  45         (t "")
  46         ))
  47
  48
  49 ;;; @ Feature value presentation
  50 ;;;
  51
  52 (defun est-eval-value-as-S-exp (value)
  53   (list 'S-exp nil (format "%S" value)))
  54
  55 (defun est-eval-value-default (value)
  56   (if (listp value)
  57       (if (eq (car value) 'omitted)
  58           value
  59         (list* 'list
  60                '(:separator " ")
  61                (mapcar
  62                 (lambda (unit)
  63                   (format "%S" unit))
  64                 value)))
  65     (est-eval-value-as-S-exp value)))
  66
  67 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
  68 ;;   (when (integerp spec)
  69 ;;     (setq spec (format "%02d" spec)))
  70 ;;   (cond ((string= spec "YY") `((decimal (:feature
  71 ;;                                          ->published/date*year)) "年"))
  72 ;;         ((string= spec "00") `((decimal (:feature ,feature))))
  73 ;;         ((string= spec "01") `((decimal (:feature ,feature)) "期"))
  74 ;;         ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
  75 ;;         ((string= spec "03") `((decimal (:feature ,feature)) "号"))
  76 ;;         ((string= spec "04") `((decimal (:feature ,feature)) "&HD-JA-4A54;"))
  77 ;;         ((string= spec "05") `((decimal (:feature ,feature)) "&HD-JA-4A53;"))
  78 ;;         ((string= spec "06") `((decimal (:feature ,feature)) "&GT-56392;"))
  79 ;;         ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
  80 ;;         ((string= spec "08") `((decimal (:feature ,feature)) "&GT-53119;"))
  81 ;;         ((string= spec "09") `((decimal (:feature ,feature)) "&GT-53119;分"))
  82 ;;         ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
  83 ;;         ((string= spec "11") `((decimal (:feature ,feature)) "分冊"))
  84 ;;         ((string= spec "12") `((decimal (:feature ,feature)) "&HD-JA-3C21;"))
  85 ;;         ((string= spec "13") `((decimal (:feature ,feature)) "&MJ013520;号"))
  86 ;;         ((string= spec "14") `((decimal (:feature ,feature)) "特&GT-56392;号"))
  87 ;;         ((string= spec "15") `((decimal (:feature ,feature)) "本"))
  88 ;;         ((string= spec "16") `((decimal (:feature ,feature)) "分"))
  89 ;;         ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
  90 ;;         ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
  91 ;;         ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
  92 ;;         ((string= spec "54") `("Issue " ((decimal (:feature ,feature)))))
  93 ;;         ((string= spec "55") `("Tome " ((decimal (:feature ,feature)))))
  94 ;;         ((string= spec "56") `("Tomo " ((decimal (:feature ,feature)))))
  95 ;;         ((string= spec "57") `("Tomus " ((decimal (:feature ,feature)))))
  96 ;;         ((string= spec "58") `("Fasc." ((decimal (:feature ,feature)))))
  97 ;;         ((string= spec "59") `("Livre " ((decimal (:feature ,feature)))))
  98 ;;         ((string= spec "60") `("Année " ((decimal (:feature ,feature)))))
  99 ;;         ((string= spec "61") `("Bd." ((decimal (:feature ,feature)))))
 100 ;;         ((string= spec "62") `("Heft " ((decimal (:feature ,feature)))))
 101 ;;         ((string= spec "63") `("Nr." ((decimal (:feature ,feature)))))
 102 ;;         ((string= spec "64") `("Jahrg." ((decimal (:feature ,feature)))))
 103 ;;         ((string= spec "65") `("Jaarg." ((decimal (:feature ,feature)))))
 104 ;;         ((string= spec "66") `("Trimestre" ((decimal (:feature ,feature)))))
 105 ;;         (t nil)
 106 ;;         ))
 107
 108 (defun est-eval-value-as-journal-volume (value &optional short)
 109   (let ((journal (car (or (concord-object-get value '<-journal/volume)
 110                           (concord-object-get value '<-volume))))
 111         (vol-name (concord-object-get value '<-journal/volume*name))
 112         volume-type number-type
 113         year
 114         dest ret title subtitle)
 115     (cond
 116      (journal
 117       (if vol-name
 118           (setq dest
 119                 (list
 120                  (list 'object (list :object value)
 121                        vol-name)))
 122         (setq volume-type (concord-object-get journal 'volume/type/code)
 123               number-type (concord-object-get journal 'number/type/code))
 124         (setq year (or (concord-object-get value '->published/date*year)
 125                        (concord-object-get
 126                         (car (concord-object-get value 'date)) 'year)))
 127         (setq dest
 128               (list
 129                (list 'object
 130                      (list :object value)
 131                      (ruimoku-format-volume
 132                       volume-type
 133                       (or (concord-object-get value '<-journal/volume*volume)
 134                           (concord-object-get value '<-volume*volume))
 135                       year 'cjk)
 136                      (ruimoku-format-volume
 137                       number-type
 138                       (or (concord-object-get value '<-journal/volume*number)
 139                           (concord-object-get value '<-volume*number))
 140                       year 'cjk))))
 141         )
 142       (unless short
 143         (if (setq ret (est-eval-value-as-object journal))
 144             (setq dest
 145                   (list* ret " " dest))))
 146       (list* 'list '(:subtype sequence :separator "") dest)
 147       )
 148      ((setq title (concord-object-get value 'title))
 149       (setq subtitle (concord-object-get value 'title/subtitle))
 150       (list* 'object
 151              (list :object value)
 152              (if (eq (concord-object-get value 'writing-system) 'cjk)
 153                  (list
 154                   "「"
 155                   (list 'object (list :object value)
 156                         (if subtitle
 157                             (concat title " — " subtitle)
 158                           title))
 159                   "」")
 160                (list
 161                 " ‘"
 162                 (list 'object (list :object value)
 163                       (if subtitle
 164                           (concat title " — " subtitle)
 165                         title))
 166                 "’")))
 167       )
 168      (t
 169       (est-eval-value-default value)
 170       ))
 171     ;; (concat (concord-object-get journal 'name)
 172     ;;         " "
 173     ;;         (ruimoku-format-volume
 174     ;;          volume-type
 175     ;;          (or (concord-object-get value '<-journal/volume*volume)
 176     ;;              (concord-object-get value '<-volume*volume))
 177     ;;          year 'cjk)
 178     ;;         (ruimoku-format-volume
 179     ;;          number-type
 180     ;;          (or (concord-object-get value '<-journal/volume*number)
 181     ;;              (concord-object-get value '<-volume*number))
 182     ;;          year 'cjk))
 183     ))
 184
 185 (defun est-eval-value-as-article (value)
 186   (let ((journal-volume (car (concord-object-get value '<-article)))
 187         (page (concord-object-get value 'page))
 188         date ret dest)
 189     (when journal-volume
 190       (setq date (car (concord-object-get journal-volume 'date)))
 191       (if (and date
 192                (setq ret (est-eval-value-as-object date)))
 193           (setq dest (list ", " ret))))
 194     (if page
 195         (setq dest (list* ", pp." page dest)))
 196     (when (and journal-volume
 197                (setq ret (est-eval-value-as-journal-volume journal-volume)))
 198       (setq dest (cons ret dest)))
 199     (if (setq ret (est-eval-value-as-book value))
 200         (setq dest (list* ret " " dest)))
 201     (list* 'list '(:subtype sequence :separator "") dest))
 202   ;; (let ((creators (concord-object-get value '->creator))
 203   ;;       (title (concord-object-get value 'title))
 204   ;;       creator-name creator-role)
 205   ;;   (concat
 206   ;;    (mapconcat
 207   ;;     (lambda (creator)
 208   ;;       (setq creator-name
 209   ;;             (concord-object-get
 210   ;;              (car (concord-object-get creator '->creator/name))
 211   ;;              '=name))
 212   ;;       (setq creator-role
 213   ;;             (or (concord-object-get creator 'role*name)
 214   ;;                 (format "(%s)"
 215   ;;                         (concord-object-get creator 'role*type))))
 216   ;;       (concat creator-name " " creator-role))
 217   ;;     creators ", ")
 218   ;;    (if (eq (concord-object-get value 'writing-system) 'cjk)
 219   ;;        (concat  "「" title "」")
 220   ;;      (concat " ‘" title "’"))))
 221   )
 222
 223 (defun est-eval-value-as-book (value)
 224   (let ((creators (concord-object-get value '->creator))
 225         (title (concord-object-get value 'title))
 226         (subtitle (concord-object-get value 'title/subtitle))
 227         (series (concord-object-get value 'series))
 228         (publisher (car (concord-object-get value 'publisher)))
 229         (date (car (concord-object-get value 'date)))
 230         ;; creator-name creator-role
 231         dest ret)
 232     (if (and date
 233              (setq ret (est-eval-value-as-object date)))
 234         (setq dest (list ", " ret)))
 235     (if (and publisher
 236              (setq ret (est-eval-value-as-object publisher)))
 237         (setq dest (list* " " ret dest)))
 238     (if series
 239         (setq dest (list* series "," dest)))
 240     (setq dest
 241           (if title
 242               (if (eq (concord-object-get value 'writing-system) 'cjk)
 243                   (list*
 244                    "「"
 245                  (list 'object (list :object value)
 246                        (if subtitle
 247                            (concat title " — " subtitle)
 248                          title))
 249                  "」" dest)
 250               (list*
 251                " ‘"
 252                (list 'object (list :object value)
 253                      (if subtitle
 254                          (concat title " — " subtitle)
 255                        title))
 256                "’" dest))
 257             (list* " "
 258                    (list 'object (list :object value)
 259                          "(review)")
 260                    dest)))
 261     (when (and creators
 262                (setq ret (est-eval-value-as-creators-names creators)))
 263       (setq dest (cons ret dest)))
 264     (list* 'list '(:subtype sequence :separator "") dest)
 265     ;; (concat
 266     ;;  (mapconcat
 267     ;;   (lambda (creator)
 268     ;;     (setq creator-name
 269     ;;           (concord-object-get
 270     ;;            (car (concord-object-get creator '->creator/name))
 271     ;;            '=name))
 272     ;;     (setq creator-role
 273     ;;           (or (concord-object-get creator 'role*name)
 274     ;;               (format "(%s)"
 275     ;;                       (concord-object-get creator 'role*type))))
 276     ;;     (concat creator-name " " creator-role))
 277     ;;   creators ", ")
 278     ;;  (if (eq (concord-object-get value 'writing-system) 'cjk)
 279     ;;      (concat  "「" title
 280     ;;               (if subtitle
 281     ;;                   (concat " — " subtitle))
 282     ;;               "」")
 283     ;;    (concat " ‘" title
 284     ;;            (if subtitle
 285     ;;                (concat " — " subtitle))
 286     ;;            "’"))
 287     ;;  (if series
 288     ;;      (concat " " series))
 289     ;;  (if publisher
 290     ;;      (concat ", "
 291     ;;              (concord-object-get
 292     ;;               (car (concord-object-get
 293     ;;                     publisher '->publisher/name))
 294     ;;               '=name)))
 295     ;;  (if date
 296     ;;      (concat ", " (concord-object-get date 'name)))))
 297     ))
 298
 299 ;; (defun est-eval-creator (value)
 300 ;;   (est-eval-list
 301 ;;    '((value (:feature ->name))
 302 ;;      (string (:feature role*name)))
 303 ;;    value nil))
 304
 305 (defun est-eval-value-as-object (value)
 306   (if (or (characterp value)
 307           (concord-object-p value))
 308       (list 'object (list :object value)
 309             (if (characterp value)
 310                 (char-to-string value)
 311               (let ((genre (concord-object-genre value))
 312                     genre-o
 313                     format)
 314                 (cond
 315                  ((eq genre 'journal-volume@ruimoku)
 316                   ;; (est-eval-list
 317                   ;;  (est-journal-volume-get-object-format value)
 318                   ;;  value nil)
 319                   (est-eval-value-as-journal-volume value)
 320                   )
 321                  ((eq genre 'article@ruimoku)
 322                   (est-eval-value-as-article value)
 323                   )
 324                  ((eq genre 'book@ruimoku)
 325                   (est-eval-value-as-book value)
 326                   )
 327                  ;; ((eq genre 'creator@ruimoku)
 328                  ;;  (est-eval-creator value)
 329                  ;;  )
 330                  (t
 331                   (setq genre-o (concord-decode-object '=id genre 'genre))
 332                   (or (and genre-o
 333                            (setq format
 334                                  (concord-object-get
 335                                   genre-o 'object-representative-format))
 336                            (est-eval-list format value nil))
 337                       (www-get-feature-value
 338                        value
 339                        (or (and genre-o
 340                                 (www-get-feature-value
 341                                  genre-o 'object-representative-feature))
 342                            'name))
 343                       (www-get-feature-value value '=name)
 344                       (est-eval-value-default value))
 345                   ))
 346                 )))
 347     (est-eval-value-default value)))
 348
 349 (defun est-eval-value-as-HEX (value)
 350   (if (integerp value)
 351       (list 'HEX nil (format "%X" value))
 352     (est-eval-value-as-S-exp value)))
 353
 354 (defun est-eval-value-as-kuten (value)
 355   (if (integerp value)
 356       (list 'ku-ten
 357             nil
 358             (format "%02d-%02d"
 359                     (- (lsh value -8) 32)
 360                     (- (logand value 255) 32)))
 361     (est-eval-value-as-S-exp value)))
 362
 363 (defun est-eval-value-as-kangxi-radical (value)
 364   (if (and (integerp value)
 365            (<= 0 value)
 366            (<= value 214))
 367       (list 'kangxi-radical
 368             nil
 369             (format "%c" (ideographic-radical value)))
 370     (est-eval-value-as-S-exp value)))
 371
 372 (defun est-eval-value-as-object-list (value &optional separator subtype)
 373   (if (and (listp value)
 374            (listp (cdr value)))
 375       (condition-case nil
 376           (let (props)
 377             (if separator
 378                 (setq props (list :separator separator)))
 379             (if subtype
 380                 (setq props (list* :subtype subtype props)))
 381             (list* 'list props
 382                    (mapcar #'est-eval-value-as-object value)))
 383         (error (format "%s" value)))
 384     (format "%s" value)))
 385
 386 (defun est-eval-value-as-composition-list (value &optional separator subtype)
 387   (if (and (listp value)
 388            (listp (cdr value)))
 389       (condition-case nil
 390           (let (props)
 391             (if separator
 392                 (setq props (list :separator separator)))
 393             (if subtype
 394                 (setq props (list* :subtype subtype props)))
 395             (list* 'list props
 396                    (mapcar
 397                     (lambda (cell)
 398                       (list 'list nil
 399                             "+ "
 400                             (list 'object (list :object (car cell))
 401                                   (format "U+%04X" (car cell)))
 402                             " : "
 403                             (est-eval-value-as-object (cdr cell))))
 404                     (sort value
 405                           (lambda (a b)
 406                             (< (car a)(car b)))))))
 407         (error (format "%s" value)))
 408     (format "%s" value)))
 409
 410 (defun est-eval-value-as-decomposition-list (value)
 411   (if (and (listp value)
 412            (listp (cdr value)))
 413       (condition-case nil
 414           (let (props)
 415             (list* 'list props
 416                    (mapconcat #'char-to-string value "")
 417                    (list
 418                     " ("
 419                     (list* 'list '(:separator " + ")
 420                            (mapcar
 421                             (lambda (chr)
 422                               (list 'object (list :object chr)
 423                                     (format "U+%04X" chr)))
 424                             value))
 425                     ")")))
 426         (error (format "%s" value)))
 427     (format "%s" value)))
 428
 429 (defun est-eval-value-as-ids (value)
 430   (if (listp value)
 431       (list 'ids nil (ideographic-structure-to-ids value))
 432     (format "%s" value)))
 433
 434 (defun est-eval-value-as-space-separated-ids (value)
 435   (if (listp value)
 436       (list* 'ids
 437              '(:separator " ")
 438              ;; (mapconcat #'char-to-string
 439              ;;            (ideographic-structure-to-ids value)
 440              ;;            " ")
 441              (mapcar #'est-eval-value-as-object
 442                      (ideographic-structure-to-ids value))
 443              )
 444     (est-eval-value-default value)))
 445
 446 (defun est-eval-value-as-domain-list (value)
 447   (if (listp value)
 448       (let (source item source-objs source0 start end num)
 449         (list* 'res-list
 450                '(:separator " ")
 451                (mapcar
 452                 (lambda (unit)
 453                   (setq unit
 454                         (if (symbolp unit)
 455                             (symbol-name unit)
 456                           (format "%s" unit)))
 457                   (cond
 458                    ((string-match "=" unit)
 459                     (setq source (intern
 460                                   (substring unit 0 (match-beginning 0)))
 461                           item (car (read-from-string
 462                                      (substring unit (match-end 0)))))
 463                     (cond
 464                      ((eq source 'bos)
 465                       (setq source-objs
 466                             (list
 467                              (est-eval-value-as-object
 468                               (or (concord-decode-object
 469                                    '=id item 'book@ruimoku)
 470                                   (concord-decode-object
 471                                    '=id item 'article@ruimoku)
 472                                   (intern unit)))))
 473                       )
 474                      ((memq source '(zob1959 zob1968))
 475                       (if (and (symbolp item)
 476                                (setq num (symbol-name item))
 477                                (string-match
 478                                 "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
 479                           (setq start (string-to-number
 480                                        (match-string 1 num))
 481                                 end (string-to-number
 482                                      (match-string 2 num)))
 483                         (setq start item
 484                               end item))
 485                       (if (not (numberp start))
 486                           (setq source-objs
 487                                 (list
 488                                  (est-eval-value-as-object (intern unit))))
 489                         (if (eq source source0)
 490                             (setq source-objs
 491                                   (list
 492                                    (list 'link
 493                                          (list :ref
 494                                                (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 495                                                        start))
 496                                          start)))
 497                           (setq source0 source)
 498                           (setq source-objs
 499                                 (list
 500                                  (list 'link
 501                                        (list :ref
 502                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 503                                                      start))
 504                                        start)
 505                                  "="
 506                                  '(link
 507                                    (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
 508                                    "\u4EAC大人\u6587研甲\u9AA8")))
 509                           )
 510                         (setq num (1+ start))
 511                         (while (<= num end)
 512                           (setq source-objs
 513                                 (cons
 514                                  (list 'link
 515                                        (list :ref
 516                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 517                                                      num))
 518                                        num)
 519                                  source-objs))
 520                           (setq num (1+ num)))
 521                         (setq source-objs (nreverse source-objs)))
 522                       )
 523                      (t
 524                       (setq source-objs
 525                             (list (est-eval-value-as-object (intern unit))))
 526                       ))
 527                     (list* 'res-link
 528                            (list :source source :item item)
 529                            source-objs)
 530                     )
 531                    (t
 532                     (list 'res-link nil unit)
 533                     )))
 534                 value)))
 535     (est-eval-value-default value)))
 536
 537 (defun est-eval-value-as-creators-names (value &optional subtype)
 538   (if (listp value)
 539       (let (role-name)
 540         (list* 'creator-name
 541                (if subtype
 542                    '(:subtype unordered-list)
 543                  '(:separator " "))
 544                (mapcar (lambda (creator)
 545                          (cond
 546                           ((concord-object-p creator)
 547                            (setq role-name
 548                                  (concord-object-get
 549                                   creator 'role*name))
 550                            (est-eval-list
 551                             (list
 552                              '(value (:feature ->creator/name))
 553                              (list
 554                               'object (list :object creator)
 555                               (or role-name
 556                                   (format "(%s)"
 557                                           (concord-object-get creator
 558                                                               'role*type)))))
 559                             creator nil)
 560                            )
 561                           (t creator)))
 562                        value)
 563                ))
 564     (est-eval-value-default value)))
 565
 566 (defun est-eval-value-as-created-works (value &optional subtype)
 567   (if (listp value)
 568       (list* 'creator-name
 569              (if subtype
 570                  '(:subtype unordered-list)
 571                '(:separator " "))
 572              (mapcar (lambda (creator)
 573                        (est-eval-list
 574                         '((value (:feature <-creator)))
 575                         creator nil))
 576                      value))
 577     (est-eval-value-default value)))
 578
 579 (defun est-eval-value-as-journal-volumes (value &optional subtype)
 580   (if (listp value)
 581       (list* 'journal-volumes
 582              (if subtype
 583                  '(:subtype unordered-list)
 584                '(:separator " "))
 585              (mapcar (lambda (volume)
 586                        (if (concord-object-p volume)
 587                            (est-eval-value-as-journal-volume volume 'short)
 588                          volume))
 589                      value))
 590     (est-eval-value-default value)))
 591
 592
 593 ;;; @ format evaluator
 594 ;;;
 595
 596 ;; (defun est-make-env (object feature-name)
 597 ;;   (list (cons 'object object)
 598 ;;         (cons 'feature-name feature-name)))
 599
 600 ;; (defun est-env-push-item (env item value)
 601 ;;   (cons (cons item value)
 602 ;;         env))
 603
 604 ;; (defun est-env-get-item (env item)
 605 ;;   (cdr (assq item env)))
 606
 607 ;; (defun est-env-current-value (env)
 608 ;;   (let ((obj (est-env-get-item env 'object))
 609 ;;         (feature (est-env-get-item env 'feature-name)))
 610 ;;     (if (characterp obj)
 611 ;;         (char-feature obj feature)
 612 ;;       (concord-object-get obj feature))))
 613
 614
 615 (defun est-eval-props-to-string (props &optional format)
 616   (unless format
 617     (setq format (plist-get props :format)))
 618   (concat "%"
 619           (plist-get props :flag)
 620           (if (plist-get props :len)
 621               (format "0%d"
 622                       (let ((ret (plist-get props :len)))
 623                         (if (stringp ret)
 624                             (string-to-int ret)
 625                           ret))))
 626           (cond
 627            ((eq format 'decimal) "d")
 628            ((eq format 'hex) "x")
 629            ((eq format 'HEX) "X")
 630            ((eq format 'S-exp) "S")
 631            (t "s"))))
 632
 633 (defun est-eval-apply-value (object feature-name format props value
 634                                     &optional uri-object)
 635   (list 'value
 636         (list :object object
 637               :feature feature-name)
 638         (cond
 639          ((memq format '(decimal hex HEX))
 640           (if (integerp value)
 641               (list format
 642                     nil
 643                     (format (est-eval-props-to-string props format)
 644                             value))
 645             (format "%s" value))
 646           )
 647          ((eq format 'string)
 648           (list 'string nil (format "%s" value))
 649           )
 650          ((eq format 'wiki-text)
 651           (est-eval-list value object feature-name nil uri-object)
 652           )
 653          ((eq format 'S-exp)
 654           (est-eval-value-as-S-exp value)
 655           )
 656          ((eq format 'ku-ten)
 657           (est-eval-value-as-kuten value))
 658          ((eq format 'kangxi-radical)
 659           (est-eval-value-as-kangxi-radical value))
 660          ((eq format 'ids)
 661           (est-eval-value-as-ids value))
 662          ((eq format 'decomposition)
 663           (est-eval-value-as-decomposition-list value))
 664          ((eq format 'composition)
 665           (est-eval-value-as-composition-list value))
 666          ((or (eq format 'space-separated)
 667               (eq format 'space-separated-char-list))
 668           (est-eval-value-as-object-list value " "))
 669          ((eq format 'unordered-list)
 670           (est-eval-value-as-object-list value nil 'unordered-list))
 671          ((eq format 'unordered-composition-list)
 672           (est-eval-value-as-composition-list value nil 'unordered-list))
 673          ((eq format 'space-separated-ids)
 674           (est-eval-value-as-space-separated-ids value))
 675          ((eq format 'space-separated-domain-list)
 676           (est-eval-value-as-domain-list value))
 677          ((eq format 'space-separated-creator-name-list)
 678           (est-eval-value-as-creators-names value))
 679          ((eq format 'unordered-creator-name-list)
 680           (est-eval-value-as-creators-names value 'unordered-list))
 681          ((eq format 'space-separated-created-work-list)
 682           (est-eval-value-as-created-works value))
 683          ((eq format 'unordered-created-work-list)
 684           (est-eval-value-as-created-works value 'unordered-list))
 685          ((eq format 'journal-volume-list)
 686           (est-eval-value-as-journal-volumes value))
 687          (t
 688           (est-eval-value-default value)
 689           ))
 690         ))
 691
 692 (defun est-eval-feature-value (object feature-name
 693                                       &optional format lang uri-object value)
 694   (unless value
 695     (setq value (www-get-feature-value object feature-name)))
 696   (unless format
 697     (setq format (www-feature-value-format feature-name)))
 698   (if (and (consp value)
 699            est-eval-list-feature-items-limit)
 700       (let ((ret (condition-case nil
 701                      (nthcdr est-eval-list-feature-items-limit value)
 702                    (error nil nil))))
 703         (when ret
 704           (setcdr ret
 705                   (list (list 'omitted
 706                               (list :object object :feature feature-name)
 707                               "..."))))))
 708   (cond
 709    ((symbolp format)
 710     (est-eval-apply-value object feature-name
 711                           format nil value
 712                           uri-object)
 713     )
 714    ((consp format)
 715     (cond
 716      ((null (cdr format))
 717       (setq format (car format))
 718       (est-eval-apply-value object feature-name
 719                             (car format) (nth 1 format) value
 720                             uri-object)
 721       )
 722      (t
 723       (est-eval-list format object feature-name lang uri-object)
 724       )))))
 725
 726 (defun est-eval-unit (exp object feature-name
 727                                  &optional lang uri-object value)
 728   (unless value
 729     (setq value (www-get-feature-value object feature-name)))
 730   (unless uri-object
 731     (setq uri-object (www-uri-encode-object object)))
 732   (cond
 733    ((stringp exp) exp)
 734    ((or (characterp exp)
 735         (concord-object-p exp))
 736     (est-eval-value-as-object exp)
 737     )
 738    ((null exp) "")
 739    ((consp exp)
 740     (cond
 741      ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
 742                               S-exp string default))
 743       (let ((fn (plist-get (nth 1 exp) :feature))
 744             domain domain-fn ret)
 745         (when fn
 746           (when (stringp fn)
 747             (setq fn (intern fn)))
 748           (setq domain (char-feature-name-domain feature-name))
 749           (setq domain-fn (char-feature-name-at-domain fn domain))
 750           (if (setq ret (www-get-feature-value object domain-fn))
 751               (setq feature-name domain-fn
 752                     value ret)
 753             (setq feature-name fn
 754                   value (www-get-feature-value object fn)))
 755           (push feature-name chise-wiki-displayed-features)
 756           ))
 757       (if (eq (car exp) 'value)
 758           (est-eval-feature-value object feature-name
 759                                          (plist-get (nth 1 exp) :format)
 760                                          lang uri-object value)
 761         (est-eval-apply-value
 762          object feature-name
 763          (car exp) (nth 1 exp) value
 764          uri-object))
 765       )
 766      ((eq (car exp) 'name)
 767       (let ((fn (plist-get (nth 1 exp) :feature))
 768             domain domain-fn)
 769         (when fn
 770           (setq domain (char-feature-name-domain feature-name))
 771           (when (stringp fn)
 772             (setq fn (intern fn)))
 773           (setq domain-fn (char-feature-name-at-domain fn domain))
 774           (setq feature-name domain-fn)))
 775       (list 'feature-name
 776             (list :object object
 777                   :feature feature-name)
 778             (www-format-feature-name* feature-name lang))
 779       )
 780      ((eq (car exp) 'name-url)
 781       (let ((fn (plist-get (nth 1 exp) :feature))
 782             (object (plist-get (nth 1 exp) :object))
 783             domain domain-fn)
 784         (when fn
 785           (setq domain (char-feature-name-domain feature-name))
 786           (when (stringp fn)
 787             (setq fn (intern fn)))
 788           (setq domain-fn (char-feature-name-at-domain fn domain))
 789           (setq feature-name domain-fn)))
 790       (list 'name-url (list :feature feature-name)
 791             (www-uri-make-feature-name-url
 792              (est-object-genre object)
 793              (www-uri-encode-feature-name feature-name)
 794              uri-object))
 795       )
 796      ((eq (car exp) 'domain-name)
 797       (let ((domain (char-feature-name-domain feature-name)))
 798         (if domain
 799             (format "@%s" domain)
 800           ""))
 801       )
 802      ((eq (car exp) 'omitted)
 803       (list 'omitted
 804             (list :object object :feature feature-name)
 805             "...")
 806       )
 807      ((eq (car exp) 'prev-char)
 808       (list 'prev-char
 809             (list :object object :feature feature-name)
 810             '(input (:type "submit" :value "-")))
 811       )
 812      ((eq (car exp) 'next-char)
 813       (list 'next-char
 814             (list :object object :feature feature-name)
 815             '(input (:type "submit" :value "+")))
 816       )
 817      ((eq (car exp) 'link)
 818       (list 'link
 819             (list :ref
 820                   (est-eval-list (plist-get (nth 1 exp) :ref)
 821                                         object feature-name lang uri-object))
 822             (est-eval-list (nthcdr 2 exp)
 823                                   object feature-name lang uri-object))
 824       )
 825      (t
 826       exp)))))
 827
 828 (defun est-eval-list (format-list object feature-name
 829                                   &optional lang uri-object)
 830   (if (consp format-list)
 831       (let ((ret
 832              (mapcar
 833               (lambda (exp)
 834                 (est-eval-unit exp object feature-name lang uri-object nil))
 835               format-list)))
 836         (if (cdr ret)
 837             (list* 'list nil ret)
 838           (car ret)))
 839     (est-eval-unit format-list object feature-name lang uri-object nil)))
 840
 841
 842 ;;; @ End.
 843 ;;;
 844
 845 (provide 'est-eval)
 846
 847 ;;; est-eval.el ends here