all-the-icons-completion.el (6077B)
1 ;;; all-the-icons-completion.el --- Add icons to completion candidates -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2021 Itai Y. Efrat 4 ;; 5 ;; Author: Itai Y. Efrat <https://github.com/iyefrat> 6 ;; Maintainer: Itai Y. Efrat <itai3397@gmail.com> 7 ;; Created: June 06, 2021 8 ;; Modified: June 06, 2021 9 ;; Version: 1.0 10 ;; Keywords: convenient, lisp 11 ;; Homepage: https://github.com/iyefrat/all-the-icons-completion 12 ;; Package-Requires: ((emacs "26.1") (all-the-icons "5.0")) 13 ;; 14 ;; This file is not part of GNU Emacs. 15 ;; 16 ;; Licence: 17 ;; 18 ;; This program is free software: you can redistribute it and/or modify 19 ;; it under the terms of the GNU General Public License as published by 20 ;; the Free Software Foundation, either version 3 of the License, or 21 ;; (at your option) any later version. 22 ;; 23 ;; This program is distributed in the hope that it will be useful, 24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 26 ;; GNU General Public License for more details. 27 ;; 28 ;; You should have received a copy of the GNU General Public License 29 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 30 ;; 31 ;;; Commentary: 32 ;; 33 ;; Add icons to completion candidates. 34 ;; 35 ;;; Code: 36 37 (require 'all-the-icons) 38 39 (defgroup all-the-icons-completion nil 40 "Add icons to completion candidates." 41 :version "26.1" 42 :group 'appearance 43 :group 'convenience 44 :prefix "all-the-icons-completion") 45 46 (defface all-the-icons-completion-dir-face 47 '((t nil)) 48 "Face for the directory icon." 49 :group 'all-the-icons-faces) 50 51 (cl-defgeneric all-the-icons-completion-get-icon (_cand _cat) 52 "Return the icon for the candidate CAND of completion category CAT." 53 "") 54 55 (cl-defmethod all-the-icons-completion-get-icon (cand (_cat (eql file))) 56 "Return the icon for the candidate CAND of completion category file." 57 (cond ((string-match-p "\\/$" cand) 58 (concat 59 (all-the-icons-icon-for-dir cand :face 'all-the-icons-completion-dir-face) 60 " ")) 61 (t (concat (all-the-icons-icon-for-file cand) " ")))) 62 63 (cl-defmethod all-the-icons-completion-get-icon (cand (_cat (eql project-file))) 64 "Return the icon for the candidate CAND of completion category project-file." 65 (all-the-icons-completion-get-icon cand 'file)) 66 67 (cl-defmethod all-the-icons-completion-get-icon (cand (_cat (eql buffer))) 68 "Return the icon for the candidate CAND of completion category buffer." 69 (let* ((mode (buffer-local-value 'major-mode (get-buffer cand))) 70 (icon (all-the-icons-icon-for-mode mode)) 71 (parent-icon (all-the-icons-icon-for-mode 72 (get mode 'derived-mode-parent)))) 73 (concat 74 (if (symbolp icon) 75 (if (symbolp parent-icon) 76 (all-the-icons-faicon "sticky-note-o") 77 parent-icon) 78 icon) 79 " "))) 80 81 (autoload 'bookmark-get-filename "bookmark") 82 (cl-defmethod all-the-icons-completion-get-icon (cand (_cat (eql bookmark))) 83 "Return the icon for the candidate CAND of completion category bookmark." 84 (if-let (fname (bookmark-get-filename cand)) 85 (all-the-icons-completion-get-icon fname 'file) 86 (concat (all-the-icons-octicon "bookmark" :face 'all-the-icons-completion-dir-face) " "))) 87 88 (defun all-the-icons-completion-completion-metadata-get (orig metadata prop) 89 "Meant as :around advice for `completion-metadata-get', Add icons as prefix. 90 ORIG should be `completion-metadata-get' 91 METADATA is the metadata. 92 PROP is the property which is looked up." 93 (if (eq prop 'affixation-function) 94 (let ((cat (funcall orig metadata 'category)) 95 (aff (or (funcall orig metadata 'affixation-function) 96 (when-let ((ann (funcall orig metadata 'annotation-function))) 97 (lambda (cands) 98 (mapcar (lambda (x) (list x "" (funcall ann x))) cands)))))) 99 (cond 100 ((and (eq cat 'multi-category) aff) 101 (lambda (cands) 102 (mapcar (lambda (x) 103 (pcase-exhaustive x 104 (`(,cand ,prefix ,suffix) 105 (let ((orig (get-text-property 0 'multi-category cand))) 106 (list cand 107 (concat (all-the-icons-completion-get-icon (cdr orig) (car orig)) 108 prefix) 109 suffix))))) 110 (funcall aff cands)))) 111 ((and cat aff) 112 (lambda (cands) 113 (mapcar (lambda (x) 114 (pcase-exhaustive x 115 (`(,cand ,prefix ,suffix) 116 (list cand 117 (concat (all-the-icons-completion-get-icon cand cat) 118 prefix) 119 suffix)))) 120 (funcall aff cands)))) 121 ((eq cat 'multi-category) 122 (lambda (cands) 123 (mapcar (lambda (x) 124 (let ((orig (get-text-property 0 'multi-category x))) 125 (list x (all-the-icons-completion-get-icon (cdr orig) (car orig)) ""))) 126 cands))) 127 (cat 128 (lambda (cands) 129 (mapcar (lambda (x) 130 (list x (all-the-icons-completion-get-icon x cat) "")) 131 cands))) 132 (aff))) 133 (funcall orig metadata prop))) 134 135 ;; For the byte compiler 136 (defvar marginalia-mode) 137 ;;;###autoload 138 (defun all-the-icons-completion-marginalia-setup () 139 "Hook to `marginalia-mode-hook' to bind `all-the-icons-completion-mode' to it." 140 (all-the-icons-completion-mode (if marginalia-mode 1 -1))) 141 142 ;;;###autoload 143 (define-minor-mode all-the-icons-completion-mode 144 "Add icons to completion candidates." 145 :global t 146 (if all-the-icons-completion-mode 147 (advice-add #'completion-metadata-get :around #'all-the-icons-completion-completion-metadata-get) 148 (advice-remove #'completion-metadata-get #'all-the-icons-completion-completion-metadata-get))) 149 150 (provide 'all-the-icons-completion) 151 ;;; all-the-icons-completion.el ends here