;; -*- coding: utf-8-mcs-er -*-
(require 'char-db-util)
+(setq file-name-coding-system 'utf-8-mcs-er)
+
+(concord-assign-genre 'creator "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'bibliography "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'era "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'period "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'journal "/usr/local/var/ruimoku/db")
+
(defvar chise-wiki-view-url "view.cgi")
(defvar chise-wiki-edit-url "edit.cgi")
(intern (substring feature-name 0 (match-beginning 0)))
feature)))
-(defun www-char-feature (character feature)
+(defun www-get-feature-value (object feature)
(let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
- (mount-char-attribute-table latest-feature)
- (or (char-feature character latest-feature)
- (char-feature character feature))))
+ (cond
+ ((characterp object)
+ (mount-char-attribute-table latest-feature)
+ (or (char-feature object latest-feature)
+ (char-feature object feature))
+ )
+ (t
+ (or (concord-object-get object latest-feature)
+ (concord-object-get object feature))
+ ))))
(defun get-previous-code-point (ccs code)
(let ((chars (charset-chars ccs))
(format "%s?feature=%s&char=%s"
chise-wiki-view-url uri-feature-name uri-char))
-(defun www-uri-decode-char (char-rep)
+(defun www-uri-decode-object (genre char-rep)
(let (ccs cpos)
(cond
((string-match "\\(%3A\\|:\\)" char-rep)
(string-to-number (substring cpos (match-end 0)) 16))
)
(t
- (setq cpos (string-to-number cpos))
+ (setq cpos (car (read-from-string cpos)))
))
- (if (numberp cpos)
- (decode-char ccs cpos))
+ (if (and (eq genre 'character)
+ (numberp cpos))
+ (decode-char ccs cpos)
+ (concord-decode-object ccs cpos genre))
)
(t
(setq char-rep (decode-uri-string char-rep 'utf-8-mcs-er))
- (when (= (length char-rep) 1)
- (aref char-rep 0))
- ))))
-
-(defun www-uri-encode-char (char)
- (if (encode-char char '=ucs)
- (mapconcat
- (lambda (byte)
- (format "%%%02X" byte))
- (encode-coding-string (char-to-string char) 'utf-8-mcs-er)
- "")
- (let ((ccs-list '(; =ucs
- =cns11643-1 =cns11643-2 =cns11643-3
- =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
- =gb2312 =gb12345
- =jis-x0208 =jis-x0208@1990
- =jis-x0212
- =cbeta =jef-china3
- =jis-x0213-1@2000 =jis-x0213-1@2004
- =jis-x0208@1983 =jis-x0208@1978
- =zinbun-oracle =>zinbun-oracle
- =daikanwa
- =gt =gt-k
- =>>jis-x0208 =>>jis-x0213-1
- =>jis-x0208 =>jis-x0213-1
- =>>gt
- =ruimoku-v6
- =big5
- =big5-cdp))
- ccs ret)
- (while (and ccs-list
- (setq ccs (pop ccs-list))
- (not (setq ret (encode-char char ccs 'defined-only)))))
- (cond (ret
- (format "%s:0x%X"
- (www-uri-encode-feature-name ccs)
- ret))
- ((and (setq ccs (car (split-char char)))
- (setq ret (encode-char char ccs)))
- (format "%s:0x%X"
- (www-uri-encode-feature-name ccs)
- ret))
- (t
- (format "system-char-id:0x%X"
- (encode-char char 'system-char-id))
- )))))
+ (cond
+ ((eq genre 'character)
+ (when (= (length char-rep) 1)
+ (aref char-rep 0))
+ )
+ ((eq genre 'feature)
+ (concord-decode-object
+ '=id (www-uri-decode-feature-name char-rep) 'feature)
+ )
+ (t
+ (concord-decode-object
+ '=id (car (read-from-string char-rep)) genre)
+ ))))))
+
+(defun www-uri-encode-object (object)
+ (if (characterp object)
+ (if (encode-char object '=ucs)
+ (mapconcat
+ (lambda (byte)
+ (format "%%%02X" byte))
+ (encode-coding-string (char-to-string object) 'utf-8-mcs-er)
+ "")
+ (let ((ccs-list '(; =ucs
+ =cns11643-1 =cns11643-2 =cns11643-3
+ =cns11643-4 =cns11643-5 =cns11643-6 =cns11643-7
+ =gb2312 =gb12345
+ =jis-x0208 =jis-x0208@1990
+ =jis-x0212
+ =cbeta =jef-china3
+ =jis-x0213-1@2000 =jis-x0213-1@2004
+ =jis-x0208@1983 =jis-x0208@1978
+ =zinbun-oracle =>zinbun-oracle
+ =daikanwa
+ =gt =gt-k
+ =>>jis-x0208 =>>jis-x0213-1
+ =>jis-x0208 =>jis-x0213-1
+ =>>gt
+ =ruimoku-v6
+ =big5
+ =big5-cdp))
+ ccs ret)
+ (while (and ccs-list
+ (setq ccs (pop ccs-list))
+ (not (setq ret (encode-char object ccs 'defined-only)))))
+ (cond (ret
+ (format "%s:0x%X"
+ (www-uri-encode-feature-name ccs)
+ ret))
+ ((and (setq ccs (car (split-char object)))
+ (setq ret (encode-char object ccs)))
+ (format "%s:0x%X"
+ (www-uri-encode-feature-name ccs)
+ ret))
+ (t
+ (format "system-char-id:0x%X"
+ (encode-char object 'system-char-id))
+ ))))
+ (format "rep.id:%s" (concord-object-id object))))
+
+(defun est-format-object (object)
+ (if (characterp object)
+ (char-to-string object)
+ (format "%s" (concord-object-id object))))
;;; @ Feature name presentation
"%s")
unit)
'without-tags))
- (lambda (unit)
- (if (characterp unit)
- (format "<a href=\"%s?char=%s\">%s</a>"
+ (let (genre-o name-f ret)
+ (lambda (unit)
+ (if (characterp unit)
+ (format "<a href=\"%s?char=%s\">%s</a>"
+ chise-wiki-view-url
+ (www-uri-encode-object unit)
+ (www-format-encode-string (char-to-string unit)))
+ (format "<a href=\"%s?%s=%s\">%s</a>"
chise-wiki-view-url
- (www-uri-encode-char unit)
- (www-format-encode-string (char-to-string unit)))
- (www-format-encode-string (format "%s" unit)))))
+ (concord-object-genre unit)
+ (concord-object-id unit)
+ (cond
+ ((setq ret
+ (www-get-feature-value
+ unit
+ (setq name-f
+ (if (setq genre-o
+ (concord-decode-object
+ '=id
+ (concord-object-genre unit)
+ 'genre))
+ (www-get-feature-value genre-o 'name)
+ 'name))))
+ (www-format-eval-feature-value
+ unit name-f nil nil nil ret
+ 'without-tags 'without-edit)
+ )
+ (t
+ (www-format-encode-string
+ (format "%S" unit))
+ ))
+ unit)))))
value " ")
(www-format-encode-string (format "%s" value) without-tags)))
(if (characterp unit)
(format "<a href=\"%s?char=%s\">%s</a>"
chise-wiki-view-url
- (www-uri-encode-char unit)
+ (www-uri-encode-object unit)
(www-format-encode-string (char-to-string unit)))
(www-format-encode-string (format "%s" unit)))))
(ideographic-structure-to-ids value) " ")
&optional value format
without-tags without-edit)
(unless value
- (setq value (www-char-feature object feature-name)))
+ (setq value (www-get-feature-value object feature-name)))
(www-format-apply-value object feature-name
format nil value nil nil
without-tags without-edit)
(setq char (decode-char 'system-char-id code))
(cond
((and (setq variants
- (or (www-char-feature char '->subsumptive)
- (www-char-feature char '->denotational)))
+ (or (www-get-feature-value char '->subsumptive)
+ (www-get-feature-value char '->denotational)))
(progn
(while (and variants
(setq ret (www-format-encode-string
(delete-region start end)
(insert ret))
)
- ((setq ret (or (www-char-feature char 'ideographic-combination)
- (www-char-feature char 'ideographic-structure)))
+ ((setq ret (or (www-get-feature-value char 'ideographic-combination)
+ (www-get-feature-value char 'ideographic-structure)))
(setq ret
(mapconcat
(lambda (ch)
(defun www-format-apply-value (object feature-name
format props value
- &optional uri-char uri-feature
+ &optional uri-object uri-feature
without-tags without-edit)
(let (ret)
(setq ret
((eq format 'wiki-text)
(if without-tags
(www-xml-format-list value)
- (www-format-eval-list value object feature-name nil uri-char
+ (www-format-eval-list value object feature-name nil uri-object
without-tags without-edit))
)
((eq format 'S-exp)
><input type=\"submit\" value=\"edit\" /></a>"
ret
chise-wiki-edit-url
- uri-char uri-feature format))))
+ uri-object uri-feature format))))
-(defun www-format-eval-feature-value (char
+(defun www-format-eval-feature-value (object
feature-name
- &optional format lang uri-char value
+ &optional format lang uri-object value
without-tags without-edit)
(unless value
- (setq value (www-char-feature char feature-name)))
+ (setq value (www-get-feature-value object feature-name)))
(unless format
(setq format (www-feature-value-format feature-name)))
(cond
((symbolp format)
(www-format-apply-value
- char feature-name
+ object feature-name
format nil value
- uri-char (www-uri-encode-feature-name feature-name)
+ uri-object (www-uri-encode-feature-name feature-name)
without-tags without-edit)
)
((consp format)
(cond ((null (cdr format))
(setq format (car format))
(www-format-apply-value
- char feature-name
+ object feature-name
(car format) (nth 1 format) value
- uri-char (www-uri-encode-feature-name feature-name)
+ uri-object (www-uri-encode-feature-name feature-name)
without-tags without-edit)
)
(t
- (www-format-eval-list format char feature-name lang uri-char
+ (www-format-eval-list format object feature-name lang uri-object
without-tags without-edit)
)))))
-(defun www-format-eval-unit (exp char feature-name
- &optional lang uri-char value
+(defun www-format-eval-unit (exp object feature-name
+ &optional lang uri-object value
without-tags without-edit)
(unless value
- (setq value (www-char-feature char feature-name)))
- (unless uri-char
- (setq uri-char (www-uri-encode-char char)))
+ (setq value (www-get-feature-value object feature-name)))
+ (unless uri-object
+ (setq uri-object (www-uri-encode-object object)))
(cond
((stringp exp) (www-format-encode-string exp))
((null exp) "")
(setq fn (intern fn)))
(setq domain (char-feature-name-domain feature-name))
(setq domain-fn (char-feature-name-at-domain fn domain))
- (if (setq ret (www-char-feature char domain-fn))
+ (if (setq ret (www-get-feature-value object domain-fn))
(setq feature-name domain-fn
value ret)
(setq feature-name fn
- value (www-char-feature char fn)))
+ value (www-get-feature-value object fn)))
(push feature-name chise-wiki-displayed-features)
))
(if (eq (car exp) 'value)
- (www-format-eval-feature-value char feature-name
+ (www-format-eval-feature-value object feature-name
(plist-get (nth 1 exp) :format)
- lang uri-char value
+ lang uri-object value
without-tags without-edit)
(www-format-apply-value
- char feature-name
+ object feature-name
(car exp) (nth 1 exp) value
- uri-char (www-uri-encode-feature-name feature-name)
+ uri-object (www-uri-encode-feature-name feature-name)
without-tags without-edit))
)
((eq (car exp) 'name)
(format "<a href=\"%s\">%s</a>"
(www-uri-make-feature-name-url
(www-uri-encode-feature-name feature-name)
- uri-char)
+ uri-object)
(www-format-feature-name feature-name lang))
)
)
(setq feature-name domain-fn)))
(www-uri-make-feature-name-url
(www-uri-encode-feature-name feature-name)
- uri-char)
+ uri-object)
)
((eq (car exp) 'domain-name)
(let ((domain (char-feature-name-domain feature-name)))
(if prev-char
(format "\n<a href=\"%s?char=%s\">%s</a>"
chise-wiki-view-url
- (www-uri-encode-char prev-char)
+ (www-uri-encode-object prev-char)
"<input type=\"submit\" value=\"-\" />"
;; (www-format-encode-string
;; (char-to-string prev-char))
(if next-char
(format "<a href=\"%s?char=%s\">%s</a>"
chise-wiki-view-url
- (www-uri-encode-char next-char)
+ (www-uri-encode-object next-char)
"<input type=\"submit\" value=\"+\" />"
;; (www-format-encode-string
;; (char-to-string next-char))
((eq (car exp) 'link)
(if without-tags
(www-format-eval-list (nthcdr 2 exp)
- char feature-name lang uri-char
+ object feature-name lang uri-object
without-tags without-edit)
(format "<a
href=\"%s\"
>%s</a
>"
(www-format-eval-list (plist-get (nth 1 exp) :ref)
- char feature-name lang uri-char
+ object feature-name lang uri-object
'without-tags 'without-edit)
(www-format-eval-list (nthcdr 2 exp)
- char feature-name lang uri-char
+ object feature-name lang uri-object
without-tags without-edit)))
)
(t
>%s</%s
>"
(car exp)
- (www-format-eval-list (nthcdr 2 exp) char feature-name
- lang uri-char
+ (www-format-eval-list (nthcdr 2 exp) object feature-name
+ lang uri-object
without-tags without-edit)
(car exp)))))))
-(defun www-format-eval-list (format-list char feature-name
- &optional lang uri-char
+(defun www-format-eval-list (format-list object feature-name
+ &optional lang uri-object
without-tags without-edit)
(if (consp format-list)
(mapconcat
(lambda (exp)
- (www-format-eval-unit exp char feature-name lang uri-char
+ (www-format-eval-unit exp object feature-name lang uri-object
nil without-tags without-edit))
format-list "")
- (www-format-eval-unit format-list char feature-name lang uri-char
+ (www-format-eval-unit format-list object feature-name lang uri-object
nil without-tags without-edit)))
projects / chise / est.git / blobdiff