(defvar chise-wiki-glyph-cgi-url
"http://chise.zinbun.kyoto-u.ac.jp/chisewiki/glyph.cgi")
+(defvar chise-wiki-displayed-features nil)
+
(defun decode-uri-string (string &optional coding-system)
(if (> (length string) 0)
(let ((i 0)
'structure)
))))
+(defun www-feature-format (feature-name)
+ (or (char-feature-property feature-name 'format)
+ (let (fn parent ret)
+ (setq fn feature-name)
+ (while (and (setq parent (char-feature-name-parent fn))
+ (null (setq ret
+ (char-feature-property
+ parent 'format))))
+ (setq fn parent))
+ ret)
+ '((name) " : " (value))))
+
(defun www-feature-value-format (feature-name)
(or (char-feature-property feature-name 'value-format)
+ (let (fn parent ret)
+ (setq fn feature-name)
+ (while (and (setq parent (char-feature-name-parent fn))
+ (null (setq ret
+ (char-feature-property
+ parent 'value-format))))
+ (setq fn parent))
+ ret)
(let ((type (www-feature-type feature-name)))
(cond ((eq type 'relation)
'space-separated-char-list)
'("0x" (HEX) " (" (decimal) ") " (prev-char) (next-char))))))
(defun char-feature-name-at-domain (feature-name domain)
+ (if domain
+ (let ((name (symbol-name feature-name)))
+ (cond
+ ((string-match "@[^*]+$" name)
+ (intern (format "%s/%s" name domain))
+ )
+ (t
+ (intern (format "%s@%s" name domain))
+ )))
+ feature-name))
+
+(defun char-feature-name-parent (feature-name)
(let ((name (symbol-name feature-name)))
- (cond
- ((string-match "@[^*]+$" name)
- (intern (format "%s/%s" name domain))
- )
- (t
- (intern (format "%s@%s" name domain))
- ))))
+ (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
+ (intern (substring name 0 (car (last (match-data) 2)))))))
+
+(defun char-feature-name-domain (feature-name)
+ (let ((name (symbol-name feature-name)))
+ (if (string-match "@[^@/*]+\\(/[^@/*]+\\)*$" name)
+ (intern (substring name (1+ (match-beginning 0)))))))
(defun char-feature-name-sans-versions (feature)
(let ((feature-name (symbol-name feature)))
)
(t feature-name)))
+(defun www-uri-make-feature-name-url (uri-feature-name uri-char)
+ (format "%s?feature=%s&char=%s"
+ chise-wiki-view-url uri-feature-name uri-char))
+
(defun www-uri-decode-char (char-rep)
(let (ccs cpos)
(cond
(t dest))))
(defun www-format-feature-name* (feature-name &optional lang)
- (let (name)
+ (let (name fn parent ret)
(cond
((or (and lang
(char-feature-property
(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-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))
(t
- (www-format-feature-name-default feature-name)))))
+ (setq fn feature-name)
+ (while (and (setq parent (char-feature-name-parent fn))
+ (null (setq ret
+ (or (and lang
+ (char-feature-property
+ parent
+ (intern (format "name@%s" lang))))
+ (char-feature-property
+ parent 'name)))))
+ (setq fn parent))
+ (cond
+ (ret
+ (concat ret (substring (symbol-name feature-name)
+ (length (symbol-name parent)))))
+ ((find-charset feature-name)
+ (www-format-feature-name-as-CCS 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
;; (if (plist-get props :zero-padding)
;; "0")
(if (plist-get props :len)
- (format "0%d" (plist-get props :len)))
+ (format "0%d"
+ (let ((ret (plist-get props :len)))
+ (if (stringp ret)
+ (string-to-int ret)
+ ret))))
(cond
((eq format 'decimal) "d")
((eq format 'hex) "x")
(cond
((memq (car exp) '(value decimal hex HEX ku-ten kangxi-radical
S-exp string default))
+ (let ((fn (plist-get (nth 1 exp) :feature))
+ domain domain-fn ret)
+ (when fn
+ (when (stringp fn)
+ (setq fn (intern fn)))
+ (setq domain (char-feature-name-domain feature-name))
+ (setq domain-fn (char-feature-name-at-domain fn domain))
+ (if (setq ret (www-char-feature char domain-fn))
+ (setq feature-name domain-fn
+ value ret)
+ (setq feature-name fn
+ value (www-char-feature char fn)))
+ (push feature-name chise-wiki-displayed-features)
+ ))
(if (eq (car exp) 'value)
(www-format-eval-feature-value char feature-name
(plist-get (nth 1 exp) :format)
without-tags without-edit))
)
((eq (car exp) 'name)
+ (let ((fn (plist-get (nth 1 exp) :feature))
+ domain domain-fn)
+ (when fn
+ (setq domain (char-feature-name-domain feature-name))
+ (when (stringp fn)
+ (setq fn (intern fn)))
+ (setq domain-fn (char-feature-name-at-domain fn domain))
+ (setq feature-name domain-fn)))
(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)))
+ (format "<a href=\"%s\">%s</a>"
+ (www-uri-make-feature-name-url
+ (www-uri-encode-feature-name feature-name)
+ uri-char)
+ (www-format-feature-name feature-name lang))
+ )
+ )
+ ((eq (car exp) 'name-url)
+ (let ((fn (plist-get (nth 1 exp) :feature))
+ domain domain-fn)
+ (when fn
+ (setq domain (char-feature-name-domain feature-name))
+ (when (stringp fn)
+ (setq fn (intern fn)))
+ (setq domain-fn (char-feature-name-at-domain fn domain))
+ (setq feature-name domain-fn)))
+ (www-uri-make-feature-name-url
+ (www-uri-encode-feature-name feature-name)
+ uri-char)
)
+ ((eq (car exp) 'domain-name)
+ (let ((domain (char-feature-name-domain feature-name)))
+ (if domain
+ (format "@%s" domain))))
((eq (car exp) 'prev-char)
(if without-tags
""
projects / chise / est.git / blobdiff