From 6ab856b7616f26eb6ba423a0abafeab172f3737d Mon Sep 17 00:00:00 2001 From: MORIOKA Tomohiko Date: Mon, 5 Apr 2010 19:11:27 +0900 Subject: [PATCH] (www-feature-value-format): Add `(prev-char) (next-char)' into default format of CCS feature. (get-previous-code-point): New function. (get-next-code-point): New function. (find-previous-defined-code-point): New function. (find-next-defined-code-point): New function. (www-format-eval-unit): Support `prev-char' and `next-char'. --- cwiki-common.el | 188 ++++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 174 insertions(+), 14 deletions(-) diff --git a/cwiki-common.el b/cwiki-common.el index fa6a4e8..2fb5094 100644 --- a/cwiki-common.el +++ b/cwiki-common.el @@ -61,8 +61,8 @@ (if (and (= (charset-dimension feature-name) 2) (= (charset-chars feature-name) 94)) '("0x" (HEX) - " (" (decimal) ") <" (ku-ten) ">") - '("0x" (HEX) " (" (decimal) ")"))))) + " (" (decimal) ") <" (ku-ten) "> " (prev-char) (next-char)) + '("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char)))))) (defun char-feature-name-at-domain (feature-name domain) (let ((name (symbol-name feature-name))) @@ -86,6 +86,129 @@ (or (char-feature character latest-feature) (char-feature character feature)))) +(defun get-previous-code-point (ccs code) + (let ((chars (charset-chars ccs)) + (dim (charset-dimension ccs)) + (i 0) + mask byte-min byte-max + bytes dest) + (cond + ((= chars 94) + (setq mask #x7F + byte-min 33 + byte-max 126) + ) + ((= chars 96) + (setq mask #x7F + byte-min 32 + byte-max 127) + ) + ((= chars 128) + (setq mask #x7F + byte-min 0 + byte-max #xFF) + ) + (t ; (= chars 256) + (setq mask #xFF + byte-min 0 + byte-max #xFF) + )) + (setq bytes (make-vector dim 0)) + (while (< i dim) + (aset bytes i (logand (lsh code (* i -8)) mask)) + (setq i (1+ i))) + (setq i 0) + (while (and (< i dim) + (progn + (aset bytes i (1- (aref bytes i))) + (< (aref bytes i) byte-min))) + (aset bytes i byte-max) + (setq i (1+ i))) + (when (< i dim) + (setq dest (aref bytes 0) + i 1) + (while (< i dim) + (setq dest (logior dest (lsh (aref bytes i) (* i 8))) + i (1+ i))) + dest))) + +(defun get-next-code-point (ccs code) + (let ((chars (charset-chars ccs)) + (dim (charset-dimension ccs)) + (i 0) + mask byte-min byte-max + bytes dest) + (cond + ((= chars 94) + (setq mask #x7F + byte-min 33 + byte-max 126) + ) + ((= chars 96) + (setq mask #x7F + byte-min 32 + byte-max 127) + ) + ((= chars 128) + (setq mask #x7F + byte-min 0 + byte-max #xFF) + ) + (t ; (= chars 256) + (setq mask #xFF + byte-min 0 + byte-max #xFF) + )) + (setq bytes (make-vector dim 0)) + (while (< i dim) + (aset bytes i (logand (lsh code (* i -8)) mask)) + (setq i (1+ i))) + (setq i 0) + (while (and (< i dim) + (progn + (aset bytes i (1+ (aref bytes i))) + (> (aref bytes i) byte-max))) + (aset bytes i byte-min) + (setq i (1+ i))) + (when (< i dim) + (setq dest (aref bytes 0) + i 1) + (while (< i dim) + (setq dest (logior dest (lsh (aref bytes i) (* i 8))) + i (1+ i))) + dest))) + +(defun find-previous-defined-code-point (ccs code) + (let ((i (get-previous-code-point ccs code)) + char) + (cond + ((eq ccs '=jis-x0208) + (setq ccs '=jis-x0208@1990)) + ((eq ccs '=jis-x0213-1) + (setq ccs '=jis-x0213-1@2004))) + (while (and i + (>= i 0) + (null (setq char (decode-char ccs i 'defined-only)))) + (setq i (get-previous-code-point ccs i))) + char)) + +(defun find-next-defined-code-point (ccs code) + (let ((i (get-next-code-point ccs code)) + max char) + (setq max (+ code 1000)) + (cond + ((eq ccs '=jis-x0208) + (setq ccs '=jis-x0208@1990)) + ((eq ccs '=jis-x0213-1) + (setq ccs '=jis-x0213-1@2004))) + (while (and i + (<= i max) + (null (setq char (decode-char ccs i + (unless (eq ccs '=ucs) + 'defined-only))))) + (setq i (get-next-code-point ccs i))) + char)) + ;;; @ URI representation ;;; @@ -811,23 +934,60 @@ without-tags without-edit)) ) ((eq (car exp) 'name) - (format "%s" - chise-wiki-view-url - (www-uri-encode-feature-name feature-name) - uri-char - (www-format-feature-name feature-name lang)) + (if without-tags + (www-format-feature-name feature-name lang) + (format "%s" + chise-wiki-view-url + (www-uri-encode-feature-name feature-name) + uri-char + (www-format-feature-name feature-name lang))) + ) + ((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) - (format "%s" - (www-format-eval-list (plist-get (nth 1 exp) :ref) - char feature-name lang uri-char - 'without-tags 'without-edit) - (www-format-eval-list (nthcdr 2 exp) - char feature-name lang uri-char - without-tags without-edit))) + (www-format-eval-list (plist-get (nth 1 exp) :ref) + char feature-name lang uri-char + 'without-tags 'without-edit) + (www-format-eval-list (nthcdr 2 exp) + char feature-name lang uri-char + without-tags without-edit))) + ) (t (format "<%s >%s