Giter VIP home page Giter VIP logo

diredfl's Introduction

Melpa Status Melpa Stable Status Build Status Support me

Extra font lock rules for a more colourful dired

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.

Screenshot

Installation

If you're an Emacs 24 user or you have a recent version of package.el you can install diredfl from the MELPA repository. The version of diredfl there will always be up-to-date.

Enable diredfl-mode in all dired-mode buffers by calling or customising diredfl-global-mode as desired.

Related packages

dired-hacks also contains some enhanced font-lock support for dired, but with different goals from this package.

About

Author: Steve Purcell

Homepage: https://github.com/purcell/diredfl


Author links:

๐Ÿ’ Support this project and my other Open Source work

๐Ÿ’ผ LinkedIn profile

โœ sanityinc.com

๐Ÿฆ @sanityinc

diredfl's People

Contributors

jthat avatar minad avatar purcell avatar ubolonton avatar

Stargazers

 avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar  avatar

Watchers

 avatar  avatar  avatar  avatar  avatar

diredfl's Issues

dired-mark highlights

Following #6, files/directories marked for deletion are properly highlighted now.

However, files/directories marked with dired-mark look like this:
1

This is how they look without diredfl-mode active:
2

The highlight on the file/directory names makes it clearer, IMHO.

Ignored extensions

Reported by email:


I have an issue with font locking ignored files in Dired. If I understand
correctly, the function diredfl-match-ignored-extensions takes the extensions
for ignored files from dired-omit-extensions and
completion-ignored-extensions. The former is set in dired-x to
completion-ignored-extensions, dired-latex-unclean-extensions,
dired-bibtex-unclean-extensions, and dired-texinfo-unclean-extensions.

I have a number of extra extensions that I add to these variables. (E.g.,
Beamer adds a lot of auxiliary files.) I modified both
completion-ignored-extensions and dired-latex-unclean-extensions.
Extensions that are added to the former are fontified correctly, but extensions
added to dired-latex-unclean-extensions and dired-bibtex-unclean-extensions
are not, even though C-h v shows these variables with my modifications. So I
suspect there is a problem with diredf not picking up the modified
dired-omit-extensions variable from dired-x; it fontifies according to the
default values of the variables.

I load both dired-x and diredfl with use-package, and for diredfl I have :after
(dired-x), but it makes no difference. How can I make sure that diredfl
fontifies file names according to the modified value of the
dired-omit-extensions variable?

As a typical LaTex/Beamer/BibTeX session creates lots of temporary files, it
would be useful if all these files got fontified with the
diredfl-ignored-file-name face. I find diredfl very useful in helping me find
the files I want quickly in a Dired buffer.

Unable to hide symlink target in git-annex

When diredfl is on, my custom setting to hide symlink target for git-annex gets broken.

(use-package git-annex
 :hook (before-save . my-maybe-unlock-file)
 :bind (:map dired-mode-map
             ("% a" . jmm/dired-mark-files-git-annex-matching)
             :map git-annex-dired-map
             ("l" . git-annex-dired-lock-files)
             ("u" . git-annex-dired-unlock-files)
             ("f" . magit-annex-file-action)
             ("t" . jmm/dired-git-annex-tag)
             ("s" . jmm/dired-git-annex-print-human-file-size)
             ("S" . jmm/dired-git-annex-add-real-file-sizes)
             ("*")
             ("* u" . jmm/dired-mark-git-annex-unavailable-files))
 :config
   (defun my-file-writable-p (orig-fun file-name)
     (let ((file-list (list file-name)))
       (or (apply orig-fun file-list)
	       (let ((target (nth 0 (file-attributes file-name))))
	         (and (stringp target)
                  (string-match "\\.git/annex/" target))))))

   (advice-add 'file-writable-p :around #'my-file-writable-p)

   (setq git-annex-commit nil)
   (git-annex-dired-do-to-files "drop" "Annex: dropped %d file(s)")
   (git-annex-dired-do-to-files "edit" "Annex: unlocked %d file(s) for editing")
   (git-annex-dired-do-to-files "get" "Annex: got %d file(s)")
   (git-annex-dired-do-to-files "lock" "Annex: lock %d file(s)" t)

   (defun my-maybe-unlock-file (&optional ARG)
     (when (and buffer-file-name
                (file-symlink-p buffer-file-name)
                (string= (vc-backend buffer-file-name) "Git"))
	   (let ((target (nth 0 (file-attributes buffer-file-name))))
	     (assert (stringp target))
	     (when (string-match "\\.git/annex/" target)
		   (call-process "git-annex" nil nil nil "edit"
					     (file-relative-name buffer-file-name default-directory))))))

   (defun jmm/git-annex-find-files (&rest args)
     "Generate a list of git annex files that match ARGS.
    For example, ARGS could be \"--in=here\""
     (-remove #'s-blank?
              (s-split "\0"
                       (shell-command-to-string (mapconcat #'identity
                                                           (append '("git annex find --print0") args)
                                                           " ")))))
   (defun eshell/dga (&rest args)
     "Show a `dired' buffer of git annex files that match ARGS.
    For example, ARGS could be \"--in=here\""
     (dired (cons "." (apply #'jmm/git-annex-find-files args))))

   (defun eshell/gaf (&rest args)
     "Return a list of git annex files that match ARGS.
    For example, ARGS could be \"--in=here\""
     (apply #'jmm/git-annex-find-files args))

   (defvar-local jmm/git-annex-directory-tags nil
     "Current git-annex tags set in the directory, as a list.")

   (defun jmm/dired-git-annex-current-tags (file-list &optional intersection)
     "Get current git-annex tag for each file in FILE-LIST. With
    optional argument INTERSECTION, only show tags all files share in common."
     (let* ((metadata (with-output-to-string
                          (with-current-buffer
                              standard-output
                            (apply #'process-file "git" nil t nil "annex" "metadata" "--json" file-list))))
            (json-array-type 'list)
            (jsonout (-map 'json-read-from-string (split-string metadata "\n" t))))
       (-reduce (if intersection '-intersection '-union) (--map (cdr (assoc 'tag (cdr (assoc 'fields it)))) jsonout))))

   (defun jmm/dired-git-annex-tag (file-list tags &optional arg)
     "Add git-annex TAGS to each file in FILE-LIST.
    Used as an interactive command, prompt for a list of tags for all
    files, showing the current tags all files currently have in common."
     (interactive
      (let* ((files (dired-get-marked-files t current-prefix-arg))
             (shared-tags (jmm/dired-git-annex-current-tags files t))
             ;; Cache directory tags
             (current-tags (or jmm/git-annex-directory-tags
                               (setq jmm/git-annex-directory-tags
                                     (or (jmm/dired-git-annex-current-tags '("--all")) '("")))))
             (crm-separator " ")
             (crm-local-completion-map
               (let ((map (make-sparse-keymap)))
                 (set-keymap-parent map crm-local-completion-map)
                 (define-key map " " 'self-insert-command)
                 map))
             (tags (completing-read-multiple
                    "Tags: " (--map (concat it crm-separator) current-tags)
                    nil nil
                    (when shared-tags (mapconcat 'identity shared-tags " ")))))
        (setq jmm/git-annex-directory-tags (-union tags jmm/git-annex-directory-tags))
        (list files tags current-prefix-arg)))
     (let ((args (cl-loop for x in tags
                          append (list "-t" x))))
       (-each file-list
         (lambda (file)
           (apply #'call-process "git" nil nil nil "annex" "metadata" (append args (list file)))))
       (message (format "Tagged %d file(s)" (length file-list)))))

   (defun jmm/dired-mark-git-annex-unavailable-files ()
     "Mark git-annex files that are not present."
     (interactive)
     (dired-mark-if
      (and (looking-at-p ".* -> \\(.*\\.git/annex/.+\\)")
           (not (file-exists-p (file-truename (dired-get-filename t)))))
      "unavailable file"))

   (defun jmm/dired-mark-files-git-annex-matching (matchingoptions &optional marker-char)
     "Mark all files that match git annex's MATCHINGOPTIONS for use in later commands.
    A prefix argument means to unmark them instead.
    `.' and `..' are never marked."
     (interactive
      (list (read-string (concat (if current-prefix-arg "Unmark" "Mark")
                                 " files matching (git annex match expression): ")
                         nil 'jmm-dired-annex-matchingoptions-history)
            (if current-prefix-arg ?\040)))
     (let ((dired-marker-char (or marker-char dired-marker-char)))
       (dired-mark-if
        (and (not (looking-at-p dired-re-dot))
             (not (eolp))               ; empty line
             (let ((fn (dired-get-filename nil t)))
               (when (and fn (not (file-directory-p fn)))
                 (message "Checking %s" fn)
                 (s-present? (shell-command-to-string
                              (mapconcat
                               #'identity
                               (list "git annex find" matchingoptions (shell-quote-argument fn))
                               " "))))))
        "matching file")))

   (defun jmm/git-annex-file-target (filename)
     "If FILENAME is a git annex file, return its symlink target."
     (-when-let (symname (and filename
                              (file-symlink-p filename)))
       (when (string-match-p ".*\\.git/annex/.+" symname)
         symname)))

   (defun jmm/dired-git-annex-file-target ()
     "If the dired file at point is a git annex file, return its symlink target."
     (jmm/git-annex-file-target (dired-get-filename nil t)))

   (defun jmm/git-annex-file-size (filename)
     "Try to determine the size of the git annex file FILENAME."
     (-when-let (target (jmm/git-annex-file-target filename))
       (or (save-match-data
             (when (string-match "SHA256E-s\\([0-9]+\\)--" target)
               (string-to-number (match-string 1 target))))
           (-some-> (expand-file-name target (file-name-directory filename))
             file-attributes
             file-attribute-size))))

   (defun jmm/dired-git-annex-print-human-file-size ()
     "Try to print the human readable file size of the dired git-annex file at point."
     (interactive)
     (let* ((filename (dired-get-filename nil t))
            (string-file (file-name-nondirectory filename)))
       (-if-let (filesize (-some-> (jmm/git-annex-file-size filename)
                            file-size-human-readable))
           (message "%s - %s" filesize string-file)
         (message "Can't determine git annex file size of %s" string-file))))


   (defun jmm/dired-git-annex-add-real-file-sizes ()
     "Go through all the git-annex files in dired, replace the
    symlink file size with the real file size, then try to align
    everything."
     (interactive)
     (require 'dired-aux)
     (let ((regexp directory-listing-before-filename-regexp))
       (save-excursion
         (goto-char (point-min))
         (dired-goto-next-file)
         (while (or (dired-move-to-filename)
                    (progn (save-restriction
                             (narrow-to-region (dired-subdir-min) (dired-subdir-max))
                             (dired--align-all-files))
                           (dired-next-subdir 1 t)
                           (dired-goto-next-file)
                           (dired-move-to-filename)))
           (let ((inhibit-read-only t))
             (when (and (jmm/dired-git-annex-file-target)
                        (re-search-backward regexp (line-beginning-position) t))
               (goto-char (match-beginning 0))
               (-when-let (newsize (-some-> (jmm/git-annex-file-size (dired-get-filename nil t))
                                     file-size-human-readable))
                 (search-backward-regexp "[[:space:]]" nil t)
                 (when (re-search-forward "[[:space:]]+\\([^[:space:]]+\\)[[:space:]]" nil t)
                   (goto-char (match-beginning 1))
                   (delete-region (point) (match-end 1))
                   (insert-and-inherit newsize))))
             (forward-line))))))
   
   (defun jmm/dired-dir-files-beginning ()
     "First point where there's a filename on the line. Beginning of line."
     (save-excursion
       (goto-char (dired-subdir-min))
       (dired-goto-next-file)
       (beginning-of-line)
       (point)))

   (defun jmm/dired-dir-files-end ()
     "Last point where there's a filename. End of line."
     (save-excursion
       (goto-char (dired-subdir-max))
       (while (not (dired-get-filename nil t))
         (dired-previous-line nil))
       (end-of-line)
       (point)))

   (defun jmm/dired-file-size ()
     "Return the file size of a file at point (for sorting). Takes
    into account git-annex files."
     (let* ((filename (dired-get-filename nil t))
            (string-file (file-name-nondirectory filename)))
       (or (jmm/git-annex-file-size filename)
           (file-attribute-size (file-attributes filename)))))

   (defun jmm/dired-sort-size (&optional ascending)
     "Sort some dired lines by size (consider annex sizes).
    With optional argument ASCENDING, sort by ascending file size. (I
    like going the other way around usually.)"
     (interactive "P")
     (if (string= "Git" (vc-responsible-backend default-directory))
         (let (buffer-read-only
               (beg (jmm/dired-dir-files-beginning))
               (end (jmm/dired-dir-files-end)))
           (save-excursion
             (save-restriction
               (narrow-to-region beg end)
               (goto-char (point-min))
               (sort-subr (not ascending)
                          'forward-line 'end-of-line
                          #'jmm/dired-file-size nil))))
         (progn
           (setq dired-listing-switches (concat dired-default-listing-switches " -t"))
           (dired-sort-other dired-listing-switches)))))

Diredfl cannot colorize socket file.

For socket file, it will be displayed like "srwxrwxrwx". But regexps in current diredfl failed to match this suituation.

image

Maybe we need to add prefix s to regexp.

Add `diredfl-no-priv` when missing a directory/link priv indicator

Hi,

right now diredfl-no-priv is only applied when an ordinary privilege (rwx) is missing; for "special" indicators, like directories and links, no face is used. When font-locking the file modes column with a background colour, this can look rather awkward:

2022-05-06-191209_728x209_scrot

Would it be possible to give that first - the diredfl-no-priv face as well?

Recommend Projects

  • React photo React

    A declarative, efficient, and flexible JavaScript library for building user interfaces.

  • Vue.js photo Vue.js

    ๐Ÿ–– Vue.js is a progressive, incrementally-adoptable JavaScript framework for building UI on the web.

  • Typescript photo Typescript

    TypeScript is a superset of JavaScript that compiles to clean JavaScript output.

  • TensorFlow photo TensorFlow

    An Open Source Machine Learning Framework for Everyone

  • Django photo Django

    The Web framework for perfectionists with deadlines.

  • D3 photo D3

    Bring data to life with SVG, Canvas and HTML. ๐Ÿ“Š๐Ÿ“ˆ๐ŸŽ‰

Recommend Topics

  • javascript

    JavaScript (JS) is a lightweight interpreted programming language with first-class functions.

  • web

    Some thing interesting about web. New door for the world.

  • server

    A server is a program made to process requests and deliver data to clients.

  • Machine learning

    Machine learning is a way of modeling and interpreting data that allows a piece of software to respond intelligently.

  • Game

    Some thing interesting about game, make everyone happy.

Recommend Org

  • Facebook photo Facebook

    We are working to build community through open source technology. NB: members must have two-factor auth.

  • Microsoft photo Microsoft

    Open source projects and samples from Microsoft.

  • Google photo Google

    Google โค๏ธ Open Source for everyone.

  • D3 photo D3

    Data-Driven Documents codes.