├── README.org └── dired-file-info.el /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: Dired Show File Information 2 | 3 | Alternative to dired-show-file-type(y) to display more detailed file information. 4 | 5 | * Usage 6 | 7 | #+begin_src elisp 8 | (autoload #'dired-file-info "dired-file-info" "" t) 9 | (with-eval-after-load "dired" 10 | (define-key dired-mode-map "y" #'dired-file-info)) 11 | #+end_src 12 | 13 | * Customize 14 | 15 | | Variable | Default Value | 16 | |---------------------------------------------+---------------------| 17 | | dired-file-info-message-language | nil(Auto) | 18 | | dired-file-info-timestamp-format | "%Y-%m-%d %H:%M:%S" | 19 | | dired-file-info-details-local-file-command | exiftool or stat | 20 | | dired-file-info-details-remote-file-command | stat | 21 | | dired-file-info-details-local-dir-command | stat | 22 | | dired-file-info-details-remote-dir-command | stat | 23 | | dired-file-info-overview-items | - | 24 | 25 | * Example 26 | 27 | The following is the result of displaying directory information. The total file size and number of files are displayed. 28 | 29 | : emacs-28.2: directory 30 | : Size: 317.5MB (332967595bytes) 31 | : Files: 4365 32 | : Directories: 127 33 | : Accessed: 2022-11-10 22:26:19 34 | : Modified: 2022-09-23 12:43:15 35 | : Status Changed: 2022-09-23 12:43:05 36 | : (y:More details) 37 | 38 | The following is the result of displaying the information of a jpg image. 39 | 40 | : PXL_20221003_060116236.jpg: JPEG image data, Exif standard: [TIFF image data, little-endian, direntries=13, height=3024, manufacturer=Google, model=Pixel 3, orientation=upper-left, xresolution=185, yresolution=193, resolutionunit=2, software=HDR+ 1.0.440402506zd, datetime=2022:10:03 15:01:16, GPS-Data, width=4032], baseline, precision 8, 4032x3024, components 3 41 | : Size: 2.2MB (2328789bytes) 42 | : Accessed: 2022-11-10 22:29:32 43 | : Modified: 2022-10-03 15:01:20 44 | : Status Changed: 2022-10-19 10:03:34 45 | : (y:More details) 46 | 47 | Press y again to get more detailed information in [[https://exiftool.org/][exiftool]]. ExifTool can get information of a lot of files, not just images. 48 | -------------------------------------------------------------------------------- /dired-file-info.el: -------------------------------------------------------------------------------- 1 | ;;; dired-file-info.el --- Dired File Information -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 AKIYAMA Kouhei 4 | 5 | ;; Author: AKIYAMA Kouhei 6 | ;; Keywords: files 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; Show more detailed file information than y(dired-show-file-type) in 24 | ;; dired-mode. 25 | 26 | ;;; Usage 27 | 28 | ;; (autoload #'dired-file-info "dired-file-info" "" t) 29 | ;; (with-eval-after-load "dired" 30 | ;; (define-key dired-mode-map "y" #'dired-file-info)) 31 | 32 | ;;; Code: 33 | 34 | ;; TODO: 35 | ;; - Support marked files 36 | 37 | (require 'dired) 38 | (require 'cl-lib) 39 | 40 | ;;;; Settings 41 | 42 | (defgroup dired-file-info nil 43 | "Dired File Info" 44 | :prefix "dired-file-info-" 45 | :group 'dired 46 | :group 'files) 47 | 48 | (defcustom dired-file-info-message-language nil 49 | "Language of displayed messages." 50 | :group 'dired-file-info 51 | :type '(choice (const :tag "Auto" nil) 52 | (string :tag "Language")) 53 | :set (lambda (symbol value) 54 | (set-default symbol value) 55 | (when (fboundp 'dired-file-info-update-message-language) 56 | (dired-file-info-update-message-language)))) 57 | 58 | (defcustom dired-file-info-timestamp-format "%Y-%m-%d %H:%M:%S" 59 | "Timestamp format." 60 | :group 'dired-file-info 61 | :type '(choice (string :tag "Use format-time-string") 62 | (function :tag "Function (time)"))) 63 | 64 | (defcustom dired-file-info-details-local-file-command 65 | (if (executable-find "exiftool") 66 | "exiftool -c \"%+.06f\"" 67 | "stat") 68 | "Command to output local file details." 69 | :group 'dired-file-info 70 | :type '(choice (string :tag "command line to pass to dired-do-shell-command") 71 | (function :tag "Function (file)"))) 72 | 73 | (defcustom dired-file-info-details-remote-file-command "stat" 74 | "Command to output remote file details." 75 | :group 'dired-file-info 76 | :type '(choice (string :tag "command line to pass to dired-do-shell-command") 77 | (function :tag "Function (file)"))) 78 | 79 | (defcustom dired-file-info-details-local-dir-command "stat" 80 | "Command to output local directory details." 81 | :group 'dired-file-info 82 | :type '(choice (string :tag "command line to pass to dired-do-shell-command") 83 | (function :tag "Function (file)"))) 84 | 85 | (defcustom dired-file-info-details-remote-dir-command "stat" 86 | "Command to output remote directory details." 87 | :group 'dired-file-info 88 | :type '(choice (string :tag "command line to pass to dired-do-shell-command") 89 | (function :tag "Function (file)"))) 90 | 91 | (defcustom dired-file-info-overview-items 92 | (list #'dired-file-info--file-type 93 | #'dired-file-info--directory-size 94 | #'dired-file-info--file-size 95 | #'dired-file-info--file-timestamps) 96 | "List of overview items." 97 | :group 'dired-file-info 98 | :type '(repeat (function :tag "Function (file deref-symlinks)"))) 99 | 100 | ;;;; Message Catalog 101 | 102 | (defconst dired-file-info--messages 103 | '(("Japanese" . 104 | #s(hash-table 105 | size 30 106 | test equal 107 | data ( 108 | "Scanning directory %s" "スキャン中 %s" 109 | "Size" "サイズ" 110 | "B" "B" 111 | "bytes" "バイト" 112 | "Files" "ファイル数" 113 | "Directories" "ディレクトリ数" 114 | "Accessed" "アクセス" 115 | "Modified" "内容更新" 116 | "Status Changed" "状態更新" 117 | "More details" "詳細" 118 | ))))) 119 | 120 | (defvar dired-file-info--current-messages nil) 121 | 122 | (defun dired-file-info-set-message-language (lang) 123 | (setq dired-file-info--current-messages 124 | (alist-get (or lang current-language-environment) 125 | dired-file-info--messages nil nil #'equal))) 126 | 127 | (defun dired-file-info-update-message-language () 128 | (dired-file-info-set-message-language dired-file-info-message-language)) 129 | 130 | (dired-file-info-update-message-language) 131 | 132 | (defun dired-file-info--msg (str) 133 | (or (and dired-file-info--current-messages 134 | (gethash str dired-file-info--current-messages)) 135 | str)) 136 | 137 | ;;;; Debug 138 | 139 | (defun dired-file-info--warn (format &rest args) 140 | (display-warning 'dired-file-info 141 | (apply #'format-message format args))) 142 | 143 | ;;;; Directory Scan 144 | 145 | (defun dired-file-info--accumulate-entry (path 146 | fun-file 147 | &optional 148 | fun-enter 149 | fun-leave 150 | deref-symlinks 151 | only-one-filesystem 152 | depth 153 | attr) 154 | (when (null depth) (setq depth 0)) 155 | (let* ((attr (or attr (file-attributes path))) 156 | (type (file-attribute-type attr)) 157 | (symlink (and (stringp type) type))) 158 | ;; Note: On MS-Windows, (file-attributes "Long filename...") seems 159 | ;; to return nil. 160 | (unless attr 161 | (dired-file-info--warn "Ignore file `%s' (`file-attributes' returns nil)" 162 | path)) 163 | (when (and attr 164 | (not (and only-one-filesystem 165 | (/= only-one-filesystem 166 | (file-attribute-device-number attr))))) 167 | (cond 168 | ;; Symbolic Link 169 | (symlink 170 | (if deref-symlinks 171 | (dired-file-info--accumulate-entry 172 | symlink fun-file fun-enter fun-leave 173 | deref-symlinks only-one-filesystem depth) 174 | (funcall fun-file path attr))) 175 | 176 | ;; Directory 177 | ((eq type t) 178 | (dired-file-info--accumulate-directory 179 | path fun-file fun-enter fun-leave 180 | deref-symlinks only-one-filesystem (1+ depth))) 181 | 182 | ;; Normal File 183 | (t 184 | (funcall fun-file path attr)))))) 185 | 186 | (defun dired-file-info--files-and-attributes (dir) 187 | (condition-case err 188 | ;; On MS-Windows, a long DIR-PATH will cause a file-missing 189 | ;; ("No such file or directory") error. 190 | (directory-files-and-attributes dir) 191 | (error 192 | (dired-file-info--warn 193 | "Ignore dir `%s' (`directory-files-and-attributes' signals error `%s')" 194 | dir err) 195 | nil))) 196 | 197 | (defun dired-file-info--accumulate-directory (dir-path 198 | fun-file 199 | &optional 200 | fun-enter 201 | fun-leave 202 | deref-symlinks 203 | only-one-filesystem 204 | depth) 205 | (when (null depth) (setq depth 0)) 206 | (when fun-enter (funcall fun-enter dir-path)) 207 | (cl-loop 208 | for (entry-name . attr) in (dired-file-info--files-and-attributes dir-path) 209 | unless (string-match "\\`\\.\\.?\\'" entry-name) 210 | do (dired-file-info--accumulate-entry 211 | (concat dir-path "/" entry-name) 212 | fun-file fun-enter fun-leave 213 | deref-symlinks only-one-filesystem depth 214 | ;; By reusing already obtained attributes, not only performance 215 | ;; is improved but also errors in `file-attributes' for long 216 | ;; path names can be avoided. 217 | ;; While (file-attributes "long file name..") returns nil, the 218 | ;; attributes obtained from the `directory-files-and-attributes' 219 | ;; function do not seem to be nil. 220 | attr)) 221 | (when fun-leave (funcall fun-leave dir-path))) 222 | 223 | (defun dired-file-info--summarize-directory (dir-path 224 | &optional 225 | deref-symlinks 226 | only-one-filesystem) 227 | (let ((size 0.0) 228 | (num-files 0) 229 | (num-dirs 0)) 230 | (dired-file-info--accumulate-entry ;;-directory? deref first symlink? 231 | dir-path 232 | (lambda (_path attr) 233 | (cl-incf num-files) 234 | (cl-incf size (file-attribute-size attr))) 235 | (lambda (path) 236 | (cl-incf num-dirs) 237 | (let ((message-log-max nil)) 238 | (message (dired-file-info--msg "Scanning directory %s") path))) 239 | nil 240 | deref-symlinks 241 | only-one-filesystem 242 | 0) 243 | (list size num-files num-dirs))) 244 | 245 | ;;;; Dereference Symlinks 246 | 247 | (defun dired-file-info--deref-symlink (path deref-symlinks) 248 | (when deref-symlinks 249 | (let (target) 250 | (while (setq target (file-symlink-p path)) 251 | (setq path target)))) ;;@todo infinite loop 252 | path) 253 | 254 | (defun dired-file-info--directory-p (path deref-symlinks) 255 | (and (file-directory-p path) 256 | ;; Exclude symlink when not deref-symlinks 257 | (or (not (file-symlink-p path)) 258 | deref-symlinks))) 259 | 260 | ;;;; Format Text 261 | 262 | (defun dired-file-info--format-size (size) 263 | (when (stringp size) 264 | (setq size 265 | (and (string-match "\\`\\([0-9]+\\)" size) 266 | (string-to-number (match-string 1 size))))) 267 | 268 | (when (numberp size) 269 | (concat 270 | (dired-file-info--msg "Size") 271 | ": " (file-size-human-readable size) (dired-file-info--msg "B") 272 | " (" (format "%d" size) (dired-file-info--msg "bytes") ")"))) 273 | 274 | (defun dired-file-info--format-time (time) 275 | (cond 276 | ((stringp dired-file-info-timestamp-format) 277 | (format-time-string dired-file-info-timestamp-format time)) 278 | ((functionp dired-file-info-timestamp-format) 279 | (funcall dired-file-info-timestamp-format time)) 280 | (t ""))) 281 | 282 | ;;;; Retrieve Property 283 | 284 | (defun dired-file-info--file-type (file &optional deref-symlinks) 285 | (let (process-file-side-effects) 286 | (with-temp-buffer 287 | (if deref-symlinks 288 | (process-file "file" nil t t "-L" "--" file) 289 | (process-file "file" nil t t "--" file)) 290 | (when (bolp) 291 | (backward-delete-char 1)) 292 | (buffer-string)))) 293 | 294 | ;; (defun dired-file-info--directory-size-du (file) 295 | ;; (and (file-directory-p file) 296 | ;; (not (file-remote-p file)) 297 | ;; (let ((du (progn 298 | ;; (message "Executing du...") 299 | ;; (shell-command-to-string (mapconcat #'shell-quote-argument (list "du" "-bs" file) " "))))) 300 | ;; (message "Executing du...done") 301 | ;; (concat "\n" (dired-file-info--format-size du))))) 302 | 303 | (defun dired-file-info--directory-size (file &optional deref-symlinks) 304 | (when (dired-file-info--directory-p file deref-symlinks) 305 | (let* ((summary (dired-file-info--summarize-directory 306 | file deref-symlinks nil)) 307 | (size (nth 0 summary)) 308 | (num-files (nth 1 summary)) 309 | (num-dirs (nth 2 summary))) 310 | (concat "\n" (dired-file-info--format-size size) 311 | "\n" (dired-file-info--msg "Files") ": " (format "%d" num-files) 312 | "\n" (dired-file-info--msg "Directories") ": " (format "%d" num-dirs))))) 313 | 314 | (defun dired-file-info--file-size (file &optional deref-symlinks) 315 | (and (not (dired-file-info--directory-p file deref-symlinks)) 316 | (concat "\n" (dired-file-info--format-size 317 | (file-attribute-size 318 | (file-attributes 319 | (dired-file-info--deref-symlink file deref-symlinks))))))) 320 | 321 | (defun dired-file-info--file-timestamps (file &optional deref-symlinks) 322 | (let ((attr (file-attributes (dired-file-info--deref-symlink file deref-symlinks)))) 323 | (concat 324 | (concat "\n" (dired-file-info--msg "Accessed") ": " 325 | (dired-file-info--format-time 326 | (file-attribute-access-time attr))) 327 | (concat "\n" (dired-file-info--msg "Modified") ": " 328 | (dired-file-info--format-time 329 | (file-attribute-modification-time attr))) 330 | (concat "\n" (dired-file-info--msg "Status Changed") ": " 331 | (dired-file-info--format-time 332 | (file-attribute-status-change-time attr)))))) 333 | 334 | ;;;; Info List 335 | 336 | (defun dired-file-info--show-overview (file &optional deref-symlinks) 337 | "Display overview FILE information." 338 | (message 339 | "%s" 340 | (concat 341 | (mapconcat (lambda (fun) 342 | (funcall fun file deref-symlinks)) 343 | dired-file-info-overview-items 344 | "") 345 | "\n" 346 | "(" 347 | (if deref-symlinks "C-u ") 348 | (substitute-command-keys "\\[dired-file-info]:") 349 | (dired-file-info--msg "More details") 350 | ")" 351 | ))) 352 | 353 | (defconst dired-file-info-buffer-name "*Dired File Info*") 354 | 355 | (defun dired-file-info--show-details (file &optional deref-symlinks) 356 | "Display detailed FILE information." 357 | (setq file (dired-file-info--deref-symlink file deref-symlinks)) 358 | 359 | (let ((command (if (file-remote-p (expand-file-name file)) 360 | (if (file-directory-p file) 361 | dired-file-info-details-remote-dir-command 362 | dired-file-info-details-remote-file-command) 363 | (if (file-directory-p file) 364 | dired-file-info-details-local-dir-command 365 | dired-file-info-details-local-file-command)))) 366 | (cond 367 | ((stringp command) 368 | (let ((shell-command-buffer-name dired-file-info-buffer-name)) 369 | (dired-do-shell-command command nil (list file)) 370 | (when-let ((buffer (get-buffer dired-file-info-buffer-name))) 371 | (with-current-buffer buffer 372 | (view-mode))))) 373 | ((functionp command) 374 | (funcall command file))))) 375 | 376 | ;;;; Command 377 | 378 | (defvar dired-file-info--last-args nil) 379 | 380 | ;;;###autoload 381 | (defun dired-file-info (file &optional deref-symlinks details) 382 | "Display FILE information. 383 | 384 | Outputs detailed information when executed twice in a row." 385 | (interactive 386 | (let* ((file (dired-get-filename t)) 387 | (deref-symlinks current-prefix-arg) 388 | (details (and (eq last-command 'dired-file-info) 389 | (equal (nth 0 dired-file-info--last-args) file) 390 | (equal (nth 1 dired-file-info--last-args) deref-symlinks)))) 391 | (list file deref-symlinks details))) 392 | 393 | (if details 394 | ;; Details 395 | (progn 396 | (dired-file-info--show-details file deref-symlinks) 397 | (setq dired-file-info--last-args nil)) 398 | ;; Overview 399 | (dired-file-info--show-overview file deref-symlinks) 400 | (setq dired-file-info--last-args (list file deref-symlinks details)))) 401 | 402 | (provide 'dired-file-info) 403 | ;;; dired-file-info.el ends here 404 | --------------------------------------------------------------------------------