legacy-dotfiles/emacs/.emacs.d/site-lisp/my-smt.el

;;; my-smt.el --- My SVG mode-line theme             -*- lexical-binding: t; -*-

;; Copyright (C) 2014  Tom Willemse

;; Author: Tom Willemse <tom@ryuslash.org>
;; Keywords: faces

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;

;;; Code:

(smt/defwidget my-smt-flycheck-errors
  :text (lambda (widget)
          (ignore widget)
          (when flycheck-mode
            (let ((counts (flycheck-count-errors
                           flycheck-current-errors)))
              `(tspan " " (tspan :fill ,(if (smt/window-active-p)
                                            "#a85454"
                                          "#969696") ,(or (cdr (assoc 'error counts)) 0))
                      "/" (tspan :fill ,(if (smt/window-active-p)
                                            "#a88654"
                                          "#969696") ,(or (cdr (assoc 'warning counts)) 0)))))))

(smt/defwidget my-smt-jabber-activity
  :text (lambda (widget)
          (ignore widget)
          (if (and (smt/window-active-p)
                   (boundp 'jabber-activity-mode-string)
                   (not (equal jabber-activity-mode-string "")))
              (concat jabber-activity-mode-string " "))))

(defun my-smt-yoshi-title-style (widget)
  "Fill color for either active or inactive windows.

WIDGET is ignored."
  (ignore widget)
  (list :fill (if (smt/window-active-p)
                  "#a85454"
                "#969696")))

(smt/defwidget my-smt-po-counters
  :text (lambda (widget)
          (ignore widget)
          (when (eql major-mode 'po-mode)
            (format " %dt+%df+%du+%do" po-translated-counter
                    po-fuzzy-counter po-untranslated-counter
                    po-obsolete-counter))))

(smt/defwidget my-smt-buffer-identification
  :style 'my-smt-yoshi-title-style
  :text (lambda (widget)
          (ignore widget)
          (concat
           (s-trim
            (substring-no-properties
             (format-mode-line mode-line-buffer-identification)))
           (when (and (or buffer-file-name
                          buffer-offer-save)
                      (buffer-modified-p))
             "*"))))

(smt/defwidget my-smt-current-dictionary
  :text (lambda (widget)
          (ignore widget)
          (if flyspell-mode
              (concat " " (or ispell-current-dictionary
                              ispell-local-dictionary
                              flyspell-default-dictionary)))))

(smt/defwidget my-smt-position
  :text (lambda (widget)
          (ignore widget)
          (format-mode-line "%l/%c:%p")))

(defun my-smt-extra-minor-modes (minor-modes)
  "Add some more info to MINOR-MODES."
  (if (boundp 'evil-state)
      (let ((l (capitalize (elt (symbol-name evil-state) 0))))
        `(tspan ,minor-modes (tspan :fill "#54a875" ,(char-to-string l))))
    minor-modes))

(add-function
 :filter-return
 (symbol-function 'smt/minor-mode-indicator-text)
 #'my-smt-extra-minor-modes)

(smt/defrow my-smt-right
  :prototype 'default-right
  :widgets '(my-smt-jabber-activity
             major-mode
             my-smt-current-dictionary
             my-smt-flycheck-errors
             version-control minor-modes)
  :margin 16)

(smt/defrow my-smt-left
  :prototype 'default-left
  :widgets '(buffer-info my-smt-buffer-identification my-smt-po-counters
                         which-function))

(smt/defrow my-smt-position
  :prototype 'default-position
  :widgets '(my-smt-position))

(defun my-smt-major-mode-style (widget)
  (ignore widget)
  '(:fill "#ccc" :font-family "Fantasque Sans" :filter nil
          :font-weight "bold" :font-style "italic"))

(smt/deftheme my-smt
  :prototype 'black-crystal
  :local-widgets (list (cons 'major-mode
                             (smt/make-widget
                              :prototype 'major-mode
                              :style 'my-smt-major-mode-style)))
  :rows '(my-smt-left my-smt-position my-smt-right))

(provide 'my-smt)
;;; my-smt.el ends here