dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

all-the-icons-dired.el (6270B)


      1 ;;; all-the-icons-dired.el --- Shows icons for each file in dired mode  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2016-2020  jtbm37
      4 ;; Copyright (C) 2021 Jimmy Yuen Ho Wong
      5 
      6 ;; Author: jtbm37
      7 ;; Maintainer: Jimmy Yuen Ho Wong <wyuenho@gmail.com>
      8 ;; Version: 2.0
      9 ;; Keywords: files icons dired
     10 ;; Package-Requires: ((emacs "24.4") (all-the-icons "2.2.0"))
     11 ;; URL: https://github.com/wyuenho/all-the-icons-dired
     12 
     13 ;; This program is free software; you can redistribute it and/or modify
     14 ;; it under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation, either version 3 of the License, or
     16 ;; (at your option) any later version.
     17 
     18 ;; This program is distributed in the hope that it will be useful,
     19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     21 ;; GNU General Public License for more details.
     22 
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     25 
     26 ;;; Commentary:
     27 ;; To use this package, simply add this to your init.el:
     28 ;; (add-hook 'dired-mode-hook 'all-the-icons-dired-mode)
     29 
     30 ;; To manually install, add this to your init.el before the hook mentioned above.
     31 ;; (add-to-load-path (expand-file-name "~/path/to/all-the-icons-dired"))
     32 ;; (load "all-the-icons-dired.el")
     33 
     34 
     35 ;;; Code:
     36 
     37 (require 'cl-lib)
     38 (require 'dired)
     39 (require 'all-the-icons)
     40 (require 'subr-x)
     41 
     42 (defface all-the-icons-dired-dir-face
     43   '((((background dark)) :foreground "white")
     44     (((background light)) :foreground "black"))
     45   "Face for the directory icon"
     46   :group 'all-the-icons-faces)
     47 
     48 (defcustom all-the-icons-dired-v-adjust 0.01
     49   "The default vertical adjustment of the icon in the dired buffer."
     50   :group 'all-the-icons
     51   :type 'number)
     52 
     53 (defcustom all-the-icons-dired-monochrome t
     54   "Whether to show the icons as the same color as the text on the same line."
     55   :group 'all-the-icons
     56   :type 'boolean)
     57 
     58 (defvar all-the-icons-dired-mode)
     59 
     60 (defun all-the-icons-dired--add-overlay (pos string)
     61   "Add overlay to display STRING at POS."
     62   (let ((ov (make-overlay (1- pos) pos)))
     63     (overlay-put ov 'all-the-icons-dired-overlay t)
     64     (overlay-put ov 'after-string string)))
     65 
     66 (defun all-the-icons-dired--overlays-in (beg end)
     67   "Get all all-the-icons-dired overlays between BEG to END."
     68   (cl-remove-if-not
     69    (lambda (ov)
     70      (overlay-get ov 'all-the-icons-dired-overlay))
     71    (overlays-in beg end)))
     72 
     73 (defun all-the-icons-dired--overlays-at (pos)
     74   "Get all-the-icons-dired overlays at POS."
     75   (apply #'all-the-icons-dired--overlays-in `(,pos ,pos)))
     76 
     77 (defun all-the-icons-dired--remove-all-overlays ()
     78   "Remove all `all-the-icons-dired' overlays."
     79   (save-restriction
     80     (widen)
     81     (mapc #'delete-overlay
     82           (all-the-icons-dired--overlays-in (point-min) (point-max)))))
     83 
     84 (defun all-the-icons-dired--refresh ()
     85   "Display the icons of files in a dired buffer."
     86   (all-the-icons-dired--remove-all-overlays)
     87   (save-excursion
     88     (goto-char (point-min))
     89     (while (not (eobp))
     90       (when (dired-move-to-filename nil)
     91         (let ((case-fold-search t))
     92           (when-let* ((file (dired-get-filename 'relative 'noerror))
     93                       (icon (if (file-directory-p file)
     94                                 (all-the-icons-icon-for-dir file
     95                                                             :face 'all-the-icons-dired-dir-face
     96                                                             :v-adjust all-the-icons-dired-v-adjust)
     97                               (apply 'all-the-icons-icon-for-file file
     98                                      (append
     99                                       `(:v-adjust ,all-the-icons-dired-v-adjust)
    100                                       (when all-the-icons-dired-monochrome
    101                                         `(:face ,(face-at-point))))))))
    102             (if (member file '("." ".."))
    103                 (all-the-icons-dired--add-overlay (point) "  \t")
    104               (all-the-icons-dired--add-overlay (point) (concat icon "\t"))))))
    105       (forward-line 1))))
    106 
    107 (defun all-the-icons-dired--refresh-advice (fn &rest args)
    108   "Advice function for FN with ARGS."
    109   (apply fn args)
    110   (when all-the-icons-dired-mode
    111     (all-the-icons-dired--refresh)))
    112 
    113 (defvar all-the-icons-dired-advice-alist
    114   '((dired-aux     dired-create-directory       all-the-icons-dired--refresh-advice)
    115     (dired-aux     dired-do-create-files        all-the-icons-dired--refresh-advice)
    116     (dired-aux     dired-do-kill-lines          all-the-icons-dired--refresh-advice)
    117     (dired-aux     dired-do-rename              all-the-icons-dired--refresh-advice)
    118     (dired-aux     dired-insert-subdir          all-the-icons-dired--refresh-advice)
    119     (dired         wdired-abort-changes         all-the-icons-dired--refresh-advice)
    120     (dired         dired-internal-do-deletions  all-the-icons-dired--refresh-advice)
    121     (dired-narrow  dired-narrow--internal       all-the-icons-dired--refresh-advice)
    122     (dired         dired-readin                 all-the-icons-dired--refresh-advice)
    123     (dired         dired-revert                 all-the-icons-dired--refresh-advice)
    124     (find-dired    find-dired-sentinel          all-the-icons-dired--refresh-advice))
    125   "A list of file, adviced function, and advice function.")
    126 
    127 (defun all-the-icons-dired--setup ()
    128   "Setup `all-the-icons-dired'."
    129   (setq-local tab-width 1)
    130   (pcase-dolist (`(,file ,sym ,fn) all-the-icons-dired-advice-alist)
    131     (with-eval-after-load file
    132       (advice-add sym :around fn)))
    133   (all-the-icons-dired--refresh))
    134 
    135 (defun all-the-icons-dired--teardown ()
    136   "Functions used as advice when redisplaying buffer."
    137   (kill-local-variable 'tab-width)
    138   (pcase-dolist (`(,file ,sym ,fn) all-the-icons-dired-advice-alist)
    139     (with-eval-after-load file
    140       (advice-remove sym fn)))
    141   (all-the-icons-dired--remove-all-overlays))
    142 
    143 ;;;###autoload
    144 (define-minor-mode all-the-icons-dired-mode
    145   "Display all-the-icons icon for each file in a dired buffer."
    146   :lighter " all-the-icons-dired-mode"
    147   (when (derived-mode-p 'dired-mode)
    148     (if all-the-icons-dired-mode
    149         (all-the-icons-dired--setup)
    150       (all-the-icons-dired--teardown))))
    151 
    152 (provide 'all-the-icons-dired)
    153 ;;; all-the-icons-dired.el ends here