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