+;;;###autoload
+(defun expand-char-feature-name (feature domain)
+ (if domain
+ (intern (format "%s@%s" feature domain))
+ feature))
+
+(defun map-char-family (function char &optional ignore-sisters)
+ (let ((rest (list char))
+ ret checked)
+ (catch 'tag
+ (while rest
+ (unless (memq (car rest) checked)
+ (if (setq ret (funcall function (car rest)))
+ (throw 'tag ret))
+ (setq checked (cons (car rest) checked)
+ rest (append rest
+ (get-char-attribute (car rest) '->subsumptive)
+ (get-char-attribute (car rest) '->denotational)
+ (get-char-attribute (car rest) '->identical)))
+ (unless ignore-sisters
+ (setq rest (append rest
+ (get-char-attribute (car rest) '<-subsumptive)
+ (get-char-attribute (car rest) '<-denotational)))))
+ (setq rest (cdr rest))))))
+
+(defun get-char-feature-from-domains (char feature domains
+ &optional tester arg
+ ignore-sisters)
+ (map-char-family
+ (lambda (ch)
+ (let (ret)
+ (catch 'tag
+ (dolist (domain domains)
+ (if (and (or (null tester)
+ (equal (or (char-feature
+ ch (expand-char-feature-name
+ tester domain))
+ (char-feature ch tester))
+ arg))
+ (setq ret (or (char-feature
+ ch (expand-char-feature-name
+ feature domain))
+ (char-feature ch feature))))
+ (throw 'tag ret))))))
+ char ignore-sisters)
+ ;; (let ((rest (list char))
+ ;; ret checked)
+ ;; (catch 'tag
+ ;; (while rest
+ ;; (setq char (car rest))
+ ;; (unless (memq char checked)
+ ;; (dolist (domain domains)
+ ;; (if (and (setq ret (char-feature
+ ;; char
+ ;; (expand-char-feature-name
+ ;; feature domain)))
+ ;; (or (null tester)
+ ;; (equal (or (char-feature
+ ;; char
+ ;; (expand-char-feature-name
+ ;; tester domain))
+ ;; (char-feature char tester))
+ ;; arg)))
+ ;; (throw 'tag ret)))
+ ;; (setq rest (append rest
+ ;; (get-char-attribute char '->subsumptive)
+ ;; (get-char-attribute char '->denotational)
+ ;; (get-char-attribute char '<-subsumptive)
+ ;; (get-char-attribute char '<-denotational))
+ ;; checked (cons char checked)))
+ ;; (setq rest (cdr rest)))))
+ )
+
+