X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-common.el;h=b0e1628000fe7ddd14d9d8f18ab156ac6ad145b2;hb=9a97c38f7a05c4f573301a4e8555c0b075b1b5bc;hp=4ca601c1ecb64f020f4030b4f640bed0030041a7;hpb=ce4c1b15ba829d376130248cc68a6760e5693535;p=chise%2Fest.git diff --git a/cwiki-common.el b/cwiki-common.el index 4ca601c..b0e1628 100644 --- a/cwiki-common.el +++ b/cwiki-common.el @@ -323,6 +323,16 @@ (- (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 @@ -344,6 +354,63 @@ 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 @@ -388,6 +455,14 @@ 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) (unless value @@ -414,6 +489,7 @@ (encode-coding-region (point-min)(point-max) 'utf-8-mcs-er) (let ((coded-charset-entity-reference-alist (list* + '(=gt "GT-" 5 d) '(=cns11643-1 "C1-" 4 X) '(=cns11643-2 "C2-" 4 X) '(=cns11643-3 "C3-" 4 X) @@ -429,7 +505,6 @@ '(=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) @@ -512,6 +587,16 @@ 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 "\"GT-K%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 @@ -532,8 +617,8 @@ 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)) + (while (re-search-forward "&\\(UU\\+\\|U-\\)\\([0-9A-F]+\\);" nil t) + (setq code (string-to-int (match-string 2) 16)) (replace-match (format "\"UU+%04X\"" code @@ -606,16 +691,21 @@ 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 - ;; (setq format 'default) - (www-format-encode-string - (format (www-format-props-to-string props 'default) - value) - without-tags)))) + (www-format-value-default value without-tags) + )) + ) (if (or without-tags (eq (plist-get props :mode) 'peek)) ret (format "%s ) "&gt;") + (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" name @@ -785,4 +894,92 @@ (www-html-display-text text) (princ "

\n")) + +;;; @ for GlyphWiki +;;; + +(defvar coded-charset-GlyphWiki-id-alist + '((=ucs "u" 4 x nil) + (=ucs@JP "u" 4 x 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) + (=cns11643-1 "c1-" 4 x nil) + (=cns11643-2 "c2-" 4 x nil) + (=cns11643-3 "c3-" 4 x nil) + (=cns11643-4 "c4-" 4 x nil) + (=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) + )) + +(defun char-GlyphWiki-id (char) + (let ((rest coded-charset-GlyphWiki-id-alist) + spec ret code) + (while (and rest + (setq spec (pop rest)) + (null (setq ret (char-feature char (car spec)))))) + (when ret + (or + (and (memq (car spec) '(=ucs@unicode '=ucs@iso)) + (cond + ((and (or (encode-char char '=jis-x0208@1990) + (encode-char char '=jis-x0212) + (encode-char char '=jis-x0213-1)) + (setq code (encode-char char '=ucs@jis))) + (format "u%04x" code) + ) + ((and (or (encode-char char '=gb2312) + (encode-char char '=gb12345)) + (setq code (encode-char char '=ucs@gb))) + (format "u%04x-g" code) + ) + ((and (or (encode-char char '=cns11643-1) + (encode-char char '=cns11643-2) + (encode-char char '=cns11643-3) + (encode-char char '=cns11643-4) + (encode-char char '=cns11643-5) + (encode-char char '=cns11643-6) + (encode-char char '=cns11643-7)) + (setq code (encode-char char '=ucs@cns))) + (format "u%04x-t" code) + ) + ((and (encode-char char '=ks-x1001) + (setq code (encode-char char '=ucs@ks))) + (format "u%04x-k" code) + ))) + (format (format "%s%%0%d%s%s" + (nth 1 spec) + (nth 2 spec) + (nth 3 spec) + (or (nth 4 spec) "")) + ret))))) + + +;;; @ End. +;;; + (provide 'cwiki-common) + +;;; cwiki-common.el ends here