- Assign new genres `morpheme-entry@zh-classical',

[chise/est.git] / est-eval.el

diff --git a/est-eval.el b/est-eval.el
index d3844c0..fb850d1 100644 (file)
--- a/est-eval.el
+++ b/est-eval.el
@@ -103,36 +103,44 @@
 ;;         (t nil)
 ;;         ))
 
-(defun est-eval-value-as-journal-volume (value)
+(defun est-eval-value-as-journal-volume (value &optional short)
   (let ((journal (car (or (concord-object-get value '<-journal/volume)
                          (concord-object-get value '<-volume))))
+       (vol-name (concord-object-get value '<-journal/volume*name))
        volume-type number-type
        year
        dest ret title subtitle)
     (cond
      (journal
-      (setq volume-type (concord-object-get journal 'volume/type/code)
-           number-type (concord-object-get journal 'number/type/code))
-      (setq year (or (concord-object-get value '->published/date*year)
-                    (concord-object-get
-                     (car (concord-object-get value 'date)) 'year)))
-      (setq dest
-           (list
-            (list 'object
-                  (list :object value)
-                  (ruimoku-format-volume
-                   volume-type
-                   (or (concord-object-get value '<-journal/volume*volume)
-                       (concord-object-get value '<-volume*volume))
-                   year 'cjk)
-                  (ruimoku-format-volume
-                   number-type
-                   (or (concord-object-get value '<-journal/volume*number)
-                       (concord-object-get value '<-volume*number))
-                   year 'cjk))))
-      (if (setq ret (est-eval-value-as-object journal))
+      (if vol-name
          (setq dest
-               (list* ret " " dest)))
+               (list
+                (list 'object (list :object value)
+                      vol-name)))
+       (setq volume-type (concord-object-get journal 'volume/type/code)
+             number-type (concord-object-get journal 'number/type/code))
+       (setq year (or (concord-object-get value '->published/date*year)
+                      (concord-object-get
+                       (car (concord-object-get value 'date)) 'year)))
+       (setq dest
+             (list
+              (list 'object
+                    (list :object value)
+                    (ruimoku-format-volume
+                     volume-type
+                     (or (concord-object-get value '<-journal/volume*volume)
+                         (concord-object-get value '<-volume*volume))
+                     year 'cjk)
+                    (ruimoku-format-volume
+                     number-type
+                     (or (concord-object-get value '<-journal/volume*number)
+                         (concord-object-get value '<-volume*number))
+                     year 'cjk))))
+       )
+      (unless short
+       (if (setq ret (est-eval-value-as-object journal))
+           (setq dest
+                 (list* ret " " dest))))
       (list* 'list '(:subtype sequence :separator "") dest)
       )
      ((setq title (concord-object-get value 'title))
@@ -362,7 +370,7 @@
 (defun est-eval-value-as-object-list (value &optional separator subtype)
   (if (and (listp value)
           (listp (cdr value)))
-      (condition-case err
+      (condition-case nil
          (let (props)
            (if separator
                (setq props (list :separator separator)))
@@ -370,7 +378,7 @@
                (setq props (list* :subtype subtype props)))
            (list* 'list props
                   (mapcar #'est-eval-value-as-object value)))
-       (error err (format "%s" value)))
+       (error (format "%s" value)))
     (format "%s" value)))
 
 (defun est-eval-value-as-ids (value)
@@ -489,20 +497,23 @@
                   '(:subtype unordered-list)
                 '(:separator " "))
               (mapcar (lambda (creator)
-                        (setq role-name
-                              (concord-object-get creator
-                                                  'role*name))
-                        (est-eval-list
-                         (list
-                          '(value (:feature ->creator/name))
-                          (list
-                           'object (list :object creator)
-                           (or role-name
-                               (format "(%s)"
-                                       (concord-object-get creator
-                                                           'role*type)))))
-                         creator nil)
-                        )
+                        (cond
+                         ((concord-object-p creator)
+                          (setq role-name
+                                (concord-object-get
+                                 creator 'role*name))
+                          (est-eval-list
+                           (list
+                            '(value (:feature ->creator/name))
+                            (list
+                             'object (list :object creator)
+                             (or role-name
+                                 (format "(%s)"
+                                         (concord-object-get creator
+                                                             'role*type)))))
+                           creator nil)
+                          )
+                         (t creator)))
                       value)
               ))
     (est-eval-value-default value)))
@@ -520,6 +531,19 @@
                     value))
     (est-eval-value-default value)))
 
+(defun est-eval-value-as-journal-volumes (value &optional subtype)
+  (if (listp value)
+      (list* 'journal-volumes
+            (if subtype
+                '(:subtype unordered-list)
+              '(:separator " "))
+            (mapcar (lambda (volume)
+                      (if (concord-object-p volume)
+                          (est-eval-value-as-journal-volume volume 'short)
+                        volume))
+                    value))
+    (est-eval-value-default value)))
+
 
 ;;; @ format evaluator
 ;;;
@@ -607,6 +631,8 @@
          (est-eval-value-as-created-works value))
         ((eq format 'unordered-created-work-list)
          (est-eval-value-as-created-works value 'unordered-list))
+        ((eq format 'journal-volume-list)
+         (est-eval-value-as-journal-volumes value))
         (t
          (est-eval-value-default value)
          ))
@@ -620,7 +646,7 @@
     (setq format (www-feature-value-format feature-name)))
   (if (consp value)
       (let ((ret (condition-case nil
-                    (nthcdr 127 value)
+                    (nthcdr 255 value)
                   (error nil nil))))
        (when ret
          (setcdr ret