├── README.org └── diredful.el /README.org: -------------------------------------------------------------------------------- 1 | *Diredful.el* provides a simple UI for customizing dired mode to use 2 | different faces and colors. Faces are chosen based on file extension, 3 | file name, or a regexp matching the file line. 4 | 5 | Screenshots available at [[https://www.emacswiki.org/emacs/Diredful][EmacsWiki]]. 6 | 7 | ** Install [[https://stable.melpa.org/#/diredful][file:https://stable.melpa.org/packages/diredful-badge.svg]] [[https://melpa.org/#/diredful][file:https://melpa.org/packages/diredful-badge.svg]] 8 | 9 | Using Melpa: 10 | 11 | : M-x package-install RET diredful RET 12 | 13 | Then to activate by default, add the following into your init file 14 | (customizing this variable will not work): 15 | 16 | : (diredful-mode 1) 17 | 18 | For manual installation, put diredful.el in your Emacs-Lisp load 19 | path, and add this to your init file: 20 | 21 | : (require 'diredful) 22 | : (diredful-mode 1) 23 | 24 | ** Usage 25 | 26 | Do: 27 | 28 | : M-x diredful-add 29 | 30 | This will ask you to define a new name for a file type, like 31 | "images". You can then specify a list of extensions or file names that 32 | belong to this type and customize the face used to display them. A 33 | new face will be automatically generated and updated for each type. 34 | 35 | Note: changes will only be applied to newly created dired 36 | buffers. 37 | 38 | File Types can be added, edited, and deleted using the 39 | following commands: 40 | 41 | : M-x diredful-add 42 | : M-x diredful-delete 43 | : M-x diredful-edit 44 | : M-x diredful-edit-file-at-point 45 | 46 | These settings will be saved to the location of 47 | =diredful-init-file= (the default is 48 | "~/.emacs.d/diredful-conf.el"). You may choose a different location 49 | by doing: 50 | 51 | : M-x customize-variable RET diredful-init-file 52 | 53 | ** Tips 54 | 55 | File type names are sorted alphabetically before being applied. If two 56 | file types matched the same file, the file type that comes last in an 57 | alphabetically-sorted list will take precedence (e.g., a type named 58 | "zworldwritable" will take priority over other types). 59 | 60 | The world-writable regexp pattern used in the screenshot is =[rwx-][rwx-][rwx-][rwx-][rwx-][rwx-][rwx-]w[trwx-]=. 61 | -------------------------------------------------------------------------------- /diredful.el: -------------------------------------------------------------------------------- 1 | ;;; diredful.el --- colorful file names in dired buffers 2 | 3 | ;; Author: Thamer Mahmoud 4 | ;; Version: 1.10 5 | ;; Time-stamp: <2016-05-29 19:12:11 thamer> 6 | ;; URL: https://github.com/thamer/diredful 7 | ;; Keywords: dired, colors, extension, widget 8 | ;; Compatibility: Tested on GNU Emacs 23.4 and 24.x 9 | ;; Copyright (C) 2011-6 Thamer Mahmoud, all rights reserved. 10 | 11 | ;; This file is not part of GNU Emacs. 12 | 13 | ;; This program is free software; you can redistribute it and/or 14 | ;; modify it under the terms of the GNU General Public License as 15 | ;; published by the Free Software Foundation; either version 3, or (at 16 | ;; your option) any later version. 17 | 18 | ;; This program is distributed in the hope that it will be useful, but 19 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of 20 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 21 | ;; 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; see the file COPYING. If not, write to 25 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth 26 | ;; Floor, Boston, MA 02110-1301, USA. 27 | 28 | ;;; Commentary: 29 | ;; 30 | ;; This package provides a simple UI for customizing dired mode to use 31 | ;; different faces and colors. Faces are chosen based on file 32 | ;; extension, file name, or a regexp matching the file line. 33 | ;; 34 | ;;; Install: 35 | ;; 36 | ;; Put this file in your Emacs-Lisp load path, and add the following 37 | ;; into your $HOME/.emacs startup file. 38 | ;; 39 | ;; (require 'diredful) 40 | ;; (diredful-mode 1) 41 | ;; 42 | ;;; Usage: 43 | ;; 44 | ;; Do: 45 | ;; 46 | ;; M-x diredful-add 47 | ;; 48 | ;; This will ask you to define a new name for a file type, such as 49 | ;; "images". You can then specify a list of extensions or file names 50 | ;; that belong to this type and customize the face used to display 51 | ;; them. A new face will be automatically generated and updated for 52 | ;; each type. 53 | ;; 54 | ;; Note: changes will only be applied to newly created dired 55 | ;; buffers. 56 | ;; 57 | ;; File Types can be added, edited, and deleted using the following 58 | ;; commands: 59 | ;; 60 | ;; M-x diredful-add 61 | ;; M-x diredful-delete 62 | ;; M-x diredful-edit 63 | ;; M-x diredful-edit-file-at-point 64 | ;; 65 | ;; These settings will be saved to the location of 66 | ;; `diredful-init-file' (the default is 67 | ;; "~/.emacs.d/diredful-conf.el"). You may choose a different location 68 | ;; by doing: 69 | ;; 70 | ;; M-x customize-variable diredful-init-file 71 | ;; 72 | ;; Tip: File type names are sorted alphabetically before being 73 | ;; applied. If two file types matched the same file, the file type 74 | ;; that comes last in an alphabetically-sorted list will take 75 | ;; precedence (e.g., a type named "zworldwritable" will take priority 76 | ;; over other types). 77 | ;; 78 | 79 | ;;; Code: 80 | (defgroup diredful nil "Colorful file names in dired buffers." 81 | :group 'convenience 82 | :group 'dired) 83 | 84 | (defcustom diredful-init-file 85 | (convert-standard-filename "~/.emacs.d/diredful-conf.el") 86 | "Name of file used to save diredful settings." 87 | :type 'file 88 | :group 'diredful) 89 | 90 | (defvar diredful-names nil 91 | "List holding the names of patterns as strings.") 92 | 93 | (defvar diredful-alist nil 94 | "An alist of lists with each element representing a file type that 95 | will be matched when running and displaying files in dired 96 | buffers. Each type has the following structure: 97 | NAME ;; Name for a file type, used as a key. 98 | FACE ;; Face as a symbol that will be used to display the files. 99 | PATTERN ;; String holding one or more regexp patterns. 100 | PATTERN-TYPE ;; Set the pattern-type for pattern 101 | nil: List of file extensions (default) 102 | t: List of file or directory names 103 | 1: Regexp applied to the whole line shown by dired. 104 | WHOLELINE ;; if non-nil, apply face to the whole line \ 105 | not just the file name. 106 | WITHDIR ;; if non-nil, include directories when applying pattern. 107 | WITHOUTLINK ;; if non-nil, exclude symbolic links when applying 108 | pattern.") 109 | 110 | (defun diredful-settings-save () 111 | (let ((file (expand-file-name diredful-init-file))) 112 | (save-excursion 113 | (with-temp-buffer 114 | (print diredful-names (current-buffer)) 115 | (print diredful-alist (current-buffer)) 116 | (write-file file nil) 117 | (message "diredful: Settings saved"))))) 118 | 119 | (defun diredful-settings-load () 120 | (let ((file (expand-file-name diredful-init-file))) 121 | (save-excursion 122 | (with-temp-buffer 123 | (if (not (file-exists-p file)) 124 | (message "diredful: No diredful configuration \ 125 | file found. Run diredful-add.") 126 | (insert-file-contents file) 127 | (goto-char (point-min)) 128 | ;; Check whether names is loaded 129 | (condition-case eof 130 | (setq diredful-names (read (current-buffer))) 131 | (end-of-file (message "diredful: Failed to load. \ 132 | File exists but empty or corrupt."))) 133 | ;; Check whether list is loaded 134 | (condition-case eof 135 | (setq diredful-alist (read (current-buffer))) 136 | (end-of-file (message "diredful: Failed to load. \ 137 | File exists but empty or corrupt.")))))))) 138 | 139 | (defun diredful-filter (condp ls) 140 | (delq nil (mapcar (lambda (x) (and (funcall condp x) x)) ls))) 141 | 142 | (defun diredful-get-face-part (l) 143 | "Deal with the structure of dired-font-lock-keywords so that 144 | only the faces that we've added can be returned." 145 | (if (and (stringp (car l)) 146 | (> (length l) 0) 147 | (= (length (cadr l)) 4)) 148 | (car (cdr (car (last (cadr l))))) 149 | nil)) 150 | 151 | (defun diredful-apply (regexp face whole enable) 152 | "Add face to file type name based on the given regexp. The 153 | regexp is applied to the whole line." 154 | (let* ((face-part (list 0 face)) 155 | (face-list 156 | (list ".+" 157 | (if whole 158 | '(move-beginning-of-line nil) 159 | '(dired-move-to-filename)) 160 | nil face-part))) 161 | (if (eq enable 0) 162 | ;; Delete only the faces that we've added 163 | (setq dired-font-lock-keywords 164 | (diredful-filter 165 | '(lambda (x) 166 | (if (equal face 167 | (diredful-get-face-part x)) 168 | nil 169 | t)) dired-font-lock-keywords)) 170 | (add-to-list 'dired-font-lock-keywords 171 | (list regexp face-list))))) 172 | 173 | (defun diredful-ext-regexp (extensions withdir withoutlink) 174 | "Given a list of extensions, return a regexp usable to 175 | dired-font-lock-keywords." 176 | (concat 177 | "^. [0-9\\s ]*" 178 | (diredful-dirlink-regexp withdir withoutlink) 179 | ".*\\(" 180 | (mapconcat 181 | (lambda (str) (format "\\.%s[*]?$\\|\\.%s[*]?" str (upcase str))) 182 | extensions "\\|") 183 | "\\)$")) 184 | 185 | (defun diredful-filename-regexp (regx withdir withoutlink) 186 | "Return a regexp usable to apply on a file name." 187 | (concat 188 | "^. [0-9\\s ]*" 189 | (diredful-dirlink-regexp withdir withoutlink) 190 | ".*\\(" 191 | (mapconcat 192 | (lambda (str) (format " %s[*]?$" str)) 193 | regx "\\|") 194 | "\\)$")) 195 | 196 | (defun diredful-whole-line-regexp (regx withdir withoutlink) 197 | "Return a regexp usable to apply on a whole line." 198 | (concat 199 | "^. [0-9\\s ]*" 200 | (diredful-dirlink-regexp withdir withoutlink) 201 | "\\(" 202 | (format ".*%s.*[*]?" (car regx)) 203 | "\\)$")) 204 | 205 | (defun diredful-dirlink-regexp (dir link) 206 | (if (or (not dir) link) 207 | (concat "[^" (unless dir "d") 208 | (when link "l") 209 | "]"))) 210 | 211 | (defun diredful-make-face (name face-list) 212 | "Create and return a new face." 213 | (let* ((face-name (concat "diredful-face-" name)) 214 | (face (make-face (intern face-name)))) 215 | ;; Reset face by setting the default properties 216 | (diredful-set-attributes-from-alist 217 | face (face-all-attributes 'default)) 218 | ;; Set new properties 219 | (diredful-set-attributes face face-list) 220 | (symbol-name face))) 221 | 222 | (defun diredful-set-attributes (face attr) 223 | "Apply a list of attributes in the form (:PROP VALUE) to face." 224 | (while (string= (substring (symbol-name (car attr)) 0 1) ":") 225 | (set-face-attribute face nil (car attr) (cadr attr)) 226 | (setq attr (cddr attr)))) 227 | 228 | (defun diredful-set-attributes-from-alist (face attr) 229 | "Apply an alist of attributes in the form ((:PROP . VALUE)) to 230 | face." 231 | (while (car attr) 232 | (set-face-attribute face nil (caar attr) (cdar attr)) 233 | (setq attr (cdr attr)))) 234 | 235 | (defun diredful-add-name (name doc-string alist) 236 | "Add name to an alist, but check if a name already exists and 237 | trigger an error." 238 | (cond 239 | ((equal name "") 240 | (error (format "%s name cannot be empty" doc-string))) 241 | ((assoc name alist) 242 | (error (format "%s exists. Name must be unique. Choose \ 243 | another name" doc-string)))) name) 244 | 245 | (defun diredful-add (name) 246 | "Add a file type used for choosing colors to file names in 247 | dired buffers." 248 | (interactive 249 | (append 250 | (let* ((name (read-string (format "New name for file type: ")))) 251 | (list name)))) 252 | (diredful-add-name name "File type" diredful-alist) 253 | (add-to-list 'diredful-alist `(,name . (,'default "" nil nil))) 254 | (add-to-list 'diredful-names name) 255 | (diredful-settings-save) 256 | (diredful-edit name)) 257 | 258 | (defun diredful-delete (name) 259 | "Delete a file type used for choosing colors to file names in 260 | dired buffers." 261 | (interactive 262 | (list 263 | (completing-read 264 | "Choose a file type to delete: " diredful-names nil t))) 265 | "Deletes a file type and all its parameters." 266 | (when (equal name "") 267 | (error "File type cannot be empty")) 268 | ;; Reset all colors from dired font-lock so that any deleted types 269 | ;; wouldn't remain active 270 | (diredful-internal 0) 271 | ;; No assoc-delete-all? 272 | (setq diredful-alist 273 | (remove (assoc name diredful-alist) diredful-alist)) 274 | (setq diredful-names (remove name diredful-names)) 275 | (diredful-settings-save) 276 | ;; Re-Enable colors 277 | (diredful-internal 1)) 278 | 279 | (defvar diredful-widgets nil 280 | "List holding widget information.") 281 | 282 | (defun diredful-edit-file-at-point () 283 | "Edit file under point by checking what face is currently active." 284 | (interactive) 285 | (let ((cface (face-at-point))) 286 | (unless (stringp cface) 287 | (setq cface (symbol-name cface))) 288 | (if (string-match "diredful" cface) 289 | (let ((name (substring cface 14))) 290 | (if (member name diredful-names) 291 | (diredful-edit name) 292 | (error "diredful: The type '%s' is not found or was\ 293 | renamed. Revisit the current buffer to edit the current name." name))) 294 | (error "diredful: No pattern defined for this file or extension.\ 295 | Please use diredful-add first.")))) 296 | 297 | (defun diredful-edit (name) 298 | "Edit a file type used for choosing colors to file names in 299 | dired buffers." 300 | (interactive 301 | (list (completing-read "Edit Dired Color: " 302 | diredful-names nil t))) 303 | (when (equal name "") 304 | (error "File type cannot be empty")) 305 | (switch-to-buffer 306 | (concat "*Customize diredful type `" name "'*")) 307 | (let* ((inhibit-read-only t) 308 | (map (make-sparse-keymap)) 309 | (current (assoc name diredful-alist)) 310 | ;; Numbers here should reflect the order of the widget.el 311 | ;; buffer 312 | (face-str (nth 1 current)) 313 | (pattern-str (nth 2 current)) 314 | (pattern-type (nth 3 current)) 315 | (whole (nth 4 current)) 316 | (withdir (nth 5 current)) 317 | (withoutlink (nth 6 current))) 318 | (kill-all-local-variables) 319 | (make-local-variable 'diredful-widgets) 320 | (erase-buffer) 321 | (remove-overlays) 322 | (require 'wid-edit) 323 | (require 'cus-edit) ;; for custom-face-edit 324 | (widget-insert "Type `C-c C-v' or press [Save] after you have \ 325 | finished editing.\n\n" ) 326 | (setq diredful-widgets 327 | (list 328 | ;; This widget also includes the current name of the type 329 | ;; being edited. 330 | (widget-create 'editable-field :value name 331 | :format "Type Name: %v" "") 332 | (ignore (widget-insert "\n")) 333 | (widget-create 'editable-field :value pattern-str 334 | :format "Pattern: %v" "") 335 | (ignore (widget-insert "\nPattern Type:\n")) 336 | (widget-create 337 | 'radio-button-choice 338 | :value pattern-type 339 | '(item :format "A list of space-separated extension \ 340 | regexps. Ex. jpe?g gif png (case-insensitive)\n" 341 | nil) 342 | '(item :format "A list of space-separated regexps \ 343 | applied to file names. Ex. README [Rr]eadme.\n" 344 | t) 345 | '(item :format "Regexp on whole line (starting from \ 346 | the first permission column) including file name.\n" 347 | 1)) 348 | (ignore (widget-insert "\n ")) 349 | ;; Check Boxes 350 | (widget-create 'checkbox withdir) 351 | (ignore (widget-insert 352 | " Apply to directories.\n ")) 353 | (widget-create 'checkbox withoutlink) 354 | (ignore (widget-insert 355 | " Ignore symbolic links.\n ")) 356 | (widget-create 'checkbox whole) 357 | (ignore (widget-insert 358 | " Apply face to the whole line (not just \ 359 | file name).\n")) 360 | (ignore (widget-insert "\n")) 361 | ;; Face Attributes 362 | (ignore (widget-insert "Face to use:\n\n")) 363 | (widget-create 'custom-face-edit :value face-str))) 364 | ;; Delete empty widget-insert 365 | (delq nil diredful-widgets) 366 | (widget-insert "\n") 367 | ;; Buttons 368 | (widget-create 369 | 'push-button 370 | :button-face 'custom-button 371 | :notify (lambda (&rest ignore) 372 | (diredful-save diredful-widgets)) "Save") 373 | (widget-insert " ") 374 | (widget-create 'push-button 375 | :button-face 'custom-button 376 | :notify (lambda (&rest ignore) 377 | (kill-buffer)) 378 | "Cancel") 379 | (widget-insert "\n\n") 380 | ;; Editable name 381 | (widget-put (nth 0 diredful-widgets) :being-edited name) 382 | ;; FIXME: This is needed to get rid of cus-edit bindings. However, 383 | ;; "C-c C-v" doesn't work for editable-fields inside a 384 | ;; custom-face-edit. 385 | (mapc (lambda (p) (widget-put p :keymap nil)) diredful-widgets) 386 | ;; Keymaps 387 | (set-keymap-parent map widget-keymap) 388 | (define-key map (kbd "C-c C-v") 389 | '(lambda () (interactive) (diredful-save diredful-widgets))) 390 | (use-local-map map) 391 | (widget-setup)) 392 | (goto-char (point-min)) 393 | (widget-forward 1)) 394 | 395 | (defun diredful-save (widget-list) 396 | "Adds values of widget to type lists, saves them to file and 397 | update." 398 | (let* ((old-name (widget-get (nth 0 widget-list) :being-edited)) 399 | (current (assoc old-name diredful-alist)) 400 | (name (widget-value (nth 0 widget-list))) 401 | (withdir (widget-value (nth 3 widget-list))) 402 | (withoutlink (widget-value (nth 4 widget-list))) 403 | (whole (widget-value (nth 5 widget-list))) 404 | (pattern-type (widget-value (nth 2 widget-list))) 405 | (face (widget-value (nth 6 widget-list))) 406 | (pattern (widget-value (nth 1 widget-list)))) 407 | ;; Replace old type with new type 408 | (setq diredful-alist 409 | (remove (assoc old-name diredful-alist) 410 | diredful-alist)) 411 | (setq diredful-names (remove old-name diredful-names)) 412 | ;; Delete the old name in case of a rename 413 | (setq dired-font-lock-keywords 414 | (diredful-filter 415 | '(lambda (x) 416 | (if (equal (concat "diredful-face-" old-name) 417 | (diredful-get-face-part x)) 418 | nil 419 | t)) dired-font-lock-keywords)) 420 | ;; Update variables 421 | (add-to-list 'diredful-alist 422 | (list name face pattern pattern-type whole withdir 423 | withoutlink)) 424 | (add-to-list 'diredful-names name) 425 | (diredful-settings-save) 426 | (diredful-internal 0) 427 | (diredful-internal 1) 428 | (kill-buffer))) 429 | 430 | (defun diredful-internal (enable) 431 | "Used to reset and reload diredful variables." 432 | (if (not (length diredful-names)) 433 | (message "diredful: No file types have been \ 434 | defined. Please define a new file type using diredful-add.") 435 | (let (sorted name) 436 | ;; Make a copy of list 437 | (setq sorted (append diredful-names nil)) 438 | ;; Sort it 439 | (setq sorted (sort sorted 'string<)) 440 | ;; Loop over each pattern and collect all settings 441 | (while sorted 442 | (let* ((ft-list (assoc (car sorted) diredful-alist)) 443 | (ft-name (nth 0 ft-list)) 444 | (ft-face (nth 1 ft-list)) 445 | (ft-pattern (nth 2 ft-list)) 446 | (ft-type (nth 3 ft-list)) 447 | (ft-whole (nth 4 ft-list)) 448 | (ft-withdir (nth 5 ft-list)) 449 | (ft-withoutlink (nth 6 ft-list)) 450 | conc-commands) 451 | (unless (eq ft-face 'default) 452 | (cond 453 | ;; Type is a list of extensions 454 | ((eq ft-type nil) 455 | (progn 456 | (diredful-apply 457 | (diredful-ext-regexp 458 | (split-string ft-pattern) ft-withdir ft-withoutlink) 459 | (if (facep ft-face) 460 | (symbol-name ft-face) 461 | (diredful-make-face (car sorted) ft-face)) ft-whole 462 | enable))) 463 | ;; Type is a file name 464 | ((eq ft-type t) 465 | (progn 466 | (diredful-apply 467 | (diredful-filename-regexp 468 | (split-string ft-pattern) ft-withdir ft-withoutlink) 469 | (if (facep ft-face) 470 | (symbol-name ft-face) 471 | (diredful-make-face (car sorted) ft-face)) ft-whole 472 | enable))) 473 | ;; Type is a whole line 474 | ((eq ft-type 1) 475 | (progn 476 | (diredful-apply 477 | (diredful-whole-line-regexp 478 | (split-string ft-pattern) ft-withdir ft-withoutlink) 479 | (if (facep ft-face) 480 | (symbol-name ft-face) 481 | (diredful-make-face (car sorted) ft-face)) ft-whole 482 | enable)))))) 483 | (setq sorted (cdr sorted))) 484 | ;; Add last after processing list 485 | (diredful-apply "^[D]" "dired-flagged" nil enable) 486 | (diredful-apply "^[*]" "dired-marked" nil enable)))) 487 | 488 | ;;;###autoload 489 | (define-minor-mode diredful-mode 490 | "Toggle diredful minor mode. Will only affect newly created 491 | dired buffers. When diredful mode is enabled, files in dired 492 | buffers will be displayed in different faces and colors." 493 | :global t 494 | :group 'diredful 495 | (require 'dired) 496 | (require 'dired-x) 497 | (if diredful-mode 498 | (progn 499 | (diredful-settings-load) 500 | (diredful-internal 1)) 501 | (diredful-internal 0))) 502 | 503 | ;; FIXME: There is an autoload bug when using melpa that prevents this 504 | ;; variable from being set using the customize interface. 505 | ;;;###autoload 506 | (defcustom diredful-mode nil 507 | "Toggle diredful minor mode. Will only affect newly created 508 | dired buffers. When diredful mode is enabled, files in dired 509 | buffers will be displayed in different faces and colors." 510 | :set 'custom-set-minor-mode 511 | :type 'boolean 512 | :group 'diredful 513 | ) 514 | 515 | (provide 'diredful) 516 | ;;; diredful.el ends here. 517 | --------------------------------------------------------------------------------