X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-common.el;h=2973231b23b80f79fe05fb139db482a0fb759d66;hb=02a70bfe16c5c0ca3f707b262ed9b436ba678d36;hp=53749f971a8d7c63e446d676b52bef92e8372037;hpb=e9093fddf7fd668ec776cd306987cf63e454ef88;p=chise%2Fest.git
diff --git a/cwiki-common.el b/cwiki-common.el
index 53749f9..2973231 100644
--- a/cwiki-common.el
+++ b/cwiki-common.el
@@ -3,20 +3,35 @@
(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")
+
+(concord-assign-genre 'creator@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'person-name@ruimoku "/usr/local/var/ruimoku/db")
+
+(concord-assign-genre 'journal-volume@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'article@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'book@ruimoku "/usr/local/var/ruimoku/db")
+
+(concord-assign-genre 'classification@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'region@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'era@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'period@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'journal@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'journal-name@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'publisher@ruimoku "/usr/local/var/ruimoku/db")
+(concord-assign-genre 'publisher-name@ruimoku "/usr/local/var/ruimoku/db")
+
+(mount-char-attribute-table 'instance@ruimoku/bibliography/title)
+;; (mount-char-attribute-table 'instance@ruimoku/bibliography/content*note)
+
(defvar chise-wiki-view-url "view.cgi")
(defvar chise-wiki-edit-url "edit.cgi")
(defvar chise-wiki-bitmap-glyphs-url
- "http://chise.zinbun.kyoto-u.ac.jp/glyphs")
+ "http://www.chise.org/glyphs")
(defvar chise-wiki-glyph-cgi-url
- "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
+ "http://www.chise.org/chisewiki/glyph.cgi")
(defvar chise-wiki-displayed-features nil)
@@ -81,7 +96,7 @@
ret)
(let ((type (www-feature-type feature-name)))
(cond ((eq type 'relation)
- 'space-separated-char-list)
+ 'space-separated)
((eq type 'structure)
'space-separated-ids)
((eq type 'stext)
@@ -92,7 +107,8 @@
(= (charset-chars feature-name) 94))
'("0x" (HEX)
" (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char))
- '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))))
+ '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))
+ 'space-separated))
(defun char-feature-name-at-domain (feature-name domain)
(if domain
@@ -122,6 +138,11 @@
(intern (substring feature-name 0 (match-beginning 0)))
feature)))
+(defun est-object-genre (object)
+ (if (characterp object)
+ 'character
+ (concord-object-genre object)))
+
(defun www-get-feature-value (object feature)
(let ((latest-feature (char-feature-name-at-domain feature '$rev=latest)))
(cond
@@ -131,8 +152,12 @@
(char-feature object feature))
)
(t
- (or (concord-object-get object latest-feature)
- (concord-object-get object feature))
+ (or (condition-case nil
+ (concord-object-get object latest-feature)
+ (error nil))
+ (condition-case nil
+ (concord-object-get object feature)
+ (error nil)))
))))
(defun get-previous-code-point (ccs code)
@@ -266,6 +291,7 @@
(defun www-uri-decode-feature-name (uri-feature)
(let (feature)
+ (setq uri-feature (decode-uri-string uri-feature 'utf-8-mcs-er))
(cond
((string-match "^from\\." uri-feature)
(intern (format "<-%s" (substring uri-feature (match-end 0))))
@@ -289,6 +315,9 @@
?>)
(substring uri-feature (match-end 0))))
)
+ ((string-match "^o\\." uri-feature)
+ (intern (format "=+>%s" (substring uri-feature (match-end 0))))
+ )
((string-match "^a\\." uri-feature)
(intern (format "=>%s" (substring uri-feature (match-end 0))))
)
@@ -316,6 +345,9 @@
(defun www-uri-encode-feature-name (feature-name)
(setq feature-name (symbol-name feature-name))
(cond
+ ((string-match "^=\\+>\\([^=>]+\\)" feature-name)
+ (concat "o." (substring feature-name (match-beginning 1)))
+ )
((string-match "^=\\([^=>]+\\)" feature-name)
(concat "rep." (substring feature-name (match-beginning 1)))
)
@@ -346,9 +378,9 @@
)
(t feature-name)))
-(defun www-uri-make-feature-name-url (uri-feature-name uri-char)
- (format "%s?feature=%s&char=%s"
- chise-wiki-view-url uri-feature-name uri-char))
+(defun www-uri-make-feature-name-url (uri-genre uri-feature-name uri-object)
+ (format "%s?feature=%s&%s=%s"
+ chise-wiki-view-url uri-feature-name uri-genre uri-object))
(defun www-uri-decode-object (genre char-rep)
(let (ccs cpos)
@@ -363,7 +395,9 @@
(string-to-number (substring cpos (match-end 0)) 16))
)
(t
- (setq cpos (car (read-from-string cpos)))
+ (setq cpos (car (read-from-string
+ (decode-uri-string
+ cpos file-name-coding-system))))
))
(if (and (eq genre 'character)
(numberp cpos))
@@ -386,55 +420,81 @@
'=id (car (read-from-string char-rep)) genre)
))))))
-(defun www-uri-encode-char (char)
- (if (characterp char)
- (if (encode-char char '=ucs)
+(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 char) 'utf-8-mcs-er)
+ (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-x0213-2
=jis-x0212
+ =adobe-japan1
=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
+ =>>>adobe-japan1
+ =>>>jis-x0208 =>>>jis-x0213-1 =>>>jis-x0213-2
+ =>>jis-x0208 =>>jis-x0213-1 =>>jis-x0213-2
+ =>>adobe-japan1
+ =+>jis-x0208 =+>jis-x0213-1 =+>jis-x0213-2
+ =+>jis-x0208@1978
+ =+>adobe-japan1
=>jis-x0208 =>jis-x0213-1
=>>gt
+ =>ucs@iso =>ucs@unicode
+ =>ucs@jis =>ucs@cns =>ucs@ks
+ =>>ucs@iso =>>ucs@unicode
+ =>>ucs@jis =>>ucs@cns =>>ucs@ks
+ =>>>ucs@iso =>>>ucs@unicode
+ =>>>ucs@jis =>>>ucs@cns =>>>ucs@ks
=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)))))
+ (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 char)))
- (setq ret (encode-char char ccs)))
+ ((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 char 'system-char-id))
+ (encode-char object 'system-char-id))
))))
- (format "rep.id:%s" (concord-object-id char))))
+ (format "rep.id:%s" (concord-object-id object))))
-(defun est-format-object (object)
+(defun est-format-object (object &optional readable)
(if (characterp object)
(char-to-string object)
- (format "%s" (concord-object-id object))))
+ (let ((ret (or (if readable
+ (or (concord-object-get object 'name)
+ (concord-object-get object '=name)
+ (concord-object-get object 'title)))
+ (concord-object-id object))))
+ (format "%s" ret))))
+
+(defun www-uri-make-object-url (object &optional uri-object)
+ (format "%s?%s=%s"
+ chise-wiki-view-url
+ (est-object-genre object)
+ (or uri-object
+ (www-uri-encode-object object))))
;;; @ Feature name presentation
@@ -530,197 +590,19 @@
(www-format-feature-name* feature-name lang)))
-;;; @ Feature value presentation
+;;; @ HTML generator
;;;
-(defun www-format-value-as-kuten (value)
- (format "%02d-%02d"
- (- (lsh value -8) 32)
- (- (logand value 255) 32)))
-
-(defun www-format-value-default (value &optional without-tags)
- (if (listp value)
- (mapconcat
- (lambda (unit)
- (www-format-encode-string
- (format "%S" unit)
- without-tags))
- value " ")
- (www-format-encode-string (format "%S" value) without-tags)))
-
-(defun www-format-value-as-char-list (value &optional without-tags)
- (if (listp value)
- (mapconcat
- (if without-tags
- (lambda (unit)
- (www-format-encode-string
- (format (if (characterp unit)
- "%c"
- "%s")
- unit)
- 'without-tags))
- (let (genre-o name-f ret)
- (lambda (unit)
- (if (characterp unit)
- (format "%s"
- chise-wiki-view-url
- (www-uri-encode-char unit)
- (www-format-encode-string (char-to-string unit)))
- (format "%s"
- chise-wiki-view-url
- (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)))
-
-(defun www-format-value-as-domain-list (value &optional without-tags)
- (let (name source0 source num dest rest unit start end ddest)
- (if (listp value)
- (if without-tags
- (mapconcat
- (lambda (unit)
- (format "%s" unit))
- value " ")
- (setq rest value)
- (while rest
- (setq unit (pop rest))
- (if (symbolp unit)
- (setq name (symbol-name unit)))
- (setq dest
- (concat
- dest
- (cond
- ((string-match "^zob1968=" name)
- (setq source (intern (substring name 0 (match-end 0)))
- num (substring name (match-end 0)))
- (if (string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" num)
- (setq start (string-to-number
- (match-string 1 num))
- end (string-to-number
- (match-string 2 num)))
- (setq start (string-to-number num)
- end start))
- (setq ddest
- (if (eq source source0)
- (format
- ", %04d"
- start start)
- (setq source0 source)
- (format
- " %s=%04d"
- (www-format-encode-string "\u4EAC大人\u6587ç ç²\u9AA8")
- start start)))
- (setq start (1+ start))
- (while (<= start end)
- (setq ddest
- (concat
- ddest
- (format
- ", %04d"
- start start)))
- (setq start (1+ start)))
- ddest)
- (t
- (setq source unit)
- (if (eq source source0)
- ""
- (setq source0 source)
- (concat " " name))
- )))))
- dest)
- (www-format-encode-string (format "%s" value) without-tags))))
-
-(defun www-format-value-as-ids (value &optional without-tags)
- (if (listp value)
- (mapconcat
- (if without-tags
- (lambda (unit)
- (www-format-encode-string
- (format (if (characterp unit)
- "%c"
- "%s")
- unit)
- 'without-tags))
- (lambda (unit)
- (if (characterp unit)
- (format "%s"
- chise-wiki-view-url
- (www-uri-encode-char unit)
- (www-format-encode-string (char-to-string unit)))
- (www-format-encode-string (format "%s" unit)))))
- (ideographic-structure-to-ids value) " ")
- (www-format-encode-string (format "%s" value) without-tags)))
-
-(defun www-format-value-as-S-exp (value &optional without-tags)
- (www-format-encode-string (format "%S" value) without-tags))
-
-(defun www-format-value-as-HEX (value)
- (if (integerp value)
- (format "%X" value)
- (www-format-value-as-S-exp value)))
-
-(defun www-format-value-as-CCS-default (value)
- (if (integerp value)
- (format "0x%s (%d)"
- (www-format-value-as-HEX value)
- value)
- (www-format-value-as-S-exp value)))
-
-(defun www-format-value-as-CCS-94x94 (value)
- (if (integerp value)
- (format "0x%s [%s] (%d)"
- (www-format-value-as-HEX value)
- (www-format-value-as-kuten value)
- value)
- (www-format-value-as-S-exp value)))
-
-(defun www-format-value-as-kangxi-radical (value)
- (if (and (integerp value)
- (<= 0 value)
- (<= value 214))
- (www-format-encode-string
- (format "%c" (ideographic-radical value)))
- (www-format-value-as-S-exp value)))
-
-(defun www-format-value (object feature-name
- &optional value format
- without-tags without-edit)
- (unless value
- (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)
- )
-
-
-;;; @ format evaluator
-;;;
+(defvar www-format-char-img-style "vertical-align:bottom;")
-(defun www-format-encode-string (string &optional without-tags)
+(defun www-format-encode-string (string &optional without-tags as-body)
(with-temp-buffer
(insert string)
(let (plane code start end char variants ret rret)
+ (when as-body
+ (goto-char (point-min))
+ (while (search-forward "&" nil t)
+ (replace-match "&" nil t)))
(goto-char (point-min))
(while (search-forward "<" nil t)
(replace-match "<" nil t))
@@ -758,23 +640,27 @@
(while (re-search-forward "&CB\\([0-9]+\\);" nil t)
(setq code (string-to-int (match-string 1)))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-bitmap-glyphs-url
- (/ code 1000) code)
+ (/ code 1000) code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
- (while (re-search-forward "&J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
- (setq plane (match-string 1)
- code (string-to-int (match-string 2) 16))
+ (while (re-search-forward "&\\(o-\\)?J\\(78\\|83\\|90\\|97\\|SP\\)-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
+ (setq plane (match-string 2)
+ code (string-to-int (match-string 3) 16))
(replace-match
- (format ""
+ (format ""
plane code
chise-wiki-bitmap-glyphs-url
plane
(- (lsh code -8) 32)
- (- (logand code 255) 32))
+ (- (logand code 255) 32)
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
@@ -782,12 +668,14 @@
(setq plane (string-to-int (match-string 1))
code (string-to-int (match-string 2) 16))
(replace-match
- (format ""
+ (format ""
plane code
chise-wiki-bitmap-glyphs-url
plane
(- (lsh code -8) 32)
- (- (logand code 255) 32))
+ (- (logand code 255) 32)
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
@@ -795,10 +683,12 @@
(setq plane (string-to-int (match-string 1))
code (string-to-int (match-string 2) 16))
(replace-match
- (format ""
+ (format ""
plane code
chise-wiki-bitmap-glyphs-url
- plane code)
+ plane code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
@@ -813,69 +703,83 @@
(while (re-search-forward "&\\(A-\\)?ZOB-\\([0-9]+\\);" nil t)
(setq code (string-to-int (match-string 2)))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-bitmap-glyphs-url
- code)
+ code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
- (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
+ (while (re-search-forward "&\\(G-\\|g2-\\)?GT-\\([0-9]+\\);" nil t)
(setq code (string-to-int (match-string 2)))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-glyph-cgi-url
- code)
+ code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
(while (re-search-forward "&\\(G-\\)?GT-K\\([0-9]+\\);" nil t)
(setq code (string-to-int (match-string 2)))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-glyph-cgi-url
- code)
+ code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
(while (re-search-forward "&B-\\([0-9A-F]+\\);" nil t)
(setq code (string-to-int (match-string 1) 16))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-glyph-cgi-url
- code)
+ code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
(while (re-search-forward "&CDP-\\([0-9A-F]+\\);" nil t)
(setq code (string-to-int (match-string 1) 16))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-glyph-cgi-url
- code)
+ code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
(while (re-search-forward "&RUI6-\\([0-9A-F]+\\);" nil t)
(setq code (string-to-int (match-string 1) 16))
(replace-match
- (format ""
+ (format ""
code
chise-wiki-glyph-cgi-url
- code)
+ code
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
- (while (re-search-forward "&\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
- (setq code (string-to-int (match-string 2) 16))
+ (while (re-search-forward "&\\(A-\\)?\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 3) 16))
(replace-match
- (format ""
+ (format ""
+ code
code
- code)
+ www-format-char-img-style)
t 'literal))
(goto-char (point-min))
@@ -925,321 +829,6 @@
;; (replace-match ">-" t 'literal))
(buffer-string))))
-(defun www-format-props-to-string (props &optional format)
- (unless format
- (setq format (plist-get props :format)))
- (concat "%"
- (plist-get props :flag)
- ;; (if (plist-get props :zero-padding)
- ;; "0")
- (if (plist-get props :len)
- (format "0%d"
- (let ((ret (plist-get props :len)))
- (if (stringp ret)
- (string-to-int ret)
- ret))))
- (cond
- ((eq format 'decimal) "d")
- ((eq format 'hex) "x")
- ((eq format 'HEX) "X")
- ((eq format 'S-exp) "S")
- (t "s"))))
-
-(defun www-format-apply-value (object feature-name
- format props value
- &optional uri-object uri-feature
- without-tags without-edit)
- (let (ret)
- (setq ret
- (cond
- ((memq format '(decimal hex HEX))
- (if (integerp value)
- (format (www-format-props-to-string props format)
- value)
- (www-format-encode-string
- (format "%s" value)
- without-tags))
- )
- ((eq format 'wiki-text)
- (if without-tags
- (www-xml-format-list value)
- (www-format-eval-list value object feature-name nil uri-object
- without-tags without-edit))
- )
- ((eq format 'S-exp)
- (www-format-encode-string
- (format (www-format-props-to-string props format)
- value)
- without-tags))
- ((eq format 'ku-ten)
- (www-format-value-as-kuten value))
- ((eq format 'kangxi-radical)
- (www-format-value-as-kangxi-radical value))
- ((eq format 'space-separated-char-list)
- (www-format-value-as-char-list value without-tags))
- ((eq format 'space-separated-ids)
- (www-format-value-as-ids value without-tags))
- ((eq format 'space-separated-domain-list)
- (www-format-value-as-domain-list value without-tags))
- ((eq format 'string)
- (www-format-encode-string (format "%s" value) without-tags)
- )
- (t
- (www-format-value-default value without-tags)
- ))
- )
- (if (or without-tags
- without-edit
- (eq (plist-get props :mode) 'peek))
- ret
- (format "%s "
- ret
- chise-wiki-edit-url
- uri-object uri-feature format))))
-
-(defun www-format-eval-feature-value (object
- feature-name
- &optional format lang uri-object value
- without-tags without-edit)
- (unless value
- (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
- object feature-name
- format nil value
- 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
- object feature-name
- (car format) (nth 1 format) value
- uri-object (www-uri-encode-feature-name feature-name)
- without-tags without-edit)
- )
- (t
- (www-format-eval-list format object feature-name lang uri-object
- without-tags without-edit)
- )))))
-
-(defun www-format-eval-unit (exp object feature-name
- &optional lang uri-object value
- without-tags without-edit)
- (unless value
- (setq value (www-get-feature-value object feature-name)))
- (unless uri-object
- (setq uri-object (www-uri-encode-char object)))
- (cond
- ((stringp exp) (www-format-encode-string exp))
- ((null exp) "")
- ((consp exp)
- (cond
- ((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
- S-exp string default))
- (let ((fn (plist-get (nth 1 exp) :feature))
- domain domain-fn ret)
- (when fn
- (when (stringp fn)
- (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-get-feature-value object domain-fn))
- (setq feature-name domain-fn
- value ret)
- (setq feature-name 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 object feature-name
- (plist-get (nth 1 exp) :format)
- lang uri-object value
- without-tags without-edit)
- (www-format-apply-value
- object feature-name
- (car exp) (nth 1 exp) value
- uri-object (www-uri-encode-feature-name feature-name)
- without-tags without-edit))
- )
- ((eq (car exp) 'name)
- (let ((fn (plist-get (nth 1 exp) :feature))
- domain domain-fn)
- (when fn
- (setq domain (char-feature-name-domain feature-name))
- (when (stringp fn)
- (setq fn (intern fn)))
- (setq domain-fn (char-feature-name-at-domain fn domain))
- (setq feature-name domain-fn)))
- (if without-tags
- (www-format-feature-name feature-name lang)
- (format "%s"
- (www-uri-make-feature-name-url
- (www-uri-encode-feature-name feature-name)
- uri-object)
- (www-format-feature-name feature-name lang))
- )
- )
- ((eq (car exp) 'name-url)
- (let ((fn (plist-get (nth 1 exp) :feature))
- domain domain-fn)
- (when fn
- (setq domain (char-feature-name-domain feature-name))
- (when (stringp fn)
- (setq fn (intern fn)))
- (setq domain-fn (char-feature-name-at-domain fn domain))
- (setq feature-name domain-fn)))
- (www-uri-make-feature-name-url
- (www-uri-encode-feature-name feature-name)
- uri-object)
- )
- ((eq (car exp) 'domain-name)
- (let ((domain (char-feature-name-domain feature-name)))
- (if domain
- (format "@%s" domain))))
- ((eq (car exp) 'prev-char)
- (if without-tags
- ""
- (let ((prev-char (find-previous-defined-code-point
- feature-name value)))
- (if prev-char
- (format "\n%s"
- chise-wiki-view-url
- (www-uri-encode-char prev-char)
- ""
- ;; (www-format-encode-string
- ;; (char-to-string prev-char))
- )
- "")))
- )
- ((eq (car exp) 'next-char)
- (if without-tags
- ""
- (let ((next-char (find-next-defined-code-point
- feature-name value)))
- (if next-char
- (format "%s"
- chise-wiki-view-url
- (www-uri-encode-char next-char)
- ""
- ;; (www-format-encode-string
- ;; (char-to-string next-char))
- )
- "")))
- )
- ((eq (car exp) 'link)
- (if without-tags
- (www-format-eval-list (nthcdr 2 exp)
- object feature-name lang uri-object
- without-tags without-edit)
- (format "%s"
- (www-format-eval-list (plist-get (nth 1 exp) :ref)
- object feature-name lang uri-object
- 'without-tags 'without-edit)
- (www-format-eval-list (nthcdr 2 exp)
- object feature-name lang uri-object
- without-tags without-edit)))
- )
- (t
- (format "<%s
->%s%s
->"
- (car exp)
- (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 object feature-name
- &optional lang uri-object
- without-tags without-edit)
- (if (consp format-list)
- (mapconcat
- (lambda (exp)
- (www-format-eval-unit exp object feature-name lang uri-object
- nil without-tags without-edit))
- format-list "")
- (www-format-eval-unit format-list object feature-name lang uri-object
- nil without-tags without-edit)))
-
-
-;;; @ XML generator
-;;;
-
-(defun www-xml-format-props (props)
- (let ((dest "")
- key val)
- (while props
- (setq key (pop props)
- val (pop props))
- (if (symbolp key)
- (setq key (symbol-name key)))
- (if (eq (aref key 0) ?:)
- (setq key (substring key 1)))
- (setq dest
- (format "%s %s=\"%s\""
- dest key
- (www-format-encode-string
- (format "%s" val) 'without-tags))))
- dest))
-
-(defun www-xml-format-unit (format-unit)
- (let (name props children ret)
- (cond
- ((stringp format-unit)
- (mapconcat (lambda (c)
- (cond
- ((eq c ?&) "&")
- ;; ((eq c ?<) "<")
- ;; ((eq c ?>) ">")
- (t
- (char-to-string c))))
- (www-format-encode-string format-unit 'without-tags)
- "")
- )
- ((consp format-unit)
- (setq name (car format-unit)
- props (nth 1 format-unit)
- children (nthcdr 2 format-unit))
- (when (eq name 'link)
- (setq ret (plist-get props :ref))
- (unless (stringp ret)
- (setq props (plist-remprop (copy-list props) :ref))
- (setq children
- (cons (list* 'ref nil ret)
- children))))
- (if children
- (format "<%s%s>%s%s>"
- name
- (if props
- (www-xml-format-props props)
- "")
- (www-xml-format-list children)
- name)
- (format "<%s%s/>"
- name (www-xml-format-props props)))
- )
- (t
- (format "%s" format-unit)))))
-
-(defun www-xml-format-list (format-list)
- (if (atom format-list)
- (www-xml-format-unit format-list)
- (mapconcat #'www-xml-format-unit
- format-list "")))
-
-
-;;; @ HTML generator
-;;;
-
(defun www-html-display-text (text)
(princ
(with-temp-buffer
@@ -1274,26 +863,43 @@
(defvar coded-charset-GlyphWiki-id-alist
'((=ucs "u" 4 x nil)
- (=ucs@JP "u" 4 x nil)
+ (=adobe-japan1-0 "aj1-" 5 d nil)
+ (=adobe-japan1-1 "aj1-" 5 d nil)
+ (=adobe-japan1-2 "aj1-" 5 d nil)
+ (=adobe-japan1-3 "aj1-" 5 d nil)
+ (=adobe-japan1-4 "aj1-" 5 d nil)
+ (=adobe-japan1-5 "aj1-" 5 d nil)
+ (=adobe-japan1-6 "aj1-" 5 d nil)
+ (=decomposition@cid)
+ (=decomposition@hanyo-denshi)
+ (=hanyo-denshi/ks "koseki-" 6 d nil)
+ (=>>hanyo-denshi/ks "koseki-" 6 d nil)
(=ucs@jis "u" 4 x nil)
- (=ucs@gb "u" 4 x "-g")
(=ucs@cns "u" 4 x "-t")
- (=ucs@ks "u" 4 x "-k")
- (=ucs@iso "u" 4 x "-u")
- (=ucs@unicode "u" 4 x "-us")
- (=adobe-japan1-6 "aj1-" 5 d nil)
- (=gt "gt-" 5 d nil)
- (=big5-cdp "cdp-" 4 x nil)
- (=cbeta "cb" 5 d nil)
- (=jis-x0208@1978/1pr "j78-" 4 x nil)
- (=jis-x0208@1978/-4pr "j78-" 4 x nil)
- (=jis-x0208@1978 "j78-" 4 x nil)
- (=jis-x0208@1983 "j83-" 4 x nil)
- (=jis-x0208@1990 "j90-" 4 x nil)
(=jis-x0212 "jsp-" 4 x nil)
(=jis-x0213-1@2000 "jx1-2000-" 4 x nil)
(=jis-x0213-1@2004 "jx1-2004-" 4 x nil)
(=jis-x0213-2 "jx2-" 4 x nil)
+ (=gt "gt-" 5 d nil)
+ (=daikanwa "dkw-" 5 d nil)
+ (=>>daikanwa "dkw-" 5 d nil)
+ (=gt-k "gt-k" 5 d nil)
+ (=jef-china3 "jc3-" 4 x nil)
+ (=big5 "b-" 4 x nil)
+ (=ks-x1001 "k0-" 4 x nil)
+ (=jis-x0208@1978/1pr "j78-" 4 x nil)
+ (=jis-x0208@1978/-4pr "j78-" 4 x nil)
+ (=jis-x0208@1978 "j78-" 4 x nil)
+ (=>>>jis-x0208@1978 "j78-" 4 x nil)
+ (=>>jis-x0208@1978 "j78-" 4 x nil)
+ (=+>jis-x0208@1978 "j78-" 4 x nil)
+ (=ucs@JP "u" 4 x nil)
+ (=ucs@gb "u" 4 x "-g")
+ (=ucs@ks "u" 4 x "-k")
+ (=ucs@iso "u" 4 x "-u")
+ (=ucs@unicode "u" 4 x "-us")
+ (=big5-cdp "cdp-" 4 x nil)
+ (=>>big5-cdp "cdp-" 4 x nil)
(=cns11643-1 "c1-" 4 x nil)
(=cns11643-2 "c2-" 4 x nil)
(=cns11643-3 "c3-" 4 x nil)
@@ -1301,11 +907,19 @@
(=cns11643-5 "c5-" 4 x nil)
(=cns11643-6 "c6-" 4 x nil)
(=cns11643-7 "c7-" 4 x nil)
- (=daikanwa "dkw-" 5 d nil)
- (=gt-k "gt-k" 5 d nil)
- (=jef-china3 "jc3-" 4 x nil)
- (=big5 "b-" 4 x nil)
- (=ks-x1001 "k0-" 4 x nil)
+ (=jis-x0208 "j90-" 4 x nil)
+ (=>>>jis-x0208 "j90-" 4 x nil)
+ (=>>jis-x0208 "j90-" 4 x nil)
+ (=+>jis-x0208 "j90-" 4 x nil)
+ (=jis-x0208@1990 "j90-" 4 x nil)
+ (=>>>jis-x0208@1990 "j90-" 4 x nil)
+ (=>>jis-x0208@1990 "j90-" 4 x nil)
+ (=+>jis-x0208@1990 "j90-" 4 x nil)
+ (=jis-x0208@1983 "j83-" 4 x nil)
+ (=>>>jis-x0208@1983 "j83-" 4 x nil)
+ (=>>jis-x0208@1983 "j83-" 4 x nil)
+ (=+>jis-x0208@1983 "j83-" 4 x nil)
+ (=cbeta "cb" 5 d nil)
))
(defun char-GlyphWiki-id (char)
@@ -1316,6 +930,8 @@
(null (setq ret (char-feature char (car spec))))))
(when ret
(or
+ (and (listp ret)
+ (mapconcat #'char-GlyphWiki-id ret "-"))
(and (memq (car spec) '(=ucs@unicode '=ucs@iso))
(cond
((and (or (encode-char char '=jis-x0208@1990)