You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
341 lines
13 KiB
341 lines
13 KiB
;;; powerline-separators.el --- Separators for Powerline |
|
|
|
;; Copyright (C) 2012-2013 Donald Ephraim Curtis |
|
;; Copyright (C) 2013 Jason Milkins |
|
;; Copyright (C) 2012 Nicolas Rougier |
|
|
|
;; Author: Donald Ephraim Curtis <dcurtis@milkbox.net> |
|
;; URL: http://github.com/milkypostman/powerline/ |
|
;; Version: 2.0 |
|
;; Keywords: mode-line |
|
|
|
;;; Commentary: |
|
;; |
|
;; Separators for Powerline. |
|
;; Included separators: alternate, arrow, arrow-fade, bar, box, brace, butt, |
|
;; chamfer, contour, curve, rounded, roundstub, slant, wave, zigzag, and nil. |
|
;; |
|
|
|
;;; Code: |
|
|
|
(require 'cl-lib) |
|
(require 'color) |
|
|
|
(defun pl/interpolate (color1 color2) |
|
"Interpolate between COLOR1 and COLOR2. |
|
|
|
COLOR1 and COLOR2 must be supplied as hex strings with a leading #." |
|
(let* ((c1 (color-name-to-rgb color1)) |
|
(c2 (color-name-to-rgb color2)) |
|
(red (/ (+ (nth 0 c1) (nth 0 c2)) 2)) |
|
(green (/ (+ (nth 1 c1) (nth 1 c2)) 2)) |
|
(blue (/ (+ (nth 2 c1) (nth 2 c2)) 2))) |
|
(color-rgb-to-hex red green blue))) |
|
|
|
(defun pl/hex-color (color) |
|
"Get the hexadecimal value of COLOR." |
|
(when color |
|
(apply 'color-rgb-to-hex (color-name-to-rgb color)))) |
|
|
|
(defun pl/pattern (lst) |
|
"Turn LST into an infinite pattern." |
|
(when lst |
|
(let ((pattern (cl-copy-list lst))) |
|
(setcdr (last pattern) pattern)))) |
|
|
|
(defun pl/pattern-to-string (pattern) |
|
"Convert a PATTERN into a string that can be used in an XPM." |
|
(concat "\"" (mapconcat 'number-to-string pattern "") "\",")) |
|
|
|
(defun pl/reverse-pattern (pattern) |
|
"Reverse each line in PATTERN." |
|
(mapcar 'reverse pattern)) |
|
|
|
(defun pl/row-pattern (fill total &optional fade) |
|
"Make a list that has FILL 0s out of TOTAL 1s with FADE 2s to the right of the fill." |
|
(unless fade |
|
(setq fade 0)) |
|
(let ((fill (min fill total)) |
|
(fade (min fade (max (- total fill) 0)))) |
|
(append (make-list fill 0) |
|
(make-list fade 2) |
|
(make-list (- total fill fade) 1)))) |
|
|
|
|
|
(defun pl/pattern-defun (name dir width &rest patterns) |
|
"Create a powerline function of NAME in DIR with WIDTH for PATTERNS. |
|
|
|
PATTERNS is of the form (PATTERN HEADER FOOTER SECOND-PATTERN CENTER). |
|
PATTERN is required, all other components are optional. |
|
|
|
All generated functions generate the form: |
|
HEADER |
|
PATTERN ... |
|
CENTER |
|
SECOND-PATTERN ... |
|
FOOTER |
|
|
|
PATTERN and SECOND-PATTERN repeat infinitely to fill the space needed to generate a full height XPM. |
|
|
|
PATTERN, HEADER, FOOTER, SECOND-PATTERN, CENTER are of the form ((COLOR ...) (COLOR ...) ...). |
|
|
|
COLOR can be one of 0, 1, or 2, where 0 is the source color, 1 is the |
|
destination color, and 2 is the interpolated color between 0 and 1." |
|
(when (eq dir 'right) |
|
(setq patterns (mapcar 'pl/reverse-pattern patterns))) |
|
(let* ((pattern (pl/pattern (mapcar 'pl/pattern-to-string (car patterns)))) |
|
(header (mapcar 'pl/pattern-to-string (nth 1 patterns))) |
|
(footer (mapcar 'pl/pattern-to-string (nth 2 patterns))) |
|
(second-pattern (pl/pattern (mapcar 'pl/pattern-to-string (nth 3 patterns)))) |
|
(center (mapcar 'pl/pattern-to-string (nth 4 patterns))) |
|
(reserve (+ (length header) (length footer) (length center)))) |
|
(pl/wrap-defun name dir width |
|
`((pattern-height (max (- height ,reserve) 0)) |
|
(second-pattern-height (/ pattern-height 2)) |
|
(pattern-height ,(if second-pattern '(ceiling pattern-height 2) 'pattern-height))) |
|
(list (when header `(mapconcat 'identity ',header "")) |
|
`(mapconcat 'identity (cl-subseq ',pattern 0 pattern-height) "") |
|
(when center `(mapconcat 'identity ',center "")) |
|
(when second-pattern `(mapconcat 'identity (cl-subseq ',second-pattern 0 second-pattern-height) "")) |
|
(when footer `(mapconcat 'identity ',footer "")))))) |
|
|
|
(defun pl/background-color (face) |
|
(face-attribute face |
|
(if (face-attribute face :inverse-video nil 'default) |
|
:foreground |
|
:background) |
|
nil |
|
'default)) |
|
|
|
(defun pl/wrap-defun (name dir width let-vars body) |
|
"Generate a powerline function of NAME in DIR with WIDTH using LET-VARS and BODY." |
|
(let* ((src-face (if (eq dir 'left) 'face1 'face2)) |
|
(dst-face (if (eq dir 'left) 'face2 'face1))) |
|
`(defun ,(intern (format "powerline-%s-%s" name (symbol-name dir))) |
|
(face1 face2 &optional height) |
|
(when window-system |
|
(unless height (setq height (pl/separator-height))) |
|
(let* ,(append `((color1 (when ,src-face |
|
(pl/hex-color (pl/background-color ,src-face)))) |
|
(color2 (when ,dst-face |
|
(pl/hex-color (pl/background-color ,dst-face)))) |
|
(colori (when (and color1 color2) (pl/interpolate color1 color2))) |
|
(color1 (or color1 "None")) |
|
(color2 (or color2 "None")) |
|
(colori (or colori "None"))) |
|
let-vars) |
|
(create-image ,(append `(concat (format "/* XPM */ static char * %s_%s[] = { \"%s %s 3 1\", \"0 c %s\", \"1 c %s\", \"2 c %s\"," |
|
,(replace-regexp-in-string "-" "_" name) |
|
(symbol-name ',dir) |
|
,width |
|
height |
|
color1 |
|
color2 |
|
colori)) |
|
body |
|
'("};")) |
|
'xpm t |
|
:ascent 'center |
|
:face (when (and face1 face2) |
|
,dst-face))))))) |
|
|
|
|
|
(defmacro pl/alternate (dir) |
|
"Generate an alternating pattern XPM function for DIR." |
|
(pl/pattern-defun "alternate" dir 4 |
|
'((2 2 1 1) |
|
(0 0 2 2)))) |
|
|
|
(defmacro pl/arrow (dir) |
|
"Generate an arrow XPM function for DIR." |
|
(let ((row-modifier (if (eq dir 'left) 'identity 'reverse))) |
|
(pl/wrap-defun "arrow" dir 'middle-width |
|
'((width (1- (/ height 2))) |
|
(middle-width (1- (ceiling height 2)))) |
|
`((cl-loop for i from 0 to width |
|
concat (pl/pattern-to-string (,row-modifier (pl/row-pattern i middle-width)))) |
|
(when (cl-oddp height) |
|
(pl/pattern-to-string (make-list middle-width 0))) |
|
(cl-loop for i from width downto 0 |
|
concat (pl/pattern-to-string (,row-modifier (pl/row-pattern i middle-width)))))))) |
|
|
|
(defmacro pl/arrow-fade (dir) |
|
"Generate an arrow-fade XPM function for DIR." |
|
(let* ((row-modifier (if (eq dir 'left) 'identity 'reverse))) |
|
(pl/wrap-defun "arrow-fade" dir 'middle-width |
|
'((width (1- (/ height 2))) |
|
(middle-width (1+ (ceiling height 2)))) |
|
`((cl-loop for i from 0 to width |
|
concat (pl/pattern-to-string (,row-modifier (pl/row-pattern i middle-width 2)))) |
|
(when (cl-oddp height) |
|
(pl/pattern-to-string (,row-modifier (pl/row-pattern (1+ width) middle-width 2)))) |
|
(cl-loop for i from width downto 0 |
|
concat (pl/pattern-to-string (,row-modifier (pl/row-pattern i middle-width 2)))))))) |
|
|
|
(defmacro pl/bar (dir) |
|
"Generate a bar XPM function for DIR." |
|
(pl/pattern-defun "bar" dir 2 |
|
'((2 2)))) |
|
|
|
(defmacro pl/box (dir) |
|
"Generate a box XPM function for DIR." |
|
(pl/pattern-defun "box" dir 2 |
|
'((0 0) |
|
(0 0) |
|
(1 1) |
|
(1 1)))) |
|
|
|
(defmacro pl/brace (dir) |
|
"Generate a brace XPM function for DIR." |
|
(pl/pattern-defun "brace" dir 4 |
|
'((0 1 1 1)) |
|
'((1 1 1 1) |
|
(2 1 1 1)) |
|
'((2 1 1 1) |
|
(1 1 1 1)) |
|
'((0 1 1 1)) |
|
'((0 2 1 1) |
|
(0 2 1 1) |
|
(0 0 2 1) |
|
(0 0 0 0) |
|
(0 0 2 1) |
|
(0 2 1 1) |
|
(0 2 1 1)))) |
|
|
|
(defmacro pl/butt (dir) |
|
"Generate a butt XPM function for DIR." |
|
(pl/pattern-defun "butt" dir 3 |
|
'((0 0 0)) |
|
'((1 1 1) |
|
(0 1 1) |
|
(0 0 1)) |
|
'((0 0 1) |
|
(0 1 1) |
|
(1 1 1)))) |
|
|
|
(defmacro pl/chamfer (dir) |
|
"Generate a chamfer XPM function for DIR." |
|
(pl/pattern-defun "chamfer" dir 3 |
|
'((0 0 0)) |
|
'((1 1 1) |
|
(0 1 1) |
|
(0 0 1)))) |
|
|
|
(defmacro pl/contour (dir) |
|
"Generate a contour XPM function for DIR." |
|
(pl/pattern-defun "contour" dir 10 |
|
'((0 0 0 0 0 1 1 1 1 1)) |
|
'((1 1 1 1 1 1 1 1 1 1) |
|
(0 2 1 1 1 1 1 1 1 1) |
|
(0 0 2 1 1 1 1 1 1 1) |
|
(0 0 0 2 1 1 1 1 1 1) |
|
(0 0 0 0 1 1 1 1 1 1) |
|
(0 0 0 0 2 1 1 1 1 1)) |
|
'((0 0 0 0 0 2 1 1 1 1) |
|
(0 0 0 0 0 0 1 1 1 1) |
|
(0 0 0 0 0 0 2 1 1 1) |
|
(0 0 0 0 0 0 0 2 1 1) |
|
(0 0 0 0 0 0 0 0 0 0)))) |
|
|
|
(defmacro pl/curve (dir) |
|
"Generate a curve XPM function for DIR." |
|
(pl/pattern-defun "curve" dir 4 |
|
'((0 0 0 0)) |
|
'((1 1 1 1) |
|
(2 1 1 1) |
|
(0 0 1 1) |
|
(0 0 2 1) |
|
(0 0 0 1) |
|
(0 0 0 2)) |
|
'((0 0 0 2) |
|
(0 0 0 1) |
|
(0 0 2 1) |
|
(0 0 1 1) |
|
(2 1 1 1) |
|
(1 1 1 1)))) |
|
|
|
(defmacro pl/rounded (dir) |
|
"Generate a rounded XPM function for DIR." |
|
(pl/pattern-defun "rounded" dir 6 |
|
'((0 0 0 0 0 0)) |
|
'((2 1 1 1 1 1) |
|
(0 0 2 1 1 1) |
|
(0 0 0 0 1 1) |
|
(0 0 0 0 2 1) |
|
(0 0 0 0 0 1) |
|
(0 0 0 0 0 2)))) |
|
|
|
(defmacro pl/roundstub (dir) |
|
"Generate a roundstub XPM function for DIR." |
|
(pl/pattern-defun "roundstub" dir 3 |
|
'((0 0 0)) |
|
'((1 1 1) |
|
(0 0 1) |
|
(0 0 2)) |
|
'((0 0 2) |
|
(0 0 1) |
|
(1 1 1)))) |
|
|
|
(defmacro pl/slant (dir) |
|
"Generate a slant XPM function for DIR." |
|
(let* ((row-modifier (if (eq dir 'left) 'identity 'reverse))) |
|
(pl/wrap-defun "slant" dir 'width |
|
'((width (1- (ceiling height 2)))) |
|
`((cl-loop for i from 0 to height |
|
concat (pl/pattern-to-string (,row-modifier (pl/row-pattern (/ i 2) width)))))))) |
|
|
|
(defmacro pl/wave (dir) |
|
"Generate a wave XPM function for DIR." |
|
(pl/pattern-defun "wave" dir 11 |
|
'((0 0 0 0 0 0 1 1 1 1 1)) |
|
'((2 1 1 1 1 1 1 1 1 1 1) |
|
(0 0 1 1 1 1 1 1 1 1 1) |
|
(0 0 0 1 1 1 1 1 1 1 1) |
|
(0 0 0 2 1 1 1 1 1 1 1) |
|
(0 0 0 0 1 1 1 1 1 1 1) |
|
(0 0 0 0 2 1 1 1 1 1 1) |
|
(0 0 0 0 0 1 1 1 1 1 1) |
|
(0 0 0 0 0 1 1 1 1 1 1) |
|
(0 0 0 0 0 2 1 1 1 1 1)) |
|
'((0 0 0 0 0 0 2 1 1 1 1) |
|
(0 0 0 0 0 0 0 1 1 1 1) |
|
(0 0 0 0 0 0 0 1 1 1 1) |
|
(0 0 0 0 0 0 0 2 1 1 1) |
|
(0 0 0 0 0 0 0 0 1 1 1) |
|
(0 0 0 0 0 0 0 0 2 1 1) |
|
(0 0 0 0 0 0 0 0 0 0 2)))) |
|
|
|
(defmacro pl/zigzag (dir) |
|
"Generate a zigzag pattern XPM function for DIR." |
|
(pl/pattern-defun "zigzag" dir 3 |
|
'((1 1 1) |
|
(0 1 1) |
|
(0 0 1) |
|
(0 0 0) |
|
(0 0 1) |
|
(0 1 1)))) |
|
|
|
(defmacro pl/nil (dir) |
|
"Generate a XPM function that returns nil for DIR." |
|
`(defun ,(intern (format "powerline-nil-%s" (symbol-name dir))) |
|
(face1 face2 &optional height) |
|
nil)) |
|
|
|
(defmacro pl/utf-8 (dir) |
|
"Generate function that returns raw utf-8 symbols." |
|
(let ((dir-name (symbol-name dir)) |
|
(src-face (if (eq dir 'left) 'face1 'face2)) |
|
(dst-face (if (eq dir 'left) 'face2 'face1))) |
|
`(defun ,(intern (format "powerline-utf-8-%s" dir-name)) |
|
(face1 face2 &optional height) |
|
(powerline-raw |
|
(char-to-string ,(intern (format "powerline-utf-8-separator-%s" |
|
dir-name))) |
|
(list :foreground (pl/background-color ,src-face) |
|
:background (pl/background-color ,dst-face) |
|
:inverse-video nil))))) |
|
|
|
|
|
(provide 'powerline-separators) |
|
|
|
;;; powerline-separators.el ends here
|
|
|