X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=est-eval.el;h=fb850d1208543e238a18643c0d35c8265bb54976;hb=47b3fa0b20323de9304bd8f603704ab65666e84e;hp=fcd2b522e4dd437cc8b22cc0d86004580377f453;hpb=b7274f848e9537da90420b6a04acf9877e18e3a2;p=chise%2Fest.git diff --git a/est-eval.el b/est-eval.el index fcd2b52..fb850d1 100644 --- a/est-eval.el +++ b/est-eval.el @@ -11,19 +11,19 @@ ((eq spec 01) (concat value "期")) ((eq spec 02) (concat value "巻")) ((eq spec 03) (concat value "号")) - ((eq spec 04) (concat value ">-35694;")) + ((eq spec 04) (concat value "編")) ((eq spec 05) (concat value ">-33870;")) - ((eq spec 06) (concat value ">-56392;")) + ((eq spec 06) (concat value "集")) ((eq spec 07) (concat value "輯")) ((eq spec 08) (concat value ">-53119;")) - ((eq spec 09) (concat value ">-53119;&AJ1-03580;")) + ((eq spec 09) (concat value ">-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 ">-18140;号")) ((eq spec 14) (concat value "特>-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)) @@ -76,14 +76,14 @@ ;; ((string= spec "06") `((decimal (:feature ,feature)) ">-56392;")) ;; ((string= spec "07") `((decimal (:feature ,feature)) "輯")) ;; ((string= spec "08") `((decimal (:feature ,feature)) ">-53119;")) -;; ((string= spec "09") `((decimal (:feature ,feature)) ">-53119;&AJ1-03580;")) +;; ((string= spec "09") `((decimal (:feature ,feature)) ">-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)) ">-18140;号")) ;; ((string= spec "14") `((decimal (:feature ,feature)) "特>-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))))) @@ -103,31 +103,195 @@ ;; (t nil) ;; )) -(defun est-eval-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 ((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)) + (title (concord-object-get value 'title)) + (subtitle (concord-object-get value 'title/subtitle)) + (series (concord-object-get value 'series)) + (publisher (car (concord-object-get value 'publisher))) + (date (car (concord-object-get value 'date))) + ;; 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) @@ -150,7 +314,13 @@ ;; (est-eval-list ;; (est-journal-volume-get-object-format value) ;; value nil) - (est-eval-journal-volume value) + (est-eval-value-as-journal-volume value) + ) + ((eq genre 'article@ruimoku) + (est-eval-value-as-article value) + ) + ((eq genre 'book@ruimoku) + (est-eval-value-as-book value) ) ;; ((eq genre 'creator@ruimoku) ;; (est-eval-creator value) @@ -197,19 +367,18 @@ (format "%c" (ideographic-radical value))) (est-eval-value-as-S-exp value))) -(defun est-eval-value-as-object-list (value &optional separator) - (if (listp value) - (list* 'list - (if separator - (list :separator separator)) - ;; (mapcar - ;; (lambda (unit) - ;; (if (characterp unit) - ;; (list 'char-link nil (format "%c" unit)) - ;; (format "%s" unit))) - ;; value) - (mapcar #'est-eval-value-as-object value) - ) +(defun est-eval-value-as-object-list (value &optional separator subtype) + (if (and (listp value) + (listp (cdr value))) + (condition-case nil + (let (props) + (if separator + (setq props (list :separator separator))) + (if subtype + (setq props (list* :subtype subtype props))) + (list* 'list props + (mapcar #'est-eval-value-as-object value))) + (error (format "%s" value))) (format "%s" value))) (defun est-eval-value-as-ids (value) @@ -320,34 +489,41 @@ value))) (est-eval-value-default value))) -(defun est-eval-value-as-creators-names (value) +(defun est-eval-value-as-creators-names (value &optional subtype) (if (listp value) (let (role-name) (list* 'creator-name - '(:separator " ") + (if subtype + '(: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))) -(defun est-eval-value-as-created-works (value) +(defun est-eval-value-as-created-works (value &optional subtype) (if (listp value) (list* 'creator-name - '(:separator " ") + (if subtype + '(:subtype unordered-list) + '(:separator " ")) (mapcar (lambda (creator) (est-eval-list '((value (:feature <-creator))) @@ -355,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 ;;; @@ -428,14 +617,22 @@ ((or (eq format 'space-separated) (eq format 'space-separated-char-list)) (est-eval-value-as-object-list value " ")) + ((eq format 'unordered-list) + (est-eval-value-as-object-list value nil 'unordered-list)) ((eq format 'space-separated-ids) (est-eval-value-as-space-separated-ids value)) ((eq format 'space-separated-domain-list) (est-eval-value-as-domain-list value)) ((eq format 'space-separated-creator-name-list) (est-eval-value-as-creators-names value)) + ((eq format 'unordered-creator-name-list) + (est-eval-value-as-creators-names value 'unordered-list)) ((eq format 'space-separated-created-work-list) (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) )) @@ -449,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