Make minor-modes have menus by using `compose-region'

Also make every system register the font for the icon
This commit is contained in:
Matthew L. Fidler 2016-02-11 08:43:27 -06:00
parent e33fd86eb9
commit 74bf049996

View file

@ -160,13 +160,12 @@ the icon."
(defun mode-icons-supported-font-p (char font &optional dont-register) (defun mode-icons-supported-font-p (char font &optional dont-register)
"Determine if the CHAR is supported in FONT. "Determine if the CHAR is supported in FONT.
When DONT-REGISTER is non-nil, don't register the font. When DONT-REGISTER is non-nil, don't register the font.
Otherwise, under windows 32, register the font for use in Otherwise, register the font for use in the mode-line and
the mode-line." everywhere else."
(when (and (or (integerp char) (when (and (or (integerp char)
(and (stringp char) (= 1 (length char)))) (and (stringp char) (= 1 (length char))))
(boundp (intern (format "mode-icons-font-spec-%s" font))) (boundp (intern (format "mode-icons-font-spec-%s" font)))
(symbol-value (intern (format "mode-icons-font-spec-%s" font)))) (symbol-value (intern (format "mode-icons-font-spec-%s" font))))
(if (not (eq system-type 'windows-nt)) 'direct-font
(let* ((char (or (and (integerp char) char) (let* ((char (or (and (integerp char) char)
(and (stringp char) (= 1 (length char)) (and (stringp char) (= 1 (length char))
(aref (vconcat char) 0)))) (aref (vconcat char) 0))))
@ -178,7 +177,7 @@ the mode-line."
(t ;; not yet registered. (t ;; not yet registered.
(set-fontset-font t (cons char char) (symbol-value (intern (format "mode-icons-font-spec-%s" font)))) (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) (push (cons char font) mode-icons-font-register-alist)
t)))))) t)))))
(defun mode-icons-supported-p (icon-spec) (defun mode-icons-supported-p (icon-spec)
"Determine if ICON-SPEC is suppored on your system." "Determine if ICON-SPEC is suppored on your system."
@ -202,12 +201,14 @@ ICON-SPEC should be a specification from `mode-icons'."
((and (stringp (nth 1 icon-spec)) (not (nth 2 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)) (propertize mode 'display (mode-icons-get-icon-display (nth 1 icon-spec) (nth 2 icon-spec))
'mode-icons-p t)) 'mode-icons-p t))
((setq tmp (mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec))) ((mode-icons-supported-font-p (nth 1 icon-spec) (nth 2 icon-spec))
(if (eq 'direct-font tmp) ;; (propertize mode 'display (nth 1 icon-spec) 'mode-icons-p t)
(propertize mode 'display (nth 1 icon-spec) ;; Use `compose-region' because it allows clicable text.
'font (symbol-value (intern (format "mode-icons-font-%s" font))) (with-temp-buffer
'mode-icons-p t) (insert mode)
(propertize mode 'display (nth 1 icon-spec) 'mode-icons-p t))) (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))))) (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) (defun mode-icons-get-icon-spec (mode)
@ -238,7 +239,7 @@ ICON-SPEC should be a specification from `mode-icons'."
(setq mode-name (mode-icons-get-mode-icon mode)))) (setq mode-name (mode-icons-get-mode-icon mode))))
(defun mode-icons-major-mode-icons-undo () (defun mode-icons-major-mode-icons-undo ()
"Undo the mode-name changes" "Undo the `mode-name' icons."
(dolist (b (buffer-list)) (dolist (b (buffer-list))
(with-current-buffer b (with-current-buffer b
(when mode-icons-cached-mode-name (when mode-icons-cached-mode-name
@ -246,7 +247,7 @@ ICON-SPEC should be a specification from `mode-icons'."
mode-icons-cached-mode-name nil))))) mode-icons-cached-mode-name nil)))))
(defun mode-icons-major-mode-icons () (defun mode-icons-major-mode-icons ()
"Apply mode name changes on all buffers." "Apply mode name icons on all buffers."
(dolist (b (buffer-list)) (dolist (b (buffer-list))
(with-current-buffer b (with-current-buffer b
(mode-icons-set-current-mode-icon)))) (mode-icons-set-current-mode-icon))))