diff options
| -rw-r--r-- | mode-icons.el | 140 |
1 files changed, 122 insertions, 18 deletions
diff --git a/mode-icons.el b/mode-icons.el index 7106c16..670afe0 100644 --- a/mode-icons.el +++ b/mode-icons.el @@ -73,8 +73,20 @@ ICON should be a file name with extension. The result is the absolute path to ICON." (concat mode-icons--directory "/icons/" icon)) +(defmacro mode-icons-define-font (font) + "Define FONT for `mode-icons'." + `(progn + (defvar ,(intern (format "mode-icons-font-spec-%s" font)) + (font-spec :name ,(format "%s" font))) + (defvar ,(intern (format "mode-icons-font-%s" font)) + (find-font ,(intern (format "mode-icons-font-spec-%s" font)))))) + +(mode-icons-define-font "github-octicons") +(mode-icons-define-font "font-mfizz") +(mode-icons-define-font "FontAwesome") + (defcustom mode-icons - '(("CSS" "css" xpm) + `(("CSS" "css" xpm) ("Coffee" "coffee" xpm) ("Compilation" "compile" xpm) ("Emacs-Lisp" "emacs" xpm) @@ -107,11 +119,20 @@ absolute path to ICON." ("YASnippet" "yas" xpm) (" yas" "yas" xpm) (" hs" "hs" xpm) + ("Markdown" ,(make-string 1 #xf0c9) github-octicons) + ("Scala" ,(make-string 1 #xf15b) font-mfizz) + ("Magit" ,(make-string 1 #xf1d2) FontAwesome) + (" Pulls" ,(make-string 1 #xf092) FontAwesome) + ("Zip-Archive" ,(make-string 1 #xf1c6) FontAwesome) + ("ARev" ,(make-string 1 #xf021) FontAwesome) + ("Calc\\(ulator\\)?" ,(make-string 1 #xf1ec) FontAwesome) + ("Debug.*" ,(make-string 1 #xf188) FontAwesome) + ("Calendar" ,(make-string 1 #xf073) FontAwesome) + ("C/l" ,(make-string 1 #xf107) font-mfizz) ("Go" "go" xpm) (" Rbow" "rainbow" xpm) ;; Diminished modes - ;; ("\\(ElDoc\\|Anzu\\|SP\\|Guide\\|PgLn\\|Golden\\|Undo-Tree\\|Ergo.*\\|,\\)" nil nil) - ) + ("\\(ElDoc\\|Anzu\\|SP\\|Guide\\|PgLn\\|Golden\\|Undo-Tree\\|Ergo.*\\|,\\|Isearch\\|Ind\\|Fly\\)" nil nil)) "Icons for major and minor modes. Each specificatioun is a list with the first element being the @@ -124,13 +145,17 @@ without the extension. And the third being the type of icon." (const :tag "Suppress" nil)) (choice (const :tag "text" nil) + (const :tag "Octicons" github-octicons) + (const :tag "Fizzed" font-mfizz) + (const :tag "Font Awesome" FontAwesome) (const :tag "png" png) (const :tag "gif" gif) (const :tag "jpeg" jpeg) + (const :tag "jpg" jpg) (const :tag "xbm" xbm) (const :tag "xpm" xpm)))) :group 'mode-icons) - + (defun mode-icons-get-icon-display (icon type) "Get the value for the display property of ICON having TYPE. @@ -139,37 +164,94 @@ extension. Type should be a symbol designating the file type for the icon." (let ((icon-path (mode-icons-get-icon-file (concat icon "." (symbol-name type))))) - `(image :type ,type :file ,icon-path :ascent center))) + `(image :type ,(or (and (eq type 'jpg) 'jpeg) type) :file ,icon-path :ascent center))) (defcustom mode-icons-minor-mode-base-text-properties - '('help-echo 'rm--help-echo + '('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) + (defvar mode-icons-powerline-p nil) (defun mode-icons-need-update-p () - "Determine if the mode-icons need an update" + "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 &optional dont-register) + "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." + (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) + (mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec) t) + (and (eq (nth 2 icon-spec) 'jpg) (image-type-available-p 'jpeg)) + (and (image-type-available-p (nth 2 icon-spec))))) + (defun mode-icons-propertize-mode (mode icon-spec) "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'." - (cond - ((not (nth 1 icon-spec)) "") - (t (propertize mode 'display (mode-icons-get-icon-display (nth 1 icon-spec) (nth 2 icon-spec)))))) + (let (tmp) + (cond + ((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 mode 'display (mode-icons-get-icon-display (nth 1 icon-spec) (nth 2 icon-spec)) + 'mode-icons-p t)) + ((mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec)) + ;; (propertize mode 'display (nth 1 icon-spec) 'mode-icons-p t) + ;; Use `compose-region' because it allows clicable text. + (with-temp-buffer + (insert mode) + (compose-region (point-min) (point-max) (nth 1 icon-spec)) + (put-text-property (point-min) (point-max) 'mode-icons-p t) + (buffer-string))) + (t (propertize mode 'display (mode-icons-get-icon-display (nth 1 icon-spec) (nth 2 icon-spec)) 'mode-icons-p t))))) (defun mode-icons-get-icon-spec (mode) - "Get icon spec based on regular expression." + "Get icon spec for MODE based on regular expression." (catch 'found-mode (dolist (item mode-icons) - (when (string-match-p (car item) mode) + (when (and (mode-icons-supported-p item) + (string-match-p (car item) mode)) (throw 'found-mode item))) nil)) @@ -192,7 +274,7 @@ ICON-SPEC should be a specification from `mode-icons'." (setq mode-name (mode-icons-get-mode-icon mode)))) (defun mode-icons-major-mode-icons-undo () - "Undo the mode-name changes" + "Undo the `mode-name' icons." (dolist (b (buffer-list)) (with-current-buffer b (when mode-icons-cached-mode-name @@ -200,7 +282,7 @@ ICON-SPEC should be a specification from `mode-icons'." mode-icons-cached-mode-name nil))))) (defun mode-icons-major-mode-icons () - "Apply mode name changes on all buffers." + "Apply mode name icons on all buffers." (dolist (b (buffer-list)) (with-current-buffer b (mode-icons-set-current-mode-icon)))) @@ -212,6 +294,7 @@ ICON-SPEC should be a specification from `mode-icons'." (defvar mode-icons-set-minor-mode-icon-alist nil) (defun mode-icons-set-minor-mode-icon-undo () + "Undo minor modes." (let (minor) (dolist (mode mode-icons-set-minor-mode-icon-alist) (setq minor (assq (car mode) minor-mode-alist)) @@ -245,6 +328,10 @@ ICON-SPEC should be a specification from `mode-icons'." mode-name))))))))) (force-mode-line-update)) +(defun mode-icons--generate-major-mode-item () + "Give rich strings needed for `major-mode' viewing." + (eval `(propertize ,mode-name ,@mode-icons-major-mode-base-text-properties))) + (defun mode-icons--generate-minor-mode-list () "Extracts all rich strings necessary for the minor mode list." (delete " " (delete "" (mapcar (lambda(mode) @@ -257,6 +344,11 @@ ICON-SPEC should be a specification from `mode-icons'." '(: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'.") + (defun mode-icons-fix (&optional enable) "Fix mode-icons." (if enable @@ -265,13 +357,25 @@ ICON-SPEC should be a specification from `mode-icons'." (lambda (x) (and (listp x) (equal (car x) :propertize) (equal (cadr x) '("" minor-mode-alist)))) - mode-line-modes)))) + 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))) (when place (setq mode-icons--backup-construct (car place)) - (setcar place mode-icons--mode-line-construct))) - (let ((place (member mode-icons--mode-line-construct mode-line-modes))) + (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))) + (let ((place (member mode-icons--mode-line-construct mode-line-modes)) + (place-major (member mode-icons--major-backup-construct mode-line-modes))) (when place - (setcar place mode-icons--backup-construct))))) + (setcar place mode-icons--backup-construct)) + (when place-major + (setcar place-major mode-icons--major-backup-construct))))) ;;;###autoload (define-minor-mode mode-icons-mode |