Emacs dual header line

dual-header.el

;; Dual header line is possible by exploiting the tab-bar line that
;; sits on top of the header line and is generally hidden. For the
;; icon, it has to be precisely cut in top and bottom part and each
;; part is concatenated with either the tab-line or header-line.

(defun dual-header (top bottom)
  "This installs a double line header in current buffer using both tab line (TOP) and header line (BOTTOM)."

  (set-face-attribute 'tab-line (selected-frame)
                      :foreground (face-foreground 'default)
                      :background (face-background 'highlight)
                      :underline nil
                      :overline (face-foreground 'default)
                      :box nil
                      :height (face-attribute 'default :height))

  (set-face-attribute 'header-line (selected-frame)
                      :foreground (face-foreground 'default)
                      :background (face-background 'highlight)
                      :underline (face-foreground 'default)
                      :overline nil
                      :box nil
                      :height (face-attribute 'default :height))
  (setq tab-line-format
        (concat (propertize " " 'display '(space :width (1))
                                'face `(:background ,(face-foreground 'default)))
                top
                (propertize " " 'display '(raise +0.25))
                (propertize " " 'display '(space :align-to (- right (1))))
                (propertize " " 'display '(space :width (1))
                                'face `(:background ,(face-foreground 'default)))))

  (setq header-line-format
        (concat (propertize " " 'display '(space :width (1))
                                'face `(:background ,(face-foreground 'default)))
                bottom
                (propertize " " 'display '(raise -0.25)
                                'face `( :underline (:color "black" :position 0)))
                (propertize " " 'display '(space :align-to (- right (1))))
                (propertize " " 'display '(space :width (1))
                                'face `(:background ,(face-foreground 'default))))))


(defun dual-header-image (data)
  "This makes the image DATA to fit exacly two lines height and makes it
square in the process."

  (let* ((image (cond ((file-regular-p data)
                       (create-image data))
                      ((imagep data)
                       data)
                      (t (let ((collection (nth 0 (split-string data "/")))
                               (name (nth 1 (split-string data "/"))))
                           (svg-lib-icon name nil :collection collection
                                         :stroke 0 :scale 1.0 :padding 0)))))
         (img-width (car (image-size image t)))
         (img-height (cdr (image-size image t)))
         (ch (frame-char-height))
         (cw (frame-char-width))
         (icon-height (* 2 ch))
         (char-width  (+ 1 (truncate (/ (* 2 ch) cw))))
         (icon-width  (* char-width cw))
         (scale (/ (float icon-height) (float img-height)))
         (scaled-width (truncate (* scale img-width)))
         (scaled-height (truncate (* scale img-height)))
         (icon-true-width (truncate (* img-width scale)))
         (margin (max 0 (- icon-width icon-true-width)))
         (icon-width (+ icon-width (% margin 2)))
         (margin (- margin (% margin 2)))
         (thumbnail (cons (car image) (cl-copy-list (cdr image)))))
    (plist-put (cdr thumbnail) :height scaled-height)
    (plist-put (cdr thumbnail) :width  scaled-width)
    (plist-put (cdr thumbnail) :margin (cons (/ margin 2) 0))
    (plist-put (cdr thumbnail) :ascent 80)
    thumbnail))

(defun dual-header-split-image (image)
  "This splits IMAGE into top and bottom parts."

  (let* ((image-width (car (image-size image t)))
         (image-height (cdr (image-size image t)))
         (char-height (frame-char-height))
         (char-width (frame-char-width))
         (text-width (/ image-width char-width)))
    (cons
     (propertize (make-string text-width ? )
                 'display (list (list 'slice 0  0 image-width char-height)
                                 image)
                 'line-height t)
     (propertize (make-string text-width ? )
                 'display (list (list 'slice 0  char-height image-width char-height)
                                 image :ascent 0)
                 'line-height t))))


(let ((icon (dual-header-split-image
             (dual-header-image
              "~/Documents/Emacs/emacs-square.svg"))))
  (dual-header
   (concat (propertize " " 'display '(space :width (4)))
           (car icon)
           " "
           (propertize (format-mode-line "%b") 'face 'bold))
   (concat (propertize " " 'display '(space :width (4)))
           (cdr icon)
           " "
           (format-mode-line "(lisp mode)"))))

emacs-square.svg

<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg xmlns="http://www.w3.org/2000/svg" xmlns:xl="http://www.w3.org/1999/xlink" xmlns:dc="http://purl.org/dc/elements/1.1/" version="1.1" viewBox="384 368 64 64" width="64" height="64">
  <defs/>
  <g id="Canvas_1" stroke-dasharray="none" fill-opacity="1" stroke-opacity="1" stroke="none" fill="none">
    <title>Canvas 1</title>
    <g id="Canvas_1_Layer_1">
      <title>Layer 1</title>
      <g id="Group_331">
        <g id="Graphic_266">
          <path d="M 392 368 L 440 368 C 444.4183 368 448 371.5817 448 376 L 448 424 C 448 428.4183 444.4183 432 440 432 L 392 432 C 387.5817 432 384 428.4183 384 424 L 384 376 C 384 371.5817 387.5817 368 392 368 Z" fill="white"/>
        </g>
        <g id="Graphic_31">
          <title>emacs-read</title>
          <path d="M 392 368 L 392 368 C 387.5817 368 384 371.5817 384 376 L 384 424 C 384 428.4183 387.5817 432 392 432 L 440 432 C 444.4183 432 448 428.4183 448 424 L 448 376 C 448 371.5817 444.4183 368 440 368 Z M 428.70013 376.01454 L 428.70013 376.01454 C 429.7003 375.9942 430.5811 375.99406 431.2674 376.0214 C 443.72873 376.51817 441.2468 389.08362 433.8175 387.43495 C 405.4198 383.7292 410.16996 387.1222 431.09556 401.5051 C 422.593 402.3909 407.9818 400.82885 404.60146 407.3098 C 402.28625 411.7487 424.2512 415.9162 429.8549 417.29365 C 440.718 419.96397 436.9555 422.8843 428.34614 423.6998 C 419.487 424.53894 405.86227 423.5066 400.1955 421.9917 C 408.5014 421.73743 424.23454 421.6566 424.25294 420.66856 C 424.27003 419.74945 418.13897 419.49916 414.9427 418.80583 C 377.587 410.7026 390.74627 391.01516 419.5583 398.1955 C 413.62407 394.68543 400.8626 386.09946 404.54304 381.0769 C 405.376 379.9402 407.8495 379.27684 412.68476 380.2143 C 431.40397 383.84352 442.5264 380.5087 418.51353 376.49225 C 421.624 376.3132 425.69955 376.0756 428.70013 376.01454 Z" fill="#8ba5af"/>
        </g>
      </g>
    </g>
  </g>
</svg>