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 &optional short)
 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       (unless short
 141         (if (setq ret (est-eval-value-as-object journal))
 142             (setq dest
 143                   (list* ret " " dest))))
 144       (list* 'list '(:subtype sequence :separator "") dest)
 145       )
 146      ((setq title (concord-object-get value 'title))
 147       (setq subtitle (concord-object-get value 'title/subtitle))
 148       (list* 'object
 149              (list :object value)
 150              (if (eq (concord-object-get value 'writing-system) 'cjk)
 151                  (list
 152                   "「"
 153                   (list 'object (list :object value)
 154                         (if subtitle
 155                             (concat title " — " subtitle)
 156                           title))
 157                   "」")
 158                (list
 159                 " ‘"
 160                 (list 'object (list :object value)
 161                       (if subtitle
 162                           (concat title " — " subtitle)
 163                         title))
 164                 "’")))
 165       )
 166      (t
 167       (est-eval-value-default value)
 168       ))
 169     ;; (concat (concord-object-get journal 'name)
 170     ;;         " "
 171     ;;         (ruimoku-format-volume
 172     ;;          volume-type
 173     ;;          (or (concord-object-get value '<-journal/volume*volume)
 174     ;;              (concord-object-get value '<-volume*volume))
 175     ;;          year 'cjk)
 176     ;;         (ruimoku-format-volume
 177     ;;          number-type
 178     ;;          (or (concord-object-get value '<-journal/volume*number)
 179     ;;              (concord-object-get value '<-volume*number))
 180     ;;          year 'cjk))
 181     ))
 182
 183 (defun est-eval-value-as-article (value)
 184   (let ((journal-volume (car (concord-object-get value '<-article)))
 185         (page (concord-object-get value 'page))
 186         date ret dest)
 187     (when journal-volume
 188       (setq date (car (concord-object-get journal-volume 'date)))
 189       (if (and date
 190                (setq ret (est-eval-value-as-object date)))
 191           (setq dest (list ", " ret))))
 192     (if page
 193         (setq dest (list* ", pp." page dest)))
 194     (when (and journal-volume
 195                (setq ret (est-eval-value-as-journal-volume journal-volume)))
 196       (setq dest (cons ret dest)))
 197     (if (setq ret (est-eval-value-as-book value))
 198         (setq dest (list* ret " " dest)))
 199     (list* 'list '(:subtype sequence :separator "") dest))
 200   ;; (let ((creators (concord-object-get value '->creator))
 201   ;;       (title (concord-object-get value 'title))
 202   ;;       creator-name creator-role)
 203   ;;   (concat
 204   ;;    (mapconcat
 205   ;;     (lambda (creator)
 206   ;;       (setq creator-name
 207   ;;             (concord-object-get
 208   ;;              (car (concord-object-get creator '->creator/name))
 209   ;;              '=name))
 210   ;;       (setq creator-role
 211   ;;             (or (concord-object-get creator 'role*name)
 212   ;;                 (format "(%s)"
 213   ;;                         (concord-object-get creator 'role*type))))
 214   ;;       (concat creator-name " " creator-role))
 215   ;;     creators ", ")
 216   ;;    (if (eq (concord-object-get value 'writing-system) 'cjk)
 217   ;;        (concat  "「" title "」")
 218   ;;      (concat " ‘" title "’"))))
 219   )
 220
 221 (defun est-eval-value-as-book (value)
 222   (let ((creators (concord-object-get value '->creator))
 223         (title (concord-object-get value 'title))
 224         (subtitle (concord-object-get value 'title/subtitle))
 225         (series (concord-object-get value 'series))
 226         (publisher (car (concord-object-get value 'publisher)))
 227         (date (car (concord-object-get value 'date)))
 228         ;; creator-name creator-role
 229         dest ret)
 230     (if (and date
 231              (setq ret (est-eval-value-as-object date)))
 232         (setq dest (list ", " ret)))
 233     (if (and publisher
 234              (setq ret (est-eval-value-as-object publisher)))
 235         (setq dest (list* " " ret dest)))
 236     (if series
 237         (setq dest (list* series "," dest)))
 238     (setq dest
 239           (if title
 240               (if (eq (concord-object-get value 'writing-system) 'cjk)
 241                   (list*
 242                    "「"
 243                  (list 'object (list :object value)
 244                        (if subtitle
 245                            (concat title " — " subtitle)
 246                          title))
 247                  "」" dest)
 248               (list*
 249                " ‘"
 250                (list 'object (list :object value)
 251                      (if subtitle
 252                          (concat title " — " subtitle)
 253                        title))
 254                "’" dest))
 255             (list* " "
 256                    (list 'object (list :object value)
 257                          "(review)")
 258                    dest)))
 259     (when (and creators
 260                (setq ret (est-eval-value-as-creators-names creators)))
 261       (setq dest (cons ret dest)))
 262     (list* 'list '(:subtype sequence :separator "") dest)
 263     ;; (concat
 264     ;;  (mapconcat
 265     ;;   (lambda (creator)
 266     ;;     (setq creator-name
 267     ;;           (concord-object-get
 268     ;;            (car (concord-object-get creator '->creator/name))
 269     ;;            '=name))
 270     ;;     (setq creator-role
 271     ;;           (or (concord-object-get creator 'role*name)
 272     ;;               (format "(%s)"
 273     ;;                       (concord-object-get creator 'role*type))))
 274     ;;     (concat creator-name " " creator-role))
 275     ;;   creators ", ")
 276     ;;  (if (eq (concord-object-get value 'writing-system) 'cjk)
 277     ;;      (concat  "「" title
 278     ;;               (if subtitle
 279     ;;                   (concat " — " subtitle))
 280     ;;               "」")
 281     ;;    (concat " ‘" title
 282     ;;            (if subtitle
 283     ;;                (concat " — " subtitle))
 284     ;;            "’"))
 285     ;;  (if series
 286     ;;      (concat " " series))
 287     ;;  (if publisher
 288     ;;      (concat ", "
 289     ;;              (concord-object-get
 290     ;;               (car (concord-object-get
 291     ;;                     publisher '->publisher/name))
 292     ;;               '=name)))
 293     ;;  (if date
 294     ;;      (concat ", " (concord-object-get date 'name)))))
 295     ))
 296
 297 ;; (defun est-eval-creator (value)
 298 ;;   (est-eval-list
 299 ;;    '((value (:feature ->name))
 300 ;;      (string (:feature role*name)))
 301 ;;    value nil))
 302
 303 (defun est-eval-value-as-object (value)
 304   (if (or (characterp value)
 305           (concord-object-p value))
 306       (list 'object (list :object value)
 307             (if (characterp value)
 308                 (char-to-string value)
 309               (let ((genre (concord-object-genre value))
 310                     genre-o
 311                     format)
 312                 (cond
 313                  ((eq genre 'journal-volume@ruimoku)
 314                   ;; (est-eval-list
 315                   ;;  (est-journal-volume-get-object-format value)
 316                   ;;  value nil)
 317                   (est-eval-value-as-journal-volume value)
 318                   )
 319                  ((eq genre 'article@ruimoku)
 320                   (est-eval-value-as-article value)
 321                   )
 322                  ((eq genre 'book@ruimoku)
 323                   (est-eval-value-as-book value)
 324                   )
 325                  ;; ((eq genre 'creator@ruimoku)
 326                  ;;  (est-eval-creator value)
 327                  ;;  )
 328                  (t
 329                   (setq genre-o (concord-decode-object '=id genre 'genre))
 330                   (or (and genre-o
 331                            (setq format
 332                                  (concord-object-get
 333                                   genre-o 'object-representative-format))
 334                            (est-eval-list format value nil))
 335                       (www-get-feature-value
 336                        value
 337                        (or (and genre-o
 338                                 (www-get-feature-value
 339                                  genre-o 'object-representative-feature))
 340                            'name))
 341                       (www-get-feature-value value '=name)
 342                       (est-eval-value-default value))
 343                   ))
 344                 )))
 345     (est-eval-value-default value)))
 346
 347 (defun est-eval-value-as-HEX (value)
 348   (if (integerp value)
 349       (list 'HEX nil (format "%X" value))
 350     (est-eval-value-as-S-exp value)))
 351
 352 (defun est-eval-value-as-kuten (value)
 353   (if (integerp value)
 354       (list 'ku-ten
 355             nil
 356             (format "%02d-%02d"
 357                     (- (lsh value -8) 32)
 358                     (- (logand value 255) 32)))
 359     (est-eval-value-as-S-exp value)))
 360
 361 (defun est-eval-value-as-kangxi-radical (value)
 362   (if (and (integerp value)
 363            (<= 0 value)
 364            (<= value 214))
 365       (list 'kangxi-radical
 366             nil
 367             (format "%c" (ideographic-radical value)))
 368     (est-eval-value-as-S-exp value)))
 369
 370 (defun est-eval-value-as-object-list (value &optional separator subtype)
 371   (if (and (listp value)
 372            (listp (cdr value)))
 373       (condition-case nil
 374           (let (props)
 375             (if separator
 376                 (setq props (list :separator separator)))
 377             (if subtype
 378                 (setq props (list* :subtype subtype props)))
 379             (list* 'list props
 380                    (mapcar #'est-eval-value-as-object value)))
 381         (error (format "%s" value)))
 382     (format "%s" value)))
 383
 384 (defun est-eval-value-as-ids (value)
 385   (if (listp value)
 386       (list 'ids nil (ideographic-structure-to-ids value))
 387     (format "%s" value)))
 388
 389 (defun est-eval-value-as-space-separated-ids (value)
 390   (if (listp value)
 391       (list* 'ids
 392              '(:separator " ")
 393              ;; (mapconcat #'char-to-string
 394              ;;            (ideographic-structure-to-ids value)
 395              ;;            " ")
 396              (mapcar #'est-eval-value-as-object
 397                      (ideographic-structure-to-ids value))
 398              )
 399     (est-eval-value-default value)))
 400
 401 (defun est-eval-value-as-domain-list (value)
 402   (if (listp value)
 403       (let (source item source-objs source0 start end num)
 404         (list* 'res-list
 405                '(:separator " ")
 406                (mapcar
 407                 (lambda (unit)
 408                   (setq unit
 409                         (if (symbolp unit)
 410                             (symbol-name unit)
 411                           (format "%s" unit)))
 412                   (cond
 413                    ((string-match "=" unit)
 414                     (setq source (intern
 415                                   (substring unit 0 (match-beginning 0)))
 416                           item (car (read-from-string
 417                                      (substring unit (match-end 0)))))
 418                     (cond
 419                      ((eq source 'bos)
 420                       (setq source-objs
 421                             (list
 422                              (est-eval-value-as-object
 423                               (or (concord-decode-object
 424                                    '=id item 'book@ruimoku)
 425                                   (concord-decode-object
 426                                    '=id item 'article@ruimoku)
 427                                   (intern unit)))))
 428                       )
 429                      ((eq source 'zob1968)
 430                       (if (and (symbolp item)
 431                                (setq num (symbol-name item))
 432                                (string-match
 433                                 "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
 434                           (setq start (string-to-number
 435                                        (match-string 1 num))
 436                                 end (string-to-number
 437                                      (match-string 2 num)))
 438                         (setq start item
 439                               end item))
 440                       (if (not (numberp start))
 441                           (setq source-objs
 442                                 (list
 443                                  (est-eval-value-as-object (intern unit))))
 444                         (if (eq source source0)
 445                             (setq source-objs
 446                                   (list
 447                                    (list 'link
 448                                          (list :ref
 449                                                (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 450                                                        start))
 451                                          start)))
 452                           (setq source0 source)
 453                           (setq source-objs
 454                                 (list
 455                                  (list 'link
 456                                        (list :ref
 457                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 458                                                      start))
 459                                        start)
 460                                  "="
 461                                  '(link
 462                                    (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
 463                                    "\u4EAC大人\u6587研甲\u9AA8")))
 464                           )
 465                         (setq num (1+ start))
 466                         (while (<= num end)
 467                           (setq source-objs
 468                                 (cons
 469                                  (list 'link
 470                                        (list :ref
 471                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 472                                                      num))
 473                                        num)
 474                                  source-objs))
 475                           (setq num (1+ num)))
 476                         (setq source-objs (nreverse source-objs)))
 477                       )
 478                      (t
 479                       (setq source-objs
 480                             (list (est-eval-value-as-object (intern unit))))
 481                       ))
 482                     (list* 'res-link
 483                            (list :source source :item item)
 484                            source-objs)
 485                     )
 486                    (t
 487                     (list 'res-link nil unit)
 488                     )))
 489                 value)))
 490     (est-eval-value-default value)))
 491
 492 (defun est-eval-value-as-creators-names (value &optional subtype)
 493   (if (listp value)
 494       (let (role-name)
 495         (list* 'creator-name
 496                (if subtype
 497                    '(:subtype unordered-list)
 498                  '(:separator " "))
 499                (mapcar (lambda (creator)
 500                          (cond
 501                           ((concord-object-p creator)
 502                            (setq role-name
 503                                  (concord-object-get
 504                                   creator 'role*name))
 505                            (est-eval-list
 506                             (list
 507                              '(value (:feature ->creator/name))
 508                              (list
 509                               'object (list :object creator)
 510                               (or role-name
 511                                   (format "(%s)"
 512                                           (concord-object-get creator
 513                                                               'role*type)))))
 514                             creator nil)
 515                            )
 516                           (t creator)))
 517                        value)
 518                ))
 519     (est-eval-value-default value)))
 520
 521 (defun est-eval-value-as-created-works (value &optional subtype)
 522   (if (listp value)
 523       (list* 'creator-name
 524              (if subtype
 525                  '(:subtype unordered-list)
 526                '(:separator " "))
 527              (mapcar (lambda (creator)
 528                        (est-eval-list
 529                         '((value (:feature <-creator)))
 530                         creator nil))
 531                      value))
 532     (est-eval-value-default value)))
 533
 534 (defun est-eval-value-as-journal-volumes (value &optional subtype)
 535   (if (listp value)
 536       (list* 'journal-volumes
 537              (if subtype
 538                  '(:subtype unordered-list)
 539                '(:separator " "))
 540              (mapcar (lambda (volume)
 541                        (if (concord-object-p volume)
 542                            (est-eval-value-as-journal-volume volume 'short)
 543                          volume))
 544                      value))
 545     (est-eval-value-default value)))
 546
 547
 548 ;;; @ format evaluator
 549 ;;;
 550
 551 ;; (defun est-make-env (object feature-name)
 552 ;;   (list (cons 'object object)
 553 ;;         (cons 'feature-name feature-name)))
 554
 555 ;; (defun est-env-push-item (env item value)
 556 ;;   (cons (cons item value)
 557 ;;         env))
 558
 559 ;; (defun est-env-get-item (env item)
 560 ;;   (cdr (assq item env)))
 561
 562 ;; (defun est-env-current-value (env)
 563 ;;   (let ((obj (est-env-get-item env 'object))
 564 ;;         (feature (est-env-get-item env 'feature-name)))
 565 ;;     (if (characterp obj)
 566 ;;         (char-feature obj feature)
 567 ;;       (concord-object-get obj feature))))
 568
 569
 570 (defun est-eval-props-to-string (props &optional format)
 571   (unless format
 572     (setq format (plist-get props :format)))
 573   (concat "%"
 574           (plist-get props :flag)
 575           (if (plist-get props :len)
 576               (format "0%d"
 577                       (let ((ret (plist-get props :len)))
 578                         (if (stringp ret)
 579                             (string-to-int ret)
 580                           ret))))
 581           (cond
 582            ((eq format 'decimal) "d")
 583            ((eq format 'hex) "x")
 584            ((eq format 'HEX) "X")
 585            ((eq format 'S-exp) "S")
 586            (t "s"))))
 587
 588 (defun est-eval-apply-value (object feature-name format props value
 589                                     &optional uri-object)
 590   (list 'value
 591         (list :object object
 592               :feature feature-name)
 593         (cond
 594          ((memq format '(decimal hex HEX))
 595           (if (integerp value)
 596               (list format
 597                     nil
 598                     (format (est-eval-props-to-string props format)
 599                             value))
 600             (format "%s" value))
 601           )
 602          ((eq format 'string)
 603           (list 'string nil (format "%s" value))
 604           )
 605          ((eq format 'wiki-text)
 606           (est-eval-list value object feature-name nil uri-object)
 607           )
 608          ((eq format 'S-exp)
 609           (est-eval-value-as-S-exp value)
 610           )
 611          ((eq format 'ku-ten)
 612           (est-eval-value-as-kuten value))
 613          ((eq format 'kangxi-radical)
 614           (est-eval-value-as-kangxi-radical value))
 615          ((eq format 'ids)
 616           (est-eval-value-as-ids value))
 617          ((or (eq format 'space-separated)
 618               (eq format 'space-separated-char-list))
 619           (est-eval-value-as-object-list value " "))
 620          ((eq format 'unordered-list)
 621           (est-eval-value-as-object-list value nil 'unordered-list))
 622          ((eq format 'space-separated-ids)
 623           (est-eval-value-as-space-separated-ids value))
 624          ((eq format 'space-separated-domain-list)
 625           (est-eval-value-as-domain-list value))
 626          ((eq format 'space-separated-creator-name-list)
 627           (est-eval-value-as-creators-names value))
 628          ((eq format 'unordered-creator-name-list)
 629           (est-eval-value-as-creators-names value 'unordered-list))
 630          ((eq format 'space-separated-created-work-list)
 631           (est-eval-value-as-created-works value))
 632          ((eq format 'unordered-created-work-list)
 633           (est-eval-value-as-created-works value 'unordered-list))
 634          ((eq format 'journal-volume-list)
 635           (est-eval-value-as-journal-volumes value))
 636          (t
 637           (est-eval-value-default value)
 638           ))
 639         ))
 640
 641 (defun est-eval-feature-value (object feature-name
 642                                       &optional format lang uri-object value)
 643   (unless value
 644     (setq value (www-get-feature-value object feature-name)))
 645   (unless format
 646     (setq format (www-feature-value-format feature-name)))
 647   (if (consp value)
 648       (let ((ret (condition-case nil
 649                      (nthcdr 255 value)
 650                    (error nil nil))))
 651         (when ret
 652           (setcdr ret
 653                   (list (list 'omitted
 654                               (list :object object :feature feature-name)
 655                               "..."))))))
 656   (cond
 657    ((symbolp format)
 658     (est-eval-apply-value object feature-name
 659                           format nil value
 660                           uri-object)
 661     )
 662    ((consp format)
 663     (cond
 664      ((null (cdr format))
 665       (setq format (car format))
 666       (est-eval-apply-value object feature-name
 667                             (car format) (nth 1 format) value
 668                             uri-object)
 669       )
 670      (t
 671       (est-eval-list format object feature-name lang uri-object)
 672       )))))
 673
 674 (defun est-eval-unit (exp object feature-name
 675                                  &optional lang uri-object value)
 676   (unless value
 677     (setq value (www-get-feature-value object feature-name)))
 678   (unless uri-object
 679     (setq uri-object (www-uri-encode-object object)))
 680   (cond
 681    ((stringp exp) exp)
 682    ((or (characterp exp)
 683         (concord-object-p exp))
 684     (est-eval-value-as-object exp)
 685     )
 686    ((null exp) "")
 687    ((consp exp)
 688     (cond
 689      ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
 690                               S-exp string default))
 691       (let ((fn (plist-get (nth 1 exp) :feature))
 692             domain domain-fn ret)
 693         (when fn
 694           (when (stringp fn)
 695             (setq fn (intern fn)))
 696           (setq domain (char-feature-name-domain feature-name))
 697           (setq domain-fn (char-feature-name-at-domain fn domain))
 698           (if (setq ret (www-get-feature-value object domain-fn))
 699               (setq feature-name domain-fn
 700                     value ret)
 701             (setq feature-name fn
 702                   value (www-get-feature-value object fn)))
 703           (push feature-name chise-wiki-displayed-features)
 704           ))
 705       (if (eq (car exp) 'value)
 706           (est-eval-feature-value object feature-name
 707                                          (plist-get (nth 1 exp) :format)
 708                                          lang uri-object value)
 709         (est-eval-apply-value
 710          object feature-name
 711          (car exp) (nth 1 exp) value
 712          uri-object))
 713       )
 714      ((eq (car exp) 'name)
 715       (let ((fn (plist-get (nth 1 exp) :feature))
 716             domain domain-fn)
 717         (when fn
 718           (setq domain (char-feature-name-domain feature-name))
 719           (when (stringp fn)
 720             (setq fn (intern fn)))
 721           (setq domain-fn (char-feature-name-at-domain fn domain))
 722           (setq feature-name domain-fn)))
 723       (list 'feature-name
 724             (list :object object
 725                   :feature feature-name)
 726             (www-format-feature-name* feature-name lang))
 727       )
 728      ((eq (car exp) 'name-url)
 729       (let ((fn (plist-get (nth 1 exp) :feature))
 730             (object (plist-get (nth 1 exp) :object))
 731             domain domain-fn)
 732         (when fn
 733           (setq domain (char-feature-name-domain feature-name))
 734           (when (stringp fn)
 735             (setq fn (intern fn)))
 736           (setq domain-fn (char-feature-name-at-domain fn domain))
 737           (setq feature-name domain-fn)))
 738       (list 'name-url (list :feature feature-name)
 739             (www-uri-make-feature-name-url
 740              (est-object-genre object)
 741              (www-uri-encode-feature-name feature-name)
 742              uri-object))
 743       )
 744      ((eq (car exp) 'domain-name)
 745       (let ((domain (char-feature-name-domain feature-name)))
 746         (if domain
 747             (format "@%s" domain)
 748           ""))
 749       )
 750      ((eq (car exp) 'omitted)
 751       (list 'omitted
 752             (list :object object :feature feature-name)
 753             "...")
 754       )
 755      ((eq (car exp) 'prev-char)
 756       (list 'prev-char
 757             (list :object object :feature feature-name)
 758             '(input (:type "submit" :value "-")))
 759       )
 760      ((eq (car exp) 'next-char)
 761       (list 'next-char
 762             (list :object object :feature feature-name)
 763             '(input (:type "submit" :value "+")))
 764       )
 765      ((eq (car exp) 'link)
 766       (list 'link
 767             (list :ref
 768                   (est-eval-list (plist-get (nth 1 exp) :ref)
 769                                         object feature-name lang uri-object))
 770             (est-eval-list (nthcdr 2 exp)
 771                                   object feature-name lang uri-object))
 772       )
 773      (t
 774       exp)))))
 775
 776 (defun est-eval-list (format-list object feature-name
 777                                   &optional lang uri-object)
 778   (if (consp format-list)
 779       (let ((ret
 780              (mapcar
 781               (lambda (exp)
 782                 (est-eval-unit exp object feature-name lang uri-object nil))
 783               format-list)))
 784         (if (cdr ret)
 785             (list* 'list nil ret)
 786           (car ret)))
 787     (est-eval-unit format-list object feature-name lang uri-object nil)))
 788
 789
 790 ;;; @ End.
 791 ;;;
 792
 793 (provide 'est-eval)
 794
 795 ;;; est-eval.el ends here