X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=cwiki-common.el;h=b0e1628000fe7ddd14d9d8f18ab156ac6ad145b2;hb=9a97c38f7a05c4f573301a4e8555c0b075b1b5bc;hp=e4f64e824d2af127f14a13d1f45464eae6398d70;hpb=aaf8b055428b4ea9cd0eae50ffa383e14c51aca9;p=chise%2Fest.git diff --git a/cwiki-common.el b/cwiki-common.el index e4f64e8..b0e1628 100644 --- a/cwiki-common.el +++ b/cwiki-common.el @@ -35,6 +35,12 @@ (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) @@ -47,7 +53,10 @@ (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)) @@ -241,6 +250,19 @@ "-") " ")) +(defun www-format-feature-name-as-metadata (feature-name &optional lang) + (let ((str (symbol-name feature-name)) + base meta) + (cond + ((string-match "\\*[^*]+$" str) + (setq base (substring str 0 (match-beginning 0)) + meta (substring str (match-beginning 0))) + (concat (www-format-feature-name* (intern base) lang) + meta)) + (t + (www-format-feature-name-default feature-name) + )))) + (defun www-format-feature-name-as-rel-to (feature-name) (concat "\u2192" (substring (symbol-name feature-name) 2))) @@ -279,7 +301,9 @@ ((find-charset feature-name) (www-format-feature-name-as-CCS feature-name)) ((and (setq name (symbol-name feature-name)) - (string-match "^\\(->\\)" name)) + (string-match "\\*" name)) + (www-format-feature-name-as-metadata feature-name lang)) + ((string-match "^\\(->\\)" name) (www-format-feature-name-as-rel-to feature-name)) ((string-match "^\\(<-\\)" name) (www-format-feature-name-as-rel-from feature-name)) @@ -299,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 @@ -320,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 @@ -364,19 +455,20 @@ value) (www-format-value-as-S-exp value))) -(defun www-format-value (value &optional feature-name format without-tags) - ;; (cond - ;; ((find-charset feature-name) - ;; (cond - ;; ((and (= (charset-chars feature-name) 94) - ;; (= (charset-dimension feature-name) 2)) - ;; (www-format-value-as-CCS-94x94 value)) - ;; (t - ;; (www-format-value-as-CCS-default value))) - ;; ) - ;; (t - ;; (www-format-value-as-S-exp value))) - (www-format-apply-value format nil value nil nil without-tags) +(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 + (setq value (www-char-feature object feature-name))) + (www-format-apply-value object feature-name + format nil value nil nil without-tags) ) @@ -397,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) @@ -412,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) @@ -495,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 @@ -515,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 @@ -562,7 +664,8 @@ ((eq format 'S-exp) "S") (t "s")))) -(defun www-format-apply-value (format props value +(defun www-format-apply-value (object feature-name + format props value &optional uri-char uri-feature without-tags) (let (ret) @@ -576,6 +679,11 @@ (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-char)) + ) ((eq format 'S-exp) (www-format-encode-string (format (www-format-props-to-string props format) @@ -583,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 + (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 ;;; @@ -711,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