X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/a868705fcae46304cbe3be120e644a1bfdc3226c..8201f36c1137a8eee78cfc0ecdea629c10200b78:/colir.el

diff --git a/colir.el b/colir.el
index c9a0ada1a..792033fca 100644
--- a/colir.el
+++ b/colir.el
@@ -32,7 +32,7 @@
 
 (require 'color)
 
-(defcustom colir-compose-method 'colir-compose-overlay
+(defcustom colir-compose-method 'colir-compose-alpha
   "Select a method to compose two color channels."
   :type '(choice
           (const colir-compose-alpha)
@@ -52,17 +52,21 @@
       (* 2 a b)
     (- 1 (* 2 (- 1 a) (- 1 b)))))
 
-(defun colir-compose-alpha (a b &optional alpha)
+(defun colir-compose-alpha (a b &optional alpha gamma)
   "Compose A and B channels."
   (setq alpha (or alpha 0.5))
-  (+ (* a alpha) (* b (- 1 alpha))))
+  (setq gamma (or gamma 2.2))
+  (+ (* (expt a gamma) alpha) (* (expt b gamma) (- 1 alpha))))
 
 (defun colir-blend (c1 c2)
   "Blend the two colors C1 and C2 using `colir-compose-method'.
 C1 and C2 are triples of floats in [0.0 1.0] range."
   (apply #'color-rgb-to-hex
          (cl-mapcar
-          colir-compose-method
+          (if (eq (frame-parameter nil 'background-mode) 'dark)
+              ;; this method works nicely for dark themes
+              'colir-compose-soft-light
+            colir-compose-method)
           c1 c2)))
 
 (defun colir-blend-face-background (start end face &optional object)
@@ -73,9 +77,11 @@ Optional argument OBJECT is the string or buffer containing the text.
 See also `font-lock-append-text-property'."
   (let (next prev)
     (while (/= start end)
-      (setq next (next-single-property-change start 'face object end)
-            prev (get-text-property start 'face object))
-      (if prev
+      (setq next (next-single-property-change start 'face object end))
+      (setq prev (get-text-property start 'face object))
+      (when (listp prev)
+        (setq prev (cl-find-if #'atom prev)))
+      (if (facep prev)
           (let ((background-prev (face-background prev)))
             (progn
               (put-text-property