X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-common.el;h=45f1957fe72493f951ff57e9c5ef5a8dddbb9bf0;hb=0d8a692fec9a33ff55159de5d35ed84f62def5a4;hp=6569ac44e90e6c155748734b85a3b608782ddf70;hpb=4bbe975a4943122050924a17f29f24e6d2312c8d;p=chise%2Fest.git diff --git a/cwiki-common.el b/cwiki-common.el index 6569ac4..45f1957 100644 --- a/cwiki-common.el +++ b/cwiki-common.el @@ -4,8 +4,11 @@ (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) @@ -141,7 +144,7 @@ (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)) @@ -156,39 +159,53 @@ (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 @@ -214,6 +231,10 @@ (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) @@ -224,25 +245,28 @@ ) (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 @@ -340,7 +364,7 @@ (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)) @@ -363,11 +387,12 @@ '(=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) @@ -378,7 +403,7 @@ (replace-match (format "\"CB%05d\"" code - chise-wiki-glyphs-url + chise-wiki-bitmap-glyphs-url (/ code 1000) code) t 'literal)) @@ -389,7 +414,7 @@ (replace-match (format "\"J%s-%04X\"" plane code - chise-wiki-glyphs-url + chise-wiki-bitmap-glyphs-url plane (- (lsh code -8) 32) (- (logand code 255) 32)) @@ -402,7 +427,7 @@ (replace-match (format "\"GB%d-%04X\"" plane code - chise-wiki-glyphs-url + chise-wiki-bitmap-glyphs-url plane (- (lsh code -8) 32) (- (logand code 255) 32)) @@ -415,14 +440,88 @@ (replace-match (format "\"CNS%d-%04X\"" 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 "\"JC3-%04X\"" + 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 "\"ZOB-%04d\"" + 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 "\"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 "\"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 "\"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 "\"UU+%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 (char-feature char '->subsumptive) + (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) @@ -581,8 +680,8 @@ 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)