(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'.

diff --git a/cwiki-common.el b/cwiki-common.el
index fa6a4e8..2fb5094 100644 (file)
--- 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 "<a href=\"%s?feature=%s&char=%s\">%s</a>"
-             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 "<a href=\"%s?feature=%s&char=%s\">%s</a>"
+               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<a href=\"%s?char=%s\">%s</a>"
+                     chise-wiki-view-url
+                     (www-uri-encode-char prev-char)
+                      "<input type=\"submit\" value=\"-\" />"
+                     ;; (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 "<a href=\"%s?char=%s\">%s</a>"
+                     chise-wiki-view-url
+                     (www-uri-encode-char next-char)
+                      "<input type=\"submit\" value=\"+\" />"
+                     ;; (www-format-encode-string
+                      ;;  (char-to-string next-char))
+                     )
+           "")))
       )
      ((eq (car exp) 'link)
-      (format "<a
+      (if without-tags
+         (www-format-eval-list (nthcdr 2 exp)
+                               char feature-name lang uri-char
+                               without-tags without-edit)
+       (format "<a
  href=\"%s\"
 >%s</a
 >"
-             (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</%s