mode-icons/mode-icons.el

1905 lines
82 KiB
EmacsLisp
Raw Permalink Normal View History

;;; mode-icons.el --- Show icons for modes -*- lexical-binding: t; -*-
2012-11-10 23:12:36 +01:00
2016-02-21 13:43:50 +01:00
;; Copyright (C) 2013, 2016 Tom Willemse
;; 2016 Matthew L. Fidler
2012-11-10 23:12:36 +01:00
2013-06-02 14:45:06 +02:00
;; Author: Tom Willemse <tom@ryuslash.org>
2012-11-10 23:12:36 +01:00
;; Keywords: multimedia
2016-04-25 11:24:19 +02:00
;; Version: 0.4.0
2013-06-02 14:45:06 +02:00
;; URL: http://ryuslash.org/projects/mode-icons.html
;; Package-Requires: ((emacs "24") (cl-lib "0.5"))
2012-11-10 23:12:36 +01:00
;; 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:
2016-01-21 22:07:28 +01:00
;; This package provides a globalized minor mode that replaces the
;; major mode name in your mode-line and places like Ibuffer with an
;; icon. Currently the following programming modes are supported,
;; among others:
2012-11-10 23:12:36 +01:00
;;
2019-04-13 21:18:39 +02:00
;; - C
;; - C++
;; - C#
2016-01-21 22:07:28 +01:00
;; - CSS
;; - Coffee
2019-04-13 21:18:39 +02:00
;; - Dart
2016-01-21 22:07:28 +01:00
;; - Emacs-Lisp
;; - HTML
;; - Haml
;; - JavaScript
;; - Lisp
2017-02-15 09:56:27 +01:00
;; - Lua
2016-01-21 22:07:28 +01:00
;; - nXML
;; - PHP
;; - Python
;; - React
2016-01-21 22:07:28 +01:00
;; - Ruby
2019-04-12 23:58:45 +02:00
;; - Rust
2016-01-21 22:07:28 +01:00
;; - Sass/Scss
;; - Scheme
;; - Shell-script
;; - Slim
;; - Snippet
;; - Web
;; - Yaml
;;
;; To enable this minor mode add the following line to your init file:
;;
;; (mode-icons-mode)
;;
;; As of version 0.3.0 this project includes some icons which can use icon
;; fonts instead of images. These fonts are:
;;
;; - Font Awesome, found at URL `http://fontawesome.io/'.
;; - GitHub Octicons, found at URL `https://octicons.github.com/'.
;; - Font Mfizz, found at URL `http://fizzed.com/oss/font-mfizz'.
;; - IcoMoon, found at URL `https://icomoon.io/#icons-icomoon'.
;;
2012-11-10 23:12:36 +01:00
;;; Code:
2016-04-21 15:25:17 +02:00
(declare-function comint-send-string "comint")
(declare-function emojify-set-emoji-data "emojify")
(declare-function ht-get "ht")
(declare-function powerline-minor-modes "powerline")
(declare-function powerline-raw "powerline-raw")
(declare-function pl/add-text-property "powerline")
(declare-function mode-icons--real-powerline-raw "powerline")
(declare-function mode-icons--powerline-raw "mode-icons")
2016-04-21 15:25:17 +02:00
(declare-function mode-icons--real-powerline-major-mode "powerline")
(declare-function mode-icons--powerline-major-mode "mode-icons")
(require 'cl-lib)
2016-03-30 21:18:14 +02:00
(require 'color)
(require 'emojify nil t)
(defgroup mode-icons nil
"Provide icons for major modes."
:group 'editing-basics
:group 'convenience)
2012-11-10 23:12:36 +01:00
(defconst mode-icons--directory
(if load-file-name
(file-name-directory load-file-name)
default-directory)
2012-11-10 23:17:42 +01:00
"Where mode-icons was loaded from.")
(defun mode-icons-get-icon-file (icon)
"Get the location of ICON.
ICON should be a file name with extension. The result is the
absolute path to ICON."
2016-03-30 21:21:50 +02:00
(expand-file-name icon (expand-file-name "icons" mode-icons--directory)))
2012-11-10 23:12:36 +01:00
2016-02-19 19:45:02 +01:00
(defmacro mode-icons-save-buffer-state (&rest body)
2016-03-30 21:18:14 +02:00
"Eval BODY saving buffer state.
This macro restores the buffer state under the assumption that no
significant modification has been made in BODY. A change is
considered significant if it affects the buffer text in any way
that isn't completely restored again. Changes in text properties
like `face' or `syntax-table' are considered insignificant. This
macro allows text properties to be changed, even in a read-only
buffer.
2016-02-19 19:45:02 +01:00
This macro should be placed around all calculations which set
\"insignificant\" text properties in a buffer, even when the buffer is
known to be writeable. That way, these text properties remain set
even if the user undoes the command which set them.
This macro should ALWAYS be placed around \"temporary\" internal buffer
changes \(like adding a newline to calculate a text-property then
deleting it again\), so that the user never sees them on his
2016-02-21 13:44:04 +01:00
`buffer-undo-list'.
2016-02-19 19:45:02 +01:00
However, any user-visible changes to the buffer \(like auto-newlines\)
must not be within a `ergoemacs-save-buffer-state', since the user then
wouldn't be able to undo them.
The return value is the value of the last form in BODY.
This was stole/modified from `c-save-buffer-state'"
`(let* ((modified (buffer-modified-p)) (buffer-undo-list t)
(inhibit-read-only t) (inhibit-point-motion-hooks t)
before-change-functions after-change-functions
deactivate-mark
buffer-file-name buffer-file-truename ; Prevent primitives checking
; for file modification
)
(unwind-protect
(progn ,@body)
(and (not modified)
(buffer-modified-p)
(set-buffer-modified-p nil)))))
(defcustom mode-icons
2016-03-29 16:28:13 +02:00
`(("\\`CSS\\'" "css" xpm)
2016-03-30 20:32:08 +02:00
("\\`Coffee\\'" "coffee" xpm-bw)
2016-03-29 16:28:13 +02:00
("\\`Compilation\\'" "compile" xpm)
2019-04-13 21:18:39 +02:00
("\\`Dart\\'" "dart" xpm)
("\\`Flutter\\'" "flutter" xpm)
("\\`Elixir\\'" "elixir" xpm)
("\\`Erlang\\'" "erlang" xpm)
2016-03-29 16:28:13 +02:00
("\\`Emacs-Lisp\\'" "emacs" xpm)
("\\`Lisp Interaction\\'" "emacs" xpm)
("\\`HTML\\'" "html" xpm)
("\\`Haml\\'" "haml" xpm)
2016-04-04 23:13:53 +02:00
("\\`Image\\[imagemagick\\]\\'" "svg" xpm)
2016-03-29 16:28:13 +02:00
("\\`Inf-Ruby\\'" "infruby" xpm)
2016-04-02 05:05:13 +02:00
("\\`Java[Ss]cript\\'" "js" xpm)
2016-03-29 16:28:13 +02:00
("\\`Lisp\\'" "cl" xpm)
2017-02-15 09:56:27 +01:00
("\\`Lua\\'" "Lua-Logo_16x16" png)
2016-03-29 16:28:13 +02:00
("\\`nXML\\'" "xml" xpm)
("\\`Org\\'" "org" xpm)
("\\`PHP\\(\\|/.*\\)\\'" "php" xpm)
2016-03-29 16:28:13 +02:00
("\\`Projectile Rails Server\\'" "rails" xpm)
("\\`Python\\'" "python" xpm)
2016-11-19 03:55:59 +01:00
("\\` Emmet\\'" "emmet" xpm)
("\\`RJSX\\'" "react" xpm)
2016-03-29 16:28:13 +02:00
("\\`Ruby\\'" "ruby" xpm)
2019-04-12 23:57:46 +02:00
("\\`Rust\\'" "rust" xpm)
("\\`EnhRuby\\'" "ruby" xpm)
("\\`ESS\\[S\\]\\'" "R" xpm)
("\\`ESS\\[SAS\\]\\'" "sas" xpm)
("\\`ESS\\[BUGS\\]\\'" #xf188 FontAwesome)
("\\`iESS\\'" "R" xpm)
("\\`SCSS\\'" "sass" xpm)
("\\`Sass\\'" "sass" xpm)
2016-03-30 20:32:08 +02:00
("\\`Scheme" "scheme" xpm-bw)
("\\`Shell-script" "bash" xpm-bw)
("\\`Slim" "slim" xpm-bw)
2016-03-29 16:28:13 +02:00
("\\`Snippet" "yas" xpm)
("\\`Term\\'" "term" xpm)
("\\`Web\\'" "html" xpm)
("\\`XML\\'" "xml" xpm)
("\\`YAML\\'" "yaml" xpm)
2016-04-21 15:11:16 +02:00
("\\` ?YASnippet\\'" "yas" xpm)
("\\` ?yas\\'" "yas" xpm)
("\\` ?hs\\'" "hs" xpm)
("\\`Markdown\\'" #xf0c9 github-octicons)
("\\`GFM\\'" #xf0c9 github-octicons)
("\\`Scala\\'" #xf15b font-mfizz)
("\\`Magit\\'" #xf1d2 FontAwesome)
("\\` Pulls\\'" #xf092 FontAwesome)
("\\`Zip-Archive\\'" #xf1c6 FontAwesome)
2016-03-29 16:28:13 +02:00
("\\` ARev\\'" #xf021 FontAwesome)
("\\`Calc\\(ulator\\)?\\'" #xf1ec FontAwesome)
("\\`Debug.*\\'" #xf188 FontAwesome)
("\\`Debug.*\\'" #xf188 FontAwesome)
("\\`Calendar\\'" #xf073 FontAwesome)
("\\`Help\\'" #xf059 FontAwesome)
("\\`WoMan\\'" #xf05a FontAwesome)
2019-04-13 20:21:12 +02:00
("\\`C\\(/.*\\|\\)\\'" "c" xpm)
("\\`Custom\\'" #xf013 FontAwesome)
2016-02-11 16:28:17 +01:00
("\\`Go\\'" "go" xpm)
2016-04-21 15:11:16 +02:00
("\\` ?Rbow\\'" "rainbow" xpm)
2017-01-16 21:29:44 +01:00
("\\` ?ivy\\'" "ivy" xpm) ;; Icon created by Philipp Lehmann from the Noun Project https://thenounproject.com/search/?q=ivy&i=329756
2016-04-21 15:11:16 +02:00
("\\` ?ICY\\'" "icy" xpm) ;; http://www.clipartpal.com/clipart_pd/weather/ice_10206.html
("\\` ?Golden\\'" "golden" xpm-bw) ;; Icon created by Arthur Shlain from Noun Project
("\\`BibTeX\\'\\'" "bibtex" xpm-bw)
2019-04-13 20:21:12 +02:00
("\\`C[+][+]\\(/.*\\|\\)\\'" "cpp" xpm)
("\\`C[#]\\(/.*\\|\\)\\'" "csharp" xpm)
("\\`Haskell\\'" #xf126 font-mfizz)
("\\`Clojure\\'" #xf10b font-mfizz)
("\\`Java\\(/.*\\|\\)\\'" #xf12b font-mfizz)
("\\`C?Perl\\'" #xf148 font-mfizz)
("\\`Octave\\'" "octave" xpm)
("\\`AHK\\'" "autohotkey" xpm)
("\\`Info\\'" #xf05a FontAwesome)
2016-04-21 15:11:16 +02:00
("\\` ?Narrow\\'" #xf066 FontAwesome)
2016-03-26 06:04:48 +01:00
("\\`Dockerfile\\'" "docker" xpm)
2016-04-26 16:55:32 +02:00
("\\`Spacemacs buffer\\'" "spacemacs" png)
2016-05-02 04:57:49 +02:00
("\\` ?emoji\\'" "emoji" png)
("\\`Org-Agenda" #xf046 FontAwesome)
("\\`PS\\'" "powershell" xpm)
(mode-icons-powershell-p "powershell" xpm)
(mode-icons-cmd-p "cmd" xpm-bw)
(mode-icons-msys-p "msys" xpm)
(mode-icons-cygwin-p "cygwin" xpm)
2016-08-05 17:20:24 +02:00
(read-only #xf023 FontAwesome)
2016-02-19 19:04:58 +01:00
(writable #xf09c FontAwesome)
2016-02-19 19:45:02 +01:00
(save #xf0c7 FontAwesome)
2016-02-20 07:09:35 +01:00
(saved "" nil)
(modified-outside #xf071 FontAwesome)
(steal #xf21b FontAwesome)
;; Prefer finder icon since it looks like the old mac icon
(apple #xeabf IcoMoon-Free)
2016-02-19 23:00:18 +01:00
(apple #xf179 FontAwesome)
(win #xf17a FontAwesome)
;; FIXME: use lsb_release to determine Linux variant and choose appropriate icon
(unix #xeabd IcoMoon-Free) ;; Clear Tux (Unlike FontAwesome)
;; This icon is clearer than FontAwesome's Linux Penguin
(unix #xf166 font-mfizz) ;; Use ubuntu, since I think it is the most common.
(unix #xf17c FontAwesome) ;; Fall Back to FontAwesome
2016-02-20 07:30:19 +01:00
(undecided #xf128 FontAwesome)
2016-02-20 07:09:35 +01:00
("Text\\'" #xf0f6 FontAwesome)
2016-02-23 20:28:37 +01:00
("\\` ?company\\'" #xf1ad FontAwesome)
("\\` ?AC\\'" #xf18e FontAwesome)
("\\` ?Fly\\'" #xea12 IcoMoon-Free)
2018-09-10 17:04:05 +02:00
;; ("\\` ?FlyC.*\\'" "flycheck" xpm)
2018-08-06 04:58:22 +02:00
("\\` ?SP\\(/s\\)?\\'" "smartparens" xpm)
2016-04-21 15:11:16 +02:00
("\\` ?Ergo" #xf11c FontAwesome)
("\\` ?drag\\'" #xf047 FontAwesome)
("\\` ?Helm\\'" "helm" xpm-bw) ;; By Noe Araujo, MX, https://thenounproject.com/term/helm/233101/
2016-04-04 21:50:13 +02:00
("\\`Messages\\'" #xf27b FontAwesome)
("\\`Conf" #xf1de FontAwesome)
("\\`Fundamental\\'" #xf016 FontAwesome)
2016-03-30 01:50:24 +02:00
("\\`Javascript-IDE\\'" "js" xpm)
("\\` Undo-Tree\\'" ":palm_tree:" emoji)
("\\`LaTeX\\'" "tex" ext)
2016-04-04 23:13:53 +02:00
("\\`Image\\[xpm\\]\\'" "xpm" ext)
("\\`Image\\[png\\]\\'" "png" ext)
2016-04-21 15:11:16 +02:00
("\\` ?AI\\'" #xf03c FontAwesome)
2016-04-29 06:30:39 +02:00
("\\` ?Isearch\\'" #xf002)
(default #xf059 FontAwesome)
2016-01-25 15:45:40 +01:00
;; Diminished modes
2016-04-21 15:11:16 +02:00
("\\` ?\\(?:ElDoc\\|Anzu\\|SP\\|Guide\\|PgLn\\|Undo-Tree\\|Ergo.*\\|,\\|Isearch\\|Ind\\)\\'" nil nil))
2016-01-22 05:50:31 +01:00
"Icons for major and minor modes.
Each specificatioun is a list with the first element being the
name of the major mode. The second the name of the icon file,
without the extension. And the third being the type of icon."
:type '(repeat
2016-02-19 19:04:58 +01:00
(list (choice
(string :tag "Regular Expression")
(const :tag "Read Only Indicator" read-only)
2016-02-19 23:00:18 +01:00
(const :tag "Writable Indicator" writable)
(const :tag "Saved" saved)
(const :tag "Save" save)
(const :tag "Modified Outside Emacs" modified-outside)
(const :tag "Locked By Someone Else" steal)
2016-02-19 23:00:18 +01:00
(const :tag "Apple" apple)
(const :tag "Windows" win)
(const :tag "Unix" unix)
(const :tag "Default Icon" default)
(function :tag "Enriched minor mode"))
(choice
(string :tag "Icon Name")
2016-02-12 05:37:00 +01:00
(integer :tag "Font Glyph Code")
2016-04-21 15:57:05 +02:00
(const :tag "ess" nil))
(choice
(const :tag "text" nil)
(const :tag "png" png)
(const :tag "gif" gif)
(const :tag "jpeg" jpeg)
2016-02-21 14:24:16 +01:00
(const :tag "jpg" jpg)
(const :tag "xbm" xbm)
(const :tag "xpm" xpm)
(const :tag "Black and White xpm that changes color to match the mode-line face" xpm-bw)
(const :tag "Emoji" emoji)
2016-04-21 15:57:05 +02:00
(const :tag "Mode Icons Generated file-type" ext)
(symbol :tag "Font"))))
:group 'mode-icons)
2016-02-21 13:44:04 +01:00
(defun mode-icons-powershell-p (&optional match)
"Is the current mode a powershell process?"
(let ((proc (get-buffer-process (current-buffer))))
(and proc (string-match-p (or match "powershell") (car (process-command proc))))))
(defun mode-icons-cmd-p ()
"Is the current mode a CMD shell?"
(mode-icons-powershell-p "cmdproxy"))
(defun mode-icons-cygwin-p ()
"Is the current mode a CMD shell?"
(mode-icons-powershell-p "cygwin"))
(defun mode-icons-msys-p ()
"Is the current mode a CMD shell?"
(mode-icons-powershell-p "msys"))
2016-03-31 19:38:09 +02:00
(defvar mode-icons-get-xpm-string (make-hash-table :test 'equal))
(defun mode-icons-get-xpm-string (icon-path)
"Get XPM file contents for ICON-PATH.
If ICON-PATH is a string, return that."
(or (and (file-exists-p icon-path)
(or (gethash icon-path mode-icons-get-xpm-string)
2016-04-21 15:20:36 +02:00
(puthash icon-path (mode-icons-save-buffer-state (with-temp-buffer (insert-file-contents icon-path) (buffer-string)))
2016-03-31 19:38:09 +02:00
mode-icons-get-xpm-string)))
(and (stringp icon-path) icon-path)))
(defun mode-icons-get-icon-display-xpm-replace (icon-path rep-alist &optional name)
2017-01-10 14:08:58 +01:00
"Get xpm image from ICON-PATH and replace REP-ALIST in file.
When NAME is non-nil, also replace the internal xpm image name."
(let ((case-fold-search t)
(img (mode-icons-get-xpm-string icon-path))
(i 0))
(dolist (c rep-alist)
(setq img (replace-regexp-in-string (regexp-quote (car c)) (format "COLOR<%d>" i) img t t)
i (1+ i)))
(let ((i 0))
(dolist (c rep-alist)
(setq img (replace-regexp-in-string (format "COLOR<%d>" i) (cdr c) img t t)
i (1+ i))))
(when name
(setq img (replace-regexp-in-string "^[ ]*static[ ]+char[ ]+[*][ ]+.*?\\[" (concat "static char * " name "[") img t t)))
img))
(defun mode-icons-interpolate (c1 c2 &optional factor)
"Interpolate between C1 and C2 by FACTOR.
If FACTOR is unspecified, use 0.5"
(let* ((factor (or factor 0.5))
(red (+ (* (nth 0 c1) factor) (* (nth 0 c2) (- 1.0 factor))))
(green (+ (* (nth 1 c1) factor) (* (nth 1 c2) (- 1.0 factor))))
(blue (+ (* (nth 2 c1) factor) (* (nth 2 c2) (- 1.0 factor)))))
(setq red (/ (round (* 256.0 red)) 256.0)
green (/ (round (* 256.0 green)) 256.0)
blue (/ (round (* 256.0 blue)) 256.0))
(color-rgb-to-hex red green blue)))
(defun mode-icons-interpolate-from-scale (foreground background)
"Interpolate black to FOREGROUND and white to BACKGROUND.
2016-03-31 19:38:09 +02:00
Grayscales are in between.
Assumes that FOREGROUND and BACKGROUND are (r g b) lists."
(let ((black '(0.0 0.0 0.0))
(white '(1.0 1.0 1.0))
lst tmp
(i 0))
(while (< i 256)
(setq tmp (/ i 255.0))
(push (cons (upcase (mode-icons-interpolate black white tmp))
(upcase (mode-icons-interpolate foreground background tmp))) lst)
(setq i (1+ i)))
lst))
(defvar mode-icons-get-icon-display-xpm-bw-face (make-hash-table)
"Hash table of dynamic images.")
(defun mode-icons-background-color (&optional face)
"Get the background color of FACE.
In order, will try to get the background color from:
- FACE
- `mode-line' face
- `default' face
- Assume white."
(color-name-to-rgb (or (face-background (or face 'mode-line))
(face-background 'mode-line)
(face-background 'default)
"white")))
(defun mode-icons-foreground-color (&optional face)
"Get the foreground color of FACE.
In order, will try to get the foreground color from:
- FACE
- `mode-line' face
- `default' face
- Assume black."
(color-name-to-rgb (or (face-foreground (or face 'mode-line))
(face-foreground 'mode-line)
(face-foreground 'default)
"black")))
(defun mode-icons-get-icon-display-xpm-bw-face (icon-path &optional face)
"Change xpm at ICON-PATH to match FACE.
The white is changed to the background color.
The black is changed to the foreground color.
2017-01-10 14:08:58 +01:00
Grayscale colors are also changed by `mode-icons-interpolate-from-scale'."
(let* ((background (mode-icons-background-color face))
(foreground (mode-icons-foreground-color face))
(lst (mode-icons-interpolate-from-scale foreground background))
(name (concat "mode_icons_bw_" (substring (mode-icons-interpolate background foreground 0.0) 1) "_"
(substring (mode-icons-interpolate background foreground 1.0) 1) "_"
(file-name-sans-extension (file-name-nondirectory icon-path))))
2016-03-31 07:18:05 +02:00
(sym (intern name)))
(or (gethash sym mode-icons-get-icon-display-xpm-bw-face)
(puthash sym (mode-icons-get-icon-display-xpm-replace icon-path lst name) mode-icons-get-icon-display-xpm-bw-face))))
2016-03-31 19:38:09 +02:00
(defun mode-icons-get-xpm-icon-colors (icon-path)
"Get a list of rgb colors based on ICON-PATH xpm icon.
ICON-PATH can be a XPM string or a XPM file."
(let (colors)
2016-04-21 15:20:36 +02:00
(mode-icons-save-buffer-state
(with-temp-buffer
(insert (mode-icons-get-xpm-string icon-path))
(goto-char (point-min))
(while (re-search-forward "#[0-9A-Fa-f]\\{6\\}" nil t)
(push (color-name-to-rgb (match-string 0)) colors))))
2016-03-31 19:38:09 +02:00
colors))
(defun mode-icons-desaturate-colors (colors &optional foreground background)
"Desaturate COLORS.
If COLORS is an icon-path of an xpm file, use the colors from
that file.
When FOREGROUND and BACKGROUND are both non-nil, use
`mode-icons-interpolate-from-scale' to change the grayscale to
match the foreground (black) and background (white) colors.
Assume that COLORS is a list of (r g b) values.
Returns a replacement list for `mode-icons-get-icon-display-xpm-replace'"
(if (and colors (stringp colors))
(mode-icons-desaturate-colors (mode-icons-get-xpm-icon-colors colors) foreground background)
(let (color-list
val tmp
(trans-alist (and foreground background (mode-icons-interpolate-from-scale foreground background))))
(dolist (color colors)
(setq val (+ (* 0.3 (nth 0 color)) (* 0.59 (nth 1 color)) (* 0.11 (nth 2 color)))
val (upcase (color-rgb-to-hex val val val)))
2016-03-31 19:38:09 +02:00
(when (and trans-alist (setq tmp (assoc val trans-alist)))
(setq val (cdr tmp)))
(push (cons (upcase (color-rgb-to-hex (nth 0 color) (nth 1 color) (nth 2 color))) val) color-list))
2016-03-31 19:38:09 +02:00
color-list)))
(defun mode-icons-desaturate-xpm (icon-path &optional face)
"Desaturate the xpm at ICON-PATH.
When FACE is non-nil, match the foreground and background colors
in FACE instead of making the image black and white."
(let* ((background (mode-icons-background-color face))
(foreground (mode-icons-foreground-color face))
2016-03-31 19:38:09 +02:00
(lst (mode-icons-desaturate-colors icon-path foreground background))
(name (concat "mode_icons_desaturate_"
(or (and background foreground
(substring (mode-icons-interpolate background foreground 0.0) 1))
"black") "_"
(or (and background foreground
(substring (mode-icons-interpolate background foreground 1.0) 1))
"white") "_"
(file-name-sans-extension (file-name-nondirectory icon-path))))
(sym (intern name)))
(or (gethash sym mode-icons-get-icon-display-xpm-bw-face)
(puthash sym (mode-icons-get-icon-display-xpm-replace icon-path lst name) mode-icons-get-icon-display-xpm-bw-face))))
(defcustom mode-icons-desaturate-inactive t
"Should the inactive mode-line be desaturated.
And changed to match the icon colors?
This only works with xpm files."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-desaturate-active nil
"Should the active mode-line be desaturated.
And changed to match the icon colors?
This only works with xpm files."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-grayscale-transform t
"Should grayscale 'xpm-bw images match mode-line colors?"
:type 'boolean
:group 'mode-icons)
2016-03-30 22:52:54 +02:00
(defvar mode-icons-get-icon-display (make-hash-table :test 'equal)
"Hash table of `mode-icons-get-icon-display'.")
(defun mode-icons--get-face (&optional face active)
2016-04-07 17:22:27 +02:00
"If FACE is unspecified, use ACTIVE to determine the face.
ACTIVE tells if current window is active."
(or face (and active 'mode-line) 'mode-line-inactive))
(defcustom mode-icons-line-height-adjust 0
"The manual adjustment of the mode-line height for images."
:type 'integer
:group 'mode-icons)
(defun mode-icons-line-height (&optional window)
"Gets the height in pixels of WINDOW's mode-line font.
This function also adjusts the line height by
`mode-icons-line-height-adjust'. If WINDOW is nil, it defaults to
the current window.
This function returns nil if the current display isnt a graphic
one. This is to make sure that things still work when dealing
with, for example, a starting daemon."
(when (display-graphic-p)
(+ mode-icons-line-height-adjust
(aref (font-info (face-font 'mode-line) (window-frame window)) 3))))
2016-04-07 16:34:55 +02:00
(defun mode-icons-get-icon-display (icon type &optional face active)
"Get the value for the display property of ICON having TYPE.
ICON should be a string naming the file of the icon, without its
extension. Type should be a symbol designating the file type for
the icon.
FACE should be the face for rendering black and white xpm icons
2016-04-07 16:34:55 +02:00
specified by type 'xpm-bw.
ACTIVE is an indicator that the current window is active."
(let* ((face (mode-icons--get-face face active))
2016-03-31 19:38:09 +02:00
(key (list icon type face active
mode-icons-desaturate-inactive mode-icons-desaturate-active
mode-icons-grayscale-transform custom-enabled-themes))
tmp)
2016-03-31 19:38:09 +02:00
(or (gethash key mode-icons-get-icon-display)
(puthash key
(cond
((memq type '(png xpm xpm-bw gif jpeg jpg xbm xpm))
(let ((icon-path (mode-icons-get-icon-file
(concat icon "." (or (and (eq type 'xpm-bw) "xpm")
(symbol-name type))))))
(cond
((and mode-icons-grayscale-transform (eq type 'xpm-bw))
(create-image (mode-icons-get-icon-display-xpm-bw-face icon-path face)
2016-04-12 21:03:43 +02:00
;; Use imagemagick for rescaling...
(or (and (fboundp 'imagemagick-types)
(memq 'png (imagemagick-types)) 'imagemagick)
'xpm)
t :ascent 'center
:face face
:xpm-bw t
:height (mode-icons-line-height)
:icon icon))
((eq type 'xpm-bw)
2016-04-12 21:03:43 +02:00
(create-image icon-path
(or (and (fboundp 'imagemagick-types)
(memq 'png (imagemagick-types)) 'imagemagick)
'xpm)
:height (mode-icons-line-height)
2016-04-12 21:03:43 +02:00
:ascent 'center
:face face
:icon icon))
((and (eq type 'xpm)
(or (and active mode-icons-desaturate-active)
(and (not active) mode-icons-desaturate-inactive)))
(create-image (mode-icons-desaturate-xpm icon-path face)
2016-04-12 21:03:43 +02:00
(or (and (fboundp 'imagemagick-types)
(memq 'png (imagemagick-types)) 'imagemagick)
'xpm) t
:ascent 'center
:height (mode-icons-line-height)
2016-04-12 21:03:43 +02:00
:face face :icon icon))
(t
2016-04-12 21:03:43 +02:00
(create-image icon-path
(or (and (fboundp 'imagemagick-types)
(memq (or (and (eq type 'jpg) 'jpeg) type) (imagemagick-types))
'imagemagick)
(or (and (eq type 'jpg) 'jpeg) type))
nil
:height (mode-icons-line-height)
2016-04-12 21:03:43 +02:00
:ascent 'center :face face :icon icon)))))
((and (eq type 'emoji) (setq tmp (mode-icons--get-emoji " " (list "" icon type) face)))
(get-text-property 0 'display tmp))
;; Shouldn't get here...
((and (eq type 'ext) (setq tmp (mode-icons--ext-available-p (list "" icon type))))
2016-04-07 16:34:55 +02:00
(mode-icons-get-icon-display (concat "ext-" (downcase icon)) 'xpm-bw face active))
((and (image-type-available-p 'xpm)
(setq tmp (mode-icons--get-font-xpm-file (list "" icon type)))
(file-exists-p tmp))
(setq tmp nil)
2016-04-07 16:34:55 +02:00
(mode-icons-get-icon-display (mode-icons--get-font-xpm-file (list "" icon type) t) 'xpm-bw face active))
(t nil))
mode-icons-get-icon-display))))
2016-01-22 22:54:31 +01:00
(defcustom mode-icons-minor-mode-base-text-properties
'('help-echo nil
2016-01-22 22:54:31 +01:00
'mouse-face 'mode-line-highlight
'local-map mode-line-minor-mode-keymap)
"List of text propeties to apply to every minor mode."
:type '(repeat sexp)
:group 'mode-icons)
(defcustom mode-icons-major-mode-base-text-properties
'('help-echo "Major mode\nmouse-1: Display major mode menu\nmouse-2: Show help for major mode\nmouse-3: Toggle minor modes"
'mouse-face 'mode-line-highlight
'local-map mode-line-major-mode-keymap)
"List of text propeties to apply to every major mode."
:type '(repeat sexp)
:group 'mode-icons)
2016-02-19 06:13:20 +01:00
(defcustom mode-icons-narrow-text-properties
'('local-map
'(keymap
(mode-line keymap
(mouse-2 . mode-line-widen)))
'mouse-face 'mode-line-highlight 'help-echo "mouse-2: Remove narrowing from buffer")
"List of text propeties to apply to narrowing buffer indicator."
:type '(repeat sexp)
:group 'mode-icons)
2016-02-19 19:04:58 +01:00
(defcustom mode-icons-read-only-text-properties
'('mouse-face 'mode-line-highlight 'local-map
'(keymap
(mode-line keymap
(mouse-1 . mode-line-toggle-read-only)))
'help-echo 'mode-line-read-only-help-echo)
"List of text propeties to apply to read-only buffer indicator."
:type '(repeat sexp)
:group 'mode-icons)
2016-02-19 19:45:02 +01:00
(defcustom mode-icons-modified-text-properties
'('mouse-face 'mode-line-highlight
2016-02-21 14:24:16 +01:00
'local-map
'(keymap
(mode-line keymap
(mouse-1 . mode-icons-save-steal-or-revert-buffer)
2016-02-21 14:24:16 +01:00
(mouse-3 . mode-line-toggle-modified)))
'help-echo 'mode-icons-modified-help-echo)
2016-02-19 19:45:02 +01:00
"List of text propeties to apply to read-only buffer indicator."
:type '(repeat sexp)
:group 'mode-icons)
(defun mode-icons-save-steal-or-revert-buffer (event)
2016-02-26 16:29:43 +01:00
"Save buffer OR revert file from mode line.
2016-02-19 19:45:02 +01:00
Use EVENT to determine location."
(interactive "e")
(with-selected-window (posn-window (event-start event))
(let* ((bfn (buffer-file-name))
(revert-p (not (or (and bfn (file-remote-p buffer-file-name))
(verify-visited-file-modtime (current-buffer)))))
(steal-p (and (not (or (and bfn (file-remote-p buffer-file-name))
(member (file-locked-p bfn) '(nil t)))))))
(cond
(revert-p (revert-buffer t t))
(steal-p
(message "To steal or ignore lock, start editing the file."))
(t (call-interactively (key-binding (where-is-internal 'save-buffer global-map t))))))
2016-02-19 19:45:02 +01:00
(force-mode-line-update)))
(defun mode-icons-modified-help-echo (window _object _point)
"Return help text specifying WINDOW's buffer modification status."
(let* ((bfn (buffer-file-name))
(revert-p (not (or (and bfn (file-remote-p buffer-file-name))
(verify-visited-file-modtime (current-buffer)))))
(steal-p (and (not (or (and bfn (file-remote-p buffer-file-name))
(member (file-locked-p bfn) '(nil t))))))
(mod-p (buffer-modified-p (window-buffer window))))
(format "Buffer is %s\nmouse-1: %s Buffer\nmouse-3: Toggle modification state"
(cond
(steal-p
"locked for editing by another user.")
(revert-p
"modified outside of emacs!")
((buffer-modified-p (window-buffer window))
"modified")
(t "unmodified"))
(cond
(steal-p
"Echo about lock status of")
(revert-p
"Revert")
(mod-p
"Save")
(t "")))))
2016-02-19 19:45:02 +01:00
(defcustom mode-icons-read-only-text-properties
'('mouse-face 'mode-line-highlight 'local-map
'(keymap
(mode-line keymap
(mouse-1 . mode-line-toggle-read-only)))
'help-echo 'mode-line-read-only-help-echo)
"List of text propeties to apply to read-only buffer indicator."
:type '(repeat sexp)
:group 'mode-icons)
2016-01-22 22:54:31 +01:00
(defvar mode-icons-powerline-p nil)
(defun mode-icons-need-update-p ()
"Determine if the mode-icons need an update."
2016-01-22 22:54:31 +01:00
(not (or (and (boundp 'rich-minority-mode) rich-minority-mode)
(member 'sml/pos-id-separator mode-line-format)
(string-match-p "powerline" (prin1-to-string mode-line-format)))))
(defvar mode-icons-font-register-alist nil
"Alist of characters supported.")
2016-03-30 21:18:14 +02:00
(defun mode-icons-supported-font-p (char font)
"Determine if the CHAR is supported in FONT.
When DONT-REGISTER is non-nil, don't register the font.
Otherwise, register the font for use in the mode-line and
everywhere else."
2016-04-21 15:57:05 +02:00
(if (memq font '(ext emoji xpm xbm jpg jpeg gif png nil)) nil
(unless (boundp (intern (format "mode-icons-font-spec-%s" font)))
(set (intern (format "mode-icons-font-spec-%s" font))
(and (member (format "%s" font) (font-family-list))
(font-spec :name (format "%s" font)))))
(when (and (or (integerp char)
(and (stringp char) (= 1 (length char))))
(boundp (intern (format "mode-icons-font-spec-%s" font)))
(symbol-value (intern (format "mode-icons-font-spec-%s" font))))
(let* ((char (or (and (integerp char) char)
(and (stringp char) (= 1 (length char))
(aref (vconcat char) 0))))
(found-char-p (assoc char mode-icons-font-register-alist))
(char-font-p (and found-char-p (eq (cdr found-char-p) font))))
(cond
(char-font-p t)
(found-char-p t)
(t ;; not yet registered.
(set-fontset-font t (cons char char) (symbol-value (intern (format "mode-icons-font-spec-%s" font))))
(push (cons char font) mode-icons-font-register-alist)
t))))))
2016-02-09 17:09:40 +01:00
(defun mode-icons-supported-p (icon-spec)
"Determine if ICON-SPEC is suppored on your system."
(or
2016-02-09 17:11:24 +01:00
(and (or (eq (nth 2 icon-spec) nil) (eq (nth 1 icon-spec) nil)) t)
(and (eq (nth 2 icon-spec) 'emoji)
(or (and (image-type-available-p 'png) (featurep 'emojify))
(and (image-type-available-p 'xpm)
(file-exists-p (mode-icons--get-emoji-xpm-file icon-spec)))))
(and (eq (nth 2 icon-spec) 'jpg) (image-type-available-p 'jpeg))
(and (eq (nth 2 icon-spec) 'xpm-bw) (image-type-available-p 'xpm))
(and (eq (nth 2 icon-spec) 'ext) (image-type-available-p 'xpm)
(mode-icons--ext-available-p icon-spec))
(or (mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec))
(and (image-type-available-p 'xpm)
(mode-icons--get-font-xpm-file icon-spec)
(file-exists-p (mode-icons--get-font-xpm-file icon-spec))))
(or (image-type-available-p (nth 2 icon-spec))
(and (eq (nth 2 icon-spec) 'png)
(and (image-type-available-p 'xpm)
(file-exists-p (mode-icons--get-png-xpm-file icon-spec))))) ))
(defvar emojify-emojis)
(defvar mode-icons--gimp (executable-find "gimp")
"Gimp to convert png to xpm.")
(defvar mode-icons--gimp-inferior-args "-i -d -b -")
(defvar mode-icons--stop-gimp-after nil
"Seconds of idle time before mode-icons gimp is stopped.
When nil, don't stop the gimp inferior mode.")
(defvar mode-icons--stop-gimp-timer nil)
(defun mode-icons--start-gimp-inferior ()
"GIMP inferior process."
(interactive)
(when (file-exists-p mode-icons--gimp)
(unless (get-buffer "*mode-icons-gimp*")
2016-04-04 17:41:20 +02:00
(cl-letf (((symbol-function 'pop-to-buffer-same-window) (lambda(&rest _ignore))))
(save-excursion
(run-scheme (format "\"%s\" %s" mode-icons--gimp mode-icons--gimp-inferior-args))))
(with-current-buffer (get-buffer "*scheme*")
(rename-buffer "*mode-icons-gimp*")
(set-process-query-on-exit-flag (get-buffer-process (get-buffer "*mode-icons-gimp*")) nil)))))
(defvar mode-icons--gimp-ready-p nil)
(defun mode-icons--gimp-ready-p ()
"Determine if GIMP inferior process is ready."
(if (file-exists-p mode-icons--gimp)
(or mode-icons--gimp-ready-p
(let (buf)
(mode-icons--start-gimp-inferior)
(and (setq buf (get-buffer "*mode-icons-gimp*"))
(with-current-buffer buf
(goto-char (point-min))
(when (re-search-forward "ts>" nil t)
(setq mode-icons--gimp-ready-p t))))))))
(defvar mode-icons--stop-gimp-inferior nil)
(defun mode-icons--stop-gimp-inferior ()
"Stop the inferior gimp process."
(interactive)
(when (file-exists-p mode-icons--gimp)
(let ((buf (get-buffer "*mode-icons-gimp*")))
(cond
((and (mode-icons--gimp-ready-p) buf
(get-buffer-process buf))
(mode-icons--process-gimp "(gimp-quit 0)")
(setq mode-icons--gimp-ready-p nil
mode-icons--stop-gimp-inferior t)
(run-with-idle-timer 1 nil #'mode-icons--stop-gimp-inferior))
((and buf (not (get-buffer-process buf)))
(kill-buffer (get-buffer "*mode-icons-gimp*")))
(t (run-with-idle-timer 1 nil #'mode-icons--stop-gimp-inferior))))))
2016-04-04 17:41:20 +02:00
(defun mode-icons--process-gimp (scm)
"Process gimp SCM (scheme)."
(when mode-icons--stop-gimp-timer
(cancel-timer mode-icons--stop-gimp-timer))
(when (file-exists-p mode-icons--gimp)
(if (mode-icons--gimp-ready-p)
(progn
(comint-send-string
(with-current-buffer (get-buffer "*mode-icons-gimp*"))
(concat scm "\n"))
(when mode-icons--stop-gimp-after
(setq mode-icons--stop-gimp-timer (run-with-timer mode-icons--stop-gimp-after nil #'mode-icons--stop-gimp-inferior))))
(run-with-idle-timer 1 nil #'mode-icons--process-gimp scm))))
(defvar mode-icons--generic-type-to-xpm-gimp-script
(replace-regexp-in-string
"[ \n\t]+" " "
"(let* ((image-width 1024)
(image-height 20)
(buffer-image 1)
(text \"%s\")
(font-size 20)
(font-name \"FontAwesome\")
(xpm-image \"%s\")
(font-size-2 10)
(text-2 \"%s\")
(font-name-2 \"Haettenschweiler\")
(bg-color '(255 255 255))
(fg-color '(0 0 0))
(image (car (gimp-image-new 1024 16 0)))
(layer (car (gimp-layer-new image image-width image-height RGB-IMAGE \"layer 1\" 100 NORMAL)))
(layer2 (car (gimp-layer-new image image-width image-height RGB-IMAGE \"layer 2\" 100 NORMAL)))
(out-text)
(out-width)
(out-height)
(out-buffer)
(drawable))
(gimp-image-add-layer image layer 0)
(gimp-context-set-background bg-color)
(gimp-context-set-foreground fg-color)
(gimp-layer-add-alpha layer)
(gimp-drawable-fill layer TRANSPARENT-FILL)
(gimp-image-add-layer image layer2 0)
(gimp-layer-add-alpha layer2)
(gimp-drawable-fill layer2 TRANSPARENT-FILL)
(gimp-text-fontname image layer2 3 7 text-2 0 TRUE font-size-2 PIXELS font-name-2)
(set! out-text (car (gimp-text-fontname image layer 0 0 text 0 TRUE font-size PIXELS font-name)))
(set! out-width (car (gimp-drawable-width out-text)))
(set! out-height (car (gimp-drawable-height out-text)))
(set! out-buffer (* out-height (/ buffer-image 100)))
(set! out-height (+ out-height out-buffer out-buffer))
(set! out-width (+ out-width out-buffer out-buffer))
(gimp-image-resize image out-width out-height 0 0)
(gimp-layer-resize layer out-width out-height 0 0)
(gimp-layer-set-offsets out-text out-buffer out-buffer)
(gimp-image-flatten image)
(set! drawable (car (gimp-image-get-active-layer image)))
(file-xpm-save RUN-NONINTERACTIVE image drawable xpm-image xpm-image 127)
(gimp-image-delete image))")
"Generic Type script.")
(defvar mode-icons--font-to-xpm-gimp-script
(replace-regexp-in-string
"[ \n\t]+" " "
"(let* ((image-width 1024)
(image-height 20)
(buffer-image 1)
(text \"%s\")
(font-size 20)
(font-name \"%s\")
(xpm-image \"%s\")
(bg-color '(255 255 255))
(fg-color '(0 0 0))
(image (car (gimp-image-new 1024 16 0)))
(layer (car (gimp-layer-new image image-width image-height RGB-IMAGE \"layer 1\" 100 NORMAL)))
(out-text)
(out-width)
(out-height)
(out-buffer)
(drawable))
(gimp-image-add-layer image layer 0)
(gimp-context-set-background bg-color)
(gimp-context-set-foreground fg-color)
(gimp-layer-add-alpha layer)
(gimp-drawable-fill layer TRANSPARENT-FILL)
(set! out-text (car (gimp-text-fontname image layer 0 0 text 0 TRUE font-size PIXELS font-name)))
(set! out-width (car (gimp-drawable-width out-text)))
(set! out-height (car (gimp-drawable-height out-text)))
(set! out-buffer (* out-height (/ buffer-image 100)))
(set! out-height (+ out-height out-buffer out-buffer))
(set! out-width (+ out-width out-buffer out-buffer))
(gimp-image-resize image out-width out-height 0 0)
(gimp-layer-resize layer out-width out-height 0 0)
(gimp-layer-set-offsets out-text out-buffer out-buffer)
(gimp-image-flatten image)
(set! drawable (car (gimp-image-get-active-layer image)))
(file-xpm-save RUN-NONINTERACTIVE image drawable xpm-image xpm-image 127)
(gimp-image-delete image))")
"Gimp scheme script to convert a font character to xpm file.")
(defvar mode-icons--convert-ext-to-xpm (make-hash-table :test 'equal))
(defun mode-icons--convert-ext-to-xpm (ext)
"Convert EXT to a xpm file."
(let ((xpm (mode-icons-get-icon-file (concat "ext-" (downcase ext) ".xpm"))))
(when (and mode-icons--gimp (file-exists-p mode-icons--gimp)
xpm (not (gethash xpm mode-icons--convert-ext-to-xpm))
(not (file-exists-p xpm)))
(puthash xpm t mode-icons--convert-ext-to-xpm)
(mode-icons--process-gimp
(format mode-icons--generic-type-to-xpm-gimp-script (make-string 1 #xf016) xpm
(downcase ext))))))
(defun mode-icons--ext-available-p (icon-spec)
"Determine if ICON-SPEC's ext is availble for display.
If not, try `mode-icons--convert-ext-to-xpm'."
(when (eq (nth 2 icon-spec) 'ext)
(let ((xpm (mode-icons-get-icon-file (concat "ext-" (downcase (nth 1 icon-spec)) ".xpm"))))
(if (file-readable-p xpm)
xpm
(mode-icons--convert-ext-to-xpm (nth 1 icon-spec))
nil))))
(defcustom mode-icons-generate-font-grayscale nil
"Generate grayscale images for font icons.
This is used instead of transparancy to capure the font's
anti-aliasing. `mode-icons' will transform the colors to match
the background instead."
:type 'boolean
:group 'mode-icons)
(defvar mode-icons--convert-text-to-xpm (make-hash-table :test 'equal))
(defun mode-icons--convert-text-to-xpm (text font xpm &optional face height)
"Convert TEXT in FONT to XPM file using gimp.
When FACE is non-nil, use the face background and foreground
properties to render the font (its no longer transparent).
When HEIGHT is non-nil, use the font HEIGHT (in pixels) instead
of 20px."
(when (and mode-icons--gimp (file-exists-p mode-icons--gimp)
xpm (not (gethash xpm mode-icons--convert-text-to-xpm))
(not (file-exists-p xpm)))
(puthash xpm t mode-icons--convert-text-to-xpm)
(let ((script (format mode-icons--font-to-xpm-gimp-script text font xpm))
(background (mode-icons-background-color face))
(foreground (mode-icons-foreground-color face)))
(when face
(setq background (mapcar (lambda(x)
(round (* 255 x))) background)
foreground (mapcar (lambda(x)
(round (* 255 x))) foreground))
(setq script (replace-regexp-in-string
(regexp-quote "(bg-color '(255 255 255))")
(format "(bg-color '%s)" background)
script)
script (replace-regexp-in-string
(regexp-quote "(fg-color '(0 0 0))")
(format "(fg-color '%s)" foreground)
script)
script (replace-regexp-in-string
"TRANSPARENT-FILL" "BACKGROUND-FILL" script)
script (replace-regexp-in-string
(regexp-quote "(gimp-layer-add-alpha layer)") "" script)))
(when height
(setq script (replace-regexp-in-string
(regexp-quote "(image-height 20)")
(format "(image-height %s)" background)
script)
script (replace-regexp-in-string
(regexp-quote "(font-size 20)")
(format "(font-size %s)" background)
script)
script (replace-regexp-in-string
"TRANSPARENT-FILL" "BACKGROUND-FILL" script)
script (replace-regexp-in-string
(regexp-quote "(gimp-layer-add-alpha layer)") "" script)))
(when mode-icons-generate-font-grayscale
(setq script (replace-regexp-in-string
"TRANSPARENT-FILL" "BACKGROUND-FILL" script)
script (replace-regexp-in-string
(regexp-quote "(gimp-layer-add-alpha layer)") "" script)))
(mode-icons--process-gimp script))))
(defun mode-icons--get-font-xpm-file (icon-spec &optional icon-name)
"Get the font icon equivalent xpm file name from ICON-SPEC.
When ICON-NAME is non-nil, return the small icon name without the
extension or directory."
(let* ((xpm-int (or (and (stringp (nth 1 icon-spec))
(= 1 (length (nth 1 icon-spec)))
(aref (nth 1 icon-spec) 0))
(and (integerp (nth 1 icon-spec))
(nth 1 icon-spec))))
(xpm-base (and (integerp xpm-int)
(format "%s-%x" (nth 2 icon-spec)
xpm-int))))
(and xpm-base
(if icon-name
xpm-base
(mode-icons-get-icon-file (concat xpm-base ".xpm"))))))
(defun mode-icons--create-font-xpm-file (icon-spec)
"Create a font-based xpm file based on ICON-SPEC."
(mode-icons--convert-text-to-xpm
(or (and (stringp (nth 1 icon-spec))
(nth 1 icon-spec))
(and (integerp (nth 1 icon-spec))
(make-string 1 (nth 1 icon-spec))))
(symbol-name (nth 2 icon-spec))
(mode-icons--get-font-xpm-file icon-spec)))
(defun mode-icons--convert-all-font-icons-to-xpm ()
"Convert all font icons to xpm files."
(interactive)
(setq mode-icons--convert-text-to-xpm (make-hash-table :test 'equal))
(dolist (icon-spec mode-icons)
(when (mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec))
(mode-icons--create-font-xpm-file icon-spec))))
(defvar mode-icons--png-to-xpm-gimp-script
(replace-regexp-in-string
"[ \n\t]+" " "
"(let* ((png-image \"%s\")
(xpm-image \"%s\")
(image (car (file-png-load RUN-NONINTERACTIVE png-image png-image)))
(drawable (car (gimp-image-get-active-layer image)))
(width (car (gimp-image-width image)))
(height (car (gimp-image-height image)))
(new-height 16.0)
(new-width (inexact->exact (round (* width (/ new-height height))))))
(gimp-image-resize image 16 new-width 0 0)
(set! drawable (car (gimp-image-get-active-layer image)))
(file-xpm-save RUN-NONINTERACTIVE image drawable xpm-image xpm-image 127)
(gimp-image-delete image))")
"Gimp scheme script to convert png to xpm.")
(defvar mode-icons--convert-png-to-xpm (make-hash-table :test 'equal)
"Hash table to make sure you only convert once.")
(defun mode-icons--convert-png-to-xpm (png xpm)
"Covert PNG to a ?x16 XPM using `mode-icons--gimp'."
(when (and mode-icons--gimp (file-exists-p mode-icons--gimp)
xpm (not (gethash (list png xpm) mode-icons--convert-png-to-xpm))
(not (file-exists-p xpm)))
(puthash (list png xpm) t mode-icons--convert-png-to-xpm)
(mode-icons--process-gimp (format mode-icons--png-to-xpm-gimp-script png xpm))))
(defun mode-icons--get-png-xpm-file (icon-spec &optional icon-name)
"Get the png->xpm file name from ICON-SPEC.
When ICON-NAME is non-nil, return the mode-icons icon name."
(if icon-name
(nth 1 icon-spec)
(mode-icons-get-icon-file (concat (nth 1 icon-spec) ".xpm"))))
2016-04-26 19:30:12 +02:00
(defun mode-icons--convert-all-png-icons-to-xpm ()
"Convert all png icons to xpm files."
(interactive)
(setq mode-icons--convert-png-to-xpm (make-hash-table :test 'equal))
(dolist (icon-spec mode-icons)
(when (eq 'png (nth 2 icon-spec))
(mode-icons--convert-png-to-xpm
(mode-icons-get-icon-file (concat (nth 1 icon-spec) ".png"))
(mode-icons-get-icon-file (concat (nth 1 icon-spec) ".xpm"))))))
(defun mode-icons--get-emoji-xpm-file (icon-spec &optional icon-name)
"Get the emoji xpm file name from ICON-SPEC.
This only supports emoji enclosed in a \":\" like :herb:.
When ICON-NAME is non-nil, return the mode-icons icon name.
For :herb: it would be e-herb."
(let* ((xpm-base (nth 1 icon-spec))
file)
(when (char-equal (aref xpm-base 0) ?:)
(setq file (substring xpm-base 1))
(when (char-equal (aref (substring xpm-base -1) 0) ?:)
(setq file (substring file 0 -1))
(if icon-name
(concat "e-" file)
(mode-icons-get-icon-file (concat "e-" file ".xpm")))))))
2016-04-07 16:34:55 +02:00
(defun mode-icons--get-png (mode icon-spec &optional face active)
"Get MODE for png ICON-SPEC using FACE.
2016-04-07 16:34:55 +02:00
If possible, convert the png file to an xpm file.
ACTIVE is a flag telling if the current window is active."
(let* ((xpm (mode-icons--get-png-xpm-file icon-spec))
(xpm-name (mode-icons--get-png-xpm-file icon-spec t))
(xpm-p (file-readable-p xpm))
(png (mode-icons-get-icon-file (concat (nth 1 icon-spec) ".png")))
2016-04-07 17:22:27 +02:00
(png-p (file-readable-p png))
(face (mode-icons--get-face face active)))
(if xpm-p
(propertize (format "%s" mode) 'display
(mode-icons-get-icon-display
xpm-name 'xpm
2016-04-07 17:22:27 +02:00
face active)
'face face
'mode-icons-p (list (nth 0 icon-spec) xpm-name 'xpm))
(if (not png-p)
(propertize (format "%s" mode)
2016-04-07 17:22:27 +02:00
'face face
'mode-icons-p icon-spec)
(mode-icons--convert-png-to-xpm png xpm)
(propertize (format "%s" mode)
'display
(create-image png
;; use imagemagick if available and supports PNG images
;; (allows resizing images)
(or (and (and (fboundp 'imagemagick-types)
(memq 'png (imagemagick-types)))
'imagemagick) 'png)
nil
:height (mode-icons-line-height)
:ascent 'center
:heuristic-mask t
:face face)
2016-04-07 17:22:27 +02:00
'face face
'mode-icons-p icon-spec)))))
(defcustom mode-icons-prefer-xpm-over-emoji nil
"Prefer generated xpms over fonts.
If mode-icons has a generated font character, prefer that over
the actual font."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-generate-emoji-xpms nil
"Generate font compatibility xpms for fonts."
:type 'boolean
:group 'mode-icons)
2016-04-07 16:34:55 +02:00
(defun mode-icons--get-emoji (mode icon-spec &optional face active)
"Get MODE emoji for ICON-SPEC using FACE.
ACTIVE is a flag for if the current window is active."
(let* ((xpm (mode-icons--get-emoji-xpm-file icon-spec))
(xpm-name (mode-icons--get-emoji-xpm-file icon-spec t))
2016-04-07 17:22:27 +02:00
(xpm-p (file-readable-p xpm))
(face (mode-icons--get-face face active)))
(if (or (and mode-icons-prefer-xpm-over-emoji xpm-p)
(and xpm-p (not (featurep 'emojify)))
(and xpm-p (not (image-type-available-p 'png))))
(propertize (format "%s" mode) 'display
(mode-icons-get-icon-display
2016-04-07 17:22:27 +02:00
xpm-name 'xpm face active)
'mode-icons-p (list (nth 0 icon-spec) xpm-name 'xpm))
(unless emojify-emojis
(emojify-set-emoji-data))
(let* ((emoji (ht-get emojify-emojis (nth 1 icon-spec)))
2017-01-12 17:43:26 +01:00
(image-file (expand-file-name (ht-get emoji "image") (if (fboundp 'emojify-image-dir)
(emojify-image-dir)
emojify-image-dir)))
(image-type (intern (upcase (file-name-extension image-file)))))
(if (not (file-exists-p image-file))
(propertize (format "%s" mode)
2016-04-07 17:22:27 +02:00
'face face
'mode-icons-p icon-spec)
(when mode-icons-generate-emoji-xpms
(mode-icons--convert-png-to-xpm image-file xpm))
(propertize (format "%s" mode)
'display
(create-image image-file
;; use imagemagick if available and supports PNG images
;; (allows resizing images)
(or (and (and (fboundp 'imagemagick-types)
(memq image-type (imagemagick-types)))
'imagemagick) 'png)
nil
:ascent 'center
:heuristic-mask t
:face face
;; :background (emojify--get-image-background beg end)
;; no-op if imagemagick is not available
:height (mode-icons-line-height))
2016-04-07 17:22:27 +02:00
'face face
'mode-icons-p icon-spec))))))
(defcustom mode-icons-prefer-xpm-over-font nil
"Prefer generated xpms over fonts.
If mode-icons has a generated font character, prefer that over
the actual font."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-generate-font-xpms nil
"Generate font compatibility xpms for fonts."
:type 'boolean
:group 'mode-icons)
2016-04-07 16:34:55 +02:00
(defun mode-icons--get-font (mode icon-spec &optional face active)
"Get font for MODE based on ICON-SPEC, and FACE.
ACTIVE if a flag for if the current window is active."
;; Use `compose-region' because it allows clickable text.
(let* ((xpm (mode-icons--get-font-xpm-file icon-spec))
(xpm-name (mode-icons--get-font-xpm-file icon-spec t))
2016-04-07 17:22:27 +02:00
(xpm-p (file-readable-p xpm))
(face (mode-icons--get-face face active)))
(when (and (not xpm-p) mode-icons-generate-font-xpms)
(mode-icons--create-font-xpm-file icon-spec))
(if (and xpm-p (or mode-icons-prefer-xpm-over-font
(not (mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec)))))
(propertize (format "%s" mode) 'display
(mode-icons-get-icon-display
2016-04-07 17:22:27 +02:00
xpm-name 'xpm face active)
'mode-icons-p (list (nth 0 icon-spec) xpm-name 'xpm-bw)
'face face)
2016-04-21 15:20:36 +02:00
(mode-icons-save-buffer-state
(with-temp-buffer
(if (stringp mode)
(insert mode)
(insert (or (and (integerp (nth 1 icon-spec))
(make-string 1 (nth 1 icon-spec)))
(nth 1 icon-spec))))
(compose-region (point-min) (point-max) (or (and (integerp (nth 1 icon-spec))
(make-string 1 (nth 1 icon-spec)))
(nth 1 icon-spec)))
(put-text-property (point-min) (point-max)
'face face)
(if (mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec))
(put-text-property (point-min) (point-max)
'mode-icons-p icon-spec)
(put-text-property (point-min) (point-max)
'mode-icons-p (list (nth 0 icon-spec) xpm-name 'xpm-bw)))
2016-04-21 15:20:36 +02:00
(buffer-string))))))
2016-04-07 16:34:55 +02:00
(defun mode-icons-propertize-mode (mode icon-spec &optional face active)
"Propertize MODE with ICON-SPEC.
MODE should be a string, the name of the mode to propertize.
ICON-SPEC should be a specification from `mode-icons'.
2016-04-07 16:34:55 +02:00
FACE is the face to match when a xpm-bw image is used.
ACTIVE is a flag to tell if the current window is active."
(let (tmp new-icon-spec)
(mode-icons-save-buffer-state ;; Otherwise may cause issues with trasient mark mode
(cond
((and (stringp mode) (get-text-property 0 'mode-icons-p mode))
mode)
((not (nth 1 icon-spec))
"")
((and (stringp (nth 1 icon-spec)) (not (nth 2 icon-spec)))
(propertize (nth 1 icon-spec) 'display (nth 1 icon-spec)
'mode-icons-p icon-spec))
((mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec))
;; (propertize mode 'display (nth 1 icon-spec) 'mode-icons-p t)
;;(mode-icons--get-font " AI" '("\\` ?AI\\'" 61500 FontAwesome) face active)
2016-04-07 16:34:55 +02:00
(mode-icons--get-font mode icon-spec face active))
((and (stringp (nth 1 icon-spec)) (eq (nth 2 icon-spec) 'emoji))
2016-04-07 16:34:55 +02:00
(mode-icons--get-emoji mode icon-spec face active))
((and (stringp (nth 1 icon-spec)) (eq (nth 2 icon-spec) 'png))
2016-04-07 16:34:55 +02:00
(mode-icons--get-png mode icon-spec face active))
((and (stringp (nth 1 icon-spec)) (eq (nth 2 icon-spec) 'ext))
(propertize (format "%s" mode) 'display
(mode-icons-get-icon-display
2016-04-07 17:22:27 +02:00
(concat "ext-" (nth 1 icon-spec)) 'xpm-bw face active)
'mode-icons-p (list (nth 0 icon-spec)
(concat "ext-" (nth 1 icon-spec))
'xpm-bw)))
2016-04-07 17:22:27 +02:00
(t (setq tmp (mode-icons-get-icon-display (nth 1 icon-spec) (nth 2 icon-spec) face active))
;; (when (string= (nth 0 icon-spec) "\\` ?AI\\'")
;; (message "plist: %s" tmp))
(cond
((and (plist-get (cdr tmp) :xpm-bw) (plist-get (cdr tmp) :icon))
(setq new-icon-spec (list (nth 0 icon-spec) (plist-get (cdr tmp) :icon) 'xpm-bw)))
((and (eq (plist-get (cdr tmp) :type) 'xpm) (plist-get (cdr tmp) :icon))
(setq new-icon-spec (list (nth 0 icon-spec) (plist-get (cdr tmp) :icon) 'xpm)))
(t (setq new-icon-spec icon-spec)))
(propertize (format "%s" mode) 'display tmp
'mode-icons-p new-icon-spec))))))
2016-03-30 22:52:54 +02:00
(defvar mode-icons-get-icon-spec (make-hash-table :test 'equal)
"Hash table of icon-specifications.")
(defun mode-icons-get-icon-spec (mode &optional is-major-mode-p)
2016-02-09 15:05:13 +01:00
"Get icon spec for MODE based on regular expression."
2016-03-30 22:52:54 +02:00
(or (gethash mode mode-icons-get-icon-spec)
(let* (case-fold-search
(ignore-cache nil)
(icon-spec (catch 'found-mode
(dolist (item mode-icons)
(when (and (mode-icons-supported-p item)
(or
(and
(stringp (car item))
(stringp mode)
(string-match-p (car item) mode))
(and
(symbolp (car item))
(symbolp mode)
(eq mode (car item)))
(and
is-major-mode-p
(symbolp (car item))
(functionp (car item))
(and (ignore-errors (funcall (car item)))
(setq ignore-cache t)))))
(throw 'found-mode item)))
nil)))
(when (and icon-spec (eq (nth 2 icon-spec) 'emoji)
(file-exists-p (mode-icons--get-emoji-xpm-file icon-spec)))
(setq icon-spec (list (nth 0 icon-spec) (mode-icons--get-emoji-xpm-file icon-spec t) 'xpm)))
(unless ignore-cache
(puthash mode icon-spec mode-icons-get-icon-spec))
icon-spec)))
2016-01-22 16:44:27 +01:00
2016-02-20 07:14:52 +01:00
(defcustom mode-icons-show-mode-name nil
"Show Icon and `mode-name'."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-change-mode-name t
"Change the `mode-name' variable.
This allows functions like `ibuffer' or `helm-mode' to show the
icon as well."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-use-default-icon nil
"Use the 'default icon when icon-name cannot be found."
:type 'boolean
:group 'mode-icons)
2016-04-07 16:34:55 +02:00
(defun mode-icons-get-mode-icon (mode &optional face active)
"Get the icon for MODE, if there is one.
2016-04-07 16:34:55 +02:00
FACE represents the face used when the icon is a xpm-bw image.
ACTIVE represents if the window is active."
(let* ((mode-name (format-mode-line mode))
(icon-spec (mode-icons-get-icon-spec mode-name t))
(face (mode-icons--get-face face active))
2016-03-02 16:23:14 +01:00
ret)
(when (and (not icon-spec) mode-icons-use-default-icon)
(setq icon-spec (mode-icons-get-icon-spec 'default)))
(if icon-spec
2016-03-02 16:23:14 +01:00
(setq ret
(if mode-icons-show-mode-name
(concat (mode-icons-propertize-mode mode-name icon-spec face active) " " mode-name)
2016-04-07 16:34:55 +02:00
(mode-icons-propertize-mode mode-name icon-spec face active)))
2016-03-02 16:23:14 +01:00
(setq ret mode-name))
;; Don't hide major mode names...
(when (string= ret "")
(setq ret mode-name))
ret))
2012-11-10 23:12:36 +01:00
2016-01-22 17:47:32 +01:00
(defvar mode-icons-cached-mode-name nil
"Cached mode name to restore when disabling mode-icons.")
(defvar mode-icons--mode-name nil
"Mode name displayed by mode-icons.")
2016-01-22 05:50:31 +01:00
(defun mode-icons-set-mode-icon (mode)
"Set the icon for MODE."
2016-01-22 17:47:32 +01:00
(unless mode-icons-cached-mode-name
(set (make-local-variable 'mode-icons-cached-mode-name)
mode-name)
(set (make-local-variable 'mode-icons--mode-name)
2016-04-07 17:22:27 +02:00
(mode-icons-get-mode-icon mode nil t))
(when mode-icons-change-mode-name
(setq mode-name mode-icons--mode-name))))
2016-01-22 17:47:32 +01:00
(defun mode-icons-major-mode-icons-undo ()
"Undo the `mode-name' icons."
2016-01-22 17:47:32 +01:00
(dolist (b (buffer-list))
(with-current-buffer b
(when mode-icons-cached-mode-name
(setq mode-name mode-icons-cached-mode-name
mode-icons-cached-mode-name nil)))))
2016-01-22 17:47:32 +01:00
(defun mode-icons-major-mode-icons ()
"Apply mode name icons on all buffers."
2016-01-22 17:47:32 +01:00
(dolist (b (buffer-list))
(with-current-buffer b
(mode-icons-set-current-mode-icon))))
2012-11-10 23:12:36 +01:00
2016-01-22 05:50:31 +01:00
(defun mode-icons-set-current-mode-icon ()
"Set the icon for the current major mode."
2016-01-22 05:50:31 +01:00
(mode-icons-set-mode-icon mode-name))
2012-11-10 23:12:36 +01:00
2016-01-22 07:23:45 +01:00
(defvar mode-icons-set-minor-mode-icon-alist nil)
(defun mode-icons-set-minor-mode-icon-undo (&optional dont-update)
"Undo minor modes.
When DONT-UPDATE is non-nil, don't call `force-mode-line-update'."
2016-01-22 07:23:45 +01:00
(let (minor)
(dolist (mode mode-icons-set-minor-mode-icon-alist)
(setq minor (assq (car mode) minor-mode-alist))
(when minor
(setcdr minor (cdr mode)))))
2016-01-22 22:54:31 +01:00
(setq mode-icons-set-minor-mode-icon-alist nil)
(unless dont-update
(force-mode-line-update)))
2016-01-22 07:23:45 +01:00
(defcustom mode-icons-separate-images-with-spaces t
"Separate minor-mode icons with spaces."
:type 'boolean
:group 'mode-icons)
(defun mode-icons-set-minor-mode-icon (&optional dont-update)
"Set the icon for the minor modes.
When DONT-UPDATE is non-nil, don't call `force-mode-line-update'"
(let (icon-spec mode-name minor cur-mode)
2016-01-22 07:23:45 +01:00
(dolist (mode minor-mode-alist)
(setq cur-mode
(or (assq (car mode) mode-icons-set-minor-mode-icon-alist)
mode))
(setq mode-name (format-mode-line cur-mode)
icon-spec (mode-icons-get-icon-spec mode-name))
(when icon-spec
(setq minor (assq (car cur-mode) minor-mode-alist))
(when minor
(or (assq (car cur-mode) mode-icons-set-minor-mode-icon-alist)
(push (copy-sequence minor) mode-icons-set-minor-mode-icon-alist))
(setq mode-name (replace-regexp-in-string "^ " "" mode-name)
mode-name (mode-icons-propertize-mode mode-name icon-spec))
(if (string= "" mode-name)
(setcdr minor (list ""))
(setcdr minor (list (concat (or (and mode-icons-separate-images-with-spaces " ") "")
mode-name))))))))
(unless dont-update
(force-mode-line-update)))
2016-01-22 07:23:45 +01:00
2016-04-04 17:41:20 +02:00
(defun mode-icons--generate-major-mode-item (&optional face)
"Give rich strings needed for `major-mode' viewing.
FACE is the face that the major mode item should be rendered in."
2016-04-07 17:22:27 +02:00
(let* ((active (mode-icons--selected-window-active))
(face (mode-icons--get-face face active)))
2016-04-04 17:41:20 +02:00
(eval `(propertize ,(mode-icons--recolor-string (or mode-icons--mode-name mode-name) active face)
2016-04-07 17:22:27 +02:00
'face ',face
,@mode-icons-major-mode-base-text-properties))))
;;; selected take from powerline
(defvar mode-icons--selected-window (frame-selected-window)
"Selected window.")
(defun mode-icons--set-selected-window ()
"Set the variable `mode-icons--selected-window' appropriately."
(when (not (minibuffer-window-active-p (frame-selected-window)))
(setq mode-icons--selected-window (frame-selected-window))))
(defun mode-icons--unset-selected-window ()
"Unsets the variable `mode-icons--selected-window' and update the modeline."
(setq mode-icons--selected-window nil)
(force-mode-line-update))
(add-hook 'window-configuration-change-hook 'mode-icons--set-selected-window)
;; focus-in-hook was introduced in emacs v24.4.
;; Gets evaluated in the last frame's environment.
2016-03-31 19:38:09 +02:00
;; (add-hook 'focus-in-hook 'mode-icons--set-selected-window)
;; focus-out-hook was introduced in emacs v24.4.
2016-03-31 19:38:09 +02:00
;; (add-hook 'focus-out-hook 'mode-icons--unset-selected-window)
;; Executes after the window manager requests that the user's events
;; be directed to a different frame.
(defadvice handle-switch-frame
(after mode-icons--set-selected-window-after-switch-frame activate)
"Make `mode-icons' aware of selected window."
(mode-icons--set-selected-window))
(defadvice select-window (after mode-icons--select-window activate)
"Make `mode-icons' aware of selected window."
(mode-icons--set-selected-window))
(defun mode-icons--selected-window-active ()
"Return whether the current window is active."
(eq mode-icons--selected-window (selected-window)))
2016-04-01 06:34:44 +02:00
(defun mode-icons--property-substrings (str prop)
"Return a list of substrings of STR when PROP change."
;; Taken from powerline by Donald Ephraim Curtis, Jason Milkins and
;; Nicolas Rougier
(let ((beg 0) (end 0)
(len (length str))
(out))
(while (< end (length str))
(setq end (or (next-single-property-change beg prop str) len))
(setq out (append out (list (substring str beg (setq beg end))))))
out))
(defun mode-icons--recolor-string (string &optional active face)
"Recolor `mode-icons' in STRING.
ACTIVE tells if the current window is active.
FACE is the face to recolor the icon to."
(let* ((face (mode-icons--get-face face active))
icon-spec)
2016-04-01 06:34:44 +02:00
(mapconcat
(lambda(str)
(cond
((get-text-property 0 'display str)
(mode-icons--recolor-minor-mode-image str active face))
((and (setq icon-spec (get-text-property 0 'mode-icons-p str))
(mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec)))
(mode-icons--get-font str icon-spec face active))
(t
str)))
2016-04-01 06:34:44 +02:00
(mode-icons--property-substrings string 'mode-icons-p)
"")))
(defun mode-icons--recolor-minor-mode-image (mode active &optional face)
"Recolor MODE image based on if the window is ACTIVE.
Use FACE when specified."
(let ((icon-spec (get-text-property 0 'mode-icons-p mode))
(face (mode-icons--get-face face active)))
(cond
2016-03-31 19:38:09 +02:00
((and icon-spec (memq (nth 2 icon-spec) '(xpm xpm-bw)))
(propertize mode 'display (mode-icons-get-icon-display
2016-04-07 17:22:27 +02:00
(nth 1 icon-spec) (nth 2 icon-spec) face active)
'face face
'mode-icons-p icon-spec))
((and icon-spec (memq (nth 2 icon-spec) '(emoji))
(file-exists-p (mode-icons--get-emoji-xpm-file icon-spec)))
(propertize mode 'display (mode-icons-get-icon-display
(mode-icons--get-emoji-xpm-file icon-spec t)
2016-04-07 17:22:27 +02:00
'xpm face active) 'face face
'mode-icons-p icon-spec))
(t (propertize mode 'face face)))))
2016-04-01 06:34:44 +02:00
(defun mode-icons--generate-minor-mode-list (&optional face)
"Extracts all rich strings necessary for the minor mode list.
When FACE is non-nil, use FACE to render the `minor-mode-alist'."
2016-04-07 17:22:27 +02:00
(let* ((active (mode-icons--selected-window-active))
(face (mode-icons--get-face face active)))
(delete " " (delete "" (mapcar (lambda(mode)
2016-04-01 06:34:44 +02:00
(concat " " (eval `(propertize ,(mode-icons--recolor-minor-mode-image mode active face)
,@mode-icons-minor-mode-base-text-properties))))
(split-string (format-mode-line minor-mode-alist)))))))
2016-01-22 22:54:31 +01:00
(defun mode-icons--generate-narrow (&optional face)
"Extracts all rich strings necessary for narrow indicator.
When FACE is non-nil, use FACE to render the narrow indicator."
2016-04-07 17:22:27 +02:00
(let* ((active (mode-icons--selected-window-active))
(face (mode-icons--get-face active face))
icon-spec)
2016-02-19 06:13:20 +01:00
(delete " " (delete "" (mapcar (lambda(mode)
(concat " " (eval `(propertize
,(if (setq icon-spec (mode-icons-get-icon-spec (concat " " mode)))
(mode-icons--recolor-minor-mode-image
(mode-icons-propertize-mode (concat " " mode) icon-spec face active)
active face)
2016-02-19 06:13:20 +01:00
mode)
,@mode-icons-narrow-text-properties))))
(split-string (format-mode-line "%n")))))))
2016-02-19 19:04:58 +01:00
2016-02-20 07:09:35 +01:00
(defcustom mode-icons-read-only-space t
"Add Space after read-only icon."
:type 'boolean
:group 'mode-icons)
(defun mode-icons--read-only-status (&optional face)
"Get Read Only Status icon.
FACE is the face to render the icon in."
(let ((active (mode-icons--selected-window-active)))
(eval `(propertize
,(let ((ro (format-mode-line "%1*"))
icon-spec)
(setq ro (or (cond
((string= "%" ro)
(if (setq icon-spec (mode-icons-get-icon-spec 'read-only))
(mode-icons-propertize-mode 'read-only icon-spec face active)
ro))
(t
(if (setq icon-spec (mode-icons-get-icon-spec 'writable))
(mode-icons-propertize-mode 'writable icon-spec face active)
ro)))
"")
ro (mode-icons--recolor-minor-mode-image ro active face))
(when (and mode-icons-read-only-space
(not (string= ro "")))
(setq ro (concat ro " ")))
2016-04-25 11:24:19 +02:00
ro)
,@mode-icons-read-only-text-properties))))
2016-02-19 19:04:58 +01:00
2016-02-20 07:09:35 +01:00
(defcustom mode-icons-modified-status-space t
"Add Space to modified status."
:type 'boolean
:group 'mode-icons)
(defun mode-icons--modified-status (&optional face)
"Get modified status icon.
FACE is the face to render the icon in."
(let ((active (mode-icons--selected-window-active)))
(eval `(propertize
,(or (ignore-errors
(let* ((bfn (buffer-file-name))
(nice-file-p (and (file-remote-p bfn)))
(mod (or (and (not (or nice-file-p (verify-visited-file-modtime (current-buffer))))
"!")
(and (not (or nice-file-p (member (file-locked-p bfn) '(nil t))))
"s")
(format-mode-line "%1+")))
icon-spec)
(setq mod (or (cond
((not (stringp mod)) "")
((char-equal ?s (aref mod 0))
(if (setq icon-spec (mode-icons-get-icon-spec 'steal))
(mode-icons-propertize-mode 'steal icon-spec face active)
mod))
((char-equal ?! (aref mod 0))
(if (setq icon-spec (mode-icons-get-icon-spec 'modified-outside))
(mode-icons-propertize-mode 'modified-outside icon-spec face active)
mod))
((char-equal ?* (aref mod 0))
(if (setq icon-spec (mode-icons-get-icon-spec 'save))
(mode-icons-propertize-mode 'save icon-spec face active)
mod))
(t
(if (setq icon-spec (mode-icons-get-icon-spec 'saved))
(mode-icons-propertize-mode 'saved icon-spec face active)
mod)))
""))
(setq mod (mode-icons--recolor-minor-mode-image mod active face))
(when (and mode-icons-modified-status-space
(stringp mod)
(not (string= mod "")))
(setq mod (concat mod " ")))
mod)) "")
,@mode-icons-modified-text-properties))))
2016-02-19 19:45:02 +01:00
2016-01-22 22:54:31 +01:00
;; Based on rich-minority by Artur Malabarba
(defvar mode-icons--backup-construct nil)
(defvar mode-icons--mode-line-construct
'(:eval (mode-icons--generate-minor-mode-list))
"Construct used to replace `minor-mode-alist'.")
(defvar mode-icons--major-backup-construct nil)
(defvar mode-icons--major-construct
'(:eval (mode-icons--generate-major-mode-item))
"Construct used to replace `mode-name'.")
2016-02-19 06:13:20 +01:00
(defvar mode-icons--narrow-backup-construct nil)
(defvar mode-icons--narrow-construct
'(:eval (mode-icons--generate-narrow))
"Construct used to replace %n in `mode-line-modes'.")
2016-02-19 19:04:58 +01:00
(defvar mode-icons--read-only-backup-construct nil)
(defvar mode-icons--read-only-construct
'(:eval (mode-icons--read-only-status))
"Construct used to replace %1* in `mode-line-modified'.")
2016-02-19 19:45:02 +01:00
(defvar mode-icons--modified-backup-construct nil)
(defvar mode-icons--modified-construct
'(:eval (mode-icons--modified-status))
"Construct used to replace %1+ in `mode-line-modified'.")
2016-02-19 23:00:18 +01:00
(defvar mode-icons--backup-eol-construct nil)
(defvar mode-icons--eol-construct
'(:eval (mode-icons--mode-line-eol-desc))
"End of Line Construct.")
2016-02-20 07:09:35 +01:00
(defcustom mode-icons-eol-space t
"Add a space to the end of line specification."
:type 'boolean
:group 'mode-icons)
(defcustom mode-icons-eol-text nil
2016-03-30 21:18:14 +02:00
"Describe end of line type.
2016-02-20 07:09:35 +01:00
\(Unix) -> LF
\(DOS) -> CRLF
\(Mac) -> CR"
:type 'boolean
:group 'mode-icons)
(defun mode-icons--mode-line-eol-desc (&optional string face)
2016-02-19 23:00:18 +01:00
"Modify `mode-line-eol-desc' to have icons.
2016-04-04 17:41:20 +02:00
STRING is the string to modify, or if absent, the value from
`mode-line-eol-desc'.
FACE is the face that will be used to render the segment."
2016-02-19 23:00:18 +01:00
(let* ((str (or string (mode-line-eol-desc)))
(props (text-properties-at 0 str))
2016-02-20 07:30:19 +01:00
(lt2 "")
(active (mode-icons--selected-window-active))
2016-02-19 23:00:18 +01:00
icon-spec)
(setq str (or (cond
((string= "(Unix)" str)
(setq lt2 " LF")
(if (setq icon-spec (mode-icons-get-icon-spec 'unix))
(mode-icons-propertize-mode 'unix icon-spec face active)
str))
((or (string= str "(DOS)")
(string= str "\\"))
(setq lt2 " CRLF")
(if (setq icon-spec (mode-icons-get-icon-spec 'win))
(mode-icons-propertize-mode 'win icon-spec face active)
str))
((string= str "(Mac)")
(setq lt2 " CR")
(if (setq icon-spec (mode-icons-get-icon-spec 'apple))
(mode-icons-propertize-mode 'apple icon-spec face active)
str))
((string= str ":")
(setq lt2 " Undecided")
(if (setq icon-spec (mode-icons-get-icon-spec 'undecided))
(mode-icons-propertize-mode 'undecided icon-spec face active)
str))
(t str))
""))
(setq str (mode-icons--recolor-minor-mode-image str active face))
2016-02-20 07:09:35 +01:00
(when mode-icons-eol-text
(setq str (concat str lt2)))
(when (and mode-icons-eol-space
(not (string= "" str)))
(setq str (concat str " ")))
2016-02-19 23:00:18 +01:00
(add-text-properties 0 (length str) props str)
str))
2016-02-19 19:45:02 +01:00
2016-01-22 22:54:31 +01:00
(defun mode-icons-fix (&optional enable)
2016-03-30 21:18:14 +02:00
"Fix mode-icons.
When ENABLE is non-nil, enable the changes to the mode line."
2016-01-22 22:54:31 +01:00
(if enable
(let ((place (or (member 'minor-mode-alist mode-line-modes)
(cl-member-if
(lambda (x) (and (listp x)
(equal (car x) :propertize)
(equal (cadr x) '("" minor-mode-alist))))
mode-line-modes)))
(place-major (cl-member-if
(lambda(x)
(and (listp x)
(equal (car x) :propertize)
(equal (cadr x) '("" mode-name))))
2016-02-19 06:13:20 +01:00
mode-line-modes))
(place-narrow (cl-member-if
(lambda(x)
(and (stringp x) (string= "%n" x)))
2016-02-19 19:04:58 +01:00
mode-line-modes))
(place-ro (cl-member-if
(lambda(x)
(and (stringp x) (string-match-p "%[0-9]*[*]" x)))
2016-02-19 19:45:02 +01:00
mode-line-modified))
(place-mod (cl-member-if
2016-02-19 23:00:18 +01:00
(lambda(x)
(and (stringp x) (string-match-p "%[0-9]*[+]" x)))
mode-line-modified))
(place-eol (cl-member-if
(lambda(x)
(and (listp x)
(equal (car x) :eval)
(eq (cl-caadr x) 'mode-line-eol-desc)))
2016-02-19 23:00:18 +01:00
mode-line-mule-info)))
2016-01-22 22:54:31 +01:00
(when place
(setq mode-icons--backup-construct (car place))
(setcar place mode-icons--mode-line-construct))
(when place-major
(setq mode-icons--major-backup-construct (car place-major))
2016-02-19 06:13:20 +01:00
(setcar place-major mode-icons--major-construct))
(when place-narrow
(setq mode-icons--narrow-backup-construct (car place-narrow))
2016-02-19 19:04:58 +01:00
(setcar place-narrow mode-icons--narrow-construct))
(when place-ro
(setq mode-icons--read-only-backup-construct (car place-ro))
2016-02-19 19:45:02 +01:00
(setcar place-ro mode-icons--read-only-construct))
(when place-mod
(setq mode-icons--modified-backup-construct (car place-mod))
2016-02-19 23:00:18 +01:00
(setcar place-mod mode-icons--modified-construct))
(when place-eol
(setq mode-icons--backup-eol-construct (car place-eol))
(setcar place-eol mode-icons--eol-construct)))
(let ((place (member mode-icons--mode-line-construct mode-line-modes))
2016-02-19 23:00:18 +01:00
(place-major (member mode-icons--major-construct mode-line-modes))
(place-narrow (member mode-icons--narrow-construct mode-line-modes))
(place-ro (member mode-icons--read-only-construct mode-line-modified))
(place-mod (member mode-icons--modified-construct mode-line-modified))
(place-eol (member mode-icons--eol-construct mode-line-mule-info)))
2016-01-22 22:54:31 +01:00
(when place
(setcar place mode-icons--backup-construct))
(when place-major
2016-02-19 06:13:20 +01:00
(setcar place-major mode-icons--major-backup-construct))
(when place-narrow
2016-02-19 19:04:58 +01:00
(setcar place-narrow mode-icons--narrow-backup-construct))
(when place-ro
2016-02-19 19:45:02 +01:00
(setcar place-ro mode-icons--read-only-backup-construct))
2016-02-21 13:44:04 +01:00
(when place-mod
2016-02-19 23:00:18 +01:00
(setcar place-mod mode-icons--modified-backup-construct))
(when place-eol
(setcar place-eol mode-icons--backup-eol-construct)))))
2016-01-22 22:54:31 +01:00
(defun mode-icons--mode-enable ()
"Set up for the command mode-icons-mode."
(add-hook 'after-change-major-mode-hook #'mode-icons-reset)
(mode-icons-fix t)
(mode-icons-set-minor-mode-icon)
(mode-icons-major-mode-icons))
(defun mode-icons--mode-enable-for-first-frame ()
"Set up for the command mode-icons-mode and then stop it from running again.
This function should be used in the
server-after-make-frame-hook hook. It will call
mode-icons--mode-enable and then remove itself from
server-after-make-frame-hook."
(mode-icons--mode-enable)
(remove-hook 'server-after-make-frame-hook #'mode-icons--mode-enable-for-first-frame))
(defun mode-icons--mode-disable ()
"Tear down for the command mode-icons-mode."
(remove-hook 'after-change-major-mode-hook #'mode-icons-reset)
(mode-icons-set-minor-mode-icon-undo)
(mode-icons-major-mode-icons-undo)
(mode-icons-fix))
;;;###autoload
(define-minor-mode mode-icons-mode
"Replace the name of the current major mode with an icon."
:global t
(if mode-icons-mode
(if (daemonp)
(add-hook 'server-after-make-frame-hook #'mode-icons--mode-enable-for-first-frame)
(mode-icons--mode-enable))
(mode-icons--mode-disable)))
(defun mode-icons-reset-hash ()
"Reset `mode-icons-get-icon-spec' and `mode-icons-get-icon-display'."
(interactive)
(setq mode-icons-get-icon-spec (make-hash-table :test 'equal)
mode-icons-get-icon-display (make-hash-table :test 'equal)))
(defun mode-icons-reset ()
"Reset mode-icons icons."
(interactive)
(when (and mode-icons-mode (not (minibufferp)))
;; Reset the major mode now.
(mode-icons-set-current-mode-icon)
;; Reset the minor mode later, in case the mode turns on some
;; minor-modes.
(run-with-idle-timer
0.1 nil `(lambda()
;; Reset the minor mode icons
(when (buffer-live-p ,(current-buffer))
(with-current-buffer ,(current-buffer)
(mode-icons-set-minor-mode-icon)))))))
2016-04-01 06:34:44 +02:00
2016-04-29 06:30:39 +02:00
(defadvice isearch-mode (after mode-icons--reset-isearch-icon activate)
"Make `mode-icons' aware of icon."
(mode-icons-set-minor-mode-icon))
2016-04-01 06:34:44 +02:00
(eval-after-load 'powerline
'(progn
(declare-function mode-icons--real-powerline-minor-modes "powerline")
(fset 'mode-icons--real-powerline-minor-modes #'powerline-minor-modes)
2016-04-01 06:34:44 +02:00
(defun mode-icons--powerline-minor-modes (&optional face pad)
"Powerline minor modes is replaced by this function.
FACE is the face to use.
PAD is the padding around the minor modes.
The original is called if `mode-icons-mode' is disabled. It is
saved in `mode-icons--real-powerline-minor-modes'."
2016-04-01 06:34:44 +02:00
(if mode-icons-mode
(mode-icons--generate-minor-mode-list face)
2016-04-01 06:34:44 +02:00
(mode-icons--real-powerline-minor-modes face pad)))
(fset 'mode-icons--real-powerline-major-mode #'powerline-minor-modes)
2016-04-04 17:41:20 +02:00
(defun mode-icons--powerline-major-mode (&optional face pad)
"Powerline major modes is replaced by this function.
FACE is the face to use.
PAD is the padding around the minor modes.
The original is called if `mode-icons-mode' is disabled. It is
saved in `mode-icons--real-powerline-major-mode'."
2016-04-04 17:41:20 +02:00
(if mode-icons-mode
(powerline-raw (format-mode-line (mode-icons--generate-major-mode-item face) face) face pad)
(mode-icons--real-powerline-major-mode face pad)))
(fset 'powerline-major-mode #'mode-icons--powerline-major-mode)
(fset 'mode-icons--real-powerline-raw #'powerline-raw)
(defun mode-icons--powerline-raw (str &optional face pad)
"Render STR as mode-line data using FACE and optionally PAD import on left (l) or right (r).
This uses `mode-icons--recolor-string' when `mode-icons-mode' is enabled."
(if mode-icons-mode
(when str
(let* ((rendered-str (format-mode-line str))
(padded-str (concat
(when (and (> (length rendered-str) 0) (eq pad 'l)) " ")
(if (listp str) rendered-str str)
(when (and (> (length rendered-str) 0) (eq pad 'r)) " "))))
(if face
(mode-icons--recolor-string (pl/add-text-property padded-str 'face face)
(mode-icons--selected-window-active) face)
padded-str)))
(mode-icons--real-powerline-raw str face pad)))
(fset 'powerline-raw #'mode-icons--powerline-raw)))
2016-04-01 06:34:44 +02:00
(eval-after-load 'emojify
'(progn
(mode-icons-reset-hash)))
2012-11-10 23:12:36 +01:00
(provide 'mode-icons)
;;; mode-icons.el ends here
;; Local Variables:
;; indent-tabs-mode: nil
;; End: