- Assign new genres `morpheme-entry@zh-classical',
[chise/est.git] / est-eval.el
index 748197a..fb850d1 100644 (file)
        ((eq spec 01) (concat value "期"))
        ((eq spec 02) (concat value "巻"))
        ((eq spec 03) (concat value "号"))
-       ((eq spec 04) (concat value "&GT-35694;"))
+       ((eq spec 04) (concat value "編"))
        ((eq spec 05) (concat value "&GT-33870;"))
-       ((eq spec 06) (concat value "&GT-56392;"))
+       ((eq spec 06) (concat value "集"))
        ((eq spec 07) (concat value "輯"))
        ((eq spec 08) (concat value "&GT-53119;"))
-       ((eq spec 09) (concat value "&GT-53119;&AJ1-03580;"))
+       ((eq spec 09) (concat value "&GT-53119;分"))
        ((eq spec 10) (concat value "冊"))
-       ((eq spec 11) (concat value "&AJ1-03580;冊"))
+       ((eq spec 11) (concat value "分冊"))
        ((eq spec 12) (concat value "&J90-3C21;"))
        ((eq spec 13) (concat value "&GT-18140;号"))
        ((eq spec 14) (concat value "特&GT-56392;号"))
        ((eq spec 15) (concat value "本"))
-       ((eq spec 16) (concat value "&AJ1-03580;"))
+       ((eq spec 16) (concat value "分"))
        ((eq spec 51) (concat "Vol." value))
        ((eq spec 52) (concat "No." value))
        ((eq spec 53) (concat "Part " value))
 ;;         ((string= spec "06") `((decimal (:feature ,feature)) "&GT-56392;"))
 ;;         ((string= spec "07") `((decimal (:feature ,feature)) "輯"))
 ;;         ((string= spec "08") `((decimal (:feature ,feature)) "&GT-53119;"))
-;;         ((string= spec "09") `((decimal (:feature ,feature)) "&GT-53119;&AJ1-03580;"))
+;;         ((string= spec "09") `((decimal (:feature ,feature)) "&GT-53119;分"))
 ;;         ((string= spec "10") `((decimal (:feature ,feature)) "冊"))
-;;         ((string= spec "11") `((decimal (:feature ,feature)) "&AJ1-03580;冊"))
+;;         ((string= spec "11") `((decimal (:feature ,feature)) "分冊"))
 ;;         ((string= spec "12") `((decimal (:feature ,feature)) "&J90-3C21;"))
 ;;         ((string= spec "13") `((decimal (:feature ,feature)) "&GT-18140;号"))
 ;;         ((string= spec "14") `((decimal (:feature ,feature)) "特&GT-56392;号"))
 ;;         ((string= spec "15") `((decimal (:feature ,feature)) "本"))
-;;         ((string= spec "16") `((decimal (:feature ,feature)) "&AJ1-03580;"))
+;;         ((string= spec "16") `((decimal (:feature ,feature)) "分"))
 ;;         ((string= spec "51") `("Vol." ((decimal (:feature ,feature)))))
 ;;         ((string= spec "52") `("No." ((decimal (:feature ,feature)))))
 ;;         ((string= spec "53") `("Part " ((decimal (:feature ,feature)))))
 ;;         (t nil)
 ;;         ))
 
-(defun est-eval-value-as-journal-volume (value)
-  (let ((journal (car (concord-object-get value '<-volume)))
+(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)
-    (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)))
-    ;; (append (list (concord-object-get journal 'name))
-    ;;         (est-journal-volume-object-get-volume-format
-    ;;          volume-type '<-volume*volume)
-    ;;         (est-journal-volume-object-get-volume-format
-    ;;          number-type '<-volume*number)
-    ;;         )
-    (concat (concord-object-get journal 'name)
-           " "
-           (ruimoku-format-volume
-            volume-type
-            (concord-object-get value '<-volume*volume)
-            year 'cjk)
-           (ruimoku-format-volume
-            number-type
-            (concord-object-get value '<-volume*number)
-            year 'cjk))
+       year
+       dest ret title subtitle)
+    (cond
+     (journal
+      (if vol-name
+         (setq 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))
+      (setq subtitle (concord-object-get value 'title/subtitle))
+      (list* 'object
+             (list :object value)
+             (if (eq (concord-object-get value 'writing-system) 'cjk)
+                 (list
+                  "「"
+                  (list 'object (list :object value)
+                        (if subtitle
+                            (concat title " — " subtitle)
+                          title))
+                  "」")
+               (list
+                " ‘"
+                (list 'object (list :object value)
+                      (if subtitle
+                          (concat title " — " subtitle)
+                        title))
+                "’")))
+      )
+     (t
+      (est-eval-value-default value)
+      ))
+    ;; (concat (concord-object-get journal 'name)
+    ;;         " "
+    ;;         (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))
     ))
 
 (defun est-eval-value-as-article (value)
-  (let ((creators (concord-object-get value '->creator))
-       (title (concord-object-get value 'title))
-       creator-name creator-role)
-    (concat
-     (mapconcat
-      (lambda (creator)
-       (setq creator-name
-             (concord-object-get
-              (car (concord-object-get creator '->creator/name))
-              '=name))
-       (setq creator-role
-             (or (concord-object-get creator 'role*name)
-                 (format "(%s)"
-                         (concord-object-get creator 'role*type))))
-       (concat creator-name " " creator-role))
-      creators ", ")
-     (if (eq (concord-object-get value 'writing-system) 'cjk)
-        (concat  "「" title "」")
-       (concat " ‘" title "’")))))
+  (let ((journal-volume (car (concord-object-get value '<-article)))
+       (page (concord-object-get value 'page))
+       date ret dest)
+    (when journal-volume
+      (setq date (car (concord-object-get journal-volume 'date)))
+      (if (and date
+              (setq ret (est-eval-value-as-object date)))
+         (setq dest (list ", " ret))))
+    (if page
+       (setq dest (list* ", pp." page dest)))
+    (when (and journal-volume
+              (setq ret (est-eval-value-as-journal-volume journal-volume)))
+      (setq dest (cons ret dest)))
+    (if (setq ret (est-eval-value-as-book value))
+       (setq dest (list* ret " " dest)))
+    (list* 'list '(:subtype sequence :separator "") dest))
+  ;; (let ((creators (concord-object-get value '->creator))
+  ;;       (title (concord-object-get value 'title))
+  ;;       creator-name creator-role)
+  ;;   (concat
+  ;;    (mapconcat
+  ;;     (lambda (creator)
+  ;;       (setq creator-name
+  ;;             (concord-object-get
+  ;;              (car (concord-object-get creator '->creator/name))
+  ;;              '=name))
+  ;;       (setq creator-role
+  ;;             (or (concord-object-get creator 'role*name)
+  ;;                 (format "(%s)"
+  ;;                         (concord-object-get creator 'role*type))))
+  ;;       (concat creator-name " " creator-role))
+  ;;     creators ", ")
+  ;;    (if (eq (concord-object-get value 'writing-system) 'cjk)
+  ;;        (concat  "「" title "」")
+  ;;      (concat " ‘" title "’"))))
+  )
 
 (defun est-eval-value-as-book (value)
   (let ((creators (concord-object-get value '->creator))
        (series (concord-object-get value 'series))
        (publisher (car (concord-object-get value 'publisher)))
        (date (car (concord-object-get value 'date)))
-       creator-name creator-role)
-    (concat
-     (mapconcat
-      (lambda (creator)
-       (setq creator-name
-             (concord-object-get
-              (car (concord-object-get creator '->creator/name))
-              '=name))
-       (setq creator-role
-             (or (concord-object-get creator 'role*name)
-                 (format "(%s)"
-                         (concord-object-get creator 'role*type))))
-       (concat creator-name " " creator-role))
-      creators ", ")
-     (if (eq (concord-object-get value 'writing-system) 'cjk)
-        (concat  "「" title
-                 (if subtitle
-                     (concat " — " subtitle))
-                 "」")
-       (concat " ‘" title
-              (if subtitle
-                  (concat " — " subtitle))
-              "’"))
-     (if series
-        (concat " " series))
-     (if publisher
-        (concat ", "
-                (concord-object-get
-                 (car (concord-object-get
-                       publisher '->publisher/name))
-                 '=name)))
-     (if date
-        (concat ", " (concord-object-get date 'name))))))
+        ;; creator-name creator-role
+       dest ret)
+    (if (and date
+            (setq ret (est-eval-value-as-object date)))
+       (setq dest (list ", " ret)))
+    (if (and publisher
+            (setq ret (est-eval-value-as-object publisher)))
+       (setq dest (list* " " ret dest)))
+    (if series
+       (setq dest (list* series "," dest)))
+    (setq dest
+         (if title
+             (if (eq (concord-object-get value 'writing-system) 'cjk)
+                 (list*
+                  "「"
+                (list 'object (list :object value)
+                      (if subtitle
+                          (concat title " — " subtitle)
+                        title))
+                "」" dest)
+             (list*
+              " ‘"
+              (list 'object (list :object value)
+                    (if subtitle
+                        (concat title " — " subtitle)
+                      title))
+              "’" dest))
+           (list* " "
+                  (list 'object (list :object value)
+                        "(review)")
+                  dest)))
+    (when (and creators
+              (setq ret (est-eval-value-as-creators-names creators)))
+      (setq dest (cons ret dest)))
+    (list* 'list '(:subtype sequence :separator "") dest)
+    ;; (concat
+    ;;  (mapconcat
+    ;;   (lambda (creator)
+    ;;     (setq creator-name
+    ;;           (concord-object-get
+    ;;            (car (concord-object-get creator '->creator/name))
+    ;;            '=name))
+    ;;     (setq creator-role
+    ;;           (or (concord-object-get creator 'role*name)
+    ;;               (format "(%s)"
+    ;;                       (concord-object-get creator 'role*type))))
+    ;;     (concat creator-name " " creator-role))
+    ;;   creators ", ")
+    ;;  (if (eq (concord-object-get value 'writing-system) 'cjk)
+    ;;      (concat  "「" title
+    ;;               (if subtitle
+    ;;                   (concat " — " subtitle))
+    ;;               "」")
+    ;;    (concat " ‘" title
+    ;;            (if subtitle
+    ;;                (concat " — " subtitle))
+    ;;            "’"))
+    ;;  (if series
+    ;;      (concat " " series))
+    ;;  (if publisher
+    ;;      (concat ", "
+    ;;              (concord-object-get
+    ;;               (car (concord-object-get
+    ;;                     publisher '->publisher/name))
+    ;;               '=name)))
+    ;;  (if date
+    ;;      (concat ", " (concord-object-get date 'name)))))
+    ))
 
 ;; (defun est-eval-creator (value)
 ;;   (est-eval-list
 (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)))
                (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)
                   '(: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)))
                     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
 ;;;
          (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)
          ))
     (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