hl-line-failure.el

(defun my:background-at-point ()
  (let* ((face (or (get-char-property (point) 'read-face-name)
                   (get-char-property (point) 'face)))
         (bg (cond ((and face (symbolp face))
                    (condition-case nil
                        (face-background face nil 'default)
                      (error (or (face-background face)
                                 (cdr (assq 'background-color (frame-parameters)))))))
                   ((consp face)
                    (cond ((memq 'background-color face)
                           (cdr (memq 'background-color face)))
                          ((memq ':background face)
                           (cadr (memq ':background face)))))
                   (t nil))))
    bg))

(defun my:mix-color (bgcolor hlcolor)
  (message "%S" hlcolor)
  bgcolor
  )

(defadvice hl-line-move (around hl-line-move-compose-background (overlay))
  ;; from beginning of line, scan background color and make a list of  plist like:
  ;; '((:background "orchid" :begin 0 :end 4) (:background "red" :begin 9 :end 14))
  ;; change color name to hex (format "%02x" (round (* 256 (nth 0 (color-name-to-rgb "orchid")))))
  (let* ((children (overlay-get overlay :children))
         (pool (overlay-get overlay :pool))
         (range (if hl-line-range-function (funcall hl-line-range-function)
                  (list (line-beginning-position) (line-beginning-position 2))))
         bgbefore bgcurrent bgbegin bgend)
    (dolist (child children) ;; delete active overlays and insert them into pool
      (delete-overlay child)
      (push child pool))
    (setq children nil)
    (save-excursion
      (goto-char (car range))
      (beginning-of-line)
      (while (not (eolp))
        (setq bgcurrent (my:background-at-point))
        (when (not (string= bgbefore bgcurrent))
            (if bgbegin (and bgbefore (setq bgend (1- (point))))
              (setq bgbegin (point)))
            (setq bgbefore bgcurrent))
        (message "before %S current %S begin %S end %S" bgbefore bgcurrent bgbegin bgend)
        (if (and bgbegin bgend)
            (let ((child (or (and (pop pool) (move-overlay bgbegin bgend))
                             (make-overlay bgbegin bgend)))
                  (color (my:mix-color bgcurrent (overlay-get overlay :face))))
              ))

        (goto-char (1+ (point)))))
    ad-do-it
  nil))
(ad-activate 'hl-line-move)