diff options
Diffstat (limited to 'elpa/mode-icons-20190627.2121/mode-icons.el')
| -rw-r--r-- | elpa/mode-icons-20190627.2121/mode-icons.el | 1883 |
1 files changed, 0 insertions, 1883 deletions
diff --git a/elpa/mode-icons-20190627.2121/mode-icons.el b/elpa/mode-icons-20190627.2121/mode-icons.el deleted file mode 100644 index cfa68ec..0000000 --- a/elpa/mode-icons-20190627.2121/mode-icons.el +++ /dev/null @@ -1,1883 +0,0 @@ -;;; mode-icons.el --- Show icons for modes -*- lexical-binding: t; -*- - -;; Copyright (C) 2013, 2016 Tom Willemse -;; 2016 Matthew L. Fidler - -;; Author: Tom Willemse <tom@ryuslash.org> -;; Keywords: multimedia -;; Version: 0.4.0 -;; URL: http://ryuslash.org/projects/mode-icons.html -;; Package-Requires: ((emacs "24") (cl-lib "0.5")) - -;; 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: - -;; 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: -;; -;; - C -;; - C++ -;; - C# -;; - CSS -;; - Coffee -;; - Dart -;; - Emacs-Lisp -;; - HTML -;; - Haml -;; - JavaScript -;; - Lisp -;; - Lua -;; - nXML -;; - PHP -;; - Python -;; - React -;; - Ruby -;; - Rust -;; - 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'. -;; - -;;; Code: - -(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") -(declare-function mode-icons--real-powerline-major-mode "powerline") -(declare-function mode-icons--powerline-major-mode "mode-icons") - -(require 'cl-lib) -(require 'color) -(require 'emojify nil t) - -(defgroup mode-icons nil - "Provide icons for major modes." - :group 'editing-basics - :group 'convenience) - -(defconst mode-icons--directory - (if load-file-name - (file-name-directory load-file-name) - default-directory) - "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." - (expand-file-name icon (expand-file-name "icons" mode-icons--directory))) - -(defmacro mode-icons-save-buffer-state (&rest body) - "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. - -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 -`buffer-undo-list'. - -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 - `(("\\`CSS\\'" "css" xpm) - ("\\`Coffee\\'" "coffee" xpm-bw) - ("\\`Compilation\\'" "compile" xpm) - ("\\`Dart\\'" "dart" xpm) - ("\\`Flutter\\'" "flutter" xpm) - ("\\`Elixir\\'" "elixir" xpm) - ("\\`Erlang\\'" "erlang" xpm) - ("\\`Emacs-Lisp\\'" "emacs" xpm) - ("\\`Lisp Interaction\\'" "emacs" xpm) - ("\\`HTML\\'" "html" xpm) - ("\\`Haml\\'" "haml" xpm) - ("\\`Image\\[imagemagick\\]\\'" "svg" xpm) - ("\\`Inf-Ruby\\'" "infruby" xpm) - ("\\`Java[Ss]cript\\'" "js" xpm) - ("\\`Lisp\\'" "cl" xpm) - ("\\`Lua\\'" "Lua-Logo_16x16" png) - ("\\`nXML\\'" "xml" xpm) - ("\\`Org\\'" "org" xpm) - ("\\`PHP\\(\\|/.*\\)\\'" "php" xpm) - ("\\`Projectile Rails Server\\'" "rails" xpm) - ("\\`Python\\'" "python" xpm) - ("\\` Emmet\\'" "emmet" xpm) - ("\\`RJSX\\'" "react" xpm) - ("\\`Ruby\\'" "ruby" xpm) - ("\\`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) - ("\\`Scheme" "scheme" xpm-bw) - ("\\`Shell-script" "bash" xpm-bw) - ("\\`Slim" "slim" xpm-bw) - ("\\`Snippet" "yas" xpm) - ("\\`Term\\'" "term" xpm) - ("\\`Web\\'" "html" xpm) - ("\\`XML\\'" "xml" xpm) - ("\\`YAML\\'" "yaml" xpm) - ("\\` ?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) - ("\\` ARev\\'" #xf021 FontAwesome) - ("\\`Calc\\(ulator\\)?\\'" #xf1ec FontAwesome) - ("\\`Debug.*\\'" #xf188 FontAwesome) - ("\\`Debug.*\\'" #xf188 FontAwesome) - ("\\`Calendar\\'" #xf073 FontAwesome) - ("\\`Help\\'" #xf059 FontAwesome) - ("\\`WoMan\\'" #xf05a FontAwesome) - ("\\`C\\(/.*\\|\\)\\'" "c" xpm) - ("\\`Custom\\'" #xf013 FontAwesome) - ("\\`Go\\'" "go" xpm) - ("\\` ?Rbow\\'" "rainbow" xpm) - ("\\` ?ivy\\'" "ivy" xpm) ;; Icon created by Philipp Lehmann from the Noun Project https://thenounproject.com/search/?q=ivy&i=329756 - ("\\` ?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) - ("\\`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) - ("\\` ?Narrow\\'" #xf066 FontAwesome) - ("\\`Dockerfile\\'" "docker" xpm) - ("\\`Spacemacs buffer\\'" "spacemacs" png) - ("\\` ?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) - (read-only #xf023 FontAwesome) - (writable #xf09c FontAwesome) - (save #xf0c7 FontAwesome) - (saved "" nil) - (modified-outside #xf071 FontAwesome) - (steal #xf21b FontAwesome) - ;; Prefer finder icon since it looks like the old mac icon - (apple #xeabf IcoMoon-Free) - (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 - (undecided #xf128 FontAwesome) - ("Text\\'" #xf0f6 FontAwesome) - ("\\` ?company\\'" #xf1ad FontAwesome) - ("\\` ?AC\\'" #xf18e FontAwesome) - ("\\` ?Fly\\'" #xea12 IcoMoon-Free) - ;; ("\\` ?FlyC.*\\'" "flycheck" xpm) - ("\\` ?SP\\(/s\\)?\\'" "smartparens" xpm) - ("\\` ?Ergo" #xf11c FontAwesome) - ("\\` ?drag\\'" #xf047 FontAwesome) - ("\\` ?Helm\\'" "helm" xpm-bw) ;; By Noe Araujo, MX, https://thenounproject.com/term/helm/233101/ - ("\\`Messages\\'" #xf27b FontAwesome) - ("\\`Conf" #xf1de FontAwesome) - ("\\`Fundamental\\'" #xf016 FontAwesome) - ("\\`Javascript-IDE\\'" "js" xpm) - ("\\` Undo-Tree\\'" ":palm_tree:" emoji) - ("\\`LaTeX\\'" "tex" ext) - ("\\`Image\\[xpm\\]\\'" "xpm" ext) - ("\\`Image\\[png\\]\\'" "png" ext) - ("\\` ?AI\\'" #xf03c FontAwesome) - ("\\` ?Isearch\\'" #xf002) - (default #xf059 FontAwesome) - ;; Diminished modes - ("\\` ?\\(?:ElDoc\\|Anzu\\|SP\\|Guide\\|PgLn\\|Undo-Tree\\|Ergo.*\\|,\\|Isearch\\|Ind\\)\\'" nil nil)) - "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 - (list (choice - (string :tag "Regular Expression") - (const :tag "Read Only Indicator" read-only) - (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) - (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") - (integer :tag "Font Glyph Code") - (const :tag "ess" nil)) - (choice - (const :tag "text" nil) - (const :tag "png" png) - (const :tag "gif" gif) - (const :tag "jpeg" jpeg) - (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) - (const :tag "Mode Icons Generated file-type" ext) - (symbol :tag "Font")))) - :group 'mode-icons) - -(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")) - -(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) - (puthash icon-path (mode-icons-save-buffer-state (with-temp-buffer (insert-file-contents icon-path) (buffer-string))) - 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) - "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. -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. -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)))) - (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)))) - -(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) - (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)))) - 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))) - (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)) - 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)) - (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) - -(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) - "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, if accessible. -This uses `window-mode-line-height' on emacs 24.4+. Otherwise it assumes 16. - -This function also adjusts the line height by `mode-icons-line-height-adjust'." - (+ mode-icons-line-height-adjust - (or (and (fboundp 'window-mode-line-height) (window-mode-line-height window)) 16))) - -(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 -specified by type 'xpm-bw. - -ACTIVE is an indicator that the current window is active." - (let* ((face (mode-icons--get-face face active)) - (key (list icon type face active - mode-icons-desaturate-inactive mode-icons-desaturate-active - mode-icons-grayscale-transform custom-enabled-themes)) - tmp) - (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) - ;; 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) - (create-image icon-path - (or (and (fboundp 'imagemagick-types) - (memq 'png (imagemagick-types)) 'imagemagick) - 'xpm) - :height (mode-icons-line-height) - :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) - (or (and (fboundp 'imagemagick-types) - (memq 'png (imagemagick-types)) 'imagemagick) - 'xpm) t - :ascent 'center - :height (mode-icons-line-height) - :face face :icon icon)) - (t - (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) - :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)))) - (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) - (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)))) - -(defcustom mode-icons-minor-mode-base-text-properties - '('help-echo nil - '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) - -(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) - -(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) - -(defcustom mode-icons-modified-text-properties - '('mouse-face 'mode-line-highlight - 'local-map - '(keymap - (mode-line keymap - (mouse-1 . mode-icons-save-steal-or-revert-buffer) - (mouse-3 . mode-line-toggle-modified))) - 'help-echo 'mode-icons-modified-help-echo) - "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) - "Save buffer OR revert file from mode line. -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)))))) - (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 ""))))) - -(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) - -(defvar mode-icons-powerline-p nil) -(defun mode-icons-need-update-p () - "Determine if the mode-icons need an update." - (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.") - -(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." - (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)))))) - -(defun mode-icons-supported-p (icon-spec) - "Determine if ICON-SPEC is suppored on your system." - (or - (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*") - (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)))))) - -(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")))) - -(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"))))))) - -(defun mode-icons--get-png (mode icon-spec &optional face active) - "Get MODE for png ICON-SPEC using FACE. -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"))) - (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 - face active) - 'face face - 'mode-icons-p (list (nth 0 icon-spec) xpm-name 'xpm)) - (if (not png-p) - (propertize (format "%s" mode) - '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) - '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) - -(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)) - (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 - 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))) - (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) - '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)) - '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) - -(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)) - (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 - xpm-name 'xpm face active) - 'mode-icons-p (list (nth 0 icon-spec) xpm-name 'xpm-bw) - 'face face) - (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))) - (buffer-string)))))) - -(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'. -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) - (mode-icons--get-font mode icon-spec face active)) - ((and (stringp (nth 1 icon-spec)) (eq (nth 2 icon-spec) 'emoji)) - (mode-icons--get-emoji mode icon-spec face active)) - ((and (stringp (nth 1 icon-spec)) (eq (nth 2 icon-spec) 'png)) - (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 - (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))) - (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)))))) - -(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) - "Get icon spec for MODE based on regular expression." - (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))) - -(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) - -(defun mode-icons-get-mode-icon (mode &optional face active) - "Get the icon for MODE, if there is one. -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)) - ret) - (when (and (not icon-spec) mode-icons-use-default-icon) - (setq icon-spec (mode-icons-get-icon-spec 'default))) - (if icon-spec - (setq ret - (if mode-icons-show-mode-name - (concat (mode-icons-propertize-mode mode-name icon-spec face active) " " mode-name) - (mode-icons-propertize-mode mode-name icon-spec face active))) - (setq ret mode-name)) - ;; Don't hide major mode names... - (when (string= ret "") - (setq ret mode-name)) - ret)) - -(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.") - -(defun mode-icons-set-mode-icon (mode) - "Set the icon for MODE." - (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) - (mode-icons-get-mode-icon mode nil t)) - (when mode-icons-change-mode-name - (setq mode-name mode-icons--mode-name)))) - -(defun mode-icons-major-mode-icons-undo () - "Undo the `mode-name' icons." - (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))))) - -(defun mode-icons-major-mode-icons () - "Apply mode name icons on all buffers." - (dolist (b (buffer-list)) - (with-current-buffer b - (mode-icons-set-current-mode-icon)))) - -(defun mode-icons-set-current-mode-icon () - "Set the icon for the current major mode." - (mode-icons-set-mode-icon mode-name)) - -(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'." - (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))))) - (setq mode-icons-set-minor-mode-icon-alist nil) - (unless dont-update - (force-mode-line-update))) - -(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) - (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))) - -(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." - (let* ((active (mode-icons--selected-window-active)) - (face (mode-icons--get-face face active))) - (eval `(propertize ,(mode-icons--recolor-string (or mode-icons--mode-name mode-name) active face) - '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. -;; (add-hook 'focus-in-hook 'mode-icons--set-selected-window) - -;; focus-out-hook was introduced in emacs v24.4. -;; (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))) - -(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) - (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))) - (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 - ((and icon-spec (memq (nth 2 icon-spec) '(xpm xpm-bw))) - (propertize mode 'display (mode-icons-get-icon-display - (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) - 'xpm face active) 'face face - 'mode-icons-p icon-spec)) - (t (propertize mode 'face face))))) - -(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'." - (let* ((active (mode-icons--selected-window-active)) - (face (mode-icons--get-face face active))) - (delete " " (delete "" (mapcar (lambda(mode) - (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))))))) - -(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." - (let* ((active (mode-icons--selected-window-active)) - (face (mode-icons--get-face active face)) - icon-spec) - (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) - mode) - ,@mode-icons-narrow-text-properties)))) - (split-string (format-mode-line "%n"))))))) - - -(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 " "))) - ro) - ,@mode-icons-read-only-text-properties)))) - -(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)))) - -;; 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'.") - -(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'.") - - -(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'.") - - -(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'.") - -(defvar mode-icons--backup-eol-construct nil) -(defvar mode-icons--eol-construct - '(:eval (mode-icons--mode-line-eol-desc)) - "End of Line Construct.") - -(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 - "Describe end of line type. -\(Unix) -> LF -\(DOS) -> CRLF -\(Mac) -> CR" - :type 'boolean - :group 'mode-icons) - -(defun mode-icons--mode-line-eol-desc (&optional string face) - "Modify `mode-line-eol-desc' to have icons. - -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." - (let* ((str (or string (mode-line-eol-desc))) - (props (text-properties-at 0 str)) - (lt2 "") - (active (mode-icons--selected-window-active)) - 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)) - (when mode-icons-eol-text - (setq str (concat str lt2))) - (when (and mode-icons-eol-space - (not (string= "" str))) - (setq str (concat str " "))) - (add-text-properties 0 (length str) props str) - str)) - - -(defun mode-icons-fix (&optional enable) - "Fix mode-icons. -When ENABLE is non-nil, enable the changes to the mode line." - (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)))) - mode-line-modes)) - (place-narrow (cl-member-if - (lambda(x) - (and (stringp x) (string= "%n" x))) - mode-line-modes)) - (place-ro (cl-member-if - (lambda(x) - (and (stringp x) (string-match-p "%[0-9]*[*]" x))) - mode-line-modified)) - (place-mod (cl-member-if - (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))) - mode-line-mule-info))) - (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)) - (setcar place-major mode-icons--major-construct)) - (when place-narrow - (setq mode-icons--narrow-backup-construct (car place-narrow)) - (setcar place-narrow mode-icons--narrow-construct)) - (when place-ro - (setq mode-icons--read-only-backup-construct (car place-ro)) - (setcar place-ro mode-icons--read-only-construct)) - (when place-mod - (setq mode-icons--modified-backup-construct (car place-mod)) - (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)) - (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))) - (when place - (setcar place mode-icons--backup-construct)) - (when place-major - (setcar place-major mode-icons--major-backup-construct)) - (when place-narrow - (setcar place-narrow mode-icons--narrow-backup-construct)) - (when place-ro - (setcar place-ro mode-icons--read-only-backup-construct)) - (when place-mod - (setcar place-mod mode-icons--modified-backup-construct)) - (when place-eol - (setcar place-eol mode-icons--backup-eol-construct))))) - -;;;###autoload -(define-minor-mode mode-icons-mode - "Replace the name of the current major mode with an icon." - :global t - (if mode-icons-mode - (progn - (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)) - (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))) - -(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))))))) - -(add-hook 'emacs-startup-hook #'mode-icons-reset) - -(defadvice isearch-mode (after mode-icons--reset-isearch-icon activate) - "Make `mode-icons' aware of icon." - (mode-icons-set-minor-mode-icon)) - -(eval-after-load 'powerline - '(progn - (declare-function mode-icons--real-powerline-minor-modes "powerline") - (fset 'mode-icons--real-powerline-minor-modes #'powerline-minor-modes) - (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'." - (if mode-icons-mode - (mode-icons--generate-minor-mode-list face) - (mode-icons--real-powerline-minor-modes face pad))) - (fset 'mode-icons--real-powerline-major-mode #'powerline-minor-modes) - (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'." - (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))) - - -(eval-after-load 'emojify - '(progn - (mode-icons-reset-hash))) - -(provide 'mode-icons) -;;; mode-icons.el ends here -;; Local Variables: -;; indent-tabs-mode: nil -;; End: |