(defvar chise-wiki-view-url "view.cgi")
(defvar chise-wiki-edit-url "edit/edit.cgi")
-(defvar chise-wiki-glyphs-url
- "http://chise.zinbun.kyoto-u.ac.jp/glyphs/")
+(defvar chise-wiki-bitmap-glyphs-url
+ "http://chise.zinbun.kyoto-u.ac.jp/glyphs")
+
+(defvar chise-wiki-glyph-cgi-url
+ "http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
(defun decode-uri-string (string &optional coding-system)
(if (> (length string) 0)
(or (char-feature-property feature-name 'type)
(let ((str (symbol-name feature-name)))
(cond
+ ((string-match "\\*note\\(@[^*]+\\)?$" str)
+ 'stext)
+ ((string-match "\\*sources\\(@[^*]+\\)?$" str)
+ 'domain-list)
+ ((string-match "\\*" str)
+ nil)
((string-match "^\\(->\\|<-\\)" str)
'relation)
((string-match "^ideographic-structure\\(@\\|$\\)" str)
(cond ((eq type 'relation)
'space-separated-char-list)
((eq type 'structure)
- 'space-separated-ids)))
+ 'space-separated-ids)
+ ((eq type 'stext)
+ 'wiki-text)
+ ))
(if (find-charset feature-name)
(if (and (= (charset-dimension feature-name) 2)
(= (charset-chars feature-name) 94))
" (" (decimal) ") <" (ku-ten) ">")
'("0x" (HEX) " (" (decimal) ")")))))
+(defun char-feature-name-at-domain (feature-name domain)
+ (let ((name (symbol-name feature-name)))
+ (cond
+ ((string-match "@[^*]+$" name)
+ (intern (format "%s/%s" name domain))
+ )
+ (t
+ (intern (format "%s@%s" name domain))
+ ))))
+
+(defun char-feature-name-sans-versions (feature)
+ (let ((feature-name (symbol-name feature)))
+ (if (string-match "[@/]\\$rev=latest$" feature-name)
+ (intern (substring feature-name 0 (match-beginning 0)))
+ feature)))
+
+(defun www-char-feature (character 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))))
+
;;; @ URI representation
;;;
(defun www-uri-decode-char (char-rep)
(let (ccs cpos)
(cond
- ((string-match ":" char-rep)
+ ((string-match "\\(%3A\\|:\\)" char-rep)
(setq ccs (substring char-rep 0 (match-beginning 0))
cpos (substring char-rep (match-end 0)))
(setq ccs (www-uri-decode-feature-name ccs))
(if (numberp cpos)
(decode-char ccs cpos))
)
- ((= (length char-rep) 1)
- (aref char-rep 0)
+ (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)
- (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
- =daikanwa
- =gt =gt-k
- =big5
- =big5-cdp
- =>>jis-x0208 =>>jis-x0213-1
- =>jis-x0208 =>jis-x0213-1))
- 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))
- ((setq ccs (car (split-char char)))
- (format "%s:0x%X"
- (www-uri-encode-feature-name ccs)
- (encode-char char ccs))))))
+ (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
+ =daikanwa
+ =gt =gt-k
+ =>>jis-x0208 =>>jis-x0213-1
+ =>jis-x0208 =>jis-x0213-1
+ =>>gt
+ =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))
+ )))))
;;; @ Feature name presentation
(symbol-name feature-name)
"-"))
(dest (upcase (pop rest))))
+ (when (string-match "^=+>*" dest)
+ (setq dest (concat (substring dest 0 (match-end 0))
+ " "
+ (substring dest (match-end 0)))))
(cond
(rest
(while (cdr rest)
)
(t dest))))
-(defun www-format-feature-name (feature-name &optional lang)
+(defun www-format-feature-name* (feature-name &optional lang)
(let (name)
- (www-format-encode-string
- (cond
- ((or (and lang
- (char-feature-property
- feature-name
- (intern (format "name@%s" lang))))
- (char-feature-property
- feature-name 'name)))
- ((find-charset feature-name)
- (www-format-feature-name-as-CCS feature-name))
- ((and (setq name (symbol-name feature-name))
- (string-match "^\\(->\\)" name))
- (www-format-feature-name-as-rel-to feature-name))
- ((string-match "^\\(<-\\)" name)
- (www-format-feature-name-as-rel-from feature-name))
- (t
- (www-format-feature-name-default feature-name))))))
+ (cond
+ ((or (and lang
+ (char-feature-property
+ feature-name
+ (intern (format "name@%s" lang))))
+ (char-feature-property
+ feature-name 'name)))
+ ((find-charset feature-name)
+ (www-format-feature-name-as-CCS feature-name))
+ ((and (setq name (symbol-name feature-name))
+ (string-match "^\\(->\\)" name))
+ (www-format-feature-name-as-rel-to feature-name))
+ ((string-match "^\\(<-\\)" name)
+ (www-format-feature-name-as-rel-from feature-name))
+ (t
+ (www-format-feature-name-default feature-name)))))
+
+(defun www-format-feature-name (feature-name &optional lang)
+ (www-format-encode-string
+ (www-format-feature-name* feature-name lang)))
;;; @ Feature value presentation
(defun www-format-encode-string (string &optional without-tags)
(with-temp-buffer
(insert string)
- (let (plane code)
+ (let (plane code start end char variants ret)
(goto-char (point-min))
(while (search-forward "<" nil t)
(replace-match "<" nil t))
'(=jis-x0208@1990 "J90-" 4 X)
'(=jis-x0212 "JSP-" 4 X)
'(=cbeta "CB" 5 d)
- '(=jef-china3 "JC3-" 4 X)
'(=jis-x0208@1997 "J97-" 4 X)
'(=jis-x0208@1978 "J78-" 4 X)
'(=jis-x0208@1983 "J83-" 4 X)
+ '(=gt "GT-" 5 d)
'(=zinbun-oracle "ZOB-" 4 d)
+ '(=jef-china3 "JC3-" 4 X)
'(=daikanwa "M-" 5 d)
coded-charset-entity-reference-alist)))
(encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
(replace-match
(format "<img alt=\"CB%05d\" src=\"%s/cb-gaiji/%02d/CB%05d.gif\">"
code
- chise-wiki-glyphs-url
+ chise-wiki-bitmap-glyphs-url
(/ code 1000) code)
t 'literal))
(replace-match
(format "<img alt=\"J%s-%04X\" src=\"%s/JIS-%s/%02d-%02d.gif\">"
plane code
- chise-wiki-glyphs-url
+ chise-wiki-bitmap-glyphs-url
plane
(- (lsh code -8) 32)
(- (logand code 255) 32))
(replace-match
(format "<img alt=\"GB%d-%04X\" src=\"%s/GB%d/%02d-%02d.gif\">"
plane code
- chise-wiki-glyphs-url
+ chise-wiki-bitmap-glyphs-url
plane
(- (lsh code -8) 32)
(- (logand code 255) 32))
(replace-match
(format "<img alt=\"CNS%d-%04X\" src=\"%s/CNS%d/%04X.gif\">"
plane code
- chise-wiki-glyphs-url
+ chise-wiki-bitmap-glyphs-url
plane code)
t 'literal))
- ))
- (goto-char (point-min))
- (while (search-forward ">-" nil t)
- (replace-match "&GT-" t 'literal))
+ (goto-char (point-min))
+ (while (re-search-forward "&JC3-\\([0-9A-F][0-9A-F][0-9A-F][0-9A-F]\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (replace-match
+ (format "<img alt=\"JC3-%04X\" src=\"http://kanji.zinbun.kyoto-u.ac.jp/db/CHINA3/Gaiji/%04x.gif\">"
+ code code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&ZOB-\\([0-9]+\\);" nil t)
+ (setq code (string-to-int (match-string 1)))
+ (replace-match
+ (format "<img alt=\"ZOB-%04d\" src=\"%s/ZOB-1968/%04d.png\">"
+ code
+ chise-wiki-bitmap-glyphs-url
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&\\(G-\\)?GT-\\([0-9]+\\);" nil t)
+ (setq code (string-to-int (match-string 2)))
+ (replace-match
+ (format "<img alt=\"GT-%05d\" src=\"%s?char=GT-%05d\">"
+ code
+ chise-wiki-glyph-cgi-url
+ code)
+ 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 "<img alt=\"B-%04X\" src=\"%s?char=B-%04X\">"
+ code
+ chise-wiki-glyph-cgi-url
+ code)
+ 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 "<img alt=\"CDP-%04X\" src=\"%s?char=CDP-%04X\">"
+ code
+ chise-wiki-glyph-cgi-url
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&UU\\+\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (replace-match
+ (format "<img alt=\"UU+%04X\" src=\"http://www.unicode.org/cgi-bin/refglyph?24-%04X\">"
+ code
+ code)
+ t 'literal))
+
+ (goto-char (point-min))
+ (while (re-search-forward "&MCS-\\([0-9A-F]+\\);" nil t)
+ (setq code (string-to-int (match-string 1) 16))
+ (setq start (match-beginning 0)
+ end (match-end 0))
+ (setq char (decode-char 'system-char-id code))
+ (setq variants (or (www-char-feature char '->subsumptive)
+ (www-char-feature char '->denotational)))
+ (while (and variants
+ (setq ret (www-format-encode-string
+ (char-to-string (car variants))))
+ (string-match "&MCS-\\([0-9A-F]+\\);" ret))
+ (setq variants (cdr variants)))
+ (unless (string-match "&MCS-\\([0-9A-F]+\\);" ret)
+ (goto-char start)
+ (delete-region start end)
+ (insert ret)))
+ ))
+ ;; (goto-char (point-min))
+ ;; (while (search-forward ">-" nil t)
+ ;; (replace-match "&GT-" t 'literal))
(buffer-string))))
(defun www-format-props-to-string (props &optional format)
((eq format 'space-separated-ids)
(www-format-value-as-ids value without-tags))
(t
- (setq format 'default)
+ ;; (setq format 'default)
(www-format-encode-string
(format (www-format-props-to-string props 'default)
value)
feature-name
&optional format lang uri-char value)
(unless value
- (setq value (char-feature char feature-name)))
+ (setq value (www-char-feature char feature-name)))
(unless format
(setq format (www-feature-value-format feature-name)))
(cond
(defun www-format-eval-unit (exp char feature-name
&optional lang uri-char value)
(unless value
- (setq value (char-feature char feature-name)))
+ (setq value (www-char-feature char feature-name)))
(unless uri-char
(setq uri-char (www-uri-encode-char char)))
(cond
nil t))
(encode-coding-region (point-min)(point-max) 'utf-8-mcs-er)
(goto-char (point-min))
- (while (search-forward "&" nil t)
- (replace-match "&" nil t))
+ (while (search-forward ">-" nil t)
+ (replace-match "&GT-" nil t))
(buffer-string))))
(defun www-html-display-paragraph (text)
projects / chise / est.git / blobdiff