383 lines
16 KiB
EmacsLisp
383 lines
16 KiB
EmacsLisp
;;; diredfl.el --- Extra font lock rules for a more colourful dired -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2017 Steve Purcell
|
|
|
|
;; Author: Steve Purcell <steve@sanityinc.com>
|
|
;; Author: Drew Adams
|
|
;; Keywords: faces
|
|
;; Package-Commit: 17e805763d57370c4eff2c92ed257b72eeb9f94a
|
|
;; URL: https://github.com/purcell/diredfl
|
|
;; Package-Requires: ((emacs "24"))
|
|
;; Package-Version: 20230224.1302
|
|
;; Package-X-Original-Version: 0
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This is adapted from the extra font lock rules provided by Drew
|
|
;; Adams' `dired+' package, but published via a modern means, and with
|
|
;; support for older Emacsen removed.
|
|
|
|
;; Enable in all Dired buffers by calling or customising `diredfl-global-mode'.
|
|
|
|
;; Alternatively:
|
|
|
|
;; (add-hook 'dired-mode-hook 'diredfl-mode)
|
|
|
|
;;; Code:
|
|
|
|
(require 'dired)
|
|
|
|
(defgroup diredfl ()
|
|
"Extra font lock rules for a more colourful Dired."
|
|
:group 'dired)
|
|
|
|
(defcustom diredfl-compressed-extensions '(".tar" ".taz" ".tgz" ".arj" ".lzh"
|
|
".lzma" ".xz" ".zip" ".z" ".Z" ".gz" ".bz2")
|
|
"*List of compressed-file extensions, for highlighting."
|
|
:type '(repeat string) :group 'diredfl)
|
|
|
|
(defcustom diredfl-ignore-compressed-flag t
|
|
"*Non-nil means to font-lock names of compressed files as ignored files.
|
|
This applies to filenames whose extensions are in
|
|
`diredfl-compressed-extensions'. If nil they are highlighted using
|
|
face `diredfl-compressed-file-name'."
|
|
:type 'boolean :group 'diredfl)
|
|
|
|
(defface diredfl-autofile-name
|
|
'((((background dark)) (:background "#111313F03181")) ; Very dark blue
|
|
(t (:background "#EEECEC0FCE7E"))) ; Very pale goldenrod
|
|
"*Face used in Dired for names of files that are autofile bookmarks."
|
|
:group 'diredfl)
|
|
(defvar diredfl-autofile-name 'diredfl-autofile-name)
|
|
|
|
(defface diredfl-compressed-file-name
|
|
'((((background dark)) (:foreground "Blue"))
|
|
(t (:foreground "Brown")))
|
|
"*Face used for compressed file names."
|
|
:group 'diredfl)
|
|
(defvar diredfl-compressed-file-name 'diredfl-compressed-file-name)
|
|
|
|
(defface diredfl-compressed-file-suffix
|
|
'((((background dark)) (:foreground "Blue"))
|
|
(t (:foreground "Yellow")))
|
|
"*Face used for compressed file suffixes in Dired buffers.
|
|
This means the `.' plus the file extension. Example: `.zip'."
|
|
:group 'diredfl)
|
|
(defvar diredfl-compressed-file-suffix 'diredfl-compressed-file-suffix)
|
|
|
|
(defface diredfl-date-time
|
|
'((((background dark)) (:foreground "#74749A9AF7F7")) ; ~ med blue
|
|
(t (:foreground "DarkGoldenrod4")))
|
|
"*Face used for date and time in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-date-time 'diredfl-date-time)
|
|
|
|
(defface diredfl-deletion
|
|
'((t (:foreground "Yellow" :background "Red")))
|
|
"*Face used for deletion flags (D) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-deletion 'diredfl-deletion)
|
|
|
|
(defface diredfl-deletion-file-name
|
|
'((t (:foreground "Red")))
|
|
"*Face used for names of deleted files in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-deletion-file-name 'diredfl-deletion-file-name)
|
|
|
|
(defface diredfl-dir-heading
|
|
'((((background dark)) (:foreground "Yellow" :background "#00003F3F3434")) ; ~ dark green
|
|
(t (:foreground "Blue" :background "Pink")))
|
|
"*Face used for directory headings in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-dir-heading 'diredfl-dir-heading)
|
|
|
|
(defface diredfl-dir-name
|
|
'((((background dark))
|
|
(:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C")) ; ~ cyan, dark gray
|
|
(t (:foreground "DarkRed" :background "LightGray")))
|
|
"*Face used for directory names."
|
|
:group 'diredfl)
|
|
(defvar diredfl-dir-name 'diredfl-dir-name)
|
|
|
|
(defface diredfl-dir-priv
|
|
'((((background dark))
|
|
(:foreground "#7474FFFFFFFF" :background "#2C2C2C2C2C2C")) ; ~ cyan, dark gray
|
|
(t (:foreground "DarkRed" :background "LightGray")))
|
|
"*Face used for directory privilege indicator (d) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-dir-priv 'diredfl-dir-priv)
|
|
|
|
(defface diredfl-exec-priv
|
|
'((((background dark)) (:background "#4F4F3B3B2121")) ; ~ dark brown
|
|
(t (:background "LightSteelBlue")))
|
|
"*Face used for execute privilege indicator (x) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-exec-priv 'diredfl-exec-priv)
|
|
|
|
;; For this to show up, you need `F' among the options in `dired-listing-switches'.
|
|
;; For example, I use "-alF" for `dired-listing-switches'.
|
|
(defface diredfl-executable-tag
|
|
'((t (:foreground "Red")))
|
|
"*Face used for executable tag (*) on file names in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-executable-tag 'diredfl-executable-tag)
|
|
|
|
(defface diredfl-file-name
|
|
'((((background dark)) (:foreground "Yellow"))
|
|
(t (:foreground "Blue")))
|
|
"*Face used for file names (without suffixes) in Dired buffers.
|
|
This means the base name. It does not include the `.'."
|
|
:group 'diredfl)
|
|
(defvar diredfl-file-name 'diredfl-file-name)
|
|
|
|
(defface diredfl-file-suffix
|
|
'((((background dark)) (:foreground "#7474FFFF7474")) ; ~ light green
|
|
(t (:foreground "DarkMagenta")))
|
|
"*Face used for file suffixes in Dired buffers.
|
|
This means the `.' plus the file extension. Example: `.elc'."
|
|
:group 'diredfl)
|
|
(defvar diredfl-file-suffix 'diredfl-file-suffix)
|
|
|
|
(defface diredfl-flag-mark
|
|
'((((background dark)) (:foreground "Blue" :background "#7575D4D41D1D")) ; ~ olive green
|
|
(t (:foreground "Yellow" :background "Blueviolet")))
|
|
"*Face used for flags and marks (except D) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-flag-mark 'diredfl-flag-mark)
|
|
|
|
(defface diredfl-flag-mark-line
|
|
'((((background dark)) (:background "#787831311414")) ; ~ dark red brown
|
|
(t (:background "Skyblue")))
|
|
"*Face used for flagged and marked lines in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-flag-mark-line 'diredfl-flag-mark-line)
|
|
|
|
(defface diredfl-ignored-file-name
|
|
'(;; (((background dark)) (:foreground "#FFFF921F921F")) ; ~ salmon
|
|
;; (((background dark)) (:foreground "#A71F5F645F64")) ; ~ dark salmon
|
|
(((background dark)) (:foreground "#C29D6F156F15")) ; ~ salmon
|
|
(t (:foreground "#00006DE06DE0"))) ; ~ dark cyan
|
|
"*Face used for ignored file names in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-ignored-file-name 'diredfl-ignored-file-name)
|
|
|
|
(defface diredfl-link-priv
|
|
'((((background dark)) (:foreground "#00007373FFFF")) ; ~ blue
|
|
(t (:foreground "DarkOrange")))
|
|
"*Face used for link privilege indicator (l) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-link-priv 'diredfl-link-priv)
|
|
|
|
(defface diredfl-no-priv
|
|
'((((background dark)) (:background "#2C2C2C2C2C2C")) ; ~ dark gray
|
|
(t (:background "LightGray")))
|
|
"*Face used for no privilege indicator (-) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-no-priv 'diredfl-no-priv)
|
|
|
|
(defface diredfl-number
|
|
'((((background dark)) (:foreground "#FFFFFFFF7474")) ; ~ light yellow
|
|
(t (:foreground "DarkBlue")))
|
|
"*Face used for numerical fields in Dired buffers.
|
|
In particular, inode number, number of hard links, and file size."
|
|
:group 'diredfl)
|
|
(defvar diredfl-number 'diredfl-number)
|
|
|
|
(defface diredfl-other-priv
|
|
'((((background dark)) (:background "#111117175555")) ; ~ dark blue
|
|
(t (:background "PaleGoldenrod")))
|
|
"*Face used for l,s,S,t,T privilege indicators in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-other-priv 'diredfl-other-priv)
|
|
|
|
(defface diredfl-rare-priv
|
|
'((((background dark)) (:foreground "Green" :background "#FFFF00008080")) ; ~ hot pink
|
|
(t (:foreground "Magenta" :background "SpringGreen")))
|
|
"*Face used for rare privilege indicators (b,c,s,m,p,S) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-rare-priv 'diredfl-rare-priv)
|
|
|
|
(defface diredfl-read-priv
|
|
'((((background dark)) (:background "#999932325555")) ; ~ burgundy / dark magenta
|
|
(t (:background "MediumAquamarine")))
|
|
"*Face used for read privilege indicator (w) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-read-priv 'diredfl-read-priv)
|
|
|
|
(defface diredfl-symlink
|
|
'((((background dark)) (:foreground "#00007373FFFF")) ; ~ blue
|
|
(t (:foreground "DarkOrange")))
|
|
"*Face used for symbolic links in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-symlink 'diredfl-symlink)
|
|
|
|
(defface diredfl-tagged-autofile-name
|
|
'((((background dark)) (:background "#328C0411328C")) ; Very dark magenta
|
|
(t (:background "#CD73FBEECD73"))) ; Very pale green
|
|
"*Face used in Dired for names of files that are autofile bookmarks."
|
|
:group 'diredfl)
|
|
(defvar diredfl-tagged-autofile-name 'diredfl-tagged-autofile-name)
|
|
|
|
(defface diredfl-write-priv
|
|
'((((background dark)) (:background "#25258F8F2929")) ; ~ dark green
|
|
(t (:background "Orchid")))
|
|
"*Face used for write privilege indicator (w) in Dired buffers."
|
|
:group 'diredfl)
|
|
(defvar diredfl-write-priv 'diredfl-write-priv)
|
|
|
|
(defun diredfl-match-ignored-extensions (limit)
|
|
"A matcher of ignored filename extensions for use in `font-lock-keywords'.
|
|
LIMIT is the extent of the search."
|
|
(let ((ignored-extensions
|
|
(append (if (boundp 'dired-omit-extensions)
|
|
dired-omit-extensions
|
|
completion-ignored-extensions)
|
|
(when diredfl-ignore-compressed-flag
|
|
diredfl-compressed-extensions))))
|
|
(when ignored-extensions
|
|
(re-search-forward
|
|
(concat "^ \\(.*"
|
|
(regexp-opt ignored-extensions)
|
|
;; Optional executable flag
|
|
"[*]?\\)$")
|
|
limit
|
|
t))))
|
|
|
|
;;; Define second level of fontifying.
|
|
(defconst diredfl-font-lock-keywords-1
|
|
(list
|
|
'("^ \\(.+:\\)$" 1 diredfl-dir-heading) ; Directory headers
|
|
'("^ wildcard.*$" 0 'default) ; Override others, e.g. `l' for `diredfl-other-priv'.
|
|
'("^ (No match).*$" 0 'default) ; Override others, e.g. `t' for `diredfl-other-priv'.
|
|
'("[^ .]\\(\\.[^. /]+\\)$" 1 diredfl-file-suffix) ; Suffix, including `.'.
|
|
'("\\([^ ]+\\) -> .+$" 1 diredfl-symlink) ; Symbolic links
|
|
|
|
;; 1) Date/time and 2) filename w/o suffix.
|
|
;; This is a bear, and it is fragile - Emacs can change `dired-move-to-filename-regexp'.
|
|
`(,dired-move-to-filename-regexp
|
|
(7 diredfl-date-time t t) ; Date/time, locale (western or eastern)
|
|
(2 diredfl-date-time t t) ; Date/time, ISO
|
|
(,(concat "\\(.+\\)\\(" (concat (funcall #'regexp-opt diredfl-compressed-extensions)
|
|
"\\)[*]?$"))
|
|
nil nil (0 diredfl-compressed-file-name keep t))) ; Compressed-file suffix
|
|
`(,dired-move-to-filename-regexp
|
|
(7 diredfl-date-time t t) ; Date/time, locale (western or eastern)
|
|
(2 diredfl-date-time t t) ; Date/time, ISO
|
|
("\\(.+\\)$" nil nil (0 diredfl-file-name keep t))) ; Filename (not a compressed file)
|
|
|
|
;; Files to ignore
|
|
'(diredfl-match-ignored-extensions 1 diredfl-ignored-file-name t)
|
|
|
|
;; Compressed-file (suffix)
|
|
(list (concat "\\(" (concat (funcall #'regexp-opt diredfl-compressed-extensions) "\\)[*]?$"))
|
|
1 diredfl-compressed-file-suffix t)
|
|
'("\\([*]\\)$" 1 diredfl-executable-tag t) ; Executable (*)
|
|
|
|
;; Inode, hard-links, & file size (. and , are for the decimal point, depending on locale)
|
|
;; See comment for `directory-listing-before-filename-regexp' in `files.el' or `files+.el'.
|
|
'("\\_<\\(\\([0-9]+\\([.,][0-9]+\\)?\\)[BkKMGTPEZY]?[ /]?\\)" 1 'diredfl-number)
|
|
|
|
;; Directory names - exclude d:/..., Windows drive letter in a dir heading.
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "\\(d\\)[^:]")
|
|
'(1 diredfl-dir-priv t) '(".+" (dired-move-to-filename) nil (0 diredfl-dir-name t)))
|
|
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\(x\\)") ; o x
|
|
'(1 diredfl-exec-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\([lsStT]\\)") ; o misc
|
|
'(1 diredfl-other-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].......\\(w\\).") ; o w
|
|
'(1 diredfl-write-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]......\\(r\\)..") ; o r
|
|
'(1 diredfl-read-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\(x\\)...") ; g x
|
|
'(1 diredfl-exec-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\([lsStT]\\)...") ; g misc
|
|
'(1 diredfl-other-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]....\\(w\\)....") ; g w
|
|
'(1 diredfl-write-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]...\\(r\\).....") ; g r
|
|
'(1 diredfl-read-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\(x\\)...") ; u x
|
|
'(1 diredfl-exec-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\([lsStT]\\)...") ; u misc
|
|
'(1 diredfl-other-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].\\(w\\)....") ; u w
|
|
'(1 diredfl-write-priv))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]\\(r\\).....") ; u r
|
|
'(1 diredfl-read-priv))
|
|
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]........\\([-rwxlsStT]\\)") ; o -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].......\\([-rwxlsStT]\\).") ; g -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]......\\([-rwxlsStT]\\)..") ; u -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].....\\([-rwxlsStT]\\)...") ; o -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]....\\([-rwxlsStT]\\)....") ; g -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]...\\([-rwxlsStT]\\).....") ; u -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]..\\([-rwxlsStT]\\)......") ; o -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl].\\([-rwxlsStT]\\).......") ; g -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "[-dl]\\([-rwxlsStT]\\)........") ; u -
|
|
'(1 diredfl-no-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "\\(-\\)")
|
|
'(1 diredfl-no-priv keep))
|
|
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "\\([bcsmpS]\\)") ; (rare)
|
|
'(1 diredfl-rare-priv keep))
|
|
(list (concat dired-re-maybe-mark dired-re-inode-size "\\(l\\)[-rwxlsStT]") ; l
|
|
'(1 diredfl-link-priv keep))
|
|
|
|
(list (concat "^\\([^\n " (char-to-string dired-del-marker) "].*$\\)")
|
|
'(1 diredfl-flag-mark-line prepend)) ; Flag/mark lines
|
|
(list (concat "^\\([^\n " (char-to-string dired-del-marker) "]\\)") ; Flags, marks (except D)
|
|
'(1 diredfl-flag-mark prepend))
|
|
|
|
(list (concat "^\\([" (char-to-string dired-del-marker) "].*$\\)") ; Deletion-flagged lines
|
|
'(1 diredfl-deletion-file-name prepend))
|
|
(list (concat "^\\([" (char-to-string dired-del-marker) "]\\)") ; Deletion flags (D)
|
|
'(1 diredfl-deletion prepend)))
|
|
"2nd level of Dired highlighting. See `font-lock-maximum-decoration'.")
|
|
|
|
|
|
;;;###autoload
|
|
(define-minor-mode diredfl-mode
|
|
"Enable additional font locking in `dired-mode'."
|
|
:global nil
|
|
(setq font-lock-defaults
|
|
(if diredfl-mode
|
|
'((dired-font-lock-keywords
|
|
dired-font-lock-keywords
|
|
diredfl-font-lock-keywords-1)
|
|
t nil nil beginning-of-line)
|
|
'(dired-font-lock-keywords t nil nil beginning-of-line)))
|
|
(font-lock-refresh-defaults))
|
|
|
|
;;;###autoload
|
|
(define-globalized-minor-mode diredfl-global-mode diredfl-mode
|
|
(lambda ()
|
|
(when (derived-mode-p 'dired-mode)
|
|
(diredfl-mode)))
|
|
:require 'diredfl)
|
|
|
|
|
|
(provide 'diredfl)
|
|
;;; diredfl.el ends here
|