Initial structure mods. Untested.

This commit is contained in:
Paul Provost 2020-02-23 18:28:31 -05:00
parent 7f3788b6ae
commit 810fb161de

View File

@ -1,12 +1,12 @@
;;; petrol-theme.el --- A light colored theme -*- lexical-binding: t -*-
;; Copyright (C) 2019 Valerii Lysenko
;; Copyright (C) 2020 Paul Provost
;; Author: Valerii Lysenko <vallyscode@gmail.com>
;; Maintainer: Valerii Lysenko <vallyscode@gmail.com>
;; Author: Paul Provost <paul@provost.one>
;; Maintainer: Paul Provost <paul@provost.one>
;; Keywords: color theme
;; Package-Version: 20200221.2201
;; URL: https://github.com/vallyscode/cloud-theme
;; Package-Version: 2020mmdd.xxxx
;; URL: https://github.com/paulprovost/petrol-theme
;; Version: 0.1
;; Package: petrol-theme
;; Package-Requires: ((emacs "24"))
@ -45,10 +45,27 @@
(deftheme petrol
"Petrol light color theme.")
(let ((class '((class color) (min-colors 89))))
(let ((class '((class color) (min-colors 89)))
;;,-----------------
;;| Generic colors.
;;`-----------------
(petrol-blue "#006c96")
(petrol-orange "#cc6d00")
(petrol-purple "#6c4ca8")
(petrol-red "#d0372d")
;;,------------------
;;| Specific colors.
;;`------------------
(petrol-link '(:weight normal :foreground petrol-blue))
(petrol-link-visited '(:weight normal :foreground petrol-purple))
)
(custom-theme-set-faces
'petrol
`(default ((,class (:background "#f2f2f2" :foreground "#454545"))))
`(default ((,class (:background "#f6f6ed" :foreground "#454545"))))
`(cursor ((,class (:background "#00638a" :foreground "#f2f2f2" ))))
@ -131,8 +148,8 @@
`(window-divider-last-pixel ((,class (:background "#2f7e9d"))))
`(link ((,class (:underline t :foreground "#006c96"))))
`(link-visited ((,class (:underline t :foreground "#6c4ca8"))))
`(link ((,class ,petrol-link)))
`(link-visited ((,class ,petrol-link-visited)))
`(dired-header ((,class (:weight bold :foreground "#2f7e9d" :background "#f2f2f2"))))
@ -298,6 +315,8 @@
`(org-level-7 ((,class (:height 1.0 :weight bold :foreground "#008080"))))
`(org-level-8 ((,class (:height 1.0 :weight bold :foreground "#6c7378"))))
`(org-link ((,class ,link)))
`(org-block ((,class (:background "#f2f2f2"))))
`(org-block-background ((,class (:background "#f2f2f2"))))
`(org-block-begin-line ((,class (:underline nil :foreground "#454545" :background "#cfd8dc"))))
@ -364,398 +383,9 @@
`(cypher-pattern-face ((,class (:foreground "#d70087" :background "#f2f2f2"))))
`(cypher-relation-type-face ((,class (:weight normal :foreground "#008080"))))
`(cypher-symbol-face ((,class (:slant italic :foreground "#454545"))))
`(cypher-variable-face ((,class (:foreground "#454545"))))))
;;
;; Petrol mode line
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Utils
(defvar petrolline-selected-window (frame-selected-window) "Selected window.")
(defun petrolline-selected-window-active-p ()
"Return t if selected window is active."
(eq petrolline-selected-window (selected-window)))
(defun petrolline-set-selected-window ()
"Set the variable for current selected window."
(when (not (minibuffer-window-active-p (frame-selected-window)))
(setq petrolline-selected-window (frame-selected-window))
(force-mode-line-update)))
(defun petrolline-unset-selected-window ()
"Unset the variable for current selected window."
(setq petrolline-selected-window nil)
(force-mode-line-update))
(add-hook 'window-configuration-change-hook 'petrolline-set-selected-window)
(add-hook 'buffer-list-update-hook 'petrolline-set-selected-window)
(with-no-warnings
(add-hook 'focus-in-hook 'petrolline-set-selected-window)
(add-hook 'focus-out-hook 'petrolline-unset-selected-window))
;; Handle mode line alignment
(defun petrolline--format (left right)
"Return a string of `window-width' length with aligned `LEFT' and `RIGHT' segments."
(let ((right-length (length right)))
(when (and (display-graphic-p) (eq 'right (get-scroll-bar-mode)))
(setq right-length (- right-length 3)))
(concat left
" "
(propertize " "
'display
`((space :align-to (- (+ right right-fringe right-margin) ,(+ right-length 0)))))
right)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Faces
(defface petrolline-evil-normal-active
'((t :foreground "#388e3c"
:weight bold
:height 1.0))
"Face for evil normal state active.")
(defface petrolline-evil-normal-inactive
'((t :foreground "#a7cf42"
:weight bold
:height 1.0))
"Face for evil normal state inactive.")
(defface petrolline-evil-insert-active
'((t :foreground "#d0372d"
:weight bold
:height 1.0))
"Face for evil insert state active.")
(defface petrolline-evil-insert-inactive
'((t :foreground "#ff9999"
:weight bold
:height 1.0))
"Face for evil insert state inactive.")
(defface petrolline-evil-visual-active
'((t :foreground "#008abc"
:weight bold
:height 1.0))
"Face for evil visual state active.")
(defface petrolline-evil-visual-inactive
'((t :foreground "#8dd0eb"
:weight bold
:height 1.0))
"Face for evil visual state inactive.")
(defface petrolline-evil-replace-active
'((t :foreground "#c06600"
:weight bold
:height 1.0))
"Face for evil replace state active.")
(defface petrolline-evil-replace-inactive
'((t :foreground "#f0d97a"
:weight bold
:height 1.0))
"Face for evil replace state inactive.")
(defface petrolline-evil-emacs-active
'((t :foreground "#6c4ca8"
:weight bold
:height 1.0))
"Face for evil emacs state active.")
(defface petrolline-evil-emacs-inactive
'((t :foreground "#b48cff"
:weight bold
:height 1.0))
"Face for evil emacs state inactive.")
(defface petrolline-file-name-active
'((t :foreground "#00638a"
:weight bold))
"Face for buffer file name active.")
(defface petrolline-file-name-inactive
'((t :foreground "#8dd0eb"
:weight bold))
"Face for buffer file name inactive.")
(defface petrolline-major-mode-active
'((t :foreground "#6c4ca8"
:weight bold
:height 1.0))
"Face for major mode name active.")
(defface petrolline-major-mode-inactive
'((t :foreground "#b48cff"
:weight bold
:height 1.0))
"Face for major mode name inactive.")
(defface petrolline-vc-active
'((t :foreground "#5e8203"
:weight normal
:slant italic))
"Face for VC state active.")
(defface petrolline-vc-inactive
'((t :foreground "#a7cf42"
:weight normal
:slant italic))
"Face for VC state inactive.")
(defface petrolline-file-size-active
'((t :foreground "#cc6d00"
:weight normal))
"Face for file size active buffer.")
(defface petrolline-file-size-inactive
'((t :foreground "#f0d97a"
:weight normal))
"Face for file size inactive buffer.")
(defface petrolline-readonly
'((t :weight normal))
"Face for rean only buffer indication."
:group 'petrolline)
(defface petrolline-modified
'((t :weight normal))
"Face for modified buffer indication."
:group 'petrolline)
(defface petrolline-position-active
'((t :foreground "#cc6d00"
:weight normal))
"Face for position in active buffer.")
(defface petrolline-position-inactive
'((t :foreground "#f0d97a"
:weight normal))
"Face for position in inactive buffer.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Segments
(defmacro defpetrolline (name body)
"Create a function with `NAME' and `BODY'."
`(defun ,name (&optional face)
(let ((str (format-mode-line ,body)))
(if face
(propertize str 'face face)
str))))
(defvar evil-state)
(declare-function evil-normal-state-p "evil")
(declare-function evil-insert-state-p "evil")
(declare-function evil-motion-state-p "evil")
(declare-function evil-visual-state-p "evil")
(declare-function evil-operator-state-p "evil")
(declare-function evil-replace-state-p "evil")
(declare-function evil-emacs-state-p "evil")
(declare-function evil-state-property "evil")
(defpetrolline petrolline--evil
(when (bound-and-true-p evil-local-mode)
(let ((active (petrolline-selected-window-active-p))
(tag (evil-state-property evil-state :tag t)))
(propertize tag
'face
(if active
(cond ((evil-normal-state-p) 'petrolline-evil-normal-active)
((evil-insert-state-p) 'petrolline-evil-insert-active)
((evil-motion-state-p) 'petrolline-evil-normal-active)
((evil-visual-state-p) 'petrolline-evil-visual-active)
((evil-operator-state-p) 'petrolline-evil-normal-active)
((evil-replace-state-p) 'petrolline-evil-replace-active)
((evil-emacs-state-p) 'petrolline-evil-emacs-active))
'petrolline-evil-emacs-inactive)))))
;; File name segment
(defpetrolline petrolline--file-name
(propertize "%b"
'help-echo (buffer-file-name)
'face
(if (petrolline-selected-window-active-p)
'petrolline-file-name-active
'petrolline-file-name-inactive)))
;; Major mode segment
(defpetrolline petrolline--major-mode
(propertize "%m"
'help-echo "Major mode name"
'face
(if (petrolline-selected-window-active-p)
'petrolline-major-mode-active
'petrolline-major-mode-inactive)))
;; Version Control segment
(defpetrolline petrolline--vc
(when (and vc-mode buffer-file-name)
(list
(propertize (format-mode-line '(vc-mode vc-mode))
'face
(if (petrolline-selected-window-active-p)
'petrolline-vc-active
'petrolline-vc-inactive)))))
;; File size segment
(defpetrolline petrolline--file-size
(propertize "%I"
'help-echo "file size"
'face
(if (petrolline-selected-window-active-p)
'petrolline-file-size-active
'petrolline-file-size-inactive)))
;; Readonly segment
(defpetrolline petrolline--readonly
(let ((tag (if (and
buffer-read-only
(not (string-match-p "\\*.*\\*" (buffer-name))))
(char-to-string ?r)
"")))
(propertize tag
'help-echo "read only"
'face
'petrolline-readonly)))
;; Modified segment
(defpetrolline petrolline--modified
(let ((tag (if (and (buffer-modified-p (current-buffer))
(not (string-match-p "\\*.*\\*" (buffer-name))))
(char-to-string ?*)
"")))
(propertize tag 'face 'petrolline-modified)))
;; Position segment
(defpetrolline petrolline--position
(let ((f (if (petrolline-selected-window-active-p)
'petrolline-position-active
'petrolline-position-inactive)))
(list
(propertize "%l" 'face f)
":"
(propertize "%c" 'face f))))
;; End of line segment
(defpetrolline petrolline--eol
(pcase (coding-system-eol-type buffer-file-coding-system)
(0 "LF")
(1 "CRLF")
(2 "CR")))
;; Encoding segment
(defpetrolline petrolline--encoding
(let ((sys (coding-system-plist buffer-file-coding-system)))
(cond ((memq (plist-get sys :category) '(coding-category-undecided coding-category-utf-8))
"utf-8")
(t (symbol-name (plist-get sys :name))))))
;; Flycheck segment
(declare-function flycheck-count-errors "flycheck" (errors))
(defvar flycheck-current-errors)
(defvar-local petrolline--flycheck-state nil)
(defun petrolline--flycheck-segment (&optional status)
"Display flycheck `STATUS'."
(setq petrolline--flycheck-state
(pcase status
('finished (if flycheck-current-errors
(let-alist (flycheck-count-errors flycheck-current-errors)
(let* ((errors (or .error 0))
(warnings (or .warning 0)))
(concat
(propertize "" 'help-echo "warnings" 'face 'warning)
" "
(number-to-string warnings)
" "
(propertize "" 'help-echo "errors" 'face 'error)
" "
(number-to-string errors)
)))
(propertize "" 'help-echo "good" 'face 'success)))
('running "⟲ checking")
('no-checker "? no checker")
('errored "! error")
('interrupted "! paused"))))
(defpetrolline petrolline--flycheck
petrolline--flycheck-state)
(defvar petrolline-default-mode-line-format mode-line-format
"Default format for mode line.")
(defun petrolline-default ()
"Rollback to default mode line."
(interactive)
(setq-default mode-line-format petrolline-default-mode-line-format))
;;;###autoload
(defun petrol-theme-mode-line ()
"Customize mode line to petrol style."
(interactive)
;; Setup flycheck hooks
(add-hook 'flycheck-status-changed-functions #'petrolline--flycheck-segment)
(add-hook 'flycheck-mode-hook #'petrolline--flycheck-segment)
(let ((class '((class color) (min-colors 89))))
(custom-set-faces
`(mode-line
((,class (:background "#f2f2f2"
:height 120
:foreground "#6c7b8b"
:box (:line-width 1 :color "#f2f2f2")))))
`(mode-line-inactive
((,class (:background "#f2f2f2"
:height 120
:foreground "#a8b3ba"
:box (:line-width 1 :color "#f2f2f2")))))))
(setq-default mode-line-format
'((:eval
(petrolline--format
;; left
(format-mode-line
'((:eval (petrolline--evil))
" "
(:eval (petrolline--file-name))
(:eval (petrolline--readonly))
(:eval (petrolline--modified))
" "
(:eval (petrolline--vc))
" "
(:eval (petrolline--flycheck))
" "
))
(format-mode-line
'(" "
(:eval (petrolline--position))
" "
(:eval (petrolline--encoding))
" "
(:eval (petrolline--eol))
" "
(:eval (petrolline--major-mode))
" ")))))))
`(cypher-variable-face ((,class (:foreground "#454545"))))
)
)
;;;###autoload
(and load-file-name