est-eval.el

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