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 "&MJ019590;"))
  18         ((eq spec 06) (concat value "集"))
  19         ((eq spec 07) (concat value "輯"))
  20         ((eq spec 08) (concat value "部"))
  21         ((eq spec 09) (concat value "部分"))
  22         ((eq spec 10) (concat value "冊"))
  23         ((eq spec 11) (concat value "分冊"))
  24         ((eq spec 12) (concat value "次"))
  25         ((eq spec 13) (concat value "月号"))
  26         ((eq spec 14) (concat value "特集号"))
  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-eval-value-as-image-resource (value &optional accept-full-image)
  68   (let ((name (concord-object-get value 'name)))
  69     (cond
  70      ((concord-object-get value 'image-offset-x)
  71       (list 'img (list* :src (or (concord-object-get value '=location@iiif)
  72                                  (concord-object-get value '=location))
  73                         (if name
  74                             (list :alt name))))
  75       )
  76      (accept-full-image
  77       (list 'img (list* :src (concord-object-get value '=location)
  78                         (if name
  79                             (list :alt name))))
  80       )
  81      (t
  82       name))))
  83
  84 (defun est-eval-value-as-glyph-image (value)
  85   (let ((image-resource (car (concord-object-get value '->image-resource))))
  86     (est-eval-value-as-image-resource image-resource)))
  87
  88 (defun est-eval-value-as-image-object (value)
  89   (let ((image-resource (car (concord-object-get value '->image-resource))))
  90     (list 'object (list :object value)
  91           (est-eval-value-as-image-resource
  92            image-resource 'accept-full-image))))
  93
  94 ;; (defun est-journal-volume-object-get-volume-format (spec feature)
  95 ;;   (when (integerp spec)
  96 ;;     (setq spec (format "%02d" spec)))
  97 ;;   (cond ((string= spec "YY") `((decimal (:feature
  98 ;;                                          ->published/date*year)) "年"))
  99 ;;         ((string= spec "00") `((decimal (:feature ,feature))))
 100 ;;         ((string= spec "01") `((decimal (:feature ,feature)) "期"))
 101 ;;         ((string= spec "02") `((decimal (:feature ,feature)) "巻"))
 102 ;;         ((string= spec "03") `((decimal (:feature ,feature)) "号"))
 103 ;;         ((string= spec "04") `((decimal (:feature ,feature)) "&AJ1-03620;"))
 104 ;;         ((string= spec "05") `((decimal (:feature ,feature)) "&MJ019590;"))
 105 ;;         ((string= spec "06") `((decimal (:feature ,feature)) "集"))
 106 ;;         ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
 107 ;;         ((string= spec "08") `((decimal (:feature ,feature)) "部"))
 108 ;;         ((string= spec "09") `((decimal (:feature ,feature)) "部分"))
 109 ;;         ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
 110 ;;         ((string= spec "11") `((decimal (:feature ,feature)) "分冊"))
 111 ;;         ((string= spec "12") `((decimal (:feature ,feature)) "次"))
 112 ;;         ((string= spec "13") `((decimal (:feature ,feature)) "月号"))
 113 ;;         ((string= spec "14") `((decimal (:feature ,feature)) "特集号"))
 114 ;;         ((string= spec "15") `((decimal (:feature ,feature)) "本"))
 115 ;;         ((string= spec "16") `((decimal (:feature ,feature)) "分"))
 116 ;;         ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
 117 ;;         ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
 118 ;;         ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
 119 ;;         ((string= spec "54") `("Issue " ((decimal (:feature ,feature)))))
 120 ;;         ((string= spec "55") `("Tome " ((decimal (:feature ,feature)))))
 121 ;;         ((string= spec "56") `("Tomo " ((decimal (:feature ,feature)))))
 122 ;;         ((string= spec "57") `("Tomus " ((decimal (:feature ,feature)))))
 123 ;;         ((string= spec "58") `("Fasc." ((decimal (:feature ,feature)))))
 124 ;;         ((string= spec "59") `("Livre " ((decimal (:feature ,feature)))))
 125 ;;         ((string= spec "60") `("Année " ((decimal (:feature ,feature)))))
 126 ;;         ((string= spec "61") `("Bd." ((decimal (:feature ,feature)))))
 127 ;;         ((string= spec "62") `("Heft " ((decimal (:feature ,feature)))))
 128 ;;         ((string= spec "63") `("Nr." ((decimal (:feature ,feature)))))
 129 ;;         ((string= spec "64") `("Jahrg." ((decimal (:feature ,feature)))))
 130 ;;         ((string= spec "65") `("Jaarg." ((decimal (:feature ,feature)))))
 131 ;;         ((string= spec "66") `("Trimestre" ((decimal (:feature ,feature)))))
 132 ;;         (t nil)
 133 ;;         ))
 134
 135 (defun est-eval-value-as-journal-volume (value &optional short)
 136   (let ((journal (car (or (concord-object-get value '<-journal/volume)
 137                           (concord-object-get value '<-volume))))
 138         (vol-name (concord-object-get value '<-journal/volume*name))
 139         volume-type number-type
 140         year
 141         dest ret title subtitle)
 142     (cond
 143      (journal
 144       (if vol-name
 145           (setq dest
 146                 (list
 147                  (list 'object (list :object value)
 148                        vol-name)))
 149         (setq volume-type (concord-object-get journal 'volume/type/code)
 150               number-type (concord-object-get journal 'number/type/code))
 151         (setq year (or (concord-object-get value '->published/date*year)
 152                        (concord-object-get
 153                         (car (concord-object-get value 'date)) 'year)))
 154         (setq dest
 155               (list
 156                (list 'object
 157                      (list :object value)
 158                      (ruimoku-format-volume
 159                       volume-type
 160                       (or (concord-object-get value '<-journal/volume*volume)
 161                           (concord-object-get value '<-volume*volume))
 162                       year 'cjk)
 163                      (ruimoku-format-volume
 164                       number-type
 165                       (or (concord-object-get value '<-journal/volume*number)
 166                           (concord-object-get value '<-volume*number))
 167                       year 'cjk))))
 168         )
 169       (unless short
 170         (if (setq ret (est-eval-value-as-object journal))
 171             (setq dest
 172                   (list* ret " " dest))))
 173       (list* 'list '(:subtype sequence :separator "") dest)
 174       )
 175      ((setq title (concord-object-get value 'title))
 176       (setq subtitle (concord-object-get value 'title/subtitle))
 177       (list* 'object
 178              (list :object value)
 179              (if (eq (concord-object-get value 'writing-system) 'cjk)
 180                  (list
 181                   "「"
 182                   (list 'object (list :object value)
 183                         (if subtitle
 184                             (concat title " — " subtitle)
 185                           title))
 186                   "」")
 187                (list
 188                 " ‘"
 189                 (list 'object (list :object value)
 190                       (if subtitle
 191                           (concat title " — " subtitle)
 192                         title))
 193                 "’")))
 194       )
 195      (t
 196       (est-eval-value-default value)
 197       ))
 198     ;; (concat (concord-object-get journal 'name)
 199     ;;         " "
 200     ;;         (ruimoku-format-volume
 201     ;;          volume-type
 202     ;;          (or (concord-object-get value '<-journal/volume*volume)
 203     ;;              (concord-object-get value '<-volume*volume))
 204     ;;          year 'cjk)
 205     ;;         (ruimoku-format-volume
 206     ;;          number-type
 207     ;;          (or (concord-object-get value '<-journal/volume*number)
 208     ;;              (concord-object-get value '<-volume*number))
 209     ;;          year 'cjk))
 210     ))
 211
 212 (defun est-eval-value-as-article (value)
 213   (let ((journal-volume (car (concord-object-get value '<-article)))
 214         (page (concord-object-get value 'page))
 215         date ret dest)
 216     (when journal-volume
 217       (setq date (car (concord-object-get journal-volume 'date)))
 218       (if (and date
 219                (setq ret (est-eval-value-as-object date)))
 220           (setq dest (list ", " ret))))
 221     (if page
 222         (setq dest (list* ", pp." page dest)))
 223     (when (and journal-volume
 224                (setq ret (est-eval-value-as-journal-volume journal-volume)))
 225       (setq dest (cons ret dest)))
 226     (if (setq ret (est-eval-value-as-book value))
 227         (setq dest (list* ret " " dest)))
 228     (list* 'list '(:subtype sequence :separator "") dest))
 229   ;; (let ((creators (concord-object-get value '->creator))
 230   ;;       (title (concord-object-get value 'title))
 231   ;;       creator-name creator-role)
 232   ;;   (concat
 233   ;;    (mapconcat
 234   ;;     (lambda (creator)
 235   ;;       (setq creator-name
 236   ;;             (concord-object-get
 237   ;;              (car (concord-object-get creator '->creator/name))
 238   ;;              '=name))
 239   ;;       (setq creator-role
 240   ;;             (or (concord-object-get creator 'role*name)
 241   ;;                 (format "(%s)"
 242   ;;                         (concord-object-get creator 'role*type))))
 243   ;;       (concat creator-name " " creator-role))
 244   ;;     creators ", ")
 245   ;;    (if (eq (concord-object-get value 'writing-system) 'cjk)
 246   ;;        (concat  "「" title "」")
 247   ;;      (concat " ‘" title "’"))))
 248   )
 249
 250 (defun est-eval-value-as-book (value)
 251   (let ((creators (concord-object-get value '->creator))
 252         (title (concord-object-get value 'title))
 253         (subtitle (concord-object-get value 'title/subtitle))
 254         (series (concord-object-get value 'series))
 255         (publisher (car (concord-object-get value 'publisher)))
 256         (date (car (concord-object-get value 'date)))
 257         ;; creator-name creator-role
 258         dest ret)
 259     (if (and date
 260              (setq ret (est-eval-value-as-object date)))
 261         (setq dest (list ", " ret)))
 262     (if (and publisher
 263              (setq ret (est-eval-value-as-object publisher)))
 264         (setq dest (list* " " ret dest)))
 265     (if series
 266         (setq dest (list* series "," dest)))
 267     (setq dest
 268           (if title
 269               (if (eq (concord-object-get value 'writing-system) 'cjk)
 270                   (list*
 271                    "「"
 272                  (list 'object (list :object value)
 273                        (if subtitle
 274                            (concat title " — " subtitle)
 275                          title))
 276                  "」" dest)
 277               (list*
 278                " ‘"
 279                (list 'object (list :object value)
 280                      (if subtitle
 281                          (concat title " — " subtitle)
 282                        title))
 283                "’" dest))
 284             (list* " "
 285                    (list 'object (list :object value)
 286                          "(review)")
 287                    dest)))
 288     (when (and creators
 289                (setq ret (est-eval-value-as-creators-names creators)))
 290       (setq dest (cons ret dest)))
 291     (list* 'list '(:subtype sequence :separator "") dest)
 292     ;; (concat
 293     ;;  (mapconcat
 294     ;;   (lambda (creator)
 295     ;;     (setq creator-name
 296     ;;           (concord-object-get
 297     ;;            (car (concord-object-get creator '->creator/name))
 298     ;;            '=name))
 299     ;;     (setq creator-role
 300     ;;           (or (concord-object-get creator 'role*name)
 301     ;;               (format "(%s)"
 302     ;;                       (concord-object-get creator 'role*type))))
 303     ;;     (concat creator-name " " creator-role))
 304     ;;   creators ", ")
 305     ;;  (if (eq (concord-object-get value 'writing-system) 'cjk)
 306     ;;      (concat  "「" title
 307     ;;               (if subtitle
 308     ;;                   (concat " — " subtitle))
 309     ;;               "」")
 310     ;;    (concat " ‘" title
 311     ;;            (if subtitle
 312     ;;                (concat " — " subtitle))
 313     ;;            "’"))
 314     ;;  (if series
 315     ;;      (concat " " series))
 316     ;;  (if publisher
 317     ;;      (concat ", "
 318     ;;              (concord-object-get
 319     ;;               (car (concord-object-get
 320     ;;                     publisher '->publisher/name))
 321     ;;               '=name)))
 322     ;;  (if date
 323     ;;      (concat ", " (concord-object-get date 'name)))))
 324     ))
 325
 326 ;; (defun est-eval-creator (value)
 327 ;;   (est-eval-list
 328 ;;    '((value (:feature ->name))
 329 ;;      (string (:feature role*name)))
 330 ;;    value nil))
 331
 332 (defun est-eval-value-as-object (value)
 333   (if (or (characterp value)
 334           (concord-object-p value))
 335       (list 'object (list :object value)
 336             (if (characterp value)
 337                 (char-to-string value)
 338               (let ((genre (concord-object-genre value))
 339                     genre-o
 340                     format)
 341                 (cond
 342                  ((eq genre 'journal-volume@ruimoku)
 343                   ;; (est-eval-list
 344                   ;;  (est-journal-volume-get-object-format value)
 345                   ;;  value nil)
 346                   (est-eval-value-as-journal-volume value)
 347                   )
 348                  ((eq genre 'article@ruimoku)
 349                   (est-eval-value-as-article value)
 350                   )
 351                  ((eq genre 'book@ruimoku)
 352                   (est-eval-value-as-book value)
 353                   )
 354                  ;; ((eq genre 'creator@ruimoku)
 355                  ;;  (est-eval-creator value)
 356                  ;;  )
 357                  ((eq genre 'image-resource)
 358                   (est-eval-value-as-image-resource value)
 359                   )
 360                  ((eq genre 'glyph-image)
 361                   (est-eval-value-as-glyph-image value)
 362                   )
 363                  (t
 364                   (setq genre-o (concord-decode-object '=id genre 'genre))
 365                   (or (and genre-o
 366                            (setq format
 367                                  (concord-object-get
 368                                   genre-o 'object-representative-format))
 369                            (est-eval-list format value nil))
 370                       (www-get-feature-value
 371                        value
 372                        (or (and genre-o
 373                                 (www-get-feature-value
 374                                  genre-o 'object-representative-feature))
 375                            'name))
 376                       (www-get-feature-value value '=name)
 377                       (www-get-feature-value value '=title)
 378                       (est-eval-value-default value))
 379                   ))
 380                 )))
 381     (est-eval-value-default value)))
 382
 383 (defun est-eval-value-as-character (value)
 384   (let (ret)
 385   (if (and (concord-object-p value)
 386            (setq ret (concord-object-get value 'character)))
 387       (list 'object (list :object value)
 388             (mapconcat #'char-to-string ret ""))
 389     (est-eval-value-as-object value))))
 390
 391 (defun est-eval-value-as-object-with-description (value
 392                                                   object feature-name
 393                                                   &optional lang uri-object list-props)
 394   (let (ret)
 395     (cond
 396      ((characterp value)
 397       (setq ret (or (get-char-attribute value 'description)
 398                     (get-char-attribute value 'hdic-syp-description)
 399                     (get-char-attribute value 'hdic-ktb-description)))
 400       )
 401      ((concord-object-p value)
 402       (setq ret (concord-object-get value 'description))
 403       ))
 404     (if ret
 405         (list 'list nil
 406               (est-eval-value-as-object value)
 407               (est-eval-list ret
 408                              object feature-name
 409                              lang uri-object list-props))
 410       (est-eval-value-as-object value))))
 411
 412 (defun est-eval-value-as-hdic-tsj-character-with-description (value
 413                                                               object feature-name
 414                                                               &optional
 415                                                               lang uri-object list-props)
 416   (let (word desc ret)
 417     (cond
 418      ((characterp value)
 419       (when (setq word (get-char-attribute value 'hdic-tsj-word))
 420         (if (and (= (length word) 1)
 421                  (setq ret (get-char-attribute value '<-HDIC-TSJ))
 422                  (memq (aref word 0) ret))
 423             (setq desc (or (get-char-attribute value 'hdic-tsj-word-description)
 424                            (get-char-attribute value 'description)))
 425           (setq desc (list "(" word ")"))))
 426       )
 427      ((concord-object-p value)
 428       (setq desc (concord-object-get value 'description))
 429       ))
 430     (if desc
 431         (list 'list nil
 432               (est-eval-value-as-object value)
 433               (est-eval-list (append desc '("　 "))
 434                              object feature-name
 435                              lang uri-object list-props))
 436       (est-eval-value-as-object value))))
 437
 438 (defun est-eval-value-as-location (value)
 439   (let (ret)
 440   (if (and (concord-object-p value)
 441            (setq ret (concord-object-get value '=location)))
 442       (list 'object (list :object value)
 443             ret)
 444     (est-eval-value-as-object value))))
 445
 446 (defun est-eval-value-as-name (value)
 447   (let (ret)
 448   (if (and (concord-object-p value)
 449            (setq ret (concord-object-get value 'name)))
 450       (list 'object (list :object value)
 451             ret)
 452     (est-eval-value-as-object value))))
 453
 454 (defun est-eval-value-as-HEX (value)
 455   (if (integerp value)
 456       (list 'HEX nil (format "%X" value))
 457     (est-eval-value-as-S-exp value)))
 458
 459 (defun est-eval-value-as-kuten (value)
 460   (if (integerp value)
 461       (list 'ku-ten
 462             nil
 463             (format "%02d-%02d"
 464                     (- (lsh value -8) 32)
 465                     (- (logand value 255) 32)))
 466     (est-eval-value-as-S-exp value)))
 467
 468 (defun est-eval-value-as-kangxi-radical (value)
 469   (if (and (integerp value)
 470            (<= 0 value)
 471            (<= value 214))
 472       (list 'kangxi-radical
 473             nil
 474             (format "%c" (ideographic-radical value)))
 475     (est-eval-value-as-S-exp value)))
 476
 477 (defun est-eval-value-as-shuowen-radical (value)
 478   (if (and (integerp value)
 479            (<= 0 value)
 480            (<= value 540))
 481       (list 'shuowen-radical
 482             nil
 483             (format "%c" (shuowen-radical value)))
 484     (est-eval-value-as-S-exp value)))
 485
 486 (defun daijiten-page-number-to-ndl-950498 (page)
 487   (+ (/ page 2)
 488      (cond ((< page 229)
 489             23)
 490            ((< page 261)
 491             24)
 492            ((< page 263)
 493             25)
 494            ((< page 516) ; 284=285
 495             26)
 496            (t
 497             27))))
 498
 499 (defun est-eval-value-as-daijiten-page (value)
 500   (if (integerp value)
 501       (list 'link
 502             (list :ref
 503                   (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/950498/manifest.json&tify={%%22pages%%22:[%d]}"
 504                           (daijiten-page-number-to-ndl-950498 value)))
 505             value)))
 506
 507 (defun est-eval-value-as-ndl-page-by-tify (value)
 508   (if (symbolp value)
 509       (setq value (symbol-name value)))
 510   (if (stringp value)
 511       (if (string-match "/" value)
 512           (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json&tify={%%22pages%%22:[%s]}"
 513                   (substring value 0 (match-beginning 0))
 514                   (substring value (match-end 0)))
 515         (format "http://image.chise.org/tify/?manifest=https://www.dl.ndl.go.jp/api/iiif/%s/manifest.json"
 516                 value))
 517     value))
 518
 519 (defun est-eval-value-as-Web-yunzi-char (value)
 520   (if (char-or-char-int-p value)
 521       (list 'link
 522             (list :ref
 523                   (format "http://suzukish.s252.xrea.com/search/inkyo/yunzi/%c"
 524                           value))
 525             (format "/%s/" (char-to-string value)))))
 526
 527 (defun est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number (value)
 528   (if (symbolp value)
 529       (setq value (symbol-name value)))
 530   (if (and (stringp value)
 531            (string-match
 532             "^Y\\([0-9][0-9]\\)\\([0-9][0-9][0-9]\\)\\([0-9][0-9][0-9]\\)-\\([0-9]\\)$"
 533             value))
 534       (format "%d巻 %d紙 %d列 %d字目 (%s)"
 535               (string-to-int (match-string 1 value))
 536               (string-to-int (match-string 2 value))
 537               (string-to-int (match-string 3 value))
 538               (string-to-int (match-string 4 value))
 539               value)
 540     value))
 541
 542 (defun est-eval-value-as-object-list (value &optional separator subtype)
 543   (if (and (listp value)
 544            (listp (cdr value)))
 545       (condition-case nil
 546           (let (props)
 547             (if separator
 548                 (setq props (list :separator separator)))
 549             (if subtype
 550                 (setq props (list* :subtype subtype props)))
 551             (list* 'list props
 552                    (mapcar #'est-eval-value-as-object value)))
 553         (error (format "%s" value)))
 554     (format "%s" value)))
 555
 556 (defun est-eval-value-as-char-list (value &optional separator subtype)
 557   (if (and (listp value)
 558            (listp (cdr value)))
 559       (condition-case nil
 560           (let (props)
 561             (if separator
 562                 (setq props (list :separator separator)))
 563             (if subtype
 564                 (setq props (list* :subtype subtype props)))
 565             (list* 'list props
 566                    (mapcar #'est-eval-value-as-character value)))
 567         (error (format "%s" value)))
 568     (format "%s" value)))
 569
 570 (defun est-eval-value-as-location-list (value &optional separator subtype)
 571   (if (and (listp value)
 572            (listp (cdr value)))
 573       (condition-case nil
 574           (let (props)
 575             (if separator
 576                 (setq props (list :separator separator)))
 577             (if subtype
 578                 (setq props (list* :subtype subtype props)))
 579             (list* 'list props
 580                    (mapcar #'est-eval-value-as-location value)))
 581         (error (format "%s" value)))
 582     (format "%s" value)))
 583
 584 (defun est-eval-value-as-name-list (value &optional separator subtype)
 585   (if (and (listp value)
 586            (listp (cdr value)))
 587       (condition-case nil
 588           (let (props)
 589             (if separator
 590                 (setq props (list :separator separator)))
 591             (if subtype
 592                 (setq props (list* :subtype subtype props)))
 593             (list* 'list props
 594                    (mapcar #'est-eval-value-as-name value)))
 595         (error (format "%s" value)))
 596     (format "%s" value)))
 597
 598 (defun est-eval-value-as-image-list (value &optional separator subtype)
 599   (if (and (listp value)
 600            (listp (cdr value)))
 601       (condition-case nil
 602           (let (props)
 603             (if separator
 604                 (setq props (list :separator separator)))
 605             (if subtype
 606                 (setq props (list* :subtype subtype props)))
 607             (list* 'image-list props
 608                    (mapcar #'est-eval-value-as-image-object value)))
 609         (error (format "%s" value)))
 610     (format "%s" value)))
 611
 612 (defun est-eval-value-as-composition-list (value &optional separator subtype)
 613   (if (and (listp value)
 614            (listp (cdr value)))
 615       (condition-case nil
 616           (let (props)
 617             (if separator
 618                 (setq props (list :separator separator)))
 619             (if subtype
 620                 (setq props (list* :subtype subtype props)))
 621             (list* 'list props
 622                    (mapcar
 623                     (lambda (cell)
 624                       (list 'list nil
 625                             "+ "
 626                             (list 'object (list :object (car cell))
 627                                   (format "U+%04X" (car cell)))
 628                             " : "
 629                             (est-eval-value-as-object (cdr cell))))
 630                     (sort value
 631                           (lambda (a b)
 632                             (< (car a)(car b)))))))
 633         (error (format "%s" value)))
 634     (format "%s" value)))
 635
 636 (defun est-eval-value-as-decomposition-list (value)
 637   (if (and (listp value)
 638            (listp (cdr value)))
 639       (condition-case nil
 640           (let (props)
 641             (list* 'list props
 642                    (mapconcat #'char-to-string value "")
 643                    (list
 644                     " ("
 645                     (list* 'list '(:separator " + ")
 646                            (mapcar
 647                             (lambda (chr)
 648                               (list 'object (list :object chr)
 649                                     (format "U+%04X" chr)))
 650                             value))
 651                     ")")))
 652         (error (format "%s" value)))
 653     (format "%s" value)))
 654
 655 (defun est-eval-value-as-entry-character-list (value
 656                                                object feature-name
 657                                                &optional separator subtype
 658                                                lang uri-object list-props)
 659   (if (and (listp value)
 660            (listp (cdr value)))
 661       (condition-case nil
 662           (let (props)
 663             (if separator
 664                 (setq props (list :separator separator)))
 665             (if subtype
 666                 (setq props (list* :subtype subtype props)))
 667             (list* 'list props
 668                    (mapcar (lambda (cell)
 669                              (est-eval-value-as-object-with-description
 670                               cell
 671                               object feature-name
 672                               lang uri-object list-props))
 673                            value)))
 674         (error (format "%s" value)))
 675     (format "%s" value)))
 676
 677 (defun est-eval-value-as-hdic-tsj-entry-character-list (value
 678                                                         object feature-name
 679                                                         &optional separator subtype
 680                                                         lang uri-object list-props)
 681   (if (and (listp value)
 682            (listp (cdr value)))
 683       (condition-case nil
 684           (let (props)
 685             (if separator
 686                 (setq props (list :separator separator)))
 687             (if subtype
 688                 (setq props (list* :subtype subtype props)))
 689             (list* 'list props
 690                    (mapcar (lambda (cell)
 691                              (est-eval-value-as-hdic-tsj-character-with-description
 692                               cell
 693                               object feature-name
 694                               lang uri-object list-props))
 695                            value)))
 696         (error (format "%s" value)))
 697     (format "%s" value)))
 698
 699
 700 ;; (defun est-eval-value-as-ids (value)
 701 ;;   (if (listp value)
 702 ;;       (list 'ids nil (ideographic-structure-to-ids value))
 703 ;;     (format "%s" value)))
 704 (defun est-eval-value-as-ids (value)
 705   (if (listp value)
 706       (list* 'ids
 707              nil
 708              (mapcar #'est-eval-value-as-object
 709                      (ideographic-structure-to-ids value))
 710              )
 711     (est-eval-value-default value)))
 712
 713 (defun est-eval-value-as-space-separated-ids (value)
 714   (if (listp value)
 715       (list* 'ids
 716              '(:separator " ")
 717              ;; (mapconcat #'char-to-string
 718              ;;            (ideographic-structure-to-ids value)
 719              ;;            " ")
 720              (mapcar #'est-eval-value-as-object
 721                      (ideographic-structure-to-ids value))
 722              )
 723     (est-eval-value-default value)))
 724
 725 (defun est-eval-value-as-domain-list (value)
 726   (if (listp value)
 727       (let (source item source-objs source0 start end num)
 728         (list* 'res-list
 729                '(:separator " ")
 730                (mapcar
 731                 (lambda (unit)
 732                   (setq unit
 733                         (if (symbolp unit)
 734                             (symbol-name unit)
 735                           (format "%s" unit)))
 736                   (cond
 737                    ((string-match "=" unit)
 738                     (setq source (intern
 739                                   (substring unit 0 (match-beginning 0)))
 740                           item (car (read-from-string
 741                                      (substring unit (match-end 0)))))
 742                     (cond
 743                      ((eq source 'bos)
 744                       (setq source-objs
 745                             (list
 746                              (est-eval-value-as-object
 747                               (or (concord-decode-object
 748                                    '=id item 'book@ruimoku)
 749                                   (concord-decode-object
 750                                    '=id item 'article@ruimoku)
 751                                   (intern unit)))))
 752                       )
 753                      ((memq source '(zob1959 zob1968))
 754                       (if (and (symbolp item)
 755                                (setq num (symbol-name item))
 756                                (string-match
 757                                 "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
 758                           (setq start (string-to-number
 759                                        (match-string 1 num))
 760                                 end (string-to-number
 761                                      (match-string 2 num)))
 762                         (setq start item
 763                               end item))
 764                       (if (not (numberp start))
 765                           (setq source-objs
 766                                 (list
 767                                  (est-eval-value-as-object (intern unit))))
 768                         (if (eq source source0)
 769                             (setq source-objs
 770                                   (list
 771                                    (list 'link
 772                                          (list :ref
 773                                                (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 774                                                        start))
 775                                          start)))
 776                           (setq source0 source)
 777                           (setq source-objs
 778                                 (list
 779                                  (list 'link
 780                                        (list :ref
 781                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 782                                                      start))
 783                                        start)
 784                                  "="
 785                                  '(link
 786                                    (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
 787                                    "\u4EAC大人\u6587研甲\u9AA8")))
 788                           )
 789                         (setq num (1+ start))
 790                         (while (<= num end)
 791                           (setq source-objs
 792                                 (cons
 793                                  (list 'link
 794                                        (list :ref
 795                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 796                                                      num))
 797                                        num)
 798                                  source-objs))
 799                           (setq num (1+ num)))
 800                         (setq source-objs (nreverse source-objs)))
 801                       )
 802                      (t
 803                       (setq source-objs
 804                             (list (est-eval-value-as-object (intern unit))))
 805                       ))
 806                     (list* 'res-link
 807                            (list :separator " "
 808                                  :source source :item item)
 809                            source-objs)
 810                     )
 811                    (t
 812                     (list 'res-link nil unit)
 813                     )))
 814                 value)))
 815     (est-eval-value-default value)))
 816
 817 (defun est-eval-value-as-sources (value)
 818   (if (listp value)
 819       (let (unit-str
 820             source item source-objs source0 start end num
 821             source-cobj title)
 822         (list* 'res-list
 823                '(:separator " ")
 824                (mapcar
 825                 (lambda (unit)
 826                   (setq unit-str
 827                         (if (symbolp unit)
 828                             (symbol-name unit)
 829                           (format "%s" unit)))
 830                   (if (string-match "=" unit-str)
 831                       (setq source (intern
 832                                     (substring unit-str 0 (match-beginning 0)))
 833                             item (car (read-from-string
 834                                        (substring unit-str (match-end 0)))))
 835                     (setq source unit
 836                           item nil))
 837                   (cond
 838                    ((and (setq source-cobj (concord-decode-object
 839                                             '=chise-bib-id source 'bibliography))
 840                          (setq title (concord-object-get source-cobj '=title)))
 841                     (setq source-objs
 842                           (if item
 843                               (list (est-eval-value-as-object source-cobj)
 844                                     "="
 845                                     item)
 846                             (list (est-eval-value-as-object source-cobj))))
 847                     )
 848                    ((eq source 'bos)
 849                     (setq source-objs
 850                           (list
 851                            (est-eval-value-as-object
 852                             (or (concord-decode-object
 853                                  '=id item 'book@ruimoku)
 854                                 (concord-decode-object
 855                                  '=id item 'article@ruimoku)
 856                                 unit))))
 857                     )
 858                    ((memq source '(zob1959 zob1968))
 859                     (if (and (symbolp item)
 860                              (setq num (symbol-name item))
 861                              (string-match
 862                               "^\\([0-9]+\\)-\\([0-9]+\\)$" num))
 863                         (setq start (string-to-number
 864                                      (match-string 1 num))
 865                               end (string-to-number
 866                                    (match-string 2 num)))
 867                       (setq start item
 868                             end item))
 869                     (if (not (numberp start))
 870                         (setq source-objs
 871                               (list
 872                                (est-eval-value-as-object unit)))
 873                       (if (eq source source0)
 874                           (setq source-objs
 875                                 (list
 876                                  (list 'link
 877                                        (list :ref
 878                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 879                                                      start))
 880                                        start)))
 881                         (setq source0 source)
 882                         (setq source-objs
 883                               (list
 884                                (list 'link
 885                                        (list :ref
 886                                              (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 887                                                      start))
 888                                        start)
 889                                "="
 890                                '(link
 891                                  (:ref "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/")
 892                                  "\u4EAC大人\u6587研甲\u9AA8")))
 893                         )
 894                       (setq num (1+ start))
 895                       (while (<= num end)
 896                         (setq source-objs
 897                               (cons
 898                                (list 'link
 899                                      (list :ref
 900                                            (format "http://chise.zinbun.kyoto-u.ac.jp/koukotsu/rubbings/%04d"
 901                                                    num))
 902                                      num)
 903                                source-objs))
 904                         (setq num (1+ num)))
 905                       (setq source-objs (nreverse source-objs)))
 906                     )
 907                    (t
 908                     (setq source-objs
 909                           (list (est-eval-value-as-object unit)))
 910                     ))
 911                   (list* 'res-link
 912                          (list :separator " "
 913                                :source source :item item)
 914                          source-objs)
 915                   )
 916                 value)))
 917     (est-eval-value-default value)))
 918
 919 (defun est-eval-value-as-daijiten-page-list (value &optional separator subtype)
 920   (if (and (listp value)
 921            (listp (cdr value)))
 922       (condition-case nil
 923           (let (props)
 924             (if separator
 925                 (setq props (list :separator separator)))
 926             (if subtype
 927                 (setq props (list* :subtype subtype props)))
 928             (list* 'list props
 929                    (mapcar #'est-eval-value-as-daijiten-page value)))
 930         (error (format "%s" value)))
 931     (format "%s" value)))
 932
 933 (defun est-eval-value-as-Web-yunzi-char-list (value &optional separator subtype)
 934   (if (and (listp value)
 935            (listp (cdr value)))
 936       (condition-case nil
 937           (let (props)
 938             (if separator
 939                 (setq props (list :separator separator)))
 940             (if subtype
 941                 (setq props (list* :subtype subtype props)))
 942             (list* 'list props
 943                    (mapcar #'est-eval-value-as-Web-yunzi-char value)))
 944         (error (format "%s" value)))
 945     (format "%s" value)))
 946
 947 (defun est-eval-value-as-creators-names (value &optional subtype)
 948   (if (listp value)
 949       (let (role-name)
 950         (list* 'creator-name
 951                (if subtype
 952                    '(:subtype unordered-list)
 953                  '(:separator " "))
 954                (mapcar (lambda (creator)
 955                          (cond
 956                           ((concord-object-p creator)
 957                            (setq role-name
 958                                  (concord-object-get
 959                                   creator 'role*name))
 960                            (est-eval-list
 961                             (list
 962                              '(value (:feature ->creator/name))
 963                              (list
 964                               'object (list :object creator)
 965                               (or role-name
 966                                   (format "(%s)"
 967                                           (concord-object-get creator
 968                                                               'role*type)))))
 969                             creator nil)
 970                            )
 971                           (t creator)))
 972                        value)
 973                ))
 974     (est-eval-value-default value)))
 975
 976 (defun est-eval-value-as-created-works (value &optional subtype)
 977   (if (listp value)
 978       (list* 'creator-name
 979              (if subtype
 980                  '(:subtype unordered-list)
 981                '(:separator " "))
 982              (mapcar (lambda (creator)
 983                        (if (concord-object-p creator)
 984                            (est-eval-list
 985                             '((value (:feature <-creator)))
 986                             creator nil)
 987                          (est-eval-value-default creator)))
 988                      value))
 989     (est-eval-value-default value)))
 990
 991 (defun est-eval-value-as-journal-volumes (value &optional subtype)
 992   (if (listp value)
 993       (list* 'journal-volumes
 994              (if subtype
 995                  '(:subtype unordered-list)
 996                '(:separator " "))
 997              (mapcar (lambda (volume)
 998                        (if (concord-object-p volume)
 999                            (est-eval-value-as-journal-volume volume 'short)
1000                          volume))
1001                      value))
1002     (est-eval-value-default value)))
1003
1004
1005 ;;; @ format evaluator
1006 ;;;
1007
1008 ;; (defun est-make-env (object feature-name)
1009 ;;   (list (cons 'object object)
1010 ;;         (cons 'feature-name feature-name)))
1011
1012 ;; (defun est-env-push-item (env item value)
1013 ;;   (cons (cons item value)
1014 ;;         env))
1015
1016 ;; (defun est-env-get-item (env item)
1017 ;;   (cdr (assq item env)))
1018
1019 ;; (defun est-env-current-value (env)
1020 ;;   (let ((obj (est-env-get-item env 'object))
1021 ;;         (feature (est-env-get-item env 'feature-name)))
1022 ;;     (if (characterp obj)
1023 ;;         (char-feature obj feature)
1024 ;;       (concord-object-get obj feature))))
1025
1026
1027 (defun est-eval-props-to-string (props &optional format)
1028   (unless format
1029     (setq format (plist-get props :format)))
1030   (concat "%"
1031           (plist-get props :flag)
1032           (if (plist-get props :len)
1033               (format "0%d"
1034                       (let ((ret (plist-get props :len)))
1035                         (if (stringp ret)
1036                             (string-to-int ret)
1037                           ret))))
1038           (cond
1039            ((eq format 'decimal) "d")
1040            ((eq format 'hex) "x")
1041            ((eq format 'HEX) "X")
1042            ((eq format 'S-exp) "S")
1043            (t "s"))))
1044
1045 (defun est-eval-apply-value (object feature-name format props value
1046                                     &optional uri-object)
1047   (list 'value
1048         (list :object object
1049               :feature feature-name)
1050         (cond
1051          ((memq format '(decimal hex HEX))
1052           (if (integerp value)
1053               (list format
1054                     nil
1055                     (format (est-eval-props-to-string props format)
1056                             value))
1057             (format "%s" value))
1058           )
1059          ((eq format 'string)
1060           (list 'string nil (format "%s" value))
1061           )
1062          ((eq format 'wiki-text)
1063           (est-eval-list value object feature-name nil uri-object)
1064           )
1065          ((eq format 'unordered-link-list)
1066           (est-eval-list value object feature-name nil uri-object
1067                          '(:subtype unordered-list :separator " "))
1068           )
1069          ((eq format 'S-exp)
1070           (est-eval-value-as-S-exp value)
1071           )
1072          ((eq format 'ku-ten)
1073           (est-eval-value-as-kuten value))
1074          ((eq format 'kangxi-radical)
1075           (est-eval-value-as-kangxi-radical value))
1076          ((eq format 'tify-url-for-ndl)
1077           (est-eval-value-as-ndl-page-by-tify value)
1078           )
1079          ((eq format 'hdic-yy-readable)
1080           (est-eval-value-as-HDIC-Yuanben-Yupian-volume-leaf-line-number value)
1081           )
1082          ((eq format 'shuowen-radical)
1083           (est-eval-value-as-shuowen-radical value))
1084          ((eq format 'ids)
1085           (est-eval-value-as-ids value))
1086          ((eq format 'decomposition)
1087           (est-eval-value-as-decomposition-list value))
1088          ((eq format 'composition)
1089           (est-eval-value-as-composition-list value))
1090          ((or (eq format 'space-separated)
1091               (eq format 'space-separated-char-list))
1092           (est-eval-value-as-object-list value " "))
1093          ((eq format 'char-list)
1094           (est-eval-value-as-char-list value nil))
1095          ((eq format 'location-list)
1096           (est-eval-value-as-location-list value nil))
1097          ((eq format 'name-list)
1098           (est-eval-value-as-name-list value nil))
1099          ((eq format 'image-list)
1100           (est-eval-value-as-image-list value nil))
1101          ((eq format 'unordered-list)
1102           (est-eval-value-as-object-list value nil 'unordered-list))
1103          ((eq format 'unordered-composition-list)
1104           (est-eval-value-as-composition-list value nil 'unordered-list))
1105          ((eq format 'entry-character-list)
1106           (est-eval-value-as-entry-character-list
1107            value
1108            object feature-name
1109            nil nil
1110            lang uri-object list-props))
1111          ((eq format 'unordered-entry-character-list)
1112           (est-eval-value-as-entry-character-list
1113            value
1114            object feature-name
1115            nil 'unordered-list
1116            lang uri-object list-props))
1117          ((eq format 'hdic-tsj-entry-character-list)
1118           (est-eval-value-as-hdic-tsj-entry-character-list
1119            value
1120            object feature-name
1121            nil nil
1122            lang uri-object list-props))
1123          ((eq format 'space-separated-ids)
1124           (est-eval-value-as-space-separated-ids value))
1125          ((eq format 'space-separated-domain-list)
1126           ;; (est-eval-value-as-domain-list value)
1127           (est-eval-value-as-sources value))
1128          ((eq format 'space-separated-source-list)
1129           (est-eval-value-as-sources value))
1130          ((eq format 'space-separated-creator-name-list)
1131           (est-eval-value-as-creators-names value))
1132          ((eq format 'unordered-creator-name-list)
1133           (est-eval-value-as-creators-names value 'unordered-list))
1134          ((eq format 'space-separated-created-work-list)
1135           (est-eval-value-as-created-works value))
1136          ((eq format 'unordered-created-work-list)
1137           (est-eval-value-as-created-works value 'unordered-list))
1138          ((eq format 'journal-volume-list)
1139           (est-eval-value-as-journal-volumes value))
1140          ((eq format 'space-separated-daijiten-page-list)
1141           (est-eval-value-as-daijiten-page-list value " "))
1142          ((eq format 'space-separated-Web-yunzi-char-list)
1143           (est-eval-value-as-Web-yunzi-char-list value " "))
1144          (t
1145           (est-eval-value-default value)
1146           ))
1147         ))
1148
1149 (defun est-eval-feature-value (object feature-name
1150                                       &optional format lang uri-object value)
1151   (unless value
1152     (setq value (www-get-feature-value object feature-name)))
1153   (unless format
1154     (setq format (www-feature-value-format feature-name)))
1155   (if (and (consp value)
1156            est-eval-list-feature-items-limit
1157            (not (eq feature-name 'sources)))
1158       (let ((ret (condition-case nil
1159                      (nthcdr est-eval-list-feature-items-limit value)
1160                    (error nil nil))))
1161         (when ret
1162           (setcdr ret
1163                   (list (list 'omitted
1164                               (list :object object :feature feature-name)
1165                               "..."))))))
1166   (cond
1167    ((symbolp format)
1168     (est-eval-apply-value object feature-name
1169                           format nil value
1170                           uri-object)
1171     )
1172    ((consp format)
1173     (cond
1174      ((null (cdr format))
1175       (setq format (car format))
1176       (est-eval-apply-value object feature-name
1177                             (car format) (nth 1 format) value
1178                             uri-object)
1179       )
1180      (t
1181       (est-eval-list format object feature-name lang uri-object)
1182       )))))
1183
1184 (defun est-eval-unit (exp object feature-name
1185                                  &optional lang uri-object value)
1186   (unless value
1187     (setq value (www-get-feature-value object feature-name)))
1188   (unless uri-object
1189     (setq uri-object (www-uri-encode-object object)))
1190   (cond
1191    ((stringp exp) exp)
1192    ((or (characterp exp)
1193         (concord-object-p exp))
1194     (est-eval-value-as-object exp)
1195     )
1196    ((null exp) "")
1197    ((consp exp)
1198     (cond
1199      ((memq (car exp) '(value decimal hex HEX ku-ten
1200                               kangxi-radical shuowen-radical
1201                               S-exp string default
1202                               tify-url-for-ndl hdic-yy-readable))
1203       (let ((fn (plist-get (nth 1 exp) :feature))
1204             domain domain-fn ret)
1205         (when fn
1206           (when (stringp fn)
1207             (setq fn (intern fn)))
1208           (setq domain (char-feature-name-domain feature-name))
1209           (setq domain-fn (char-feature-name-at-domain fn domain))
1210           (if (setq ret (www-get-feature-value object domain-fn))
1211               (setq feature-name domain-fn
1212                     value ret)
1213             (setq feature-name fn
1214                   value (www-get-feature-value object fn)))
1215           (push feature-name chise-wiki-displayed-features)
1216           ))
1217       (if (eq (car exp) 'value)
1218           (est-eval-feature-value object feature-name
1219                                          (plist-get (nth 1 exp) :format)
1220                                          lang uri-object value)
1221         (est-eval-apply-value
1222          object feature-name
1223          (car exp) (nth 1 exp) value
1224          uri-object))
1225       )
1226      ((eq (car exp) 'name)
1227       (let ((fn (plist-get (nth 1 exp) :feature))
1228             domain domain-fn)
1229         (when fn
1230           (setq domain (char-feature-name-domain feature-name))
1231           (when (stringp fn)
1232             (setq fn (intern fn)))
1233           (setq domain-fn (char-feature-name-at-domain fn domain))
1234           (setq feature-name domain-fn)))
1235       (list 'feature-name
1236             (list :object object
1237                   :feature feature-name)
1238             (www-format-feature-name* feature-name lang))
1239       )
1240      ((eq (car exp) 'name-url)
1241       (let ((fn (plist-get (nth 1 exp) :feature))
1242             (object (plist-get (nth 1 exp) :object))
1243             domain domain-fn)
1244         (when fn
1245           (setq domain (char-feature-name-domain feature-name))
1246           (when (stringp fn)
1247             (setq fn (intern fn)))
1248           (setq domain-fn (char-feature-name-at-domain fn domain))
1249           (setq feature-name domain-fn)))
1250       (list 'name-url (list :feature feature-name)
1251             (www-uri-make-feature-name-url
1252              (est-object-genre object)
1253              (www-uri-encode-feature-name feature-name)
1254              uri-object))
1255       )
1256      ((eq (car exp) 'domain-name)
1257       (let ((domain (char-feature-name-domain feature-name)))
1258         (if domain
1259             (format "@%s" domain)
1260           ""))
1261       )
1262      ((eq (car exp) 'omitted)
1263       (list 'omitted
1264             (list :object object :feature feature-name)
1265             "...")
1266       )
1267      ((eq (car exp) 'prev-char)
1268       (list 'prev-char
1269             (list :object object :feature feature-name)
1270             '(input (:type "submit" :value "-")))
1271       )
1272      ((eq (car exp) 'next-char)
1273       (list 'next-char
1274             (list :object object :feature feature-name)
1275             '(input (:type "submit" :value "+")))
1276       )
1277      ((eq (car exp) 'link)
1278       (list 'link
1279             (list :ref
1280                   (est-eval-list (plist-get (nth 1 exp) :ref)
1281                                         object feature-name lang uri-object))
1282             (est-eval-list (nthcdr 2 exp)
1283                                   object feature-name lang uri-object))
1284       )
1285      (t
1286       exp)))))
1287
1288 (defun est-eval-list (format-list object feature-name
1289                                   &optional lang uri-object list-props)
1290   (if (consp format-list)
1291       (let ((ret
1292              (mapcar
1293               (lambda (exp)
1294                 (est-eval-unit exp object feature-name lang uri-object nil))
1295               format-list)))
1296         (if (cdr ret)
1297             (list* 'list list-props ret)
1298           (car ret)))
1299     (est-eval-unit format-list object feature-name lang uri-object nil)))
1300
1301
1302 ;;; @ End.
1303 ;;;
1304
1305 (provide 'est-eval)
1306
1307 ;;; est-eval.el ends here