munsell-conv.el (munsell-split): recognize Nv/c format.

munsell.el (munsel-resolv-property-face): new function.
(munsell-resolv-properties): ditto.
(put-text-property): adviced.
(add-text-properties): ditto.
(set-text-properties): ditto.
(overlay-put): ditto.

diff --git a/munsell-conv.el b/munsell-conv.el
index 29b3a08..9a051bc 100644 (file)
--- a/munsell-conv.el
+++ b/munsell-conv.el
@@ -1,5 +1,3 @@
-;; -*- coding: iso-2022-7bit; -*-
-
 (require 'munsell-data)
 
 (defun munsell-lookup (color)
@@ -12,10 +10,14 @@
        (value-var (nth 1 vars))
        (chroma-var (nth 2 vars)))
     `(let ((,color-var ,color-expr))
-       (if (string-match "^\\([0-9]+\\(\\.[0-9]*\\)?\\)\\(B\\|BG\\|G\\|GY\\|Y\\|YR\\|R\\|RP\\|P\\|PB\\)\\([0-9]+\\(\\.[0-9]*\\)?\\)/\\([0-9]+\\(\\.[0-9]*\\)?\\)$" ,color-var)
-          (let ((,hue-var (cons (string-to-number (match-string 1 ,color-var)) (match-string 3 ,color-var)))
-                (,value-var (string-to-number (match-string 4 ,color-var)))
-                (,chroma-var (string-to-number (match-string 6 ,color-var))))
+       (if (string-match "^\\(N\\|\\([0-9]+\\(\\.[0-9]*\\)?\\)\\(B\\|BG\\|G\\|GY\\|Y\\|YR\\|R\\|RP\\|P\\|PB\\)\\)\\([0-9]+\\(\\.[0-9]*\\)?\\)/\\([0-9]+\\(\\.[0-9]*\\)?\\)$" ,color-var)
+          (let ((,hue-var
+                 (if (match-beginning 2)
+                     (cons (string-to-number (match-string 2 ,color-var))
+                           (match-string 4 ,color-var))
+                   (cons 0 (match-string 1 ,color-var))))
+                (,value-var (string-to-number (match-string 5 ,color-var)))
+                (,chroma-var (string-to-number (match-string 7 ,color-var))))
             ,body)
         ,(or
           invalid-action

diff --git a/munsell.el b/munsell.el
index 8df9ab1..82e18b9 100644 (file)
--- a/munsell.el
+++ b/munsell.el
@@ -1,3 +1,4 @@
+(require 'advice)
 (require 'munsell-conv)
 (require 'munsell-names)
 
@@ -9,21 +10,60 @@
          (cdr p)
        color))))
 
-(defadvice modify-frame-parameters (before resolv-color activate)
+(defadvice modify-frame-parameters (before munsell-resolv-color activate)
   (ad-set-arg
    1
    (mapcar
     (lambda (p)
       (if (memq (car p)
-                '(background-color
-                  foreground-color
-                  cursor-color
-                  mouse-color
-                  border-color))
+               '(background-color
+                 foreground-color
+                 cursor-color
+                 mouse-color
+                 border-color))
           (cons
            (car p)
            (munsell-resolv-color (cdr p)))
         p))
-           (ad-get-arg 1))))
+    (ad-get-arg 1))))
 
-(provide 'munsell)
\ No newline at end of file
+(defadvice set-face-attribute-internal (before munsell-resolv-color activate)
+  (when (memq (ad-get-arg 1) '(foreground background))
+    (ad-set-arg 2 (munsell-resolv-color (ad-get-arg 2)))))
+
+(defun munsel-resolv-property-face (prop)
+  (if (and (consp prop) (not (stringp (cdr prop))))
+      (mapcar
+       (lambda (p)
+        (if (memq (car p) '(foreground-color background-color))
+            (cons (car p) (munsell-resolv-color (cdr p)))
+          p))
+       prop)
+    (if (memq (car prop) '(foreground-color background-color))
+       (cons (car prop) (munsell-resolv-color (cdr prop)))
+      prop)))
+
+(defadvice put-text-property (before munsell-resolv-color activate)
+  (when (eq (ad-get-arg 2) 'face)
+    (ad-set-arg 3 (munsel-resolv-property-face (ad-get-arg 3)))))
+
+(defun munsell-resolv-properties (props)
+  (setq props (copy-sequence props))
+  (let ((p props))
+    (while p
+      (when (eq (car p) 'face)
+       (setcar (cdr p) (munsel-resolv-property-face (cadr p))))
+      (setq p (cddr p))))
+  props)
+
+(defadvice add-text-properties (before munsell-resolv-color activate)
+  (ad-set-arg 2 (munsell-resolv-properties (ad-get-arg 2))))
+
+(defadvice set-text-properties (before munsell-resolv-color activate)
+  (ad-set-arg 2 (munsell-resolv-properties (ad-get-arg 2))))
+
+(defadvice overlay-put (before munsell-resolv-color activate)
+  (when (eq (ad-get-arg 1) 'face)
+    (ad-set-arg 2 (munsel-resolv-property-face (ad-get-arg 2)))))
+
+(provide 'munsell)