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 " "))))

;;; TODO Turn:
;;    #("message: (FORMAT-STRING &rest ARGS)"
;;       0  7 (face font-lock-function-name-face)
;;      10 23 (face eldoc-highlight-function-argument))
;;; into:
;;;  (tspan (tspan :fill (fg-color font-lock-function-name-face) "message:")
;;;         " ("
;;;         (tspan :fill (fg-color highlight-function-argument) "FORMAT-STRING")
;;;         " &rest ARGS)")
(defun my-smt-eldoc-minibuffer-message (format-string &rest args)
  (if (minibufferp)
      (progn
        (add-hook 'minibuffer-exit-hook
                  (lambda () (setq my-smt-eldoc-message nil
                              eldoc-mode-line-string nil
                              eldoc-last-message nil))
                  nil t)
        (setq my-smt-eldoc-message
              (when (stringp format-string)
                (apply 'format format-string args)))
        (force-mode-line-update t))
    (apply 'message format-string args)))

(defvar my-smt-eldoc-message nil)
(smt/defwidget my-smt-eldoc-message
  :text (lambda (widget)
          (ignore widget)
          (when my-smt-eldoc-message
            `(tspan :fill "#bfbfbf" " (" (tspan :fill "#5476a8" ,my-smt-eldoc-message) ")"))))

(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 my-smt-eldoc-message))

(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))

(add-function :override (symbol-function 'eldoc-minibuffer-message)
              #'my-smt-eldoc-minibuffer-message)

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