├── .github └── FUNDING.yml ├── .gitignore ├── .travis.yml ├── Cask ├── LICENSE ├── README.md ├── dired-avfs.el ├── dired-collapse.el ├── dired-columns.el ├── dired-filter.el ├── dired-hacks-utils.el ├── dired-hacks.el ├── dired-images.el ├── dired-list.el ├── dired-narrow.el ├── dired-open.el ├── dired-rainbow.el ├── dired-ranger.el ├── dired-subtree.el ├── dired-tagsistant.el ├── dired-ui.el └── tests ├── test-dired-collapse.el ├── test-dired-filter.el └── test-dired-utils.el /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | # These are supported funding model platforms 2 | 3 | github: [Fuco1] 4 | patreon: matusgoljer 5 | custom: https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .cask/* 2 | .eask/* 3 | *.elc 4 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: emacs-lisp 2 | env: 3 | - EVM_EMACS=emacs-24.1-bin 4 | - EVM_EMACS=emacs-24.2-bin 5 | - EVM_EMACS=emacs-24.3-bin 6 | - EVM_EMACS=emacs-24.4-bin 7 | - EVM_EMACS=emacs-24.5-bin 8 | before_install: 9 | - sudo mkdir /usr/local/evm 10 | - sudo chown $(id -u):$(id -g) /usr/local/evm 11 | - curl -fsSkL https://raw.github.com/rejeep/evm/master/go | bash 12 | - export PATH="$HOME/.evm/bin:$PATH" 13 | - evm install $EVM_EMACS --use 14 | - curl -fsSkL https://raw.github.com/cask/cask/master/go | python 15 | - export PATH="$HOME/.cask/bin:$PATH" 16 | - cask 17 | script: 18 | - cask exec buttercup -L . -------------------------------------------------------------------------------- /Cask: -------------------------------------------------------------------------------- 1 | (source gnu) 2 | (source melpa-stable) 3 | 4 | (package "dired-hacks" "0.0.1" "Dired hacks metapackage") 5 | 6 | (depends-on "f") 7 | (depends-on "dash") 8 | (depends-on "s") 9 | (depends-on "cl-lib") 10 | 11 | (development 12 | (depends-on "assess") 13 | (depends-on "buttercup") 14 | (depends-on "shut-up")) 15 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | * [dired-hacks](#dired-hacks--) 2 | * [Contribute!](#contribute) 3 | * [Packages](#packages) 4 | * [dired-hacks-utils](#dired-hacks-utils) 5 | * [dired-filter](#dired-filter) 6 | * [Stack operations](#stack-operations) 7 | * [Built-in filters](#built-in-filters) 8 | * [Saved filters](#saved-filters) 9 | * [Filter groups](#filter-groups) 10 | * [Other features](#other-features) 11 | * [dired-avfs](#dired-avfs) 12 | * [dired-open](#dired-open) 13 | * [dired-rainbow](#dired-rainbow) 14 | * [dired-subtree](#dired-subtree) 15 | * [Interactive functions](#interactive-functions) 16 | * [dired-ranger](#dired-ranger) 17 | * [Multi-stage copy/pasting of files](#multi-stage-copypasting-of-files) 18 | * [Bookmarks](#bookmarks) 19 | * [dired-narrow](#dired-narrow) 20 | * [dired-list](#dired-list) 21 | * [dired-collapse](#dired-collapse) 22 | 23 | # dired-hacks [![Build Status](https://travis-ci.org/Fuco1/dired-hacks.svg?branch=master)](https://travis-ci.org/Fuco1/dired-hacks) [![Paypal logo](https://www.paypalobjects.com/en_US/i/btn/btn_donate_LG.gif)](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88) [![Patreon](https://c5.patreon.com/external/logo/logomarkOrange.svg)](https://www.patreon.com/user?u=3282358&ty=h) 24 | 25 | Collection of useful dired additions. I don't want this to become 26 | another `dired+`, so I'm splitting all the functionality into separate 27 | mutually independent packages. All shared functionality and helpers 28 | will be extracted into a single package `dired-hacks-utils`, so that 29 | will be the only dependence. 30 | 31 | In addition, all the packages require [dash.el](https://github.com/magnars/dash.el) 32 | 33 | Please note that only the packages that are listed in this readme are 34 | "finished" (means in package repositories, with usable UI etc.). All 35 | the other files are work-in-progress packages you could probably use, 36 | but it would be a bit more painful. 37 | 38 | # Contribute! 39 | 40 | If you want to support this project, you can do it in the following ways: 41 | 42 | * Contribute code. Since this collection comes from my own config, it 43 | mostly contains stuff I use or find useful. If you have an idea 44 | that is not yet implemented and will benefit this project, feel free 45 | to implement it and submit a pull request. If you have any concerns 46 | whether your contribution will be accepted, ask beforehand. You can 47 | email the author or 48 | [start an issue](https://github.com/Fuco1/dired-hacks/issues/new) on 49 | the tracker. 50 | * Contribute ideas. Even if you can't code Emacs Lisp, you can still 51 | contribute valuable ideas for other programmers to implement. Simply 52 | [start new issue](https://github.com/Fuco1/dired-hacks/issues/new) 53 | on the tracker and submit your suggestion. 54 | * You can make a financial donation through 55 | [PayPal](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=A5PMGVKCQBT88) 56 | or [Patreon](https://www.patreon.com/user?u=3282358&ty=h). If you like dired-hacks and can spare a modest 57 | amount on a donation, feel free to do so. These donations are 58 | expressions of your gratitude and are used for my personal "rewards" 59 | (books, games, music etc.). You can also gift me a game on 60 | [Steam](http://steamcommunity.com/profiles/76561198265034071/wishlist) 61 | or buy something on 62 | [Amazon](http://www.amazon.com/gp/registry/wishlist/2I8DOQH8OZEUR). 63 | Regardless of the donations, dired-hacks will always be free both as 64 | in beer and as in speech. 65 | 66 | # Packages 67 | 68 | ## dired-hacks-utils 69 | 70 | Set of utility functions used in all the `dired-hacks` packages. 71 | 72 | This package also provides these interactive functions: 73 | 74 | * `dired-hacks-next-file` - go to next file, skipping empty and non-file lines 75 | * `dired-hacks-previous-file` - go to previous file, skipping empty 76 | and non-file lines 77 | * `dired-utils-format-information-line-mode` - Format the information 78 | (summary) line file sizes to be human readable (e.g. 1GB instead of 79 | 1048576). 80 | 81 | ## dired-filter 82 | 83 | The filtering system is designed after ibuffer: every dired 84 | buffer has associated "filter stack" where user can push 85 | filters (predicates). These filters are by default 86 | logically "anded", meaning, only the files satsifying all the 87 | predicates are shown. 88 | 89 | Some filters take additional input from the user such as part of 90 | name, regexp or extension, other filters only use a predefined 91 | predicate such as "show only directories" or "omit dot files". 92 | 93 | In addition, there are two "metafilters", the `or` filter and the 94 | `not` filter. These take other filters as arguments and change 95 | their logical interpretation. The `or` filter takes the two 96 | filters on top of the stack, pops them and pushes a filter that 97 | matches files satisfying one or the other (or both) filters. The 98 | `not` filter pops the top filter and pushes its logical negation. 99 | 100 | To enable or disable the filters, toggle minor mode 101 | `dired-filter-mode`. Toggling this mode preserves the filter 102 | stack, so you can use it to quickly hide/unhide files filtered by 103 | the current filter setup. 104 | 105 | All the provided interactive functions are available from 106 | `dired-filter-map`. You can customize `dired-filter-prefix` to set a 107 | prefix for this map or bind it manually to a prefix of your choice 108 | using: 109 | 110 | (define-key dired-mode-map (kbd "some-key") dired-filter-map) 111 | 112 | The bindings follow a convention where the filters are mapped on 113 | lower-case letters or punctuation, operators are mapped on symbols 114 | (such as !, |, * etc.) and group commands are mapped on upper-case 115 | letters. The exception to this is `p` which is bound to 116 | `dired-filter-pop`, which is a very common operation and warrants a 117 | quick binding. 118 | 119 | In addition to filtering, you can also use the same predicates to 120 | only mark files without removing the rest. All the filtering 121 | functions of the form `dired-filter-by-*` have their marking 122 | counterpart `dired-filter-mark-by-*`. These are available from 123 | `dired-filter-mark-map`. You can customize 124 | `dired-filter-mark-prefix` a prefix for this map or bind it 125 | manually to a prefix of your choice using: 126 | 127 | (define-key dired-mode-map (kbd "some-key") dired-filter-mark-map) 128 | 129 | The marking operations are not placed on stack, instead, the marks are 130 | immediately updated by "OR"-ing them together. To remove marks that 131 | would otherwise be selected by a filter, use prefix argument (usually 132 | bound to `C-u`). To logically negate the meaning of the filter, you 133 | can call the function with a double prefix argument (usually `C-u` 134 | `C-u`) 135 | 136 | You can use saved filters to mark files by calling 137 | `dired-filter-mark-by-saved-filters`. 138 | 139 | ### Stack operations 140 | 141 | To remove the filter from the stack, use `dired-filter-pop` or 142 | `dired-filter-pop-all` 143 | 144 | To break a metafilter apart, you can use `dired-filter-decompose` 145 | to decompose the parts of the metafilter and push them back to 146 | the stack. 147 | 148 | You can transpose the filters on the top of the stack using 149 | `dired-filter-transpose` 150 | 151 | ### Built-in filters 152 | 153 | Here's a list of built-in filters: 154 | 155 | * `dired-filter-by-name` 156 | * `dired-filter-by-regexp` 157 | * `dired-filter-by-extension` 158 | * `dired-filter-by-dot-files` 159 | * `dired-filter-by-omit` 160 | * `dired-filter-by-garbage` 161 | * `dired-filter-by-predicate` 162 | * `dired-filter-by-file` 163 | * `dired-filter-by-directory` 164 | * `dired-filter-by-mode` 165 | * `dired-filter-by-symlink` 166 | * `dired-filter-by-executable` 167 | 168 | You can see their documentation by calling M-x `describe-function`. 169 | 170 | Specifically, `dired-filter-by-omit` removes the files that would 171 | be removed by `dired-omit-mode`, so you should not need to use 172 | both---in fact it is discouraged, as it would make the read-in 173 | slower. 174 | 175 | When called with negative prefix argument, some filters can read 176 | multiple values. The resulting predicate is often much faster than 177 | having the filter repeated with single argument. Read the 178 | documentation to learn more about the calling conventions. 179 | Currently, these filters support reading multiple arguments: 180 | 181 | * `dired-filter-by-extension` 182 | 183 | To define your own filters, you can use the macro 184 | `dired-filter-define`. If you define some interesting filter, 185 | please consider contributing it to the upstream. 186 | 187 | ### Saved filters 188 | 189 | In addition to the built-in filters and your own custom filters, 190 | this package provides an option to save complex compound filters 191 | for later use. When you set up a filter stack you would like to 192 | save, call `dired-filter-save-filters`. You will be prompted for a 193 | name under which this stack will be saved. 194 | 195 | The saved filter will be added to `dired-filter-saved-filters` 196 | variable, which you can also customize via the customize interface 197 | or manually add entries with `push` or `add-to-list`. If you use 198 | customize, calling `dired-filter-save-filters` will automatically 199 | save the new value into your customize file. 200 | 201 | You can delete saved filters with `dired-filter-delete-saved-filters`. 202 | 203 | To use a saved filter, you can use either 204 | `dired-filter-add-saved-filters` or 205 | `dired-filter-load-saved-filters`. The first pushes the saved 206 | filter on top of the currently active stack, the second clears 207 | current filter stack before loading the saved filter configuration. 208 | 209 | An example use is to create filters for "logical groups" of files, 210 | such as media files, image files or files used when programming in 211 | certain environment (for example, show files with .h and .c 212 | extensions). Saved filters save you the time of setting up the 213 | filters each time you want this specific view. 214 | 215 | As a concrete example of above, author uses a saved filter "media" 216 | with value: 217 | 218 | (extension "ogg" "flv" "mpg" "avi" "mp4" "mp3") 219 | ;; show all files matching any of these extensions 220 | 221 | ### Filter groups 222 | 223 | Furthermore, instead of only filtering the dired buffer by 224 | removing lines you are not interested in, you can also group 225 | lines together by filters. That is, lines (files, 226 | directories...) satisfying a filter will be moved together under 227 | a common drawer. This mechanism works in analogy with ibuffer 228 | filter groups. 229 | 230 | The variable `dired-filter-group-saved-groups` contains 231 | definitions of filter groups. You can create and save multiple 232 | filter groups (views) and switch between them by setting the 233 | `dired-filter-group` variable. 234 | 235 | To enable or disable the filter groups toggle minor mode 236 | `dired-filter-group-mode`. Toggling this mode preserves the active 237 | filter group so you can use it to quickly group and ungroup the 238 | files. 239 | 240 | Here is a screenshot with an active filter group. Notice that regular 241 | filtering works also with filter groups. 242 | 243 | ![Filter group](http://i.imgur.com/qtiDX1c.png) 244 | 245 | Placing the point on the drawer header and hitting `RET` folds it. 246 | Hitting `RET` again expands it. 247 | 248 | ![Folding](http://i.imgur.com/TDUsEKq.png) 249 | 250 | The `dired-filter-group-saved-groups` used in the above screenshot is the following: 251 | 252 | ```elisp 253 | (("default" 254 | ("PDF" 255 | (extension . "pdf")) 256 | ("LaTeX" 257 | (extension "tex" "bib")) 258 | ("Org" 259 | (extension . "org")) 260 | ("Archives" 261 | (extension "zip" "rar" "gz" "bz2" "tar")))) 262 | ``` 263 | 264 | You can of course be more imaginative and use filtering based on other 265 | criteria than just extensions ;) 266 | 267 | ### Other features 268 | 269 | You can clone the currently visible dired buffer by calling 270 | `dired-filter-clone-filtered-buffer`. 271 | 272 | ## dired-avfs 273 | 274 | Adds [avfs](http://avf.sourceforge.net/) support for seamless archive 275 | browsing. This extension therefore depends on the presence of `avfsd` 276 | on your system. In debian-derived distributions you can usually do 277 | 278 | apt-get install avfs 279 | 280 | `avfs` is probably also available for Mac OS. You're out of luck on 281 | Windows, sorry. 282 | 283 | Once the daemon is installed, run it with `mountavfs` and everything 284 | "Should Just Work™". 285 | 286 | ## dired-open 287 | 288 | While emacs already has the `auto-mode-alist`, this is often 289 | insufficient. Many times, you want to open media files, pdfs or 290 | other documents with an external application. There's remedy for 291 | that too, namely `dired-guess-shell-alist-user`, but that is still 292 | not as convenient as just hitting enter. 293 | 294 | This package adds a mechanism to add "hooks" to `dired-find-file` that 295 | will run before emacs tries its own mechanisms to open the file, thus 296 | enabling you to launch other application or code and suspend the 297 | default behaviour. 298 | 299 | By default, two additional methods are enabled, 300 | `dired-open-by-extension` and `dired-open-subdir`. 301 | 302 | This package also provides other convenient hooks: 303 | 304 | * `dired-open-xdg` - try to open the file using `xdg-open` 305 | * `dired-open-guess-shell-alist` - try to open the file by 306 | launching applications from `dired-guess-shell-alist-user` 307 | * `dired-open-call-function-by-extension` - call an elisp function 308 | based on extension. 309 | 310 | These are not used by default. 311 | 312 | You can customize the list of functions to try by customizing 313 | `dired-open-functions`. 314 | 315 | To fall back to the default `dired-find-file`, you can provide the 316 | prefix argument (usually `C-u`) to the `dired-open-file` function. 317 | This is useful for example when you configure html files to be 318 | opened in browser and you want to edit the file instead of view it. 319 | 320 | Note also that this package can handle calls when point is not on a 321 | line representing a file---an example hook is provided to open a 322 | subdirectory under point if point is on the subdir line, see 323 | `dired-open-subdir`. 324 | 325 | If you write your own handler, make sure they do *not* throw errors 326 | but instead return nil if they can't proceed. Please, don't forget to 327 | submit interesting handlers! 328 | 329 | ## dired-rainbow 330 | 331 | This package adds more customizable highlighting for files in dired 332 | listings. The group `dired-faces` provides only nine faces and 333 | isn't very fine-grained. 334 | 335 | The definitions are added by several macros, currently available 336 | are: 337 | 338 | * `dired-rainbow-define` - add face by file extension 339 | * `dired-rainbow-define-chmod` - add face by file permissions 340 | 341 | You can display their documentation by calling (substituting the 342 | desired macro name): 343 | 344 | M-x describe-function RET dired-rainbow-define RET 345 | 346 | Here are some example uses: 347 | 348 | ```scheme 349 | (defconst my-dired-media-files-extensions 350 | '("mp3" "mp4" "MP3" "MP4" "avi" "mpg" "flv" "ogg") 351 | "Media files.") 352 | 353 | (dired-rainbow-define html "#4e9a06" ("htm" "html" "xhtml")) 354 | (dired-rainbow-define media "#ce5c00" my-dired-media-files-extensions) 355 | 356 | ; boring regexp due to lack of imagination 357 | (dired-rainbow-define log (:inherit default 358 | :italic t) ".*\\.log") 359 | 360 | ; highlight executable files, but not directories 361 | (dired-rainbow-define-chmod executable-unix "Green" "-[rw-]+x.*") 362 | ``` 363 | 364 | Putting it all together, the following is a basic setup (essentially a 365 | pseudo-port of [LS_COLORS](https://github.com/trapd00r/LS_COLORS) 366 | obtained by inspecting a terminal and approximating colors with 367 | [Tailwind CSS](https://tailwindcss.com/docs/colors/)). 368 | 369 | ```scheme 370 | (use-package dired-rainbow 371 | :config 372 | (progn 373 | (dired-rainbow-define-chmod directory "#6cb2eb" "d.*") 374 | (dired-rainbow-define html "#eb5286" ("css" "less" "sass" "scss" "htm" "html" "jhtm" "mht" "eml" "mustache" "xhtml")) 375 | (dired-rainbow-define xml "#f2d024" ("xml" "xsd" "xsl" "xslt" "wsdl" "bib" "json" "msg" "pgn" "rss" "yaml" "yml" "rdata")) 376 | (dired-rainbow-define document "#9561e2" ("docm" "doc" "docx" "odb" "odt" "pdb" "pdf" "ps" "rtf" "djvu" "epub" "odp" "ppt" "pptx")) 377 | (dired-rainbow-define markdown "#ffed4a" ("org" "etx" "info" "markdown" "md" "mkd" "nfo" "pod" "rst" "tex" "textfile" "txt")) 378 | (dired-rainbow-define database "#6574cd" ("xlsx" "xls" "csv" "accdb" "db" "mdb" "sqlite" "nc")) 379 | (dired-rainbow-define media "#de751f" ("mp3" "mp4" "MP3" "MP4" "avi" "mpeg" "mpg" "flv" "ogg" "mov" "mid" "midi" "wav" "aiff" "flac")) 380 | (dired-rainbow-define image "#f66d9b" ("tiff" "tif" "cdr" "gif" "ico" "jpeg" "jpg" "png" "psd" "eps" "svg")) 381 | (dired-rainbow-define log "#c17d11" ("log")) 382 | (dired-rainbow-define shell "#f6993f" ("awk" "bash" "bat" "sed" "sh" "zsh" "vim")) 383 | (dired-rainbow-define interpreted "#38c172" ("py" "ipynb" "rb" "pl" "t" "msql" "mysql" "pgsql" "sql" "r" "clj" "cljs" "scala" "js")) 384 | (dired-rainbow-define compiled "#4dc0b5" ("asm" "cl" "lisp" "el" "c" "h" "c++" "h++" "hpp" "hxx" "m" "cc" "cs" "cp" "cpp" "go" "f" "for" "ftn" "f90" "f95" "f03" "f08" "s" "rs" "hi" "hs" "pyc" ".java")) 385 | (dired-rainbow-define executable "#8cc4ff" ("exe" "msi")) 386 | (dired-rainbow-define compressed "#51d88a" ("7z" "zip" "bz2" "tgz" "txz" "gz" "xz" "z" "Z" "jar" "war" "ear" "rar" "sar" "xpi" "apk" "xz" "tar")) 387 | (dired-rainbow-define packaged "#faad63" ("deb" "rpm" "apk" "jad" "jar" "cab" "pak" "pk3" "vdf" "vpk" "bsp")) 388 | (dired-rainbow-define encrypted "#ffed4a" ("gpg" "pgp" "asc" "bfe" "enc" "signature" "sig" "p12" "pem")) 389 | (dired-rainbow-define fonts "#6cb2eb" ("afm" "fon" "fnt" "pfb" "pfm" "ttf" "otf")) 390 | (dired-rainbow-define partition "#e3342f" ("dmg" "iso" "bin" "nrg" "qcow" "toast" "vcd" "vmdk" "bak")) 391 | (dired-rainbow-define vc "#0074d9" ("git" "gitignore" "gitattributes" "gitmodules")) 392 | (dired-rainbow-define-chmod executable-unix "#38c172" "-.*x.*") 393 | )) 394 | ``` 395 | 396 | *Note*: the [256 color cheat 397 | sheet](https://jonasjacek.github.io/colors/) includes conversion from 398 | the Xterm colors used by LS_COLORS to the HEX codes used by 399 | `dired-rainbow`. Using that conversion an enterprising individual with a grasp of `sed`/`awk` could put together a 400 | *real* port of [LS_COLORS](https://github.com/trapd00r/LS_COLORS) to `dired-rainbow`. 401 | 402 | ### Related packages 403 | 404 | There is a related package called [diredfl](https://github.com/purcell/diredfl/) which extracts the extra fontification rules from Dired+ and packages them in a modern Emacsy way. They enhance things like the date face, permissions face and similar. Check it out! 405 | 406 | ## dired-subtree 407 | 408 | The basic command to work with subdirectories in dired is `i`, 409 | which inserts the subdirectory as a separate listing in the active 410 | dired buffer. 411 | 412 | This package defines function `dired-subtree-insert` which instead 413 | inserts the subdirectory directly below its line in the original 414 | listing, and indent the listing of subdirectory to resemble a 415 | tree-like structure (somewhat similar to `tree(1)` except the pretty 416 | graphics). The tree display is somewhat more intuitive than the 417 | default "flat" subdirectory manipulation provided by `i`. 418 | 419 | There are several presentation options and faces you can customize 420 | to change the way subtrees are displayed. 421 | 422 | You can further remove the unwanted lines from the subtree by using 423 | `k` command or some of the built-in "focusing" functions, such as 424 | `dired-subtree-only-*` (see list below). 425 | 426 | If you have the package `dired-filter`, you can additionally filter 427 | the subtrees with global or local filters. 428 | 429 | A demo of basic functionality is available on youtube: 430 | https://www.youtube.com/watch?v=z26b8HKFsNE 431 | 432 | ### Interactive functions 433 | 434 | Here's a list of available interactive functions. You can read 435 | more about each one by using the built-in documentation facilities 436 | of emacs. It is adviced to place bindings for these into a 437 | convenient prefix key map, for example `C-,` 438 | 439 | * `dired-subtree-insert` 440 | * `dired-subtree-remove` 441 | * `dired-subtree-toggle` 442 | * `dired-subtree-cycle` 443 | * `dired-subtree-revert` 444 | * `dired-subtree-narrow` 445 | * `dired-subtree-up` 446 | * `dired-subtree-down` 447 | * `dired-subtree-next-sibling` 448 | * `dired-subtree-previous-sibling` 449 | * `dired-subtree-beginning` 450 | * `dired-subtree-end` 451 | * `dired-subtree-mark-subtree` 452 | * `dired-subtree-unmark-subtree` 453 | * `dired-subtree-only-this-file` 454 | * `dired-subtree-only-this-directory` 455 | 456 | If you have package `dired-filter`, additional command 457 | `dired-subtree-apply-filter` is available. 458 | 459 | ## dired-ranger 460 | 461 | This package implements useful features present in the 462 | [ranger](http://ranger.github.io/) file manager which are missing 463 | in dired. 464 | 465 | ### Multi-stage copy/pasting of files 466 | 467 | A feature present in most orthodox file managers is a "two-stage" 468 | copy/paste process. Roughly, the user first selects some files, 469 | "copies" them into a clipboard and then pastes them to the target 470 | location. This workflow is missing in dired. 471 | 472 | In dired, user first marks the files, then issues the 473 | `dired-do-copy` command which prompts for the destination. The 474 | files are then copied there. The `dired-dwim-target` option makes 475 | this a bit friendlier---if two dired windows are opened, the other 476 | one is automatically the default target. 477 | 478 | With the multi-stage operations, you can gather files from 479 | *multiple* dired buffers into a single "clipboard", then copy or 480 | move all of them to the target location. Another huge advantage is 481 | that if the target dired buffer is already opened, switching to it 482 | via ido or ibuffer is often faster than selecting the path. 483 | 484 | Call `dired-ranger-copy` to add marked files (or the file under 485 | point if no files are marked) to the "clipboard". With non-nil 486 | prefix argument, add the marked files to the current clipboard. 487 | 488 | Past clipboards are stored in `dired-ranger-copy-ring` so you can 489 | repeat the past pastes. 490 | 491 | Call `dired-ranger-paste` or `dired-ranger-move` to copy or move 492 | the files in the current clipboard to the current dired buffer. 493 | With raw prefix argument (usually C-u), the clipboard is not 494 | cleared, so you can repeat the copy operation in another dired 495 | buffer. 496 | 497 | ### Bookmarks 498 | 499 | Use `dired-ranger-bookmark` to bookmark current dired buffer. You 500 | can later quickly revisit it by calling 501 | `dired-ranger-bookmark-visit`. 502 | 503 | A bookmark name is any single character, letter, digit or a symbol. 504 | 505 | A special bookmark with name `dired-ranger-bookmark-LRU` represents 506 | the least recently used dired buffer. Its default value is \`. If 507 | you bind `dired-ranger-bookmark-visit` to the same keybinding, 508 | hitting \`\` will instantly bring you to the previously used dired 509 | buffer. This can be used to toggle between two dired buffers in a 510 | very fast way. 511 | 512 | These bookmarks are not persistent. If you want persistent 513 | bookmarks use the bookmarks provided by emacs, see (info "(emacs) 514 | Bookmarks"). 515 | 516 | ## dired-narrow 517 | 518 | This package provides live filtering of files in dired buffers. In 519 | general, after calling the respective narrowing function you type a 520 | filter string into the minibuffer. After each change the changes 521 | automatically reflect in the buffer. Typing C-g will cancel the 522 | narrowing and restore the original view, typing RET will exit the live 523 | filtering mode and leave the dired buffer in the narrowed state. To 524 | bring it back to the original view, you can call `revert-buffer` 525 | (usually bound to g). 526 | 527 | During the filtering process, several special functions are available. 528 | You can customize the binding by changing `dired-narrow-map`. 529 | 530 | * `dired-narrow-next-file` (\ or C-n) - move the point to the next file 531 | * `dired-narrow-previous-file` (\ or C-p) - move the point to the previous 532 | file 533 | * `dired-narrow-enter-directory` (\ or C-j) - descend into 534 | the directory under point and immediately go back to narrowing mode 535 | 536 | You can customize what happens after exiting the live filtering mode 537 | by customizing `dired-narrow-exit-action`. 538 | `dired-narrow-exit-action` may be executed automatically, 539 | when there is only one file left while narrowing. 540 | In order to enable this feature, add `(setq dired-narrow-exit-when-1-left t)` to your config. 541 | It makes sense when you use find-file as your exit action, e.g. 542 | `(setq dired-narrow-exit-action 'dired-narrow-find-file)`. 543 | A chosen file will be quickly highlighted before executing `dired-narrow-exit-action`. 544 | This behavior is controlled by variables `dired-narrow-enable-blinking`, 545 | `dired-narrow-blink-time` and by a face `dired-narrow-blink`. 546 | 547 | 548 | These narrowing functions are provided: 549 | 550 | * `dired-narrow` 551 | * `dired-narrow-regexp` 552 | * `dired-narrow-fuzzy` 553 | 554 | You can also create your own narrowing functions quite easily. To 555 | define new narrowing function, use `dired-narrow--internal` and 556 | pass it an apropriate filter. The filter should take one argument 557 | which is the filter string from the minibuffer. It is then called 558 | at each line that describes a file with point at the beginning of 559 | the file name. If the filter returns nil, the file is removed from 560 | the view. As an inspiration, look at the built-in functions 561 | mentioned above. 562 | 563 | ## dired-list 564 | 565 | Produce a file listing with a shell incantation and make a dired 566 | out of it! 567 | 568 | This package provides one principal function, `dired-list` which 569 | can be used to produce dired buffers from shell programs outputing 570 | text roughly in the format of `la -ls`. 571 | 572 | For most standard output formats the default filter and sentinel 573 | should work, but you can also provide your own if the situation 574 | requires it. 575 | 576 | Most of the time you can pipe a zero-delimited list of files to `ls` 577 | through `xargs(1)` using 578 | 579 | | xargs -I '{}' -0 ls -l '{}' 580 | 581 | which creates a compatible listing. For more information read the 582 | documentation of `dired-list`, for example by invoking 583 | 584 | C-h f dired-list RET 585 | 586 | in emacs. 587 | 588 | In addition to the generic interface this package implements common 589 | listings (patches and extensions welcome!), these are: 590 | 591 | * `dired-list-mpc` 592 | * `dired-list-git-ls-files` 593 | * `dired-list-hg-locate` 594 | * `dired-list-locate` 595 | * `dired-list-find-file` 596 | * `dired-list-find-name` 597 | * `dired-list-grep` 598 | 599 | ## dired-collapse 600 | 601 | Often times we find ourselves in a situation where a single file 602 | or directory is nested in a chain of nested directories with no 603 | other content. This is sometimes due to various mandatory 604 | layouts demanded by packaging tools or tools generating these 605 | deeply-nested "unique" paths to disambiguate architectures or 606 | versions (but we often use only one anyway). If the user wants 607 | to access these directories they have to quite needlessly 608 | drill-down through varying number of "uninteresting" directories 609 | to get to the content. 610 | 611 | This minor mode is in main inspired by how GitHub renders these 612 | paths: if there is a chain of directories where each one only has 613 | one child, they are concatenated together and shown on the first 614 | level in this collapsed form. When the user clicks this 615 | collapsed directory they are immediately brought to the deepest 616 | directory with some actual content. 617 | 618 | To enable or disable this functionality use `dired-collapse-mode` to 619 | toggle it for the current dired buffer. To enable the mode globally 620 | in all dired buffers, use `global-dired-collapse-mode`. 621 | 622 | If the deepest directory contains only a single file this file is 623 | displayed instead of the last directory. This way we can get 624 | directly to the file itself. This is often helpful with config 625 | files which are stored in their own directories, for example in 626 | `~/.config/foo/config` and similar situations. 627 | 628 | The files or directories re-inserted in this manner will also 629 | have updated permissions, file sizes and modification dates so 630 | they truly correspond to the properties of the file being shown. 631 | 632 | The path to the deepest file is dimmed with the 633 | `dired-collapse-shadow` face so that it does not distract but at the 634 | same time is still available for inspection. 635 | 636 | The mode is integrated with `dired-rainbow` so the nested files 637 | are properly colored according to user's rules. 638 | 639 | The directory without collapsed path might look something like this: 640 | 641 | ![before](http://i.imgur.com/Xje5Nmo.png) 642 | 643 | After collapsing: 644 | 645 | ![after](http://i.imgur.com/mm6gFbX.png) 646 | -------------------------------------------------------------------------------- /dired-avfs.el: -------------------------------------------------------------------------------- 1 | ;;; dired-avfs.el --- AVFS support for dired 2 | 3 | ;; Copyright (C) 2014 Matus Goljer 4 | 5 | ;; Author: Matus Goljer 6 | ;; Maintainer: Matus Goljer 7 | ;; Keywords: files 8 | ;; Version: 0.0.1 9 | ;; Created: 14th February 2014 10 | ;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1") (emacs "24")) 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Adds AVFS (http://avf.sourceforge.net/) support for seamless archive 29 | ;; browsing. This extension therefore depends on the presence of `avfsd' 30 | ;; on your system. In debian-derived distributions you can usually do 31 | ;; 32 | ;; apt-get install avfs 33 | ;; 34 | ;; `avfs' is probably also available for Mac OS. You're out of luck on 35 | ;; Windows, sorry. 36 | 37 | ;; Once the daemon is installed, run it with `mountavfs' and everything 38 | ;; "Should Just Work^TM". 39 | 40 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection. 41 | 42 | ;;; Code: 43 | 44 | (require 'dired-hacks-utils) 45 | (require 'dash) 46 | 47 | (defgroup dired-avfs () 48 | "AVFS support for dired." 49 | :group 'dired-hacks 50 | :prefix "dired-avfs-") 51 | 52 | (defcustom dired-avfs-root "~/.avfs" 53 | "Root where the avfs virtual filesystem is mounted." 54 | :type 'directory 55 | :group 'dired-avfs) 56 | 57 | (defcustom dired-avfs-archives 58 | '("zip" "rar" "tar" "tar.gz" "tgz" "tar.bz2" "tb2" "tbz2" "tar.xz" "txz" "tar.zst" "7z") 59 | "Archives that are automagically opened via avfs." 60 | :type '(repeat string) 61 | :group 'dired-avfs) 62 | 63 | (defcustom dired-avfs-hide-root t 64 | "If non-nil, hide the avfs root in dired listing." 65 | :type 'boolean 66 | :group 'dired-avfs) 67 | 68 | (defcustom dired-avfs-ignore-commands nil 69 | "Do not open a file via avfs if it was opened using this command. 70 | 71 | For example, this allows the user to open files via avfs from 72 | dired, but not from `find-file'." 73 | :type '(repeat function) 74 | :group 'dired-avfs) 75 | 76 | (defcustom dired-avfs-file-size-threshold 100 77 | "Ask before opening files if their size exceeds this setting. 78 | 79 | The value is in megabytes." 80 | :type 'number 81 | :group 'dired-avfs) 82 | 83 | (defun dired-avfs--archive-filename (filename) 84 | "Transform FILENAME into corresponding avfs filename." 85 | (file-truename (concat dired-avfs-root (file-truename filename) "#"))) 86 | 87 | (defun dired-avfs--archive-p (filename) 88 | "Non-nil if FILENAME should be opened in avfs." 89 | (let ((extensions (concat "\\." (regexp-opt dired-avfs-archives) "\\'"))) 90 | (string-match-p extensions filename))) 91 | 92 | (defun dired-avfs--open (filename) 93 | "Open FILENAME as avfs filename." 94 | (find-file (dired-avfs--archive-filename filename))) 95 | 96 | (defun dired-avfs--hide-root () 97 | "Remove the avfs root prefix from the dired header." 98 | (save-excursion 99 | (when dired-avfs-hide-root 100 | (goto-char (point-min)) 101 | (when (search-forward (file-truename dired-avfs-root) nil t) 102 | (let ((inhibit-read-only t)) 103 | (put-text-property (match-beginning 0) (match-end 0) 'invisible t)))))) 104 | 105 | (add-hook 'dired-after-readin-hook 'dired-avfs--hide-root) 106 | 107 | (defun dired-avfs-open () 108 | "Open file at point using avfs." 109 | (interactive) 110 | (dired-avfs--open (dired-file-name-at-point))) 111 | 112 | (defadvice find-file-noselect (before fix-avfs-arguments activate) 113 | "Change target filename to avfs-compatible filename. 114 | 115 | If the target is archive that can be handled via avfs, 116 | automagically change the filename to the location of virtual 117 | directory representing this archive." 118 | (when (and (not (memq this-command dired-avfs-ignore-commands)) 119 | (or (not (featurep 'tramp)) 120 | (not (tramp-tramp-file-p (ad-get-arg 0)))) 121 | (dired-avfs--archive-p (ad-get-arg 0)) 122 | (if (> (nth 7 (file-attributes (ad-get-arg 0))) (* dired-avfs-file-size-threshold 1048576)) 123 | (y-or-n-p (format "Size of this file exceeds `dired-avfs-file-size-threshold' (%d MB), extracting the information might take very long time. Do you want to continue?" 124 | dired-avfs-file-size-threshold)) 125 | t)) 126 | (ad-set-arg 0 (dired-avfs--archive-filename (ad-get-arg 0))))) 127 | 128 | (provide 'dired-avfs) 129 | 130 | ;;; dired-avfs.el ends here 131 | -------------------------------------------------------------------------------- /dired-collapse.el: -------------------------------------------------------------------------------- 1 | ;;; dired-collapse.el --- Collapse unique nested paths in dired listing -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2017 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 1.1.0 8 | ;; Created: 15th July 2017 9 | ;; Package-Requires: ((f "0.19.0") (s "1.13.1") (dired-hacks-utils "0.0.1") (emacs "24")) 10 | ;; Keywords: files 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 15 | ;; as published by the Free Software Foundation; either version 3 16 | ;; of the License, or (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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Often times we find ourselves in a situation where a single file 29 | ;; or directory is nested in a chain of nested directories with no 30 | ;; other content. This is sometimes due to various mandatory 31 | ;; layouts demanded by packaging tools or tools generating these 32 | ;; deeply-nested "unique" paths to disambiguate architectures or 33 | ;; versions (but we often use only one anyway). If the user wants 34 | ;; to access these directories they have to quite needlessly 35 | ;; drill-down through varying number of "uninteresting" directories 36 | ;; to get to the content. 37 | 38 | ;; This minor mode is in main inspired by how GitHub renders these 39 | ;; paths: if there is a chain of directories where each one only has 40 | ;; one child, they are concatenated together and shown on the first 41 | ;; level in this collapsed form. When the user clicks this 42 | ;; collapsed directory they are immediately brought to the deepest 43 | ;; directory with some actual content. 44 | 45 | ;; To enable or disable this functionality use `dired-collapse-mode' 46 | ;; to toggle it for the current dired buffer. To enable the mode 47 | ;; globally in all dired buffers, use `global-dired-collapse-mode'. 48 | 49 | ;; If the deepest directory contains only a single file this file is 50 | ;; displayed instead of the last directory. This way we can get 51 | ;; directly to the file itself. This is often helpful with config 52 | ;; files which are stored in their own directories, for example in 53 | ;; `~/.config/foo/config' and similar situations. 54 | 55 | ;; The files or directories re-inserted in this manner will also 56 | ;; have updated permissions, file sizes and modification dates so 57 | ;; they truly correspond to the properties of the file being shown. 58 | 59 | ;; The path to the deepest file is dimmed with the 60 | ;; `dired-collapse-shadow' face so that it does not distract but at 61 | ;; the same time is still available for inspection. 62 | 63 | ;; The mode is integrated with `dired-rainbow' so the nested files 64 | ;; are properly colored according to user's rules. 65 | 66 | ;;; Code: 67 | 68 | (require 'dired) 69 | (require 'f) 70 | (require 'dired-hacks-utils) 71 | (require 's) ; for s-chop-prefix 72 | 73 | (defgroup dired-collapse () 74 | "Collapse unique nested paths in dired listing." 75 | :group 'dired-hacks 76 | :prefix "dired-collapse-") 77 | 78 | (defcustom dired-collapse-remote nil 79 | "If non-nil, enable `dired-collapse' in remote (TRAMP) buffers." 80 | :type 'boolean 81 | :group 'dired-collapse) 82 | 83 | (defcustom dired-collapse-fontify t 84 | "If non-nil, fontify with a shaded overlay." 85 | :type 'boolean 86 | :group 'dired-collapse) 87 | 88 | (defface dired-collapse-shadow 89 | '((t :inherit shadow)) 90 | "Face for the shadow overlay." 91 | :group 'dired-collapse) 92 | 93 | ;;;###autoload 94 | (define-minor-mode dired-collapse-mode 95 | "Toggle collapsing of unique nested paths in Dired." 96 | :group 'dired-collapse 97 | :lighter "" 98 | (if dired-collapse-mode 99 | (progn 100 | (add-hook 'dired-after-readin-hook 'dired-collapse 'append 'local) 101 | (add-hook 'dired-subtree-after-insert-hook 'dired-collapse 'append 'local) 102 | (add-hook 'dired-omit-mode-hook 'dired-collapse 'append 'local) 103 | ;; collapse the buffer only if it is not empty (= we haven't 104 | ;; yet read in the current directory) 105 | (unless (= (buffer-size) 0) 106 | (dired-collapse))) 107 | (remove-hook 'dired-after-readin-hook 'dired-collapse 'local) 108 | (remove-hook 'dired-subtree-after-insert-hook 'dired-collapse 'local) 109 | (remove-hook 'dired-omit-mode-hook 'dired-collapse 'local) 110 | (revert-buffer))) 111 | 112 | (defun turn-on-dired-collapse-mode () 113 | (when (derived-mode-p 'dired-mode) 114 | (dired-collapse-mode))) 115 | 116 | (define-globalized-minor-mode global-dired-collapse-mode 117 | dired-collapse-mode 118 | turn-on-dired-collapse-mode 119 | :group 'dired-collapse) 120 | 121 | (defun dired-collapse--replace-file (file) 122 | "Replace file on the current line with FILE." 123 | (delete-region (line-beginning-position) (1+ (line-end-position))) 124 | (insert " ") 125 | (insert-directory file dired-listing-switches nil nil) 126 | (forward-line -1) 127 | (dired-align-file (line-beginning-position) (1+ (line-end-position))) 128 | (when-let (replaced-file (dired-utils-get-filename)) 129 | (when (file-remote-p replaced-file) 130 | (while (search-forward (dired-current-directory) (line-end-position) t) 131 | (replace-match ""))))) 132 | 133 | (defun dired-collapse--create-ov (&optional to-eol) 134 | "Create the shadow overlay which marks the collapsed path. 135 | 136 | To customize the face properties, theme the 137 | `dired-collapse-shadow' face. 138 | 139 | If TO-EOL is non-nil, extend the overlay over the whole 140 | filename (for example when the final directory is empty)." 141 | (save-excursion 142 | (dired-move-to-filename) 143 | (let* ((beg (point)) 144 | (end (save-excursion 145 | (dired-move-to-end-of-filename) 146 | (if to-eol 147 | (point) 148 | (1+ (search-backward "/"))))) 149 | (ov (make-overlay beg end))) 150 | (overlay-put ov 'face 'dired-collapse-shadow) 151 | ov))) 152 | 153 | (defun dired-collapse () 154 | "Collapse unique nested paths in dired listing." 155 | (when (or (not (file-remote-p default-directory)) dired-collapse-remote) 156 | (let (;; dired-hide-details-mode hides details by assigning a 157 | ;; special invisibility text property to them, while 158 | ;; dired-collapse requires all the details. So we disable 159 | ;; invisibility here temporarily. 160 | (buffer-invisibility-spec nil) 161 | (inhibit-read-only t) 162 | (rgx (and (bound-and-true-p dired-omit-mode) (dired-omit-regexp)))) 163 | (save-excursion 164 | (goto-char (point-min)) 165 | (while (not (eobp)) 166 | (when-let ((filename-no-dir (dired-utils-get-filename 'no-dir))) 167 | (when (and (looking-at-p dired-re-dir) 168 | (not (member filename-no-dir (list "." ".."))) 169 | (not (eolp))) 170 | (let ((path (dired-utils-get-filename)) 171 | files) 172 | (while (and (file-directory-p path) 173 | (file-accessible-directory-p path) 174 | (f-readable? path) 175 | (setq files (f-entries path)) 176 | (or (not (bound-and-true-p dired-omit-mode)) 177 | (setq files (cl-remove-if 178 | (lambda(f) 179 | (string-match rgx (file-name-nondirectory f))) 180 | files))) 181 | (= 1 (length files))) 182 | (setq path (car files))) 183 | (if (and (not files) 184 | (equal path (dired-utils-get-filename))) 185 | (when dired-collapse-fontify 186 | (dired-collapse--create-ov 'to-eol)) 187 | (setq path (s-chop-prefix (dired-current-directory) path)) 188 | (when (string-match-p "/" path) 189 | (let ((default-directory (dired-current-directory))) 190 | (dired-collapse--replace-file path)) 191 | (dired-insert-set-properties (line-beginning-position) (line-end-position)) 192 | (when dired-collapse-fontify 193 | (dired-collapse--create-ov (= 0 (length files))))))))) 194 | (forward-line 1)))))) 195 | 196 | (provide 'dired-collapse) 197 | ;;; dired-collapse.el ends here 198 | -------------------------------------------------------------------------------- /dired-columns.el: -------------------------------------------------------------------------------- 1 | (require 's) 2 | (require 'dash) 3 | 4 | (defvar dired-columns-list '(name-only ext size date)) 5 | (defvar dired-columns-name-columns '(name name-only)) 6 | (defvar dired-columns-name-column-width 40) 7 | 8 | 9 | ;;; extractors 10 | (defvar dired-columns-permissions-regexp " \\([dl-][rwx-]\\{9\\}\\)" 11 | "Regexp matching permissions column.") 12 | 13 | (defvar dired-columns-user-regexp " [dl-][rwx-]\\{9\\} \\(.*?\\) " 14 | "Regexp matching user column.") 15 | 16 | (defvar dired-columns-group-regexp " [dl-][rwx-]\\{9\\} \\(?:.*?\\)[ ]+\\(.*?\\) " 17 | "Regexp matching group column.") 18 | 19 | (defvar dired-columns-size-regexp " [dl-][rwx-]\\{9\\} \\(?:.*?\\)[ ]+\\(?:.*?\\)[ ]+\\(.*?\\) " 20 | "Regexp matching size column.") 21 | 22 | (defvar dired-columns-date-regexp" [dl-][rwx-]\\{9\\} \\(?:.*?\\)[ ]+\\(?:.*?\\)[ ]+\\(?:.*?\\) \\(............\\) " 23 | "Regexp matching date column.") 24 | 25 | (defun dired-columns--regexp-extractor (regexp) 26 | (save-excursion 27 | (when (re-search-forward regexp nil t) 28 | (match-string 1)))) 29 | 30 | (defun dired-columns--name-extractor () 31 | (dired-get-filename)) 32 | 33 | (defun dired-columns--name-only-extractor () 34 | (-when-let (name (dired-get-filename 'no-dir)) 35 | (if (file-directory-p name) 36 | name 37 | (if (string-match "\\`\\([^.].*\\)\\.\\(.*\\)\\'" name) 38 | (match-string 1 name) 39 | name)))) 40 | 41 | (defun dired-columns--ext-extractor () 42 | (save-excursion 43 | (-when-let (name (dired-get-filename 'no-dir)) 44 | (if (file-directory-p name) 45 | nil 46 | (let* ((bofn (progn 47 | (dired-move-to-filename) 48 | (point))) 49 | (eofn (dired-move-to-end-of-filename)) 50 | (bext (--if-let (search-backward "." bofn t) 51 | ;; if there's no extension, we shouldn't hide the filename 52 | (if (= it bofn) eofn it) 53 | eofn))) 54 | (when (/= eofn bext) 55 | (buffer-substring (1+ bext) eofn))))))) 56 | 57 | (defun dired-columns--size-extractor () 58 | (dired-columns--regexp-extractor dired-columns-size-regexp)) 59 | 60 | (defun dired-columns--date-extractor () 61 | (dired-columns--regexp-extractor dired-columns-date-regexp)) 62 | 63 | (defun dired-columns--collect () 64 | "Collect all the columns on current line. 65 | 66 | The columns are picked according to `dired-columns-list'." 67 | (--map 68 | (let ((extractor (intern (format "dired-columns--%s-extractor" it)))) 69 | (funcall extractor)) 70 | dired-columns-list)) 71 | 72 | 73 | ;;; formatters 74 | 75 | (defun dired-columns--name-formatter (value) 76 | (s-pad-right 60 " " value)) 77 | 78 | (defun dired-columns--name-only-formatter (value) 79 | (s-pad-right 60 " " value)) 80 | 81 | (defun dired-columns--ext-formatter (value) 82 | (s-pad-right 5 " " value)) 83 | 84 | (defun dired-columns--size-formatter (value) 85 | (s-pad-left 8 " " value)) 86 | 87 | (defun dired-columns--date-formatter (value) 88 | (concat " " value)) 89 | 90 | (defun dired-columns--replace-lines () 91 | (let* ((parts (--split-with (not (memq it dired-columns-name-columns)) dired-columns-list)) 92 | (name-only (memq 'name-only dired-columns-list)) 93 | (front (car parts)) 94 | (back (cdadr parts)) 95 | (front-func (--map (cons (intern (format "dired-columns--%s-extractor" it)) 96 | (intern (format "dired-columns--%s-formatter" it))) front)) 97 | (back-func (--map (cons (intern (format "dired-columns--%s-extractor" it)) 98 | (intern (format "dired-columns--%s-formatter" it))) back))) 99 | (let ((inhibit-read-only t)) 100 | (while (= (forward-line) 0) 101 | (ignore-errors 102 | (let* ((line (dired-columns--replace-line front-func back-func)) 103 | (is-dir (file-directory-p (dired-get-filename))) 104 | (bofn (save-excursion (dired-move-to-filename) (point))) 105 | (eofn (save-excursion (dired-move-to-filename) (dired-move-to-end-of-filename) (point))) 106 | (bext (if is-dir eofn 107 | (save-excursion 108 | (dired-move-to-filename) 109 | (dired-move-to-end-of-filename) 110 | (--if-let (search-backward "." bofn t) 111 | ;; if there's no extension, we shouldn't hide the filename 112 | (if (= it bofn) eofn it) 113 | eofn)))) 114 | (fn-length (- bext bofn)) 115 | (after-start (if (and name-only 116 | (/= bext eofn) 117 | (not is-dir)) 118 | bext 119 | (save-excursion 120 | (dired-move-to-filename) 121 | (dired-move-to-end-of-filename) 122 | (insert " ") 123 | (point)))) 124 | (after-end eofn)) 125 | (put-text-property 126 | (+ 2 (line-beginning-position)) 127 | bofn 128 | 'display 129 | (car line)) 130 | (put-text-property 131 | (min after-start after-end) 132 | (max after-start after-end) 133 | 'display 134 | (concat (make-string (max (- dired-columns-name-column-width fn-length)) ? ) (cdr line))))))))) 135 | 136 | (defun dired-columns--replace-line (front-func back-func) 137 | (let ((columns-front (--map (funcall (cdr it) (funcall (car it))) front-func)) 138 | (columns-back (--map (funcall (cdr it) (funcall (car it))) back-func))) 139 | (cons (apply 'concat columns-front) 140 | (apply 'concat columns-back)))) 141 | -------------------------------------------------------------------------------- /dired-hacks-utils.el: -------------------------------------------------------------------------------- 1 | ;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Keywords: files 8 | ;; Version: 0.0.1 9 | ;; Created: 14th February 2014 10 | ;; Package-Requires: ((dash "2.5.0") (emacs "24.3")) 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Utilities and helpers for `dired-hacks' collection of dired 29 | ;; improvements. 30 | 31 | ;; This package also provides these interactive functions: 32 | ;; * `dired-hacks-next-file' - go to next file, skipping empty and non-file lines 33 | ;; * `dired-hacks-previous-file' - go to previous file, skipping empty 34 | ;; and non-file lines 35 | ;; * `dired-utils-format-information-line-mode' - Format the information 36 | ;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576). 37 | 38 | 39 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection 40 | 41 | ;;; Code: 42 | 43 | (require 'dash) 44 | (require 'dired) 45 | (require 'dired-aux) ;; for dired-dwim-target-directory 46 | 47 | (defgroup dired-hacks () 48 | "Collection of useful dired additions." 49 | :group 'dired 50 | :prefix "dired-hacks-") 51 | 52 | (defcustom dired-hacks-file-size-formatter #'file-size-human-readable 53 | "The function used to format file sizes. 54 | 55 | See `dired-utils-format-file-sizes'." 56 | :type 'function 57 | :group 'dired-hacks) 58 | 59 | (defcustom dired-hacks-datetime-regexp 60 | "\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)" 61 | "A regexp matching the date/time in the dired listing. 62 | 63 | It is used to determine where the filename starts. It should 64 | *not* match any characters after the last character of the 65 | timestamp. It is assumed that the timestamp is preceded and 66 | followed by at least one space character. You should only use 67 | shy groups (prefixed with ?:) because the first group is used by 68 | the font-lock to determine what portion of the name should be 69 | colored." 70 | :type 'regexp 71 | :group 'dired-hacks) 72 | 73 | (defalias 'dired-utils--string-trim 74 | (if (and (require 'subr-x nil t) 75 | (fboundp 'string-trim)) 76 | #'string-trim 77 | (lambda (string) 78 | (let ((s string)) 79 | (when (string-match "\\`[ \t\n\r]+" s) 80 | (setq s (replace-match "" t t s))) 81 | (when (string-match "[ \t\n\r]+\\'" s) 82 | (setq s (replace-match "" t t s))) 83 | s))) 84 | "Trim STRING of trailing whitespace. 85 | 86 | \(fn STRING)") 87 | 88 | (defun dired-utils-get-filename (&optional localp) 89 | "Like `dired-get-filename' but never signal an error. 90 | 91 | Optional arg LOCALP with value `no-dir' means don't include 92 | directory name in result." 93 | (dired-get-filename localp t)) 94 | 95 | (defun dired-utils-get-all-files (&optional localp) 96 | "Return all files in this dired buffer as a list. 97 | 98 | LOCALP has same semantics as in `dired-get-filename'." 99 | (save-excursion 100 | (goto-char (point-min)) 101 | (let (r) 102 | (while (= 0 (forward-line)) 103 | (--when-let (dired-utils-get-filename localp) 104 | (push it r))) 105 | (nreverse r)))) 106 | 107 | (defconst dired-utils-file-attributes-keywords 108 | '(:isdir :nlinks :uid :gid :atime :mtime :ctime :size :modes :gidchg :inode :devnum) 109 | "List of keywords to map with `file-attributes'.") 110 | 111 | (defconst dired-utils-info-keywords 112 | `(:name :issym :target ,@dired-utils-file-attributes-keywords) 113 | "List of keywords available for `dired-utils-get-info'.") 114 | 115 | (defun dired-utils--get-keyword-info (keyword) 116 | "Get file information about KEYWORD." 117 | (let ((filename (dired-utils-get-filename))) 118 | (cl-case keyword 119 | (:name filename) 120 | (:isdir (file-directory-p filename)) 121 | (:issym (and (file-symlink-p filename) t)) 122 | (:target (file-symlink-p filename)) 123 | (t 124 | (nth (-elem-index keyword dired-utils-file-attributes-keywords) 125 | (file-attributes filename)))))) 126 | 127 | (defun dired-utils-get-info (&rest keywords) 128 | "Query for info about the file at point. 129 | 130 | KEYWORDS is a list of attributes to query. 131 | 132 | When querying for one attribute, its value is returned. When 133 | querying for more than one, a list of results is returned. 134 | 135 | The available keywords are listed in 136 | `dired-utils-info-keywords'." 137 | (let ((attributes (mapcar 'dired-utils--get-keyword-info keywords))) 138 | (if (> (length attributes) 1) 139 | attributes 140 | (car attributes)))) 141 | 142 | (defun dired-utils-goto-line (filename) 143 | "Go to line describing FILENAME in listing. 144 | 145 | Should be absolute file name matched against 146 | `dired-get-filename'." 147 | (goto-char (point-min)) 148 | (let (stop) 149 | (while (and (not stop) 150 | (= (forward-line) 0)) 151 | (when (equal filename (dired-utils-get-filename)) 152 | (setq stop t) 153 | (dired-move-to-filename))) 154 | stop)) 155 | 156 | (defun dired-utils-match-filename-regexp (filename alist) 157 | "Match FILENAME against each car in ALIST and return first matched cons. 158 | 159 | Each car in ALIST is a regular expression. 160 | 161 | The matching is done using `string-match-p'." 162 | (let (match) 163 | (--each-while alist (not match) 164 | (when (string-match-p (car it) filename) 165 | (setq match it))) 166 | match)) 167 | 168 | (defun dired-utils-match-filename-extension (filename alist) 169 | "Match FILENAME against each car in ALIST and return first matched cons. 170 | 171 | Each car in ALIST is a string representing file extension 172 | *without* the delimiting dot." 173 | (let (done) 174 | (--each-while alist (not done) 175 | (when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") filename) 176 | (setq done it))) 177 | done)) 178 | 179 | (defun dired-utils-format-information-line () 180 | "Format the disk space on the Dired information line." 181 | (save-excursion 182 | (goto-char (point-min)) 183 | (forward-line) 184 | (let ((inhibit-read-only t) 185 | (limit (line-end-position))) 186 | (while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+$\\>\\)" nil t) 187 | (replace-match 188 | (save-match-data 189 | (propertize (dired-utils--string-trim 190 | (funcall dired-hacks-file-size-formatter 191 | (* 1024 (string-to-number (match-string 1))) t)) 192 | 'invisible 'dired-hide-details-information)) 193 | t nil nil 1))))) 194 | 195 | 196 | ;;; Predicates 197 | (defun dired-utils-is-file-p () 198 | "Return non-nil if the line at point is a file or a directory." 199 | (dired-utils-get-filename 'no-dir)) 200 | 201 | (defun dired-utils-is-dir-p () 202 | "Return non-nil if the line at point is a directory." 203 | (--when-let (dired-utils-get-filename) 204 | (file-directory-p it))) 205 | 206 | 207 | ;;; Interactive 208 | ;; TODO: add wrap-around option 209 | (defun dired-hacks-next-file (&optional arg) 210 | "Move point to the next file. 211 | 212 | Optional prefix ARG says how many lines to move; default is one 213 | line." 214 | (interactive "p") 215 | (unless arg (setq arg 1)) 216 | (if (< arg 0) 217 | (dired-hacks-previous-file (- arg)) 218 | (--dotimes arg 219 | (forward-line) 220 | (while (and (or (not (dired-utils-is-file-p)) 221 | (get-text-property (point) 'invisible)) 222 | (= (forward-line) 0)))) 223 | (if (not (= (point) (point-max))) 224 | (dired-move-to-filename) 225 | (forward-line -1) 226 | (dired-move-to-filename) 227 | nil))) 228 | 229 | (defun dired-hacks-previous-file (&optional arg) 230 | "Move point to the previous file. 231 | 232 | Optional prefix ARG says how many lines to move; default is one 233 | line." 234 | (interactive "p") 235 | (unless arg (setq arg 1)) 236 | (if (< arg 0) 237 | (dired-hacks-next-file (- arg)) 238 | (--dotimes arg 239 | (forward-line -1) 240 | (while (and (or (not (dired-utils-is-file-p)) 241 | (get-text-property (point) 'invisible)) 242 | (= (forward-line -1) 0)))) 243 | (if (not (= (point) (point-min))) 244 | (dired-move-to-filename) 245 | (dired-hacks-next-file) 246 | nil))) 247 | 248 | (defun dired-hacks-compare-files (file-a file-b) 249 | "Test if two files FILE-A and FILE-B are the (probably) the same." 250 | (interactive (let ((other-dir (dired-dwim-target-directory))) 251 | (list (read-file-name "File A: " default-directory (car (dired-get-marked-files)) t) 252 | (read-file-name "File B: " other-dir (with-current-buffer (cdr (assoc other-dir dired-buffers)) 253 | (car (dired-get-marked-files))) t)))) 254 | (let ((md5-a (with-temp-buffer 255 | (shell-command (format "md5sum %s" file-a) (current-buffer)) 256 | (buffer-string))) 257 | (md5-b (with-temp-buffer 258 | (shell-command (format "md5sum %s" file-b) (current-buffer)) 259 | (buffer-string)))) 260 | (message "%s%sFiles are %s." md5-a md5-b 261 | (if (equal (car (split-string md5-a)) 262 | (car (split-string md5-b))) 263 | "probably the same" "different")))) 264 | 265 | (define-minor-mode dired-utils-format-information-line-mode 266 | "Toggle formatting of disk space in the Dired information line." 267 | :group 'dired-utils 268 | :lighter "" 269 | (if dired-utils-format-information-line-mode 270 | (add-hook 'dired-after-readin-hook #'dired-utils-format-information-line) 271 | (remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line))) 272 | 273 | (provide 'dired-hacks-utils) 274 | 275 | ;;; dired-hacks-utils.el ends here 276 | -------------------------------------------------------------------------------- /dired-hacks.el: -------------------------------------------------------------------------------- 1 | ;;; dired-hacks.el --- Collection of useful dired additions 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Keywords: files 8 | ;; Version: 0.0.1 9 | ;; Created: 14th February 2014 10 | ;; Package-Requires: ((dash "2.5.0")) 11 | 12 | ;; This program is free software; you can redistribute it and/or modify 13 | ;; it under the terms of the GNU General Public License as published by 14 | ;; the Free Software Foundation, either version 3 of the License, or 15 | ;; (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;; Collection of useful dired additions. I don't want this to become 28 | ;; another `dired+', so I'm splitting all the functionality into separate 29 | ;; mutually independent packages. All shared functionality and helpers 30 | ;; will be extracted into a single package `dired-hacks-utils', so that 31 | ;; will be the only dependence. 32 | 33 | ;; For information about the individual packages, see README.md, 34 | ;; or https://github.com/Fuco1/dired-hacks. 35 | 36 | ;;; Code: 37 | 38 | (provide 'dired-hacks) 39 | 40 | ;;; dired-hacks.el ends here 41 | -------------------------------------------------------------------------------- /dired-images.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | (require 'dired-hacks-utils) 3 | (require 'dash) 4 | (require 'eimp) 5 | 6 | (require 'image-mode) 7 | 8 | ;; TODO: add operations to 9 | ;; - rotate 10 | ;; - scale 11 | ;; - to original size 12 | ;; - to window size 13 | ;; - +/- given % 14 | 15 | ;; thumb customizes 16 | (defcustom di-thumbs-directory (locate-user-emacs-file ".cache/di/") 17 | "Location where thumbnails are stored." 18 | :type 'directory) 19 | 20 | (defcustom di-thumb-relief 2 21 | "" 22 | :type 'natnum 23 | ) 24 | 25 | (defcustom di-thumb-margin 3 26 | "" 27 | :type 'natnum 28 | ) 29 | 30 | (defcustom di-thumb-width 200 31 | "" 32 | :type 'natnum 33 | ) 34 | 35 | (defcustom di-thumb-height 115 36 | "" 37 | :type 'natnum 38 | ) 39 | 40 | (defcustom di-thumb-track t 41 | "If non-nil, track the selected thumb in corresponding view buffer." 42 | :type 'boolean) 43 | 44 | (defcustom di-header-format "[%c/%t] %f" 45 | "" 46 | :type 'string 47 | ) 48 | (put 'di-header-format 'risky-local-variable t) 49 | 50 | ;; see `format-spec' 51 | 52 | (defvar di-thumb-buffer nil 53 | "Thumb buffer related to this view buffer.") 54 | 55 | (defvar di-view-buffer nil 56 | "View buffer related to this thumb buffer.") 57 | 58 | (defvar di-file-list nil 59 | "List of files displayed in this view buffer. 60 | 61 | This is only meaningful if no thumb buffer is associated.") 62 | 63 | (defvar di-file-list-current 0 64 | "Currently viewed item in this view buffer. 65 | 66 | This is only meaningful if no thumb buffer is associated.") 67 | 68 | (defvar di-active-view-buffer nil 69 | "Active view buffer.") 70 | 71 | (defvar di-active-thumb-buffer nil 72 | "Active thumb buffer.") 73 | 74 | 75 | ;;; misc 76 | (defmacro di-inc (var modulo &optional delta) 77 | (setq delta (or delta 1)) 78 | `(setq ,var (mod (+ ,var ,delta) ,modulo))) 79 | 80 | (defmacro di-dec (var modulo &optional delta) 81 | (setq delta (or delta 1)) 82 | `(setq ,var (mod (- ,var ,delta) ,modulo))) 83 | 84 | 85 | ;;; dealing with windows 86 | (defun di--window-width (&optional window) 87 | "Calculate WINDOW width in pixels. 88 | 89 | Defaults to `frame-selected-window'." 90 | (* (window-width (or window (frame-selected-window))) 91 | (frame-char-width))) 92 | 93 | (defun di--thumbs-per-row (&optional window) 94 | "Return number of thumbs that will fit on a row in WINDOW. 95 | 96 | WINDOW defaults to `frame-selected-window'." 97 | (/ (di--window-width (or window (frame-selected-window))) 98 | (+ (* 2 di-thumb-relief) 99 | (* 2 di-thumb-margin) 100 | di-thumb-width))) 101 | 102 | 103 | ;;; dealing with file names/paths 104 | (defun di--thumbs-directory () 105 | "Return the current thumbnails directory. 106 | 107 | Create the thumbnails directory if it does not exist. 108 | 109 | This function sanitizes the variable `di-thumbs-directory'." 110 | (let ((dir (file-name-as-directory 111 | (expand-file-name di-thumbs-directory)))) 112 | (unless (file-directory-p dir) 113 | (make-directory dir t) 114 | (message "Creating thumbnails directory...")) 115 | dir)) 116 | 117 | ;; TODO this should go to /tmp/ 118 | (defun di--temp-file (&optional buffer) 119 | "Return the location of temp file for a view buffer. 120 | 121 | Optional argument BUFFER is a view buffer, otherwise default to 122 | the active one." 123 | (concat (di--thumbs-directory) ".di-temp-" (buffer-name (or buffer di-active-view-buffer)))) 124 | 125 | ;; TODO: add optional dimensions of the thumb 126 | (defun di--thumb-name (file) 127 | "Return the thumb filename for this FILE." 128 | (file-truename 129 | (concat (di--thumbs-directory) 130 | (replace-regexp-in-string 131 | (if (eq system-type 'windows-nt) "\\" "/") 132 | "!" file)))) 133 | 134 | 135 | ;;; dealing with images 136 | (defun di--image-spec (file) 137 | `(image :file ,file 138 | :type ,(image-type file))) 139 | 140 | (defun di--insert-image (file &optional relief margin) 141 | "Insert image FILE at point. 142 | 143 | RELIEF and MARGIN specify the image properties. See also 144 | `create-image'." 145 | (let ((i `(image :type ,(image-type file) 146 | :file ,file 147 | :relief ,(or relief 0) 148 | :margin ,(or margin 0)))) 149 | (insert-image i))) 150 | 151 | (defun di--resize-image (in-file out-file width height) 152 | "Resize IN-FILE to WIDTH and HEIGHT, save to OUT-FILE" 153 | (call-process "convert" nil nil nil "-resize" 154 | (format "%dx%d" width height) 155 | in-file out-file)) 156 | 157 | (defun di--create-fitted-image (file &optional window) 158 | "Resize FILE to fit current view window." 159 | (let* ((edges (window-inside-pixel-edges window)) 160 | (width (- (nth 2 edges) (nth 0 edges))) 161 | (height (- (nth 3 edges) (nth 1 edges)))) 162 | (di--resize-image file (di--temp-file) width height))) 163 | 164 | (defun di--open-image (file &optional window) 165 | "Open FILE as image in current buffer." 166 | ;; TODO: we need to be careful in what window we are 167 | (let ((inhibit-read-only t)) 168 | (di--create-fitted-image file window) 169 | (erase-buffer) 170 | (clear-image-cache) 171 | (di--insert-image (di--temp-file)) 172 | (image-mode-setup-winprops))) 173 | 174 | 175 | ;;; dealing with thumbnails 176 | (defun di--thumb-at-point-p (&optional point) 177 | "Return true if there is a thumb at point. 178 | 179 | If POINT is specified, test this point instead." 180 | (get-text-property (or point (point)) 'di-thumbnail)) 181 | 182 | (defun di--create-thumb (file thumb) 183 | "Create a thumb of FILE and save as THUMB." 184 | (call-process "convert" nil nil nil "-thumbnail" 185 | (format "%dx%d" di-thumb-width di-thumb-height) 186 | file thumb)) 187 | 188 | (defun di--generate-thumbs (files) 189 | "Generate thumbnails for FILES. 190 | 191 | FILES can be a single string describing a file path or a list of 192 | strings describing file paths." 193 | (--each (if (listp files) files (list files)) 194 | (let ((thumb-name (di--thumb-name it))) 195 | (if (and (not (file-exists-p thumb-name)) 196 | (not (= 0 (di--create-thumb it thumb-name)))) 197 | (message "Thumb could not be created for file %s" it))))) 198 | 199 | (defun di--arrange-thumbs (&optional window) 200 | "Arrange thumbs in this view buffer in rows. 201 | 202 | The number of thumbs per row is calculated using 203 | `di--thumbs-per-row'." 204 | (save-excursion 205 | (goto-char (point-min)) 206 | (let ((inhibit-read-only t) 207 | (row (di--thumbs-per-row (or window (frame-selected-window)))) 208 | (count 0)) 209 | (save-excursion (replace-string "\n" "")) 210 | (while (not (eobp)) 211 | (forward-char row) 212 | (unless (eobp) (insert "\n")))))) 213 | 214 | (defun di--insert-thumb (file dired-buffer) 215 | "Insert thumbnail image FILE. 216 | 217 | DIRED-BUFFER is an associated dired buffer." 218 | (let* ((thumb-name (di--thumb-name file)) 219 | (beg (point)) 220 | (size (image-size `(image :file ,thumb-name 221 | :type ,(image-type thumb-name)) t))) 222 | (di--insert-image thumb-name 223 | di-thumb-relief 224 | (cons (+ di-thumb-margin (/ (- di-thumb-width (car size)) 2)) 225 | di-thumb-margin)) 226 | (add-text-properties 227 | beg (point) 228 | (list :di-thumbnail t 229 | :original-file-name file 230 | :dired-buffer dired-buffer 231 | :mouse-face 'highlight)))) 232 | 233 | (defun di--insert-thumbs (files dired-buffer) 234 | "Insert thumbnails of FILES. 235 | 236 | DIRED-BUFFER is an associated dired buffer." 237 | (--each files (di--insert-thumb it dired-buffer))) 238 | 239 | 240 | ;;; interactive/dired 241 | (defun di-display-thumbs (arg) 242 | "Display thumbnails of marked files. 243 | 244 | With prefix argument \\[universal-argument] append to the active thumb buffer instead of 245 | replacing it. 246 | 247 | With prefix argument \\[universal-argument] \\[universal-argument] open a new thumb buffer, 248 | prompting for name." 249 | (interactive "P") 250 | ;; TODO: add dired+ `dired-get-marked-files' support 251 | (let ((marked-files (dired-get-marked-files)) 252 | (buf (if (not (equal arg '(16))) 253 | (di--get-active-thumb-buffer) 254 | (let* ((default (concat "*di" 255 | (symbol-name (gensym "-thumb-")) 256 | "*")) 257 | (name (read-string (format "Thumb buffer name [default %s]: " default) 258 | nil 259 | nil 260 | default))) 261 | (di--spawn-thumb-buffer name)))) 262 | (dir-buf (current-buffer)) 263 | (inhibit-read-only t)) 264 | (di--generate-thumbs marked-files) 265 | (pop-to-buffer buf) 266 | (with-current-buffer buf 267 | (unless (equal arg '(4)) 268 | (erase-buffer)) 269 | (when (equal arg '(4)) 270 | (goto-char (point-max))) 271 | (save-excursion 272 | (di--insert-thumbs marked-files dir-buf) 273 | (--when-let (di--get-active-thumb-windows) 274 | (di--arrange-thumbs (car it))))))) 275 | 276 | ;; NOTE: (dired-get-marked-files) automagically returns the file under 277 | ;; cursor if no selection is made. 278 | ;; TODO: cleanup: remove the temp files for views which no longer exists 279 | (defun di-view-files () 280 | "View marked files." 281 | (interactive) 282 | (let ((marked-files (dired-get-marked-files)) 283 | (buf (di--spawn-view-buffer))) 284 | (pop-to-buffer buf) 285 | (with-current-buffer buf 286 | (di--open-image (car marked-files)) 287 | (set (make-local-variable 'di-file-list) marked-files) 288 | (set (make-local-variable 'di-file-list-current) 0)))) 289 | 290 | 291 | ;;; view mode 292 | (defvar di-view-mode-map 293 | (let ((map (make-sparse-keymap))) 294 | (set-keymap-parent map image-mode-map) 295 | (define-key map (kbd ".") 'di-view-next) 296 | (define-key map (kbd ",") 'di-view-previous) 297 | (define-key map (kbd "s s") 'di-view-fit-image-to-window) 298 | (define-key map (kbd "") 'di-view-next) 299 | (define-key map (kbd "") 'di-view-previous) 300 | map)) 301 | 302 | (defun di--spawn-view-buffer (&optional name) 303 | "Spawn a new view buffer and set it as active." 304 | (let ((buf (get-buffer-create (or name 305 | (concat 306 | "*di" 307 | (symbol-name (gensym "-view-")) 308 | "*"))))) 309 | (setq di-active-view-buffer buf) 310 | (with-current-buffer di-active-view-buffer 311 | (di-view-mode) 312 | (add-hook 'kill-buffer-hook 313 | (let ((buffer (di--temp-file (current-buffer)))) 314 | (lambda () 315 | (ignore-errors 316 | (delete-file buffer)))) nil 'local)) 317 | buf)) 318 | 319 | (defun di--get-active-view-buffer () 320 | "Return the active view buffer." 321 | (unless (and di-active-view-buffer 322 | (buffer-live-p di-active-view-buffer)) 323 | (di--spawn-view-buffer "*di-view*")) 324 | di-active-view-buffer) 325 | 326 | (defun di--get-active-view-windows () 327 | "Return a list of windows displaying active view buffer." 328 | (let ((active (di--get-active-view-buffer))) 329 | (--filter (equal (window-buffer it) 330 | active) (-mapcat 'window-list (frame-list))))) 331 | 332 | (defun di--view-current-index () 333 | "Return the index of currently viewed image in this view buffer." 334 | (if di-thumb-buffer 335 | (with-current-buffer di-thumb-buffer 336 | (di--thumb-current-index)) 337 | di-file-list-current)) 338 | 339 | (defun di--view-current-file () 340 | "Return the filename of currently viewed image in this view buffer." 341 | (if di-thumb-buffer 342 | (with-current-buffer di-thumb-buffer 343 | (plist-get (text-properties-at (point)) :original-file-name)) 344 | (nth di-file-list-current di-file-list))) 345 | 346 | (defun di--view-total () 347 | "Return total amount of images are associated with this view buffer." 348 | (if di-thumb-buffer 349 | (with-current-buffer di-thumb-buffer 350 | (di--thumb-total)) 351 | (length di-file-list))) 352 | 353 | (defun di-view-next (&optional arg) 354 | "Display next file" 355 | (interactive "p") 356 | (if di-thumb-buffer 357 | (with-current-buffer di-thumb-buffer 358 | (di-thumb-next) 359 | ;; TODO: this should set point in all the windows 360 | (set-window-point (car (di--get-active-thumb-windows)) (point))) 361 | (redisplay) 362 | (di-inc di-file-list-current (di--view-total) arg) 363 | (di--open-image (nth di-file-list-current di-file-list)))) 364 | 365 | (defun di-view-previous (&optional arg) 366 | "Display previous file." 367 | (interactive "p") 368 | (if di-thumb-buffer 369 | (with-current-buffer di-thumb-buffer 370 | (di-thumb-previous) 371 | (set-window-point (car (di--get-active-thumb-windows)) (point))) 372 | (di-dec di-file-list-current (di--view-total) arg) 373 | (di--open-image (nth di-file-list-current di-file-list)))) 374 | 375 | (defun di-view-fit-image-to-window () 376 | "Fit image to window." 377 | (interactive) 378 | (di--open-image (di--view-current-file))) 379 | 380 | (define-derived-mode di-view-mode special-mode 381 | "DI View" 382 | "docs" 383 | (use-local-map di-view-mode-map) 384 | (setq cursor-type nil truncate-lines t 385 | image-type (plist-get (cdr (image-get-display-property)) :type)) 386 | (setq header-line-format 387 | '(:eval (format-spec 388 | di-header-format 389 | (list 390 | (cons ?c (1+ (di--view-current-index))) 391 | (cons ?t (di--view-total)) 392 | (cons ?F (di--view-current-file)) 393 | (cons ?f (file-name-nondirectory (di--view-current-file)))))))) 394 | 395 | 396 | ;;; thumb mode 397 | (defvar di-thumb-mode-map 398 | (let ((map (make-sparse-keymap))) 399 | (set-keymap-parent map special-mode-map) 400 | (define-key map (kbd "f") 'di-thumb-next) 401 | (define-key map (kbd "b") 'di-thumb-previous) 402 | (define-key map (kbd "n") 'di-thumb-next-line) 403 | (define-key map (kbd "p") 'di-thumb-previous-line) 404 | (define-key map (kbd ".") 'di-thumb-next) 405 | (define-key map (kbd ",") 'di-thumb-previous) 406 | (define-key map (kbd "") 'di-thumb-next) 407 | (define-key map (kbd "") 'di-thumb-previous) 408 | (define-key map (kbd "") 'di-thumb-next-line) 409 | (define-key map (kbd "") 'di-thumb-previous-line) 410 | (define-key map (kbd "RET") 'di-thumb-preview) 411 | map)) 412 | 413 | (defun di--spawn-thumb-buffer (name) 414 | "Spawn a new thumb buffer and set it as active." 415 | (let ((buf (get-buffer-create name))) 416 | (setq di-active-thumb-buffer buf) 417 | (with-current-buffer di-active-thumb-buffer 418 | (di-thumb-mode)) 419 | buf)) 420 | 421 | (defun di--get-active-thumb-buffer () 422 | "Return the active thumb buffer." 423 | (unless (and di-active-thumb-buffer 424 | (buffer-live-p di-active-thumb-buffer)) 425 | (di--spawn-thumb-buffer "*di-thumb*")) 426 | di-active-thumb-buffer) 427 | 428 | (defun di--get-active-thumb-windows () 429 | "Return a list of windows displaying active view buffer." 430 | (let ((active (di--get-active-thumb-buffer))) 431 | (--filter (equal (window-buffer it) 432 | active) (-mapcat 'window-list (frame-list))))) 433 | 434 | (defun di--thumb-current-index () 435 | "Return index of the currently highlighted thumb." 436 | (+ (* (1- (line-number-at-pos)) 437 | (di--thumbs-per-row (car (di--get-active-thumb-windows)))) 438 | (current-column))) 439 | 440 | (defun di--thumb-total () 441 | "Return number of thumbs displayed in this thumb buffer." 442 | (length 443 | (replace-regexp-in-string 444 | "\n" "" 445 | (buffer-substring-no-properties (point-min) (point-max))))) 446 | 447 | (defun di-thumb-next () 448 | (interactive) 449 | (forward-char) 450 | (when (and (looking-at "$") (not (eobp))) 451 | (forward-char)) 452 | (when (eobp) 453 | (goto-char (point-min))) 454 | (when (and di-view-buffer 455 | di-thumb-track) 456 | (di-thumb-preview t))) 457 | 458 | (defun di-thumb-previous () 459 | (interactive) 460 | (if (bobp) 461 | (progn 462 | (goto-char (point-max)) 463 | (backward-char)) 464 | (backward-char) 465 | (when (looking-at "$") 466 | (backward-char))) 467 | (when (and di-view-buffer 468 | di-thumb-track) 469 | (di-thumb-preview t))) 470 | 471 | (defun di-thumb-next-line () 472 | (interactive) 473 | (let ((cc (current-column))) 474 | (forward-line) 475 | (condition-case er 476 | (forward-char cc) 477 | (end-of-buffer 478 | (goto-char (point-min)) 479 | (forward-char cc))) 480 | (when (eobp) 481 | (goto-char (point-min)) 482 | (forward-char cc))) 483 | (when (and di-view-buffer 484 | di-thumb-track) 485 | (di-thumb-preview t))) 486 | 487 | (defun di-thumb-previous-line () 488 | (interactive) 489 | (let ((cc (current-column))) 490 | (if (= (forward-line -1) -1) 491 | (progn 492 | (goto-char (point-max)) 493 | (beginning-of-line) 494 | (condition-case er 495 | (progn 496 | (forward-char cc) 497 | (when (eobp) 498 | (forward-line -1) 499 | (forward-char cc))) 500 | (end-of-buffer 501 | (forward-line -1) 502 | (forward-char cc)))) 503 | (forward-char cc))) 504 | (when (and di-view-buffer 505 | di-thumb-track) 506 | (di-thumb-preview t))) 507 | 508 | (defun di-thumb-preview (&optional arg) 509 | "Open the thumb at point in view buffer. 510 | 511 | With ARG, do not pop to the view window." 512 | (interactive "P") 513 | (let ((buf (if (and di-view-buffer 514 | (buffer-live-p di-view-buffer)) 515 | di-view-buffer 516 | (di--spawn-view-buffer))) 517 | (thumb-buf (current-buffer)) 518 | ;; TODO: abstract this into a data structure about thumbs/views 519 | (tps (text-properties-at (point))) 520 | (inhibit-read-only t)) 521 | (setq di-active-view-buffer buf) 522 | (setq di-active-thumb-buffer thumb-buf) 523 | (set (make-local-variable 'di-view-buffer) buf) 524 | ;; TODO: only call this if there is no window displaying buf 525 | (if arg 526 | (display-buffer buf) 527 | (pop-to-buffer buf)) 528 | (with-current-buffer buf 529 | (di--open-image (plist-get tps :original-file-name) 530 | (car (di--get-active-view-windows))) 531 | (set (make-local-variable 'di-thumb-buffer) thumb-buf)))) 532 | 533 | (define-derived-mode di-thumb-mode special-mode 534 | "DI Thumb" 535 | "docs" 536 | (use-local-map di-thumb-mode-map)) 537 | 538 | (provide 'dired-images) 539 | -------------------------------------------------------------------------------- /dired-list.el: -------------------------------------------------------------------------------- 1 | ;;; dired-list.el --- Create dired listings from sources 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 14th February 2014 9 | ;; URL: https://github.com/Fuco1/dired-hacks 10 | ;; Package-Requires: ((dash "2.10.0") (emacs "24.3") (dired-hacks-utils "0.0.1")) 11 | ;; Keywords: files 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 15 | ;; as published by the Free Software Foundation; either version 3 16 | ;; of the License, or (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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Produce a file listing with a shell incantation and make a Dired 29 | ;; out of it! 30 | 31 | ;; This package provides one principal function, `dired-list' which 32 | ;; can be used to produce Dired buffers from shell programs outputing 33 | ;; text roughly in the format of `la -ls'. 34 | 35 | ;; For most standard output formats the default filter and sentinel 36 | ;; should work, but you can also provide your own if the situation 37 | ;; requires it. 38 | 39 | ;; Most of the time you can pipe a zero-delimited list of files to ls 40 | ;; through xargs(1) using 41 | 42 | ;; | xargs -I '{}' -0 ls -l '{}' 43 | 44 | ;; which creates a compatible listing. For more information read the 45 | ;; documentation of `dired-list', for example by invoking 46 | 47 | ;; C-h f dired-list RET 48 | 49 | ;; in Emacs. 50 | 51 | ;; In addition to the generic interface this package implements common 52 | ;; listings (patches and extensions welcome!), these are: 53 | ;; * `dired-list-mpc' 54 | ;; * `dired-list-git-ls-files' 55 | ;; * `dired-list-hg-locate' 56 | ;; * `dired-list-locate' 57 | ;; * `dired-list-find-file' 58 | ;; * `dired-list-find-name' 59 | ;; * `dired-list-grep' 60 | 61 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection. 62 | 63 | ;;; Code: 64 | (require 'dash) 65 | (require 'dired-hacks-utils) 66 | 67 | (require 'grep) 68 | (require 'find-dired) 69 | 70 | ; TODO: this will become obsolete in 30.1, because -N always comes with --dired flag 71 | (defcustom dired-list-use-N-flag t 72 | "Non-nil means the --literal flag will be used. 73 | 74 | GNU coreutils ls version 8.25 no longer uses --literal (-N) flag as default." 75 | :type 'boolean 76 | :group 'dired-list) 77 | 78 | (defun dired-list-align-size-column () 79 | "Align the filesize column." 80 | (beginning-of-line) 81 | (save-match-data 82 | (when (and (looking-at "^ [^0-9]") 83 | (re-search-forward dired-move-to-filename-regexp nil t)) 84 | (goto-char (match-beginning 7)) 85 | (backward-char 1) 86 | (let* ((size-end (point)) 87 | (size-beg (search-backward " " nil t)) 88 | (width (and size-end (- size-end size-beg)))) 89 | (when (and size-end (< 1 width) (< width 12)) 90 | (goto-char size-beg) 91 | (insert (make-string (- 12 width) ? ))))))) 92 | 93 | (defun dired-list-default-filter (proc string) 94 | "Filter the output of process PROC to make it suitable for `dired-mode'. 95 | 96 | STRING is the currently processed chunk of process output. 97 | 98 | This filter assumes that the input is in the format of `ls -l'." 99 | (let ((buf (process-buffer proc)) 100 | (inhibit-read-only t)) 101 | (if (buffer-name buf) 102 | (with-current-buffer buf 103 | (save-excursion 104 | (save-restriction 105 | (widen) 106 | (let ((beg (point-max))) 107 | (goto-char beg) 108 | (insert string) 109 | (goto-char beg) 110 | (or (looking-at "^") 111 | (progn 112 | (dired-list-align-size-column) 113 | (forward-line 1))) 114 | (while (looking-at "^") 115 | (insert " ") 116 | (dired-list-align-size-column) 117 | (forward-line 1)) 118 | (goto-char (- beg 3)) 119 | (while (search-forward " ./" nil t) 120 | (delete-region (point) (- (point) 2))) 121 | (goto-char beg) 122 | (beginning-of-line) 123 | ;; Remove occurrences of default-directory. 124 | (while (search-forward (concat " " default-directory) nil t) 125 | (replace-match " " nil t)) 126 | ;; remove '\ ' and replace with just a space 127 | (goto-char beg) 128 | (beginning-of-line) 129 | (while (search-forward "\\ " nil t) 130 | (replace-match " " nil t)) 131 | (goto-char (point-max)) 132 | (when (search-backward "\n" (process-mark proc) t) 133 | (dired-insert-set-properties (process-mark proc) (1+ (point))) 134 | (move-marker (process-mark proc) (1+ (point)))))))) 135 | (delete-process proc)))) 136 | 137 | (defun dired-list-default-sentinel (proc state) 138 | "Update the status/modeline after the process PROC finishes. 139 | 140 | STATE is the final state." 141 | (let ((buf (process-buffer proc)) 142 | (inhibit-read-only t)) 143 | (if (buffer-name buf) 144 | (with-current-buffer buf 145 | (let ((buffer-read-only nil)) 146 | (save-excursion 147 | (goto-char (point-max)) 148 | (insert "\n " state) 149 | (forward-char -1) ;Back up before \n at end of STATE. 150 | (insert " at " (substring (current-time-string) 0 19)) 151 | (forward-char 1) 152 | (setq mode-line-process (concat ":" (symbol-name (process-status proc)))) 153 | (delete-process proc) 154 | (force-mode-line-update))) 155 | (run-hooks 'dired-after-readin-hook) 156 | (message "%s finished." (current-buffer)))))) 157 | 158 | (defun dired-list-kill-process () 159 | "Kill the process running in the current buffer." 160 | (interactive) 161 | (let ((proc (get-buffer-process (current-buffer)))) 162 | (and proc 163 | (eq (process-status proc) 'run) 164 | (condition-case nil 165 | (delete-process proc) 166 | (error nil))))) 167 | 168 | (defun dired-list (dir buffer-name cmd &optional revert-function filter sentinel) 169 | "Present output of a command as a `dired-buffer'. 170 | 171 | DIR is the default directory of the resulting `dired' buffer. 172 | 173 | BUFFER-NAME is name of the created buffer. If such buffer 174 | exists, it is erased first. 175 | 176 | CMD is a sh(1) invocation to produce output for Dired to process. 177 | It should be in the format similar to `ls -l'. 178 | 179 | Optional argument REVERT-FUNCTION is used to revert (bound to 180 | \\[revert-buffer]) the buffer. 181 | 182 | Optional argument FILTER is a function used to post-process the 183 | process's output after it was inserted to Dired buffer. 184 | 185 | Optional argument SENTINEL is a function called on each change of 186 | state of the buffer's process." 187 | (let* ((dired-buffers nil) ;; do not mess with regular dired buffers 188 | (dir (file-name-as-directory (expand-file-name dir))) 189 | (filter (or filter 'dired-list-default-filter)) 190 | (sentinel (or sentinel 'dired-list-default-sentinel))) 191 | (run-hooks 'dired-list-before-buffer-creation-hook) 192 | ;; TODO: abstract buffer creation 193 | (with-current-buffer (get-buffer-create buffer-name) 194 | (switch-to-buffer (current-buffer)) 195 | (widen) 196 | ;; here we might want to remember some state from before, so add 197 | ;; a hook to do that 198 | (kill-all-local-variables) 199 | (read-only-mode -1) ;only support 24+ 200 | (let ((inhibit-read-only t)) (erase-buffer)) 201 | (setq default-directory dir) 202 | (run-hooks 'dired-before-readin-hook) 203 | (shell-command cmd (current-buffer)) 204 | (insert " " dir ":\n") 205 | (insert " " cmd "\n") 206 | (dired-mode dir) 207 | (let ((map (make-sparse-keymap))) 208 | (set-keymap-parent map (current-local-map)) 209 | (define-key map "\C-c\C-k" 'dired-list-kill-process) 210 | (use-local-map map)) 211 | (set (make-local-variable 'dired-sort-inhibit) t) 212 | (set (make-local-variable 'revert-buffer-function) revert-function) 213 | (set (make-local-variable 'dired-subdir-alist) 214 | (list (cons default-directory (point-min-marker)))) 215 | (let ((proc (get-buffer-process (current-buffer)))) 216 | (set-process-filter proc filter) 217 | (set-process-sentinel proc sentinel) 218 | (move-marker (process-mark proc) 1 (current-buffer))) 219 | (setq mode-line-process '(":%s"))))) 220 | 221 | (defcustom dired-list-mpc-music-directory "~/Music" 222 | "MPD Music directory." 223 | :type 'directory 224 | :group 'dired-list) 225 | 226 | ;;;###autoload 227 | (defun dired-list-mpc (query) 228 | "Search mpd(1) database using QUERY and display results as a `dired' buffer." 229 | (interactive "sMPC search query: ") 230 | (let ((dired-list-before-buffer-creation-hook 231 | '((lambda () (cd dired-list-mpc-music-directory))))) 232 | (dired-list dired-list-mpc-music-directory 233 | (concat "mpc " query) 234 | (concat "mpc search " 235 | query 236 | " | tr '\\n' '\\000' | xargs -I '{}' -0 ls -l '{}' &") 237 | `(lambda (ignore-auto noconfirm) 238 | (dired-list-mpc ,query))))) 239 | 240 | ;;;###autoload 241 | (defun dired-list-git-ls-files (dir) 242 | "List all files in DIR managed by git and display results as a `dired' buffer." 243 | (interactive "DDirectory: ") 244 | (dired-list dir 245 | (concat "git ls-files " dir) 246 | (concat "git ls-files -z | xargs -I '{}' -0 ls -l '{}' &") 247 | `(lambda (ignore-auto noconfirm) (dired-list-git-ls-files ,dir)))) 248 | 249 | ;;;###autoload 250 | (defun dired-list-hg-locate (dir) 251 | "List all files in DIR managed by mercurial. 252 | 253 | Display results as a `dired' buffer." 254 | (interactive "DDirectory: ") 255 | (dired-list dir 256 | (concat "hg locate " dir) 257 | (concat "hg locate -0 | xargs -I '{}' -0 ls -l '{}' &") 258 | `(lambda (ignore-auto noconfirm) (dired-list-hg-locate ,dir)))) 259 | 260 | ;;;###autoload 261 | (defun dired-list-locate (needle) 262 | "Locate(1) all files matching NEEDLE and display results as a `dired' buffer." 263 | (interactive "sLocate: ") 264 | (let ((locate (or (bound-and-true-p locate-command) "locate"))) 265 | (dired-list "/" 266 | (concat locate " " needle) 267 | (concat locate " " (shell-quote-argument needle) " -0 | xargs -I '{}' -0 ls -ld '{}' &") 268 | `(lambda (ignore-auto noconfirm) (dired-list-locate ,needle))))) 269 | 270 | (defun dired-list-git-annex-find (dir query) 271 | "Return files from git annex at DIR matching QUERY. 272 | 273 | Display results as a `dired' buffer." 274 | (interactive "DDirectory: \nsQuery: ") 275 | (dired-list dir 276 | (concat "git annex find " dir) 277 | (concat "git annex find " query 278 | (format " --print0 | xargs -I '{}' -0 ls -d%s %s '{}' &" 279 | (if dired-list-use-N-flag "N" "") 280 | dired-listing-switches)) 281 | `(lambda (ignore-auto noconfirm) (dired-list-git-annex-find ,dir ,query)))) 282 | 283 | 284 | ;; taken from grep.el/rgrep 285 | (defun dired-list--get-ignored-stuff (dir) 286 | "Return find subcommand to ignore uninteresting dirs and files in DIR. 287 | 288 | Directories are taken form `grep-find-ignored-directories', files 289 | are taken from `grep-find-ignored-files'." 290 | (concat 291 | (and grep-find-ignored-directories 292 | (concat "-type d " 293 | (shell-quote-argument "(") 294 | ;; we should use shell-quote-argument here 295 | " -path " 296 | (mapconcat 297 | (lambda (ignore) 298 | (cond ((stringp ignore) 299 | (shell-quote-argument 300 | (concat "*/" ignore))) 301 | ((consp ignore) 302 | (and (funcall (car ignore) dir) 303 | (shell-quote-argument 304 | (concat "*/" 305 | (cdr ignore))))))) 306 | grep-find-ignored-directories 307 | " -o -path ") 308 | " " 309 | (shell-quote-argument ")") 310 | " -prune -o ")) 311 | (and grep-find-ignored-files 312 | (concat (shell-quote-argument "!") " -type d " 313 | (shell-quote-argument "(") 314 | ;; we should use shell-quote-argument here 315 | " -name " 316 | (mapconcat 317 | (lambda (ignore) 318 | (cond ((stringp ignore) 319 | (shell-quote-argument ignore)) 320 | ((consp ignore) 321 | (and (funcall (car ignore) dir) 322 | (shell-quote-argument 323 | (cdr ignore)))))) 324 | grep-find-ignored-files 325 | " -o -name ") 326 | " " 327 | (shell-quote-argument ")") 328 | " -prune -o ")))) 329 | 330 | ;;;###autoload 331 | (defun dired-list-find-file (dir cmd) 332 | "Run find(1) on DIR with find command CMD. 333 | 334 | By default, directories matching `grep-find-ignored-directories' 335 | and files matching `grep-find-ignored-files' are ignored. 336 | 337 | If called with raw prefix argument \\[universal-argument], no 338 | files will be ignored." 339 | (interactive (let* ((dir (read-directory-name "Directory: " nil nil t)) 340 | (base-cmd (concat "find . " 341 | (if current-prefix-arg "" (dired-list--get-ignored-stuff dir)) 342 | " -ls &"))) 343 | (list dir 344 | (read-from-minibuffer 345 | "Find command: " 346 | (cons base-cmd (string-match-p "-ls &" base-cmd)))))) 347 | (let ((short-cmd (save-match-data 348 | (if (string-match ".* -prune -o \\(.*?\\) -ls &" cmd) 349 | (match-string 1 cmd) 350 | cmd)))) 351 | (dired-list dir 352 | (concat "find " dir ": " short-cmd) 353 | cmd 354 | `(lambda (ignore-auto noconfirm) (dired-list-find-file ,dir ,cmd))))) 355 | 356 | ;;;###autoload 357 | (defun dired-list-find-name (dir pattern) 358 | "Search DIR recursively for files matching the globbing pattern PATTERN. 359 | 360 | PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted. 361 | 362 | By default, directories matching `grep-find-ignored-directories' 363 | and files matching `grep-find-ignored-files' are ignored. 364 | 365 | If called with raw prefix argument \\[universal-argument], no 366 | files will be ignored." 367 | (interactive "DDirectory: \nsPattern: ") 368 | (dired-list dir 369 | (concat "find " dir ": " pattern) 370 | (concat "find . " (if current-prefix-arg "" (dired-list--get-ignored-stuff dir)) " -name " (shell-quote-argument pattern) " -ls &") 371 | `(lambda (ignore-auto noconfirm) (dired-list-find-name ,dir ,pattern)))) 372 | 373 | (defun dired-list-grep (dir regexp) 374 | "Recursively find files in DIR containing regexp REGEXP. 375 | 376 | Start Dired on output. The rows are added as grep streams output 377 | to the sentinel." 378 | (interactive "DDirectory: \nsRegexp: \n") 379 | (dired-list dir 380 | (concat "find grep " dir ": " regexp) 381 | (concat "find . " (dired-list--get-ignored-stuff dir) 382 | " \\( -type f -exec " grep-program " " find-grep-options 383 | " -e " (shell-quote-argument regexp) " {} \\; \\) -ls &") 384 | `(lambda (ignore-auto noconfirm) (dired-list-find-grep ,dir ,regexp)))) 385 | 386 | (provide 'dired-list) 387 | ;;; dired-list.el ends here 388 | -------------------------------------------------------------------------------- /dired-narrow.el: -------------------------------------------------------------------------------- 1 | ;;; dired-narrow.el --- Live-narrowing of search results for dired 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 14th February 2014 9 | ;; Package-Requires: ((dash "2.7.0") (dired-hacks-utils "0.0.1") (emacs "24")) 10 | ;; Keywords: files 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 15 | ;; as published by the Free Software Foundation; either version 3 16 | ;; of the License, or (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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; This package provides live filtering of files in dired buffers. In 29 | ;; general, after calling the respective narrowing function you type a 30 | ;; filter string into the minibuffer. After each change the changes 31 | ;; automatically reflect in the buffer. Typing C-g will cancel the 32 | ;; narrowing and restore the original view, typing RET will exit the 33 | ;; live filtering mode and leave the dired buffer in the narrowed 34 | ;; state. To bring it back to the original view, you can call 35 | ;; `revert-buffer' (usually bound to `g'). 36 | 37 | ;; During the filtering process, several special functions are 38 | ;; available. You can customize the binding by changing 39 | ;; `dired-narrow-map'. 40 | 41 | ;; * `dired-narrow-next-file' ( or C-n) - move the point to the 42 | ;; next file 43 | ;; * `dired-narrow-previous-file' ( or C-p) - move the point to the 44 | ;; previous file 45 | ;; * `dired-narrow-enter-directory' ( or C-j) - descend into the 46 | ;; directory under point and immediately go back to narrowing mode 47 | 48 | ;; You can customize what happens after exiting the live filtering 49 | ;; mode by customizing `dired-narrow-exit-action'. 50 | 51 | ;; These narrowing functions are provided: 52 | 53 | ;; * `dired-narrow' 54 | ;; * `dired-narrow-regexp' 55 | ;; * `dired-narrow-fuzzy' 56 | 57 | ;; You can also create your own narrowing functions quite easily. To 58 | ;; define new narrowing function, use `dired-narrow--internal' and 59 | ;; pass it an apropriate filter. The filter should take one argument 60 | ;; which is the filter string from the minibuffer. It is then called 61 | ;; at each line that describes a file with point at the beginning of 62 | ;; the file name. If the filter returns nil, the file is removed from 63 | ;; the view. As an inspiration, look at the built-in functions 64 | ;; mentioned above. 65 | 66 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection. 67 | 68 | ;;; Code: 69 | 70 | (require 'dash) 71 | (require 'dired-hacks-utils) 72 | 73 | (require 'delsel) 74 | 75 | (defgroup dired-narrow () 76 | "Live-narrowing of search results for dired." 77 | :group 'dired-hacks 78 | :prefix "dired-narrow-") 79 | 80 | (defvar dired-narrow-map 81 | (let ((map (make-sparse-keymap))) 82 | (define-key map (kbd "") 'dired-narrow-previous-file) 83 | (define-key map (kbd "") 'dired-narrow-next-file) 84 | (define-key map (kbd "") 'dired-narrow-enter-directory) 85 | (define-key map (kbd "C-p") 'dired-narrow-previous-file) 86 | (define-key map (kbd "C-n") 'dired-narrow-next-file) 87 | (define-key map (kbd "C-j") 'dired-narrow-enter-directory) 88 | (define-key map (kbd "C-g") 'minibuffer-keyboard-quit) 89 | (define-key map (kbd "RET") 'exit-minibuffer) 90 | (define-key map (kbd "") 'exit-minibuffer) 91 | map) 92 | "Keymap used while `dired-narrow' is reading the pattern.") 93 | 94 | (defcustom dired-narrow-exit-action 'ignore 95 | "Function to call after exiting minibuffer. 96 | 97 | Function takes no argument and is called with point over the file 98 | we should act on." 99 | :type '(choice 100 | (const :tag "Do nothing" ignore) 101 | (const :tag "Open file under point" dired-narrow-find-file) 102 | (function :tag "Use custom function")) 103 | :group 'dired-narrow) 104 | 105 | (defcustom dired-narrow-exit-when-one-left nil 106 | "If there is only one file left while narrowing, 107 | exit minibuffer and call `dired-narrow-exit-action'." 108 | :type 'boolean 109 | :group 'dired-narrow) 110 | 111 | (defcustom dired-narrow-enable-blinking t 112 | "If non-nil, highlight the chosen file shortly. 113 | Only works when `dired-narrow-exit-when-one-left' is non-nil." 114 | :type 'boolean 115 | :group 'dired-narrow) 116 | 117 | (defcustom dired-narrow-blink-time 0.2 118 | "How many seconds should a chosen file be highlighted." 119 | :type 'number 120 | :group 'dired-narrow) 121 | 122 | (defface dired-narrow-blink 123 | '((t :background "#eadc62" 124 | :foreground "black")) 125 | "The face used to highlight a chosen file 126 | when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are true." 127 | :group 'dired-narrow) 128 | 129 | 130 | ;; Utils 131 | 132 | ;; this is `gnus-remove-text-with-property' 133 | (defun dired-narrow--remove-text-with-property (prop) 134 | "Delete all text in the current buffer with text property PROP." 135 | (let ((start (point-min)) 136 | end) 137 | (unless (get-text-property start prop) 138 | (setq start (next-single-property-change start prop))) 139 | (while start 140 | (setq end (text-property-any start (point-max) prop nil)) 141 | (delete-region start (or end (point-max))) 142 | (setq start (when end 143 | (next-single-property-change start prop)))))) 144 | 145 | (defvar dired-narrow-filter-function 'identity 146 | "Filter function used to filter the dired view.") 147 | 148 | (defvar dired-narrow--current-file nil 149 | "Value of point just before exiting minibuffer.") 150 | 151 | (defun dired-narrow--update (filter) 152 | "Make the files not matching the FILTER invisible. 153 | 154 | Return the count of visible files that are left after update." 155 | 156 | (let ((inhibit-read-only t) 157 | (visible-files-cnt 0)) 158 | (save-excursion 159 | (goto-char (point-min)) 160 | ;; TODO: we might want to call this only if the filter gets less 161 | ;; specialized. 162 | (dired-narrow--restore) 163 | (while (dired-hacks-next-file) 164 | (if (funcall dired-narrow-filter-function filter) 165 | (progn 166 | (setq visible-files-cnt (1+ visible-files-cnt)) 167 | (when (fboundp 'dired-insert-set-properties) 168 | (dired-insert-set-properties (line-beginning-position) (1+ (line-end-position))))) 169 | (put-text-property (line-beginning-position) (1+ (line-end-position)) :dired-narrow t) 170 | (put-text-property (line-beginning-position) (1+ (line-end-position)) 'invisible :dired-narrow)))) 171 | (unless (dired-hacks-next-file) 172 | (dired-hacks-previous-file)) 173 | (unless (dired-utils-get-filename) 174 | (dired-hacks-previous-file)) 175 | visible-files-cnt)) 176 | 177 | (defun dired-narrow--restore () 178 | "Restore the invisible files of the current buffer." 179 | (let ((inhibit-read-only t)) 180 | (remove-list-of-text-properties (point-min) (point-max) 181 | '(invisible :dired-narrow)) 182 | (when (fboundp 'dired-insert-set-properties) 183 | (dired-insert-set-properties (point-min) (point-max))))) 184 | 185 | 186 | (defun dired-narrow--blink-current-file () 187 | (let* ((beg (line-beginning-position)) 188 | (end (line-end-position)) 189 | (overlay (make-overlay beg end))) 190 | (overlay-put overlay 'face 'dired-narrow-blink) 191 | (redisplay) 192 | (sleep-for dired-narrow-blink-time) 193 | (discard-input) 194 | (delete-overlay overlay))) 195 | 196 | 197 | ;; Live filtering 198 | 199 | (defvar dired-narrow-buffer nil 200 | "Dired buffer we are currently filtering.") 201 | 202 | (defvar dired-narrow--minibuffer-content "" 203 | "Content of the minibuffer during narrowing.") 204 | 205 | (defun dired-narrow--minibuffer-setup () 206 | "Set up the minibuffer for live filtering." 207 | (when dired-narrow-buffer 208 | (add-hook 'post-command-hook 'dired-narrow--live-update nil :local))) 209 | 210 | (add-hook 'minibuffer-setup-hook 'dired-narrow--minibuffer-setup) 211 | 212 | (defun dired-narrow--live-update () 213 | "Update the dired buffer based on the contents of the minibuffer." 214 | (when dired-narrow-buffer 215 | (let ((current-filter (minibuffer-contents-no-properties)) 216 | visible-files-cnt) 217 | (with-current-buffer dired-narrow-buffer 218 | (setq visible-files-cnt 219 | (unless (equal current-filter dired-narrow--minibuffer-content) 220 | (dired-narrow--update current-filter))) 221 | 222 | (setq dired-narrow--minibuffer-content current-filter) 223 | (setq dired-narrow--current-file (dired-utils-get-filename)) 224 | (set-window-point (get-buffer-window (current-buffer)) (point)) 225 | 226 | (when (and dired-narrow-exit-when-one-left 227 | visible-files-cnt 228 | (= visible-files-cnt 1)) 229 | (when dired-narrow-enable-blinking 230 | (dired-narrow--blink-current-file)) 231 | (exit-minibuffer)))))) 232 | 233 | (defun dired-narrow--internal (filter-function) 234 | "Narrow a dired buffer to the files matching a filter. 235 | 236 | The function FILTER-FUNCTION is called on each line: if it 237 | returns non-nil, the line is kept, otherwise it is removed. The 238 | function takes one argument, which is the current filter string 239 | read from minibuffer." 240 | (let ((dired-narrow-buffer (current-buffer)) 241 | (dired-narrow-filter-function filter-function) 242 | (disable-narrow nil)) 243 | (unwind-protect 244 | (progn 245 | (dired-narrow-mode 1) 246 | (add-to-invisibility-spec :dired-narrow) 247 | (setq disable-narrow (read-from-minibuffer 248 | (pcase dired-narrow-filter-function 249 | ('dired-narrow--regexp-filter 250 | "Regex Filter:\s") 251 | ('dired-narrow--fuzzy-filter 252 | "Fuzzy Filter:\s") 253 | (_ "Filter:\s")) 254 | nil dired-narrow-map)) 255 | (let ((inhibit-read-only t)) 256 | (dired-narrow--remove-text-with-property :dired-narrow)) 257 | ;; If the file no longer exists, we can't do anything, so 258 | ;; set to nil 259 | (unless (dired-utils-goto-line dired-narrow--current-file) 260 | (setq dired-narrow--current-file nil))) 261 | (with-current-buffer dired-narrow-buffer 262 | (unless disable-narrow (dired-narrow-mode -1)) 263 | (remove-from-invisibility-spec :dired-narrow) 264 | (dired-narrow--restore)) 265 | (cond 266 | ((equal disable-narrow "dired-narrow-enter-directory") 267 | (dired-narrow-find-file) 268 | (dired-narrow--internal filter-function)) 269 | (t 270 | (when (and disable-narrow 271 | dired-narrow--current-file 272 | dired-narrow-exit-action) 273 | (funcall dired-narrow-exit-action))))))) 274 | 275 | 276 | ;; Interactive 277 | 278 | (defun dired-narrow--regexp-filter (filter) 279 | (condition-case nil 280 | (string-match-p filter (dired-utils-get-filename 'no-dir)) 281 | ;; Return t if your regexp is incomplete/has errors, thus 282 | ;; filtering nothing until you fix the regexp. 283 | (invalid-regexp t))) 284 | 285 | ;;;###autoload 286 | (defun dired-narrow-regexp () 287 | "Narrow a dired buffer to the files matching a regular expression." 288 | (interactive) 289 | (dired-narrow--internal 'dired-narrow--regexp-filter)) 290 | 291 | (defun dired-narrow--string-filter (filter) 292 | (let ((words (split-string filter " "))) 293 | (--all? (save-excursion (search-forward it (line-end-position) t)) words))) 294 | 295 | (defun dired-narrow-next-file () 296 | "Move point to the next file." 297 | (interactive) 298 | (with-current-buffer dired-narrow-buffer 299 | (dired-hacks-next-file))) 300 | 301 | (defun dired-narrow-previous-file () 302 | "Move point to the previous file." 303 | (interactive) 304 | (with-current-buffer dired-narrow-buffer 305 | (dired-hacks-previous-file))) 306 | 307 | (defun dired-narrow-find-file () 308 | "Run `dired-find-file' or any remapped action on file under point." 309 | (interactive) 310 | (let ((function (or (command-remapping 'dired-find-file) 311 | 'dired-find-file))) 312 | (funcall function))) 313 | 314 | (defun dired-narrow-enter-directory () 315 | "Descend into directory under point and initiate narrowing." 316 | (interactive) 317 | (let ((inhibit-read-only t)) 318 | (erase-buffer) 319 | (insert "dired-narrow-enter-directory")) 320 | (exit-minibuffer)) 321 | 322 | ;;;###autoload 323 | (defun dired-narrow () 324 | "Narrow a dired buffer to the files matching a string. 325 | 326 | If the string contains spaces, then each word is matched against 327 | the file name separately. To succeed, all of them have to match 328 | but the order does not matter. 329 | 330 | For example \"foo bar\" matches filename \"bar-and-foo.el\"." 331 | (interactive) 332 | (dired-narrow--internal 'dired-narrow--string-filter)) 333 | 334 | (defun dired-narrow--fuzzy-filter (filter) 335 | (re-search-forward 336 | (mapconcat 'regexp-quote 337 | (mapcar 'char-to-string (string-to-list filter)) 338 | ".*") 339 | (line-end-position) t)) 340 | 341 | ;;;###autoload 342 | (defun dired-narrow-fuzzy () 343 | "Narrow a dired buffer to the files matching a fuzzy string. 344 | 345 | A fuzzy string is constructed from the filter string by inserting 346 | \".*\" between each letter. This is then matched as regular 347 | expression against the file name." 348 | (interactive) 349 | (dired-narrow--internal 'dired-narrow--fuzzy-filter)) 350 | 351 | (define-minor-mode dired-narrow-mode 352 | "Minor mode for indicating when narrowing is in progress." 353 | :lighter " dired-narrow") 354 | 355 | (defun dired-narrow--disable-on-revert () 356 | "Disable `dired-narrow-mode' after revert." 357 | (dired-narrow-mode -1)) 358 | 359 | (add-hook 'dired-after-readin-hook 'dired-narrow--disable-on-revert) 360 | 361 | (provide 'dired-narrow) 362 | ;;; dired-narrow.el ends here 363 | -------------------------------------------------------------------------------- /dired-open.el: -------------------------------------------------------------------------------- 1 | ;;; dired-open.el --- Open files from dired using using custom actions 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Keywords: files 8 | ;; Version: 0.0.1 9 | ;; Created: 14th February 2014 10 | ;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1") (emacs "24")) 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; While Emacs already has the `auto-mode-alist', this is often 29 | ;; insufficient. Many times, you want to open media files, pdfs or 30 | ;; other documents with an external application. There's remedy for 31 | ;; that too, namely `dired-guess-shell-alist-user', but that is still 32 | ;; not as convenient as just hitting enter. 33 | 34 | ;; This package adds a mechanism to add "hooks" to `dired-find-file' 35 | ;; that will run before Emacs tries its own mechanisms to open the 36 | ;; file, thus enabling you to launch other application or code and 37 | ;; suspend the default behaviour. 38 | 39 | ;; By default, two additional methods are enabled, 40 | ;; `dired-open-by-extension' and `dired-open-subdir'. 41 | 42 | ;; This package also provides other convenient hooks: 43 | ;; 44 | ;; * `dired-open-xdg' - try to open the file using `xdg-open' 45 | ;; * `dired-open-guess-shell-alist' - try to open the file by 46 | ;; launching applications from `dired-guess-shell-alist-user' 47 | ;; * `dired-open-call-function-by-extension' - call an elisp function 48 | ;; based on extension. 49 | ;; 50 | ;; These are not used by default. 51 | 52 | ;; You can customize the list of functions to try by customizing 53 | ;; `dired-open-functions'. 54 | 55 | ;; To fall back to the default `dired-find-file', you can provide the 56 | ;; prefix argument (usually C-u) to the `dired-open-file' function. 57 | ;; This is useful for example when you configure html files to be 58 | ;; opened in browser and you want to edit the file instead of view it. 59 | 60 | ;; Note also that this package can handle calls when point is not on a 61 | ;; line representing a file---an example hook is provided to open a 62 | ;; subdirectory under point if point is on the subdir line, see 63 | ;; `dired-open-subdir'. 64 | 65 | ;; If you write your own handler, make sure they do *not* throw errors 66 | ;; but instead return nil if they can't proceed. 67 | 68 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection. 69 | 70 | ;;; Code: 71 | 72 | (require 'dired-x) 73 | (require 'dired-hacks-utils) 74 | (require 'dash) 75 | 76 | (defgroup dired-open () 77 | "Open files from dired using using custom actions." 78 | :group 'dired-hacks 79 | :prefix "dired-open-") 80 | 81 | (defcustom dired-open-functions '(dired-open-by-extension dired-open-subdir) 82 | "List of functions to try to open a file. 83 | 84 | Each function should accept no arguments and should retrieve the 85 | filename and/or other context by itself. Each function should 86 | return non-nil value if it succeeded in opening the file." 87 | :type 'hook 88 | :group 'dired-open) 89 | 90 | (defcustom dired-open-find-file-function #'dired-find-file 91 | "A function that will be used if none of the `dired-open-functions' succeeded." 92 | :type 'function 93 | :group 'dired-open) 94 | 95 | (defcustom dired-open-extensions nil 96 | "Alist of extensions mapping to a programs to run them in. 97 | 98 | The filename is appended after the program." 99 | :type '(alist 100 | :key-type (string :tag "Extension") 101 | :value-type (string :tag "Program")) 102 | :group 'dired-open) 103 | 104 | (defcustom dired-open-extensions-elisp nil 105 | "Alist of extensions mapping to an elisp function to be called. 106 | 107 | The filename is passed as the only argument to the function." 108 | :type '(alist 109 | :key-type (string :tag "Extension") 110 | :value-type (function :tag "Function")) 111 | :group 'dired-open) 112 | 113 | (defcustom dired-open-use-nohup t 114 | "If non-nil, use nohup to keep external processes alive. 115 | See man page `nohup(1)'. 116 | 117 | This only affects the built-in handlers." 118 | :type 'boolean 119 | :group 'dired-open) 120 | 121 | (defcustom dired-open-query-before-exit t 122 | "If non-nil, ask the user if they want to kill any external 123 | processes started by `dired-open-file' when they exit Emacs. 124 | 125 | This only affects the built-in handlers." 126 | :type 'boolean 127 | :group 'dired-open) 128 | 129 | 130 | (defun dired-open--start-process (file command) 131 | "Open FILE with COMMAND. 132 | 133 | FILE is string, path to the file you want to open. It is 134 | resolved with `file-truename'. 135 | 136 | Note that FILE should not be \"shell escaped\", that is handled 137 | by this function if the shell is invoked. 138 | 139 | COMMAND is a string representing the command to run. If you want 140 | to call it with any switches, these should be included in this 141 | string as well." 142 | (let ((process 143 | (apply 'start-process "dired-open" nil 144 | (if dired-open-use-nohup 145 | (list "sh" "-c" 146 | (concat 147 | "nohup " 148 | command 149 | " " 150 | (shell-quote-argument (file-truename file)) 151 | " 2>&1 >/dev/null")) 152 | (append (split-string command " ") 153 | (list (file-truename file))))))) 154 | (when (and process 155 | (not dired-open-query-before-exit)) 156 | (set-process-query-on-exit-flag process nil)) 157 | process)) 158 | 159 | 160 | ;;; file opening procedures 161 | (defun dired-open-xdg () 162 | "Try to run `xdg-open' to open the file under point." 163 | (interactive) 164 | (if (executable-find "xdg-open") 165 | (let ((file (ignore-errors (dired-get-file-for-visit)))) 166 | (call-process-shell-command (concat "xdg-open '" (file-truename file) "'")) 167 | nil))) 168 | 169 | (defun dired-open-by-extension () 170 | "Open a file according to its extension. 171 | 172 | The mappings from extensions to applications is specified by 173 | `dired-open-extensions'." 174 | (interactive) 175 | (let ((file (ignore-errors (dired-get-file-for-visit))) 176 | process) 177 | (when (and file 178 | (not (file-directory-p file))) 179 | (--each-while dired-open-extensions (not process) 180 | (when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") file) 181 | (setq process (dired-open--start-process file (cdr it))))) 182 | process))) 183 | 184 | (defun dired-open-guess-shell-alist () 185 | "Open the file under point in an application suggested by 186 | `dired-guess-shell-alist-user'." 187 | (interactive) 188 | (let ((file (ignore-errors (dired-get-file-for-visit))) 189 | process) 190 | (when (and file 191 | (not (file-directory-p file))) 192 | (--each-while dired-guess-shell-alist-user (not process) 193 | (when (string-match-p (car it) file) 194 | (setq process (dired-open--start-process file (eval (cadr it))))))) 195 | process)) 196 | 197 | (defun dired-open-call-function-by-extension () 198 | "Call an elisp function on file according to its extension. 199 | 200 | The mappings from extensions to applications is specified by 201 | `dired-open-extensions-elisp'." 202 | (interactive) 203 | (-when-let (file (dired-utils-get-filename)) 204 | (when (not (file-directory-p file)) 205 | (--when-let (dired-utils-match-filename-extension file dired-open-extensions-elisp) 206 | (funcall (cdr it) file) 207 | it)))) 208 | 209 | 210 | ;;; non-file opening procedures 211 | (defun dired-open-subdir () 212 | "If point is on a subdir line, open the directory under point 213 | in a new buffer. 214 | 215 | For example, if the point is on line 216 | 217 | /home/us|er/downloads 218 | 219 | the directory /home/user is opened in new buffer." 220 | (interactive) 221 | (-when-let (subdir (dired-get-subdir)) 222 | (if (or (bolp) (eolp)) 223 | (find-file subdir) 224 | (-when-let (end (save-excursion (re-search-forward "[/:]" (line-end-position) t))) 225 | (let ((path (buffer-substring-no-properties 226 | (+ 2 (line-beginning-position)) 227 | (1- end)))) 228 | (find-file path)))))) 229 | 230 | 231 | ;;; main 232 | 233 | ;;;###autoload 234 | (defun dired-open-file (&optional arg) 235 | "Try `dired-open-functions' to open the thing under point. 236 | 237 | That can be either file or any other line of dired listing. 238 | 239 | If no function succeeded, run `dired-find-file' normally. 240 | 241 | With \\[universal-argument], run `dired-find-file' normally." 242 | (interactive "P") 243 | (when (or arg 244 | (not (run-hook-with-args-until-success 'dired-open-functions))) 245 | (funcall dired-open-find-file-function))) 246 | 247 | (define-key dired-mode-map [remap dired-find-file] 'dired-open-file) 248 | 249 | (provide 'dired-open) 250 | 251 | ;;; dired-open.el ends here 252 | -------------------------------------------------------------------------------- /dired-rainbow.el: -------------------------------------------------------------------------------- 1 | ;;; dired-rainbow.el --- Extended file highlighting according to its type 2 | 3 | ;; Copyright (C) 2014-2017 Matus Goljer 4 | 5 | ;; Author: Matus Goljer 6 | ;; Maintainer: Matus Goljer 7 | ;; Keywords: files 8 | ;; Version: 0.0.3 9 | ;; Created: 16th February 2014 10 | ;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1") (emacs "24")) 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; This package adds more customizable highlighting for files in dired 29 | ;; listings. The group `dired-faces' provides only nine faces and 30 | ;; isn't very fine-grained. 31 | ;; 32 | ;; The definitions are added by several macros, currently available 33 | ;; are: 34 | ;; 35 | ;; * `dired-rainbow-define` - add face by file extension 36 | ;; * `dired-rainbow-define-chmod` - add face by file permissions 37 | ;; 38 | ;; You can display their documentation by calling (substituting the 39 | ;; desired macro name): 40 | ;; 41 | ;; M-x describe-function RET dired-rainbow-define RET 42 | ;; 43 | ;; Here are some example uses: 44 | ;; 45 | ;; (defconst my-dired-media-files-extensions 46 | ;; '("mp3" "mp4" "MP3" "MP4" "avi" "mpg" "flv" "ogg") 47 | ;; "Media files.") 48 | ;; 49 | ;; (dired-rainbow-define html "#4e9a06" ("htm" "html" "xhtml")) 50 | ;; (dired-rainbow-define media "#ce5c00" my-dired-media-files-extensions) 51 | ;; 52 | ;; ; boring regexp due to lack of imagination 53 | ;; (dired-rainbow-define log (:inherit default 54 | ;; :italic t) ".*\\.log") 55 | ;; 56 | ;; ; highlight executable files, but not directories 57 | ;; (dired-rainbow-define-chmod executable-unix "Green" "-.*x.*") 58 | ;; 59 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection. 60 | 61 | ;;; Code: 62 | 63 | (require 'dired-hacks-utils) 64 | (require 'dash) 65 | 66 | (defgroup dired-rainbow () 67 | "Extended file highlighting according to its type." 68 | :group 'dired-hacks 69 | :prefix "dired-rainbow-") 70 | 71 | (defvar dired-rainbow-ext-to-face nil 72 | "An alist mapping extension groups to face and compiled regexp. 73 | 74 | This alist is constructed in `dired-rainbow-define' for the case 75 | when the user wants to reuse the associations outside of dired.") 76 | 77 | (defun dired-rainbow--get-face (face-props) 78 | "Return face specification according to FACE-PROPS. 79 | 80 | See `dired-rainbow-define'." 81 | (cond 82 | ((stringp face-props) 83 | `(:foreground ,face-props)) 84 | ((symbolp face-props) 85 | `(:inherit ,face-props)) 86 | (t face-props))) 87 | 88 | (defmacro dired-rainbow-define (symbol face-props extensions &optional how) 89 | "Define a custom dired face highlighting files by extension. 90 | 91 | SYMBOL is the identifier of the face. The macro will define a face named 92 | 93 | dired-rainbow-SYMBOL-face. 94 | 95 | FACE-PROPS is a string, a list or a symbol. If a string, it is 96 | assumed to be either a color name or a hexadecimal code (#......) 97 | describing a color. If a list, it is assumed to be a property 98 | list describing the face. See `defface' for list of possible 99 | attributes. If a symbol it is taken as the name of an existing 100 | face which is used. 101 | 102 | EXTENSIONS is either a list or a symbol evaluating to a list of 103 | extensions that should be highlighted with this face. Note that 104 | if you specify a symbol, its value *must* be known during 105 | compilation and must be defined before this macro is processed. 106 | 107 | Additionally, EXTENSIONS can be a single string or a symbol 108 | evaluating to a string that is interpreted as a regexp matching 109 | the entire file name. 110 | 111 | HOW is a parameter that is passed directly to `font-lock-add-keywords' 112 | to control the order." 113 | (declare (debug (symbolp [&or stringp listp symbolp] [&or symbolp listp stringp]))) 114 | (let* ((matcher (if (or (listp extensions) 115 | (stringp extensions)) 116 | extensions 117 | (symbol-value extensions))) 118 | (regexp (concat 119 | "^[^!].[^d].*[ ]" 120 | dired-hacks-datetime-regexp 121 | "[ ]\\(" 122 | (if (listp matcher) 123 | (concat ".*\\." (regexp-opt matcher)) 124 | matcher) 125 | "\\)$")) 126 | (face-name (intern (concat "dired-rainbow-" (symbol-name symbol) "-face")))) 127 | `(progn 128 | (defface ,face-name 129 | '((t ,(dired-rainbow--get-face face-props))) 130 | ,(concat "dired-rainbow face matching " (symbol-name symbol) " files.") 131 | :group 'dired-rainbow) 132 | (font-lock-add-keywords 'dired-mode '((,regexp 1 ',face-name prepend)) ,how) 133 | (font-lock-add-keywords 'wdired-mode '((,regexp 1 ',face-name prepend)) ,how) 134 | ,(if (listp matcher) `(push 135 | '(,matcher ,face-name ,(concat "\\." (regexp-opt matcher))) 136 | dired-rainbow-ext-to-face))))) 137 | 138 | (defmacro dired-rainbow-define-chmod (symbol face-props chmod &optional how) 139 | "Define a custom dired face highlighting files by chmod permissions. 140 | 141 | SYMBOL is the identifier of the face. The macro will define a face named 142 | 143 | dired-rainbow-SYMBOL-face. 144 | 145 | FACE-PROPS is a string, a list or a symbol. If a string, it is 146 | assumed to be either a color name or a hexadecimal code (#......) 147 | describing a color. If a list, it is assumed to be a property 148 | list describing the face. See `defface' for list of possible 149 | attributes. If a symbol it is taken as the name of an existing 150 | face which is used. 151 | 152 | CHMOD is a regexp matching \"ls -l\" style permissions string. 153 | For example, the pattern 154 | 155 | \"-.*x.*\" 156 | 157 | matches any file with executable flag set for user, group or everyone. 158 | 159 | HOW is a parameter that is passed directly to `font-lock-add-keywords' 160 | to control the order." 161 | (declare (debug (symbolp [&or stringp listp symbolp] stringp))) 162 | (let* ((regexp (concat 163 | "^[^!]." 164 | chmod 165 | ".*[ ]" 166 | dired-hacks-datetime-regexp 167 | "[ ]\\(.*?\\)$")) 168 | (face-name (intern (concat "dired-rainbow-" (symbol-name symbol) "-face")))) 169 | `(progn 170 | (defface ,face-name 171 | '((t ,(dired-rainbow--get-face face-props))) 172 | ,(concat "dired-rainbow face matching " (symbol-name symbol) " files.") 173 | :group 'dired-rainbow) 174 | (font-lock-add-keywords 'dired-mode '((,regexp 1 ',face-name prepend)) ,how) 175 | (font-lock-add-keywords 'wdired-mode '((,regexp 1 ',face-name prepend)) ,how)))) 176 | 177 | (provide 'dired-rainbow) 178 | 179 | ;;; dired-rainbow.el ends here 180 | -------------------------------------------------------------------------------- /dired-ranger.el: -------------------------------------------------------------------------------- 1 | ;;; dired-ranger.el --- Implementation of useful ranger features for dired 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 17th June 2014 9 | ;; Package-Requires: ((dash "2.7.0") (dired-hacks-utils "0.0.1") (emacs "24.3")) 10 | ;; Keywords: files 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 15 | ;; as published by the Free Software Foundation; either version 3 16 | ;; of the License, or (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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; This package implements useful features present in the 29 | ;; [ranger](http://ranger.github.io/) file manager which are missing 30 | ;; in dired. 31 | 32 | ;; Multi-stage copy/pasting of files 33 | ;; --------------------------------- 34 | 35 | ;; A feature present in most orthodox file managers is a "two-stage" 36 | ;; copy/paste process. Roughly, the user first selects some files, 37 | ;; "copies" them into a clipboard and then pastes them to the target 38 | ;; location. This workflow is missing in dired. 39 | 40 | ;; In dired, user first marks the files, then issues the 41 | ;; `dired-do-copy' command which prompts for the destination. The 42 | ;; files are then copied there. The `dired-dwim-target' option makes 43 | ;; this a bit friendlier---if two dired windows are opened, the other 44 | ;; one is automatically the default target. 45 | 46 | ;; With the multi-stage operations, you can gather files from 47 | ;; *multiple* dired buffers into a single "clipboard", then copy or 48 | ;; move all of them to the target location. Another huge advantage is 49 | ;; that if the target dired buffer is already opened, switching to it 50 | ;; via ido or ibuffer is often faster than selecting the path. 51 | 52 | ;; Call `dired-ranger-copy' to add marked files (or the file under 53 | ;; point if no files are marked) to the "clipboard". With non-nil 54 | ;; prefix argument, add the marked files to the current clipboard. 55 | 56 | ;; Past clipboards are stored in `dired-ranger-copy-ring' so you can 57 | ;; repeat the past pastes. 58 | 59 | ;; Call `dired-ranger-paste' or `dired-ranger-move' to copy or move 60 | ;; the files in the current clipboard to the current dired buffer. 61 | ;; With raw prefix argument (usually C-u), the clipboard is not 62 | ;; cleared, so you can repeat the copy operation in another dired 63 | ;; buffer. 64 | 65 | ;; The copy or move operation is asynchronous if `dired-async-mode' 66 | ;; is activated. 67 | 68 | ;; Bookmarks 69 | ;; --------- 70 | 71 | ;; Use `dired-ranger-bookmark' to bookmark current dired buffer. You 72 | ;; can later quickly revisit it by calling 73 | ;; `dired-ranger-bookmark-visit'. 74 | 75 | ;; A bookmark name is any single character, letter, digit or a symbol. 76 | 77 | ;; A special bookmark with name `dired-ranger-bookmark-LRU' represents 78 | ;; the least recently used dired buffer. Its default value is `. If 79 | ;; you bind `dired-ranger-bookmark-visit' to the same keybinding, 80 | ;; hitting `` will instantly bring you to the previously used dired 81 | ;; buffer. This can be used to toggle between two dired buffers in a 82 | ;; very fast way. 83 | 84 | ;; These bookmarks are not persistent. If you want persistent 85 | ;; bookmarks use the bookmarks provided by Emacs, see (info "(emacs) 86 | ;; Bookmarks"). 87 | 88 | ;;; Code: 89 | 90 | (require 'dash) 91 | (require 'ring) 92 | (require 'dired-aux) 93 | 94 | (defgroup dired-ranger () 95 | "Implementation of useful ranger features for dired." 96 | :group 'dired-hacks 97 | :prefix "dired-ranger-") 98 | 99 | 100 | ;; multi-stage copy/paste operations 101 | (defcustom dired-ranger-copy-ring-size 10 102 | "Specifies how many filesets for copy/paste operations should be stored." 103 | :type 'natnum 104 | :group 'dired-ranger) 105 | 106 | (defvar dired-ranger-copy-ring (make-ring dired-ranger-copy-ring-size)) 107 | 108 | ;;;###autoload 109 | (defun dired-ranger-copy (arg) 110 | "Place the marked items in the copy ring. 111 | 112 | With non-nil prefix argument, add the marked items to the current 113 | selection. This allows you to gather files from multiple dired 114 | buffers for a single paste." 115 | (interactive "P") 116 | ;; TODO: add dired+ `dired-get-marked-files' support? 117 | (let ((marked (dired-get-marked-files))) 118 | (if (or (not arg) 119 | (ring-empty-p dired-ranger-copy-ring)) 120 | (progn 121 | (ring-insert 122 | dired-ranger-copy-ring 123 | (cons (list (current-buffer)) marked)) 124 | ;; TODO: abstract the message/plural detection somewhere 125 | ;; (e.g. give it a verb and number to produce the correct 126 | ;; string.) 127 | (message (format "Copied %d item%s into copy ring." 128 | (length marked) 129 | (if (> (length marked) 1) "s" "")))) 130 | (let ((current (ring-remove dired-ranger-copy-ring 0))) 131 | (ring-insert 132 | dired-ranger-copy-ring 133 | (cons (-distinct (cons (current-buffer) (car current))) 134 | (-distinct (-concat (dired-get-marked-files) (cdr current))))) 135 | (message (format "Added %d item%s into copy ring." 136 | (length marked) 137 | (if (> (length marked) 1) "s" ""))))))) 138 | 139 | (defun dired-ranger--name-constructor (oldname) 140 | "Return the new file name corresponding to OLDNAME." 141 | (concat (dired-current-directory) (file-name-nondirectory oldname))) 142 | 143 | ;;;###autoload 144 | (defun dired-ranger-paste (arg) 145 | "Copy the items from copy ring to current directory. 146 | 147 | With raw prefix argument \\[universal-argument], do not remove 148 | the selection from the stack so it can be copied again. 149 | 150 | With numeric prefix argument, copy the n-th selection from the 151 | copy ring." 152 | (interactive "P") 153 | (let* ((index (if (numberp arg) arg 0)) 154 | (data (ring-ref dired-ranger-copy-ring index)) 155 | (files (cdr data))) 156 | (dired-create-files #'dired-copy-file "Copy" files 157 | #'dired-ranger--name-constructor ?C) 158 | (unless arg (ring-remove dired-ranger-copy-ring 0)))) 159 | 160 | ;;;###autoload 161 | (defun dired-ranger-move (arg) 162 | "Move the items from copy ring to current directory. 163 | 164 | This behaves like `dired-ranger-paste' but moves the files 165 | instead of copying them." 166 | (interactive "P") 167 | (let* ((index (if (numberp arg) arg 0)) 168 | (data (ring-ref dired-ranger-copy-ring index)) 169 | (files (cdr data))) 170 | (dired-create-files #'rename-file "Rename" files 171 | #'dired-ranger--name-constructor ?M) 172 | (unless arg (ring-remove dired-ranger-copy-ring 0)))) 173 | 174 | 175 | ;; bookmarks 176 | (defcustom dired-ranger-bookmark-reopen 'ask 177 | "Should we reopen closed dired buffer when visiting a bookmark? 178 | 179 | This does only correctly reopen regular dired buffers listing one 180 | directory. Special dired buffers like the output of `find-dired' 181 | or `ag-dired', virtual dired buffers and subdirectories can not 182 | be recreated. 183 | 184 | The value 'never means never reopen the directory. 185 | 186 | The value 'always means always reopen the directory. 187 | 188 | The value 'ask will ask if we should reopen or not. Reopening a 189 | dired buffer for a directory that is already opened in dired will 190 | bring that up, which might be unexpected as that directory might 191 | come from a non-standard source (i.e. not be file-system 192 | backed)." 193 | :type '(radio 194 | (const :tag "Never reopen automatically." never) 195 | (const :tag "Always reopen automatically." always) 196 | (const :tag "Reopen automatically only in standard dired buffers, ask otherwise." ask)) 197 | :group 'dired-ranger) 198 | 199 | (defcustom dired-ranger-bookmark-LRU ?` 200 | "Bookmark representing the least recently used/visited dired buffer. 201 | 202 | If a dired buffer is currently active, select the one visited 203 | before. If a non-dired buffer is active, visit the least 204 | recently visited dired buffer." 205 | :type 'char 206 | :group 'dired-ranger) 207 | 208 | (defvar dired-ranger-bookmarks nil 209 | "An alist mapping bookmarks to dired buffers and locations.") 210 | 211 | ;;;###autoload 212 | (defun dired-ranger-bookmark (char) 213 | "Bookmark current dired buffer. 214 | 215 | CHAR is a single character (a-zA-Z0-9) representing the bookmark. 216 | Reusing a bookmark replaces the content. These bookmarks are not 217 | persistent, they are used for quick jumping back and forth 218 | between currently used directories." 219 | (interactive "cBookmark name: ") 220 | (let ((dir (file-truename default-directory))) 221 | (-if-let (value (cdr (assoc char dired-ranger-bookmarks))) 222 | (setf (cdr (assoc char dired-ranger-bookmarks)) (cons dir (current-buffer))) 223 | (push (-cons* char dir (current-buffer)) dired-ranger-bookmarks)) 224 | (message "Bookmarked directory %s as `%c'" dir char))) 225 | 226 | ;;;###autoload 227 | (defun dired-ranger-bookmark-visit (char) 228 | "Visit bookmark CHAR. 229 | 230 | If the associated dired buffer was killed, we try to reopen it 231 | according to the setting `dired-ranger-bookmark-reopen'. 232 | 233 | The special bookmark `dired-ranger-bookmark-LRU' always jumps to 234 | the least recently visited dired buffer. 235 | 236 | See also `dired-ranger-bookmark'." 237 | (interactive "cBookmark name: ") 238 | (if (eq char dired-ranger-bookmark-LRU) 239 | (progn 240 | (let ((buffers (buffer-list))) 241 | (when (eq (with-current-buffer (car buffers) major-mode) 'dired-mode) 242 | (pop buffers)) 243 | (switch-to-buffer (--first (eq (with-current-buffer it major-mode) 'dired-mode) buffers)))) 244 | (-if-let* ((value (cdr (assoc char dired-ranger-bookmarks))) 245 | (dir (car value)) 246 | (buffer (cdr value))) 247 | (if (buffer-live-p buffer) 248 | (switch-to-buffer buffer) 249 | (when 250 | ;; TODO: abstract this never/always/ask pattern. It is 251 | ;; also used in filter. 252 | (cond 253 | ((eq dired-ranger-bookmark-reopen 'never) nil) 254 | ((eq dired-ranger-bookmark-reopen 'always) t) 255 | ((eq dired-ranger-bookmark-reopen 'ask) 256 | (y-or-n-p (format "The dired buffer referenced by this bookmark does not exist. Should we try to reopen `%s'?" dir)))) 257 | (find-file dir) 258 | (setf (cdr (assoc char dired-ranger-bookmarks)) (cons dir (current-buffer))))) 259 | (message "Bookmark `%c' does not exist." char)))) 260 | 261 | (provide 'dired-ranger) 262 | ;;; dired-ranger.el ends here 263 | -------------------------------------------------------------------------------- /dired-subtree.el: -------------------------------------------------------------------------------- 1 | ;;; dired-subtree.el --- Insert subdirectories in a tree-like fashion 2 | 3 | ;; Copyright (C) 2014-2015 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Keywords: files 8 | ;; Version: 0.0.1 9 | ;; Created: 25th February 2014 10 | ;; Package-Requires: ((dash "2.5.0") (dired-hacks-utils "0.0.1") (emacs "24.3")) 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; Introduction 29 | ;; ------------ 30 | 31 | ;; The basic command to work with subdirectories in dired is `i', 32 | ;; which inserts the subdirectory as a separate listing in the active 33 | ;; dired buffer. 34 | 35 | ;; This package defines function `dired-subtree-insert' which instead 36 | ;; inserts the subdirectory directly below its line in the original 37 | ;; listing, and indent the listing of subdirectory to resemble a 38 | ;; tree-like structure (somewhat similar to tree(1) except the pretty 39 | ;; graphics). The tree display is somewhat more intuitive than the 40 | ;; default "flat" subdirectory manipulation provided by `i'. 41 | 42 | ;; There are several presentation options and faces you can customize 43 | ;; to change the way subtrees are displayed. 44 | 45 | ;; You can further remove the unwanted lines from the subtree by using 46 | ;; `k' command or some of the built-in "focusing" functions, such as 47 | ;; `dired-subtree-only-*' (see list below). 48 | 49 | ;; If you have the package `dired-filter', you can additionally filter 50 | ;; the subtrees with global or local filters. 51 | 52 | ;; A demo of basic functionality is available on youtube: 53 | ;; https://www.youtube.com/watch?v=z26b8HKFsNE 54 | 55 | ;; Interactive functions 56 | ;; --------------------- 57 | 58 | ;; Here's a list of available interactive functions. You can read 59 | ;; more about each one by using the built-in documentation facilities 60 | ;; of Emacs. It is adviced to place bindings for these into a 61 | ;; convenient prefix key map, for example C-, 62 | 63 | ;; * `dired-subtree-insert' 64 | ;; * `dired-subtree-remove' 65 | ;; * `dired-subtree-toggle' 66 | ;; * `dired-subtree-cycle' 67 | ;; * `dired-subtree-revert' 68 | ;; * `dired-subtree-narrow' 69 | ;; * `dired-subtree-up' 70 | ;; * `dired-subtree-down' 71 | ;; * `dired-subtree-next-sibling' 72 | ;; * `dired-subtree-previous-sibling' 73 | ;; * `dired-subtree-beginning' 74 | ;; * `dired-subtree-end' 75 | ;; * `dired-subtree-mark-subtree' 76 | ;; * `dired-subtree-unmark-subtree' 77 | ;; * `dired-subtree-only-this-file' 78 | ;; * `dired-subtree-only-this-directory' 79 | 80 | ;; If you have package `dired-filter', additional command 81 | ;; `dired-subtree-apply-filter' is available. 82 | 83 | ;; See https://github.com/Fuco1/dired-hacks for the entire collection. 84 | 85 | ;;; Code: 86 | 87 | (require 'dired-hacks-utils) 88 | (require 'dash) 89 | (require 'cl-lib) 90 | 91 | (defgroup dired-subtree () 92 | "Insert subdirectories in a tree-like fashion." 93 | :group 'dired-hacks 94 | :prefix "dired-subtree-") 95 | 96 | (defcustom dired-subtree-line-prefix " " 97 | "A prefix put into each nested subtree. 98 | 99 | The prefix is repeated \"depth\" times. 100 | 101 | Alternatively, it can be a function taking one argument---the 102 | depth---that creates the prefix." 103 | :type '(choice string function) 104 | :group 'dired-subtree) 105 | 106 | (defcustom dired-subtree-line-prefix-face 'parents 107 | "Specifies how the prefix is fontified." 108 | :type '(radio 109 | (const :tag "No face applied" nil) 110 | (const :tag "Inherit from current subtree" subtree) 111 | (const :tag "Inherit from all parents" parents)) 112 | :group 'dired-subtree) 113 | 114 | (defcustom dired-subtree-use-backgrounds t 115 | "When non-nil, add a background face to a subtree listing." 116 | :type 'boolean 117 | :group 'dired-subtree) 118 | 119 | (defcustom dired-subtree-after-insert-hook () 120 | "Hook run at the end of `dired-subtree-insert'." 121 | :type 'hook 122 | :group 'dired-subtree) 123 | 124 | (defcustom dired-subtree-after-remove-hook () 125 | "Hook run at the end of `dired-subtree-remove'." 126 | :type 'hook 127 | :group 'dired-subtree) 128 | 129 | (defcustom dired-subtree-cycle-depth 3 130 | "Default depth expanded by `dired-subtree-cycle'." 131 | :type 'natnum 132 | :group 'dired-subtree) 133 | 134 | (defcustom dired-subtree-ignored-regexp 135 | (concat "^" (regexp-opt vc-directory-exclusion-list) "$") 136 | "Matching directories will not be expanded in `dired-subtree-cycle'." 137 | :type 'regexp 138 | :group 'dired-subtree) 139 | 140 | (defgroup dired-subtree-faces () 141 | "Faces used in `dired-subtree'." 142 | :group 'dired-subtree) 143 | 144 | (defface dired-subtree-depth-1-face 145 | '((t (:background "#252e30"))) 146 | "Background for depth 1 subtrees" 147 | :group 'dired-subtree-faces) 148 | 149 | (defface dired-subtree-depth-2-face 150 | '((t (:background "#232a2b"))) 151 | "Background for depth 2 subtrees" 152 | :group 'dired-subtree-faces) 153 | 154 | (defface dired-subtree-depth-3-face 155 | '((t (:background "#212627"))) 156 | "Background for depth 3 subtrees" 157 | :group 'dired-subtree-faces) 158 | 159 | (defface dired-subtree-depth-4-face 160 | '((t (:background "#1e2223"))) 161 | "Background for depth 4 subtrees" 162 | :group 'dired-subtree-faces) 163 | 164 | (defface dired-subtree-depth-5-face 165 | '((t (:background "#1c1d1e"))) 166 | "Background for depth 5 subtrees" 167 | :group 'dired-subtree-faces) 168 | 169 | (defface dired-subtree-depth-6-face 170 | '((t (:background "#1a191a"))) 171 | "Background for depth 6 subtrees" 172 | :group 'dired-subtree-faces) 173 | 174 | (defvar dired-subtree-overlays nil 175 | "Subtree overlays in this buffer.") 176 | (make-variable-buffer-local 'dired-subtree-overlays) 177 | 178 | 179 | ;;; Overlay manipulation 180 | ;; Maybe we should abstract the overlay-foo into some subtree 181 | ;; functions instead!!! 182 | 183 | (defun dired-subtree--remove-overlay (ov) 184 | "Remove dired-subtree overlay OV." 185 | (setq dired-subtree-overlays 186 | (--remove (equal it ov) dired-subtree-overlays)) 187 | (delete-overlay ov)) 188 | 189 | (defun dired-subtree--remove-overlays (ovs) 190 | "Remove dired-subtree overlays OVS." 191 | (mapc 'dired-subtree--remove-overlay ovs)) 192 | 193 | (defun dired-subtree--cleanup-overlays () 194 | "Remove the nil values from `dired-subtree-overlays'." 195 | (setq dired-subtree-overlays 196 | (--remove (not (overlay-buffer it)) dired-subtree-overlays))) 197 | 198 | (defun dired-subtree--get-all-ovs () 199 | "Get all dired-subtree overlays in this buffer." 200 | (--filter (overlay-get it 'dired-subtree-depth) (overlays-in (point-min) (point-max)))) 201 | 202 | (defun dired-subtree--get-all-ovs-at-point (&optional p) 203 | "Get all dired-subtree overlays at point P." 204 | (setq p (or p (point))) 205 | (--filter (overlay-get it 'dired-subtree-depth) (overlays-at (point)))) 206 | 207 | (defun dired-subtree--get-ovs-in (&optional beg end) 208 | "Get all dired-subtree overlays between BEG and END. 209 | 210 | BEG and END default to the region spanned by overlay at point." 211 | (when (not beg) 212 | (let ((ov (dired-subtree--get-ov))) 213 | (setq beg (overlay-start ov)) 214 | (setq end (overlay-end ov)))) 215 | (--filter (and (overlay-get it 'dired-subtree-depth) 216 | (>= (overlay-start it) beg) 217 | (<= (overlay-end it) end)) 218 | (overlays-in (point-min) (point-max)))) 219 | 220 | (defun dired-subtree--get-ov (&optional p) 221 | "Get the parent subtree overlay at point." 222 | (setq p (or p (point))) 223 | (car (--sort (> (overlay-get it 'dired-subtree-depth) 224 | (overlay-get other 'dired-subtree-depth)) 225 | (dired-subtree--get-all-ovs-at-point p)))) 226 | 227 | (defun dired-subtree--get-depth (ov) 228 | "Get subtree depth." 229 | (or (and ov (overlay-get ov 'dired-subtree-depth)) 0)) 230 | 231 | 232 | 233 | ;;; helpers 234 | (defvar dired-subtree-preserve-properties '(dired-subtree-filter) 235 | "Properties that should be preserved between read-ins.") 236 | 237 | (defun dired-subtree--after-readin (&optional subtrees) 238 | "Insert the SUBTREES again after dired buffer has been reverted. 239 | 240 | If no SUBTREES are specified, use `dired-subtree-overlays'." 241 | (-when-let (subtrees-to-process (or subtrees dired-subtree-overlays)) 242 | (let* ((ovs-by-depth (--sort (< (car it) (car other)) 243 | (--group-by (overlay-get it 'dired-subtree-depth) 244 | subtrees-to-process))) 245 | (sorted-ovs (--map (cons (car it) 246 | (--map (-cons* it 247 | (overlay-get it 'dired-subtree-name) 248 | (-map (lambda (x) (cons x (overlay-get it x))) 249 | dired-subtree-preserve-properties)) (cdr it))) 250 | ovs-by-depth))) 251 | ;; (depth (path1 ov1 (prop1 . value1) (prop2 . value2)) (path2 ...)) 252 | (--each sorted-ovs 253 | (--each (cdr it) 254 | (when (dired-utils-goto-line (cadr it)) 255 | (dired-subtree--remove-overlay (car it)) 256 | (dired-subtree-insert) 257 | (let ((ov (dired-subtree--get-ov))) 258 | (--each (cddr it) 259 | (overlay-put ov (car it) (cdr it))) 260 | (dired-subtree--filter-subtree ov)))))))) 261 | 262 | (defun dired-subtree--after-insert () 263 | "After inserting the subtree, setup dired-details/dired-hide-details-mode." 264 | (if (fboundp 'dired-insert-set-properties) 265 | (let ((inhibit-read-only t) 266 | (ov (dired-subtree--get-ov))) 267 | (dired-insert-set-properties (overlay-start ov) (overlay-end ov))) 268 | (when (featurep 'dired-details) 269 | (dired-details-delete-overlays) 270 | (dired-details-activate)))) 271 | 272 | (add-hook 'dired-after-readin-hook 'dired-subtree--after-readin) 273 | 274 | (add-hook 'dired-subtree-after-insert-hook 'dired-subtree--after-insert) 275 | 276 | (defun dired-subtree--unmark () 277 | "Unmark a file without moving point." 278 | (save-excursion (dired-unmark 1))) 279 | 280 | (defun dired-subtree--dired-line-is-directory-or-link-p () 281 | "Return non-nil if line under point is a directory or symlink." 282 | ;; We've replaced `file-directory-p' with the regexp test to 283 | ;; speed up filters over TRAMP. So long as dired/ls format 284 | ;; doesn't change, we're good. 285 | ;; 'd' for directories, 'l' for potential symlinks to directories. 286 | (save-excursion (beginning-of-line) (looking-at "..[dl]"))) 287 | 288 | (defun dired-subtree--is-expanded-p () 289 | "Return non-nil if directory under point is expanded." 290 | (save-excursion 291 | (when (dired-utils-get-filename) 292 | (let ((depth (dired-subtree--get-depth (dired-subtree--get-ov)))) 293 | (dired-next-line 1) 294 | (< depth (dired-subtree--get-depth (dired-subtree--get-ov))))))) 295 | 296 | (defmacro dired-subtree-with-subtree (&rest forms) 297 | "Run FORMS on each file in this subtree." 298 | (declare (debug (body))) 299 | `(save-excursion 300 | (dired-subtree-beginning) 301 | ,@forms 302 | (while (dired-subtree-next-sibling) 303 | ,@forms))) 304 | 305 | 306 | ;;;; Interactive 307 | 308 | ;;;###autoload 309 | (defun dired-subtree-narrow () 310 | "Narrow the buffer to this subtree." 311 | (interactive) 312 | (-when-let (ov (dired-subtree--get-ov)) 313 | (narrow-to-region (overlay-start ov) 314 | (overlay-end ov)))) 315 | 316 | ;;; Navigation 317 | 318 | ;; make the arguments actually do something 319 | ;;;###autoload 320 | (defun dired-subtree-up (&optional arg) 321 | "Jump up one directory." 322 | (interactive "p") 323 | (-when-let (ov (dired-subtree--get-ov)) 324 | (goto-char (overlay-start ov)) 325 | (dired-previous-line 1))) 326 | 327 | ;;;###autoload 328 | (defun dired-subtree-down (&optional arg) 329 | "Jump down one directory." 330 | (interactive "p") 331 | (-when-let* ((p (point)) 332 | (ov (car (--sort 333 | (< (overlay-start it) 334 | (overlay-start other)) 335 | (--remove 336 | (< (overlay-start it) p) 337 | (dired-subtree--get-all-ovs)))))) 338 | (goto-char (overlay-start ov)) 339 | (dired-move-to-filename))) 340 | 341 | ;;;###autoload 342 | (defun dired-subtree-next-sibling (&optional arg) 343 | "Go to the next sibling." 344 | (interactive "p") 345 | (let ((current-ov (dired-subtree--get-ov))) 346 | (dired-next-line 1) 347 | (let ((new-ov (dired-subtree--get-ov))) 348 | (cond 349 | ((not (dired-utils-is-file-p)) 350 | nil) 351 | ((< (dired-subtree--get-depth current-ov) 352 | (dired-subtree--get-depth new-ov)) 353 | (goto-char (overlay-end new-ov)) 354 | (dired-move-to-filename) 355 | t) 356 | ((> (dired-subtree--get-depth current-ov) 357 | (dired-subtree--get-depth new-ov)) 358 | ;; add option to either go to top or stay at the end 359 | (dired-previous-line 1) 360 | nil) 361 | (t t))))) 362 | 363 | ;;;###autoload 364 | (defun dired-subtree-previous-sibling (&optional arg) 365 | "Go to the previous sibling." 366 | (interactive "p") 367 | (let ((current-ov (dired-subtree--get-ov))) 368 | (dired-previous-line 1) 369 | (let ((new-ov (dired-subtree--get-ov))) 370 | (cond 371 | ;; this will need better handlign if we have inserted 372 | ;; subdirectories 373 | ((not (dired-utils-is-file-p)) 374 | nil) 375 | ((< (dired-subtree--get-depth current-ov) 376 | (dired-subtree--get-depth new-ov)) 377 | (goto-char (overlay-start new-ov)) 378 | (dired-previous-line 1) 379 | t) 380 | ((> (dired-subtree--get-depth current-ov) 381 | (dired-subtree--get-depth new-ov)) 382 | ;; add option to either go to top or stay at the end 383 | (dired-next-line 1) 384 | nil) 385 | (t t))))) 386 | 387 | ;;;###autoload 388 | (defun dired-subtree-beginning () 389 | "Go to the first file in this subtree." 390 | (interactive) 391 | (let ((ov (dired-subtree--get-ov))) 392 | (if (not ov) 393 | ;; do something when not in subtree 394 | t 395 | (goto-char (overlay-start ov)) 396 | (dired-move-to-filename)))) 397 | 398 | ;;;###autoload 399 | (defun dired-subtree-end () 400 | "Go to the first file in this subtree." 401 | (interactive) 402 | (let ((ov (dired-subtree--get-ov))) 403 | (if (not ov) 404 | ;; do something when not in subtree 405 | t 406 | (goto-char (overlay-end ov)) 407 | (dired-previous-line 1)))) 408 | 409 | ;;; Marking 410 | 411 | ;;;###autoload 412 | (defun dired-subtree-mark-subtree (&optional all) 413 | "Mark all files in this subtree. 414 | 415 | With prefix argument mark all the files in subdirectories 416 | recursively." 417 | (interactive "P") 418 | (save-excursion 419 | (if all 420 | (let ((beg (save-excursion 421 | (dired-subtree-beginning) 422 | (point))) 423 | (end (save-excursion 424 | (dired-subtree-end) 425 | (point)))) 426 | (dired-mark-files-in-region 427 | (progn (goto-char beg) (line-beginning-position)) 428 | (progn (goto-char end) (line-end-position)))) 429 | (dired-subtree-beginning) 430 | (save-excursion (dired-mark 1)) 431 | (while (dired-subtree-next-sibling) 432 | (save-excursion (dired-mark 1)))))) 433 | 434 | ;;;###autoload 435 | (defun dired-subtree-unmark-subtree (&optional all) 436 | "Unmark all files in this subtree. 437 | 438 | With prefix argument unmark all the files in subdirectories 439 | recursively." 440 | (interactive) 441 | (let ((dired-marker-char ? )) 442 | (dired-subtree-mark-subtree all))) 443 | 444 | ;;; Insertion/deletion 445 | ;;;###autoload 446 | (defun dired-subtree-revert () 447 | "Revert the subtree. 448 | 449 | This means reinserting the content of this subtree and all its 450 | children." 451 | (interactive) 452 | (let ((inhibit-read-only t) 453 | (file-name (dired-utils-get-filename))) 454 | (-when-let* ((ov (dired-subtree--get-ov)) 455 | (ovs (dired-subtree--get-ovs-in))) 456 | (dired-subtree-up) 457 | (delete-region (overlay-start ov) (overlay-end ov)) 458 | (dired-subtree--after-readin ovs) 459 | (when file-name 460 | (dired-utils-goto-line file-name))))) 461 | 462 | (defun dired-subtree--readin (dir-name) 463 | "Read in the directory. 464 | 465 | Return a string suitable for insertion in `dired' buffer." 466 | (with-temp-buffer 467 | (insert-directory dir-name dired-listing-switches nil t) 468 | (delete-char -1) 469 | (goto-char (point-min)) 470 | (delete-region 471 | (progn (beginning-of-line) (point)) 472 | (progn (forward-line 473 | (if (save-excursion 474 | (forward-line 1) 475 | (end-of-line) 476 | (looking-back "\\.")) 477 | 3 1)) (point))) 478 | (insert " ") 479 | (while (= (forward-line) 0) 480 | (insert " ")) 481 | (delete-char -2) 482 | (buffer-string))) 483 | 484 | ;;;###autoload 485 | (defun dired-subtree-insert () 486 | "Insert subtree under this directory." 487 | (interactive) 488 | (when (and (dired-subtree--dired-line-is-directory-or-link-p) 489 | (not (dired-subtree--is-expanded-p))) 490 | (let* ((dir-name (dired-get-filename nil)) 491 | (listing (dired-subtree--readin (file-name-as-directory dir-name))) 492 | beg end) 493 | (read-only-mode -1) 494 | (move-end-of-line 1) 495 | ;; this is pretty ugly, I'm sure it can be done better 496 | (save-excursion 497 | (insert listing) 498 | (setq end (+ (point) 2))) 499 | (insert "\n") 500 | (setq beg (point)) 501 | (let ((inhibit-read-only t)) 502 | (remove-text-properties (1- beg) beg '(dired-filename))) 503 | (let* ((ov (make-overlay beg end)) 504 | (parent (dired-subtree--get-ov (1- beg))) 505 | (depth (or (and parent (1+ (overlay-get parent 'dired-subtree-depth))) 506 | 1)) 507 | (face (intern (format "dired-subtree-depth-%d-face" depth)))) 508 | (when dired-subtree-use-backgrounds 509 | (overlay-put ov 'face face)) 510 | ;; refactor this to some function 511 | (overlay-put ov 'line-prefix 512 | (if (stringp dired-subtree-line-prefix) 513 | (if (not dired-subtree-use-backgrounds) 514 | (apply 'concat (-repeat depth dired-subtree-line-prefix)) 515 | (cond 516 | ((eq nil dired-subtree-line-prefix-face) 517 | (apply 'concat 518 | (-repeat depth dired-subtree-line-prefix))) 519 | ((eq 'subtree dired-subtree-line-prefix-face) 520 | (concat 521 | dired-subtree-line-prefix 522 | (propertize 523 | (apply 'concat 524 | (-repeat (1- depth) dired-subtree-line-prefix)) 525 | 'face face))) 526 | ((eq 'parents dired-subtree-line-prefix-face) 527 | (concat 528 | dired-subtree-line-prefix 529 | (apply 'concat 530 | (--map 531 | (propertize dired-subtree-line-prefix 532 | 'face 533 | (intern (format "dired-subtree-depth-%d-face" it))) 534 | (number-sequence 1 (1- depth)))))))) 535 | (funcall dired-subtree-line-prefix depth))) 536 | (overlay-put ov 'dired-subtree-name dir-name) 537 | (overlay-put ov 'dired-subtree-parent parent) 538 | (overlay-put ov 'dired-subtree-depth depth) 539 | (overlay-put ov 'evaporate t) 540 | (push ov dired-subtree-overlays)) 541 | (goto-char beg) 542 | (dired-move-to-filename) 543 | (read-only-mode 1) 544 | (when (bound-and-true-p dired-filter-mode) (dired-filter-mode 1)) 545 | (run-hooks 'dired-subtree-after-insert-hook)))) 546 | 547 | ;;;###autoload 548 | (defun dired-subtree-remove () 549 | "Remove subtree at point." 550 | (interactive) 551 | (-when-let* ((ov (dired-subtree--get-ov)) 552 | (ovs (dired-subtree--get-ovs-in 553 | (overlay-start ov) 554 | (overlay-end ov)))) 555 | (let ((inhibit-read-only t)) 556 | (dired-subtree-up) 557 | (delete-region (overlay-start ov) 558 | (overlay-end ov)) 559 | (dired-subtree--remove-overlays ovs))) 560 | (run-hooks 'dired-subtree-after-remove-hook)) 561 | 562 | ;;;###autoload 563 | (defun dired-subtree-toggle () 564 | "Insert subtree at point or remove it if it was not present." 565 | (interactive) 566 | (if (dired-subtree--is-expanded-p) 567 | (progn 568 | (dired-next-line 1) 569 | (dired-subtree-remove) 570 | ;; #175 fixes the case of the first line in dired when the 571 | ;; cursor jumps to the header in dired rather then to the 572 | ;; first file in buffer 573 | (when (bobp) 574 | (dired-next-line 1))) 575 | (save-excursion (dired-subtree-insert)))) 576 | 577 | (defun dired-subtree--insert-recursive (depth max-depth) 578 | "Insert full subtree at point." 579 | (save-excursion 580 | (let ((name (dired-get-filename nil t))) 581 | (when (and name (file-directory-p name) 582 | (<= depth (or max-depth depth)) 583 | (or (= 1 depth) 584 | (not (string-match-p dired-subtree-ignored-regexp 585 | (file-name-nondirectory name))))) 586 | (if (dired-subtree--is-expanded-p) 587 | (dired-next-line 1) 588 | (dired-subtree-insert)) 589 | (dired-subtree-end) 590 | (dired-subtree--insert-recursive (1+ depth) max-depth) 591 | (while (dired-subtree-previous-sibling) 592 | (dired-subtree--insert-recursive (1+ depth) max-depth)))))) 593 | 594 | (defvar dired-subtree--cycle-previous nil 595 | "Remember previous action for `dired-subtree-cycle'") 596 | 597 | ;;;###autoload 598 | (defun dired-subtree-cycle (&optional max-depth) 599 | "Org-mode like cycle visibility: 600 | 601 | 1) Show subtree 602 | 2) Show subtree recursively (if previous command was cycle) 603 | 3) Remove subtree 604 | 605 | Numeric prefix will set max depth" 606 | (interactive "P") 607 | (save-excursion 608 | (cond 609 | ;; prefix - show subtrees up to max-depth 610 | (max-depth 611 | (when (dired-subtree--is-expanded-p) 612 | (dired-next-line 1) 613 | (dired-subtree-remove)) 614 | (dired-subtree--insert-recursive 1 (if (integerp max-depth) max-depth nil)) 615 | (setq dired-subtree--cycle-previous :full)) 616 | ;; if directory is not expanded, expand one level 617 | ((not (dired-subtree--is-expanded-p)) 618 | (dired-subtree-insert) 619 | (setq dired-subtree--cycle-previous :insert)) 620 | ;; hide if previous command was not cycle or tree was fully expanded 621 | ((or (not (eq last-command 'dired-subtree-cycle)) 622 | (eq dired-subtree--cycle-previous :full)) 623 | (dired-next-line 1) 624 | (dired-subtree-remove) 625 | (setq dired-subtree--cycle-previous :remove)) 626 | (t 627 | (dired-subtree--insert-recursive 1 dired-subtree-cycle-depth) 628 | (setq dired-subtree--cycle-previous :full))))) 629 | 630 | (defun dired-subtree--filter-up (keep-dir kill-siblings) 631 | (save-excursion 632 | (let (ov) 633 | (save-excursion 634 | (while (dired-subtree-up)) 635 | (dired-next-line 1) 636 | (dired-subtree-mark-subtree t)) 637 | (if keep-dir 638 | (dired-subtree-unmark-subtree) 639 | (dired-subtree--unmark)) 640 | (while (and (dired-subtree-up) 641 | (> (dired-subtree--get-depth (dired-subtree--get-ov)) 0)) 642 | (if (not kill-siblings) 643 | (dired-subtree--unmark) 644 | (dired-subtree--unmark) 645 | (let ((here (point))) 646 | (dired-subtree-with-subtree 647 | (when (and (dired-subtree--is-expanded-p) 648 | (/= (point) here)) 649 | (dired-subtree--unmark) 650 | (save-excursion 651 | (dired-next-line 1) 652 | (dired-subtree-unmark-subtree t))))))) 653 | (dired-do-kill-lines) 654 | (dired-subtree--cleanup-overlays)))) 655 | 656 | ;;;###autoload 657 | (defun dired-subtree-only-this-file (&optional arg) 658 | "Remove all the siblings on the route from this file to the top-most directory. 659 | 660 | With ARG non-nil, do not remove expanded directories in parents." 661 | (interactive "P") 662 | (dired-subtree--filter-up nil arg)) 663 | 664 | ;;;###autoload 665 | (defun dired-subtree-only-this-directory (&optional arg) 666 | "Remove all the siblings on the route from this directory to the top-most directory. 667 | 668 | With ARG non-nil, do not remove expanded directories in parents." 669 | (interactive "P") 670 | (dired-subtree--filter-up t arg)) 671 | 672 | ;;; filtering 673 | (defun dired-subtree--filter-update-bs (ov) 674 | "Update the local filter list. 675 | 676 | This function assumes that `dired-filter-stack' is dynamically 677 | bound to relevant value." 678 | (let* ((filt (dired-filter--describe-filters)) 679 | (before-str (if (equal filt "") nil (concat " Local filters: " filt "\n")))) 680 | (overlay-put ov 'before-string before-str))) 681 | 682 | (defun dired-subtree--filter-subtree (ov) 683 | "Run the filter for this subtree. 684 | 685 | It is only safe to call this from readin. 686 | 687 | This depends on `dired-filter' package." 688 | (when (featurep 'dired-filter) 689 | (let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter))) 690 | (save-restriction 691 | (widen) 692 | (dired-subtree-narrow) 693 | (dired-filter--expunge) 694 | (dired-subtree--filter-update-bs ov))))) 695 | 696 | ;;;###autoload 697 | (defun dired-subtree-apply-filter () 698 | "Push a local filter for this subtree. 699 | 700 | This depends on `dired-filter' package. 701 | 702 | It works exactly the same as global dired filters, only 703 | restricted to a subtree. The global filter is also applied to 704 | the subtree. The filter action is read from `dired-filter-map'." 705 | (interactive) 706 | (when (featurep 'dired-filter) 707 | (-when-let (ov (dired-subtree--get-ov)) 708 | (let ((dired-filter-stack (overlay-get ov 'dired-subtree-filter)) 709 | (glob (current-global-map)) 710 | (loc (current-local-map)) 711 | cmd) 712 | (cl-flet ((dired-filter--update 713 | () 714 | (save-restriction 715 | (overlay-put ov 'dired-subtree-filter dired-filter-stack) 716 | (widen) 717 | (dired-subtree-revert) 718 | (dired-subtree--filter-update-bs ov)))) 719 | (unwind-protect 720 | (progn 721 | (use-global-map dired-filter-map) 722 | (use-local-map nil) 723 | (setq cmd (key-binding (read-key-sequence "Choose filter action: ")))) 724 | (use-global-map glob) 725 | (use-local-map loc)) 726 | (let ((p (point)) 727 | (beg (overlay-start ov)) 728 | (current-file (dired-utils-get-filename))) 729 | (unwind-protect 730 | (call-interactively cmd) 731 | (unless (dired-utils-goto-line current-file) 732 | (goto-char beg) 733 | (forward-line) 734 | (goto-char (min p (1- (overlay-end (dired-subtree--get-ov))))) 735 | (dired-move-to-filename))))))))) 736 | 737 | 738 | ;;; Here we redefine a couple of functions from dired.el to make them 739 | ;;; subtree-aware 740 | 741 | ;; If the point is in a subtree, we need to provide a proper 742 | ;; directory, not the one that would come from `dired-subdir-alist'. 743 | (defun dired-current-directory (&optional localp) 744 | "Return the name of the subdirectory to which this line belongs. 745 | This returns a string with trailing slash, like `default-directory'. 746 | Optional argument means return a file name relative to `default-directory'." 747 | (let ((here (point)) 748 | (alist (or dired-subdir-alist 749 | ;; probably because called in a non-dired buffer 750 | (error "No subdir-alist in %s" (current-buffer)))) 751 | elt dir) 752 | (while alist 753 | (setq elt (car alist) 754 | dir (car elt) 755 | ;; use `<=' (not `<') as subdir line is part of subdir 756 | alist (if (<= (dired-get-subdir-min elt) here) 757 | nil ; found 758 | (cdr alist)))) 759 | ;; dired-subdir: modify dir here if we are in a "subtree" view 760 | (-when-let (parent (dired-subtree--get-ov)) 761 | (setq dir (concat (overlay-get parent 'dired-subtree-name) "/"))) 762 | ;; end 763 | (if localp 764 | (dired-make-relative dir default-directory) 765 | dir))) 766 | 767 | ;; Since the tree-inserted directory is not in the dired-subdir-alist, 768 | ;; we need to guard against nil. 769 | (defun dired-get-subdir () 770 | "Return the subdir name on this line, or nil if not on a headerline." 771 | ;; Look up in the alist whether this is a headerline. 772 | (save-excursion 773 | (let ((cur-dir (dired-current-directory))) 774 | (beginning-of-line) ; alist stores b-o-l positions 775 | (and (zerop (- (point) 776 | (or (dired-get-subdir-min 777 | (assoc cur-dir 778 | dired-subdir-alist)) 779 | 0))) ;; dired-subtree: return zero if current 780 | ;; dir is not in `dired-subdir-alist'. 781 | cur-dir)))) 782 | 783 | (provide 'dired-subtree) 784 | 785 | ;;; dired-subtree.el ends here 786 | -------------------------------------------------------------------------------- /dired-tagsistant.el: -------------------------------------------------------------------------------- 1 | ;;; dired-tagsistant.el --- Tagsistant support for dired 2 | 3 | ;; Copyright (C) 2014 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 14th February 2014 9 | ;; Package-Requires: ((dash "2.8.0") (dired-hacks-utils "0.0.1") (f "0.16") (s "1.7.0") (emacs "24.3")) 10 | ;; Keywords: files 11 | ;; URL: https://github.com/Fuco1/dired-hacks 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 15 | ;; as published by the Free Software Foundation; either version 3 16 | ;; of the License, or (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 . 25 | 26 | ;;; Commentary: 27 | 28 | ;; See also http://tagsistant.net/ 29 | 30 | ;;; Code: 31 | 32 | (require 'dired-hacks-utils) 33 | (require 'dash) 34 | (require 'f) 35 | (require 's) 36 | 37 | (defgroup dired-tagsistant () 38 | "Tagsistant support for dired." 39 | :group 'dired-hacks 40 | :prefix "dired-tagsistant-") 41 | 42 | (defcustom dired-tagsistant-root "~/files" 43 | "Root where the tagsistant virtual filesystem is mounted." 44 | :type 'directory 45 | :group 'dired-tagsistant) 46 | 47 | (defun dired-tagsistant-root () 48 | "Return normalized value of `dired-tagsistant-root'." 49 | (file-truename (concat dired-tagsistant-root "/"))) 50 | 51 | (defcustom dired-tagsistant-better-header t 52 | "If non-nil, hide the tagsistant-specific noise in the header." 53 | :type 'boolean 54 | :group 'dired-tagsistant) 55 | 56 | 57 | ;; Better header display 58 | 59 | (defun dired-tagsistant--better-header () 60 | (save-excursion 61 | (when dired-tagsistant-better-header 62 | (goto-char (point-min)) 63 | (save-match-data 64 | (when (search-forward (file-truename dired-tagsistant-root) nil t) 65 | (let ((inhibit-read-only t) 66 | (header (progn 67 | (beginning-of-line) 68 | (cond 69 | ((save-excursion 70 | (re-search-forward 71 | (concat (dired-tagsistant-root) 72 | "store/\\(.*?\\)/@:") 73 | nil t)) 74 | ;; TODO: Add nicer query formatting 75 | (format "Query: %s" (match-string 1))) 76 | ((save-excursion 77 | (re-search-forward 78 | (concat (dired-tagsistant-root) 79 | "store/\\(.*?\\)/@@:") 80 | nil t)) 81 | ;; TODO: Add nicer query formatting 82 | (format "Query (no resolver): %s" (match-string 1))) 83 | ((save-excursion 84 | (re-search-forward 85 | (concat (dired-tagsistant-root) 86 | "\\(store.*?:$\\)") 87 | nil t)) 88 | (format "Tagsistant: %s" (match-string 1))))))) 89 | (when header 90 | (put-text-property (match-beginning 0) (match-end 0) 'display header)))))))) 91 | 92 | (add-hook 'dired-after-readin-hook 'dired-tagsistant--better-header) 93 | 94 | 95 | ;; Helpers 96 | 97 | (defun dired-tagsistant--path (dir fragments) 98 | "Construct a tagsistant path. 99 | 100 | DIR is a directory under `dired-tagsistant-root'. 101 | 102 | FRAGMENTS are parts of the path which will be joined with /." 103 | (let ((re (concat (dired-tagsistant-root) dir "/" (s-join "/" fragments)))) 104 | (if (s-ends-with? "/" re) re (concat re "/")))) 105 | 106 | (defun dired-tagsistant--store (&rest fragments) 107 | "Return the store directory. 108 | 109 | Join FRAGMENTS by adding / between each two items, then append to 110 | the end." 111 | (dired-tagsistant--path "store" fragments)) 112 | 113 | (defun dired-tagsistant--tags (&rest fragments) 114 | "Return the tags directory. 115 | 116 | Join FRAGMENTS by adding / between each two items, then append to 117 | the end." 118 | (dired-tagsistant--path "tags" fragments)) 119 | 120 | (defun dired-tagsistant--relations (&rest fragments) 121 | "Return the relations directory. 122 | 123 | Join FRAGMENTS by adding / between each two items, then append to 124 | the end." 125 | (dired-tagsistant--path "relations" fragments)) 126 | 127 | (defun dired-tagsistant--namespace-p (tag) 128 | "Return non-nil if TAG is a namespace tag." 129 | (s-ends-with? ":" tag)) 130 | 131 | (defun dired-tagsistant--get-tags (&optional no-namespaces) 132 | "Return a list of all available tags. 133 | 134 | If NO-NAMESPACES is non-nil, do not return namespace tags." 135 | (let ((tagdir (dired-tagsistant--tags))) 136 | (--map (s-chop-prefix tagdir it) 137 | (let ((tags (f-directories tagdir))) 138 | (if no-namespaces 139 | (-remove 'dired-tagsistant--namespace-p tags) 140 | tags))))) 141 | 142 | (defun dired-tagsistant--get-namespace-keys (namespace) 143 | "Return a list of all keys in NAMESPACE." 144 | (let ((tagdir (dired-tagsistant--tags namespace))) 145 | (--map (s-chop-prefix tagdir it) (f-directories tagdir)))) 146 | 147 | (defun dired-tagsistant--get-namespace-key-values (namespace key) 148 | (let ((tagdir (dired-tagsistant--tags namespace key))) 149 | (--map (s-chop-prefix tagdir it) (f-directories tagdir)))) 150 | 151 | (defun dired-tagsistant--create-tag-maybe (tag &optional key value) 152 | "Create TAG if it does not exist yet. 153 | 154 | If TAG is a namespace tag, create KEY if non-nil and VALUE if 155 | non-nil as well." 156 | (let* ((parts (-remove 'null (list tag key value))) 157 | (path (apply 'dired-tagsistant--tags parts))) 158 | (unless (f-directory? path) 159 | (make-directory path t)))) 160 | 161 | (defun dired-tagsistant--get-files-tags (files) 162 | "Return an alist mapping each file in FILES to a set of its tags." 163 | (--map 164 | (cons it (with-temp-buffer 165 | (shell-command 166 | (concat "cat " 167 | (shell-quote-argument it) 168 | ".tags | tr -d '\\0' | sort | uniq") 169 | (current-buffer)) 170 | (s-split "\n" (buffer-string) :omit-nulls))) 171 | files)) 172 | 173 | 174 | ;; Readers 175 | 176 | (defvar dired-tagsistant--read-history nil 177 | "History of tags read from the user.") 178 | 179 | ;; TODO: add prompt argument. 180 | (defun dired-tagsistant--read-tags () 181 | "Read tags interactively from user." 182 | (let (re tag (tags (dired-tagsistant--get-tags))) 183 | (while (not (string= "" tag)) 184 | (setq tag (completing-read 185 | (format "Tags %s(hit RET to end): " 186 | (if re (format "[%s] " (s-join ", " (reverse re))) "")) 187 | tags nil 'confirm nil 'dired-tagsistant--read-history)) 188 | (if (dired-tagsistant--namespace-p tag) 189 | (progn 190 | (setq tag (s-join "/" (cons tag (dired-tagsistant--read-tripple-tag tag)))) 191 | (pop dired-tagsistant--read-history) 192 | (push tag dired-tagsistant--read-history)) 193 | (setq tags (--remove (equal tag it) tags))) 194 | (push tag re)) 195 | (nreverse (cdr re)))) 196 | 197 | (defun dired-tagsistant--read-tripple-tag (namespace) 198 | "Read key, operator and value in NAMESPACE." 199 | (let* ((key (let ((namespaces (dired-tagsistant--get-namespace-keys namespace))) 200 | (completing-read 201 | (format "Key [%s]: " namespace) 202 | namespaces nil t nil nil (car namespaces)))) 203 | (op (completing-read (format "Operator [%s/%s]: " namespace key) 204 | '("eq" "inc" "gt" "lt") nil t nil nil "eq")) 205 | (value (let ((values (dired-tagsistant--get-namespace-key-values namespace key))) 206 | (completing-read 207 | (format "Value [%s/%s/%s]: " namespace op key) 208 | values 209 | nil nil nil nil (car values))))) 210 | (list key op value))) 211 | 212 | 213 | ;; Basic queries 214 | 215 | ;;;###autoload 216 | (defun dired-tagsistant-some-tags (tags) 217 | "Display all files matching some tag in TAGS." 218 | (interactive (list (dired-tagsistant--read-tags))) 219 | (find-file (dired-tagsistant--store (s-join "/+/" tags) "@"))) 220 | 221 | ;;;###autoload 222 | (defun dired-tagsistant-all-tags (tags) 223 | "Display all files matching all tags in TAGS." 224 | (interactive (list (dired-tagsistant--read-tags))) 225 | (find-file (dired-tagsistant--store (s-join "/" tags) "@"))) 226 | 227 | ;;;###autoload 228 | (defun dired-tagsistant-some-tags-regexp (regexp) 229 | "Display all files where some of their tags matches REGEXP." 230 | (interactive "sRegexp: ") 231 | (let* ((tags (--filter (string-match-p regexp it) (dired-tagsistant--get-tags :no-namespaces)))) 232 | (dired-tagsistant-some-tags tags))) 233 | 234 | ;;;###autoload 235 | (defun dired-tagsistant-all-tags-regexp (regexp) 236 | "Display all files where all of their tags match REGEXP." 237 | (interactive "sRegexp: ") 238 | (let* ((tags (--filter (string-match-p regexp it) (dired-tagsistant--get-tags :no-namespaces)))) 239 | (dired-tagsistant-all-tags tags))) 240 | 241 | ;;;###autoload 242 | (defun dired-tagsistant-list-tags (files) 243 | "Print all tags on each file of FILES. 244 | 245 | If FILES contains only one file, print in minibuffer, otherwise 246 | pop a window with a list of all tags for each file." 247 | (interactive (list (dired-get-marked-files))) 248 | (let ((tags (dired-tagsistant--get-files-tags files))) 249 | (if (not (cdr files)) 250 | (message "%s | %s" (f-filename (caar tags)) (s-join ", " (cdar tags))) 251 | (pop-to-buffer 252 | (with-current-buffer (get-buffer-create "*dired-tagsistant-tags*") 253 | (read-only-mode -1) 254 | (erase-buffer) 255 | (insert "|---+---|\n| File | Tags |\n|---+---|\n") 256 | (--each tags 257 | (insert "| " (f-filename (car it)) " | " (s-join ", " (cdr it)) " |\n")) 258 | (insert "|---+---|") 259 | (goto-char (point-min)) 260 | (org-table-align) 261 | (special-mode) 262 | (current-buffer)))))) 263 | 264 | 265 | ;; Tagging 266 | 267 | (defun dired-tagsistant--tag (files tags method) 268 | "Tag FILES with TAGS using METHOD. 269 | 270 | FILES is a list of files to tag. 271 | 272 | TAGS is a list of tags to assign to the files. Each tripple tag 273 | should be represented by one string. 274 | 275 | METHOD can be either :copy or :symlink." 276 | ;; create tags that do not exist 277 | (--each tags 278 | (cond 279 | ;; tripple tag 280 | ((s-matches? "/" it) 281 | (let ((parts (-select-by-indices '(0 1 3) (s-split "/" it)))) 282 | (apply 'dired-tagsistant--create-tag-maybe parts))) 283 | (:else (dired-tagsistant--create-tag-maybe it)))) 284 | ;; tag the files 285 | (let* ((store (dired-tagsistant--store (s-join "/" tags) "@@")) 286 | (reporter (make-progress-reporter "Tagging files" 0 (length files)))) 287 | (--each files 288 | (cond 289 | ((eq method :symlink) 290 | (make-symbolic-link (f-canonical it) store)) 291 | ((eq method :copy) 292 | (cond 293 | ((f-directory? it) 294 | (copy-directory it store)) 295 | (:else 296 | (copy-file it store)))) 297 | (:else (error "Unknown method"))) 298 | (progress-reporter-update reporter it-index)) 299 | (progress-reporter-done reporter))) 300 | 301 | ;;;###autoload 302 | (defun dired-tagsistant-tag (files tags) 303 | "Tag FILES with TAGS by copying them into tagsistant store. 304 | 305 | FILES is a list of files to tag. 306 | 307 | TAGS is a list of tags to assign to the files. Each tripple tag 308 | should be represented by one string. Non-existing tags will be 309 | created automatically." 310 | (interactive (list (dired-get-marked-files) 311 | (dired-tagsistant--read-tags))) 312 | ;; TODO: when in a query, also copy the query string to destination 313 | ;; and :rename, so we keep the original tag, add new ones and do not 314 | ;; copy the files around needlessly 315 | (dired-tagsistant--tag files tags :copy)) 316 | 317 | ;;;###autoload 318 | (defun dired-tagsistant-tag-symlink (files tags) 319 | "Tag files with TAGS by tagging symlinks pointing to them. 320 | 321 | Symbolic links are resolved recursively and always point to the 322 | *real* file. This saves space in the database and make updating 323 | of broken links much simpler. 324 | 325 | FILES is a list of files to tag. 326 | 327 | TAGS is a list of tags to assign to the files. Each tripple tag 328 | should be represented by one string. Non-existing tags will be 329 | created automatically." 330 | (interactive (list (dired-get-marked-files) 331 | (dired-tagsistant--read-tags))) 332 | (dired-tagsistant--tag files tags :symlink)) 333 | 334 | 335 | ;; Relations 336 | 337 | ;;;###autoload 338 | (defun dired-tagsistant-add-relation (parent rel child) 339 | (interactive (let* ((tags (dired-tagsistant--get-tags :no-namespace)) 340 | (parent (completing-read (format "Parent (default \"%s\"): " (car tags)) 341 | tags nil 342 | t nil nil (car tags))) 343 | (rel (completing-read (format "Relation (default \"%s includes\"):" parent) 344 | (list "includes" 345 | "excludes" 346 | "is_equivalent") 347 | nil t nil nil "includes")) 348 | (tags-child (-difference tags (list parent))) 349 | (child (completing-read (format "Child (default \"%s %s %s\"): " parent rel (car tags-child)) 350 | tags-child nil 351 | 'confirm nil nil (car tags-child)))) 352 | (list parent rel child))) 353 | (let ((path (dired-tagsistant--relations parent rel child))) 354 | (unless (f-directory? path) 355 | (make-directory path)))) 356 | 357 | (provide 'dired-tagsistant) 358 | ;;; dired-tagsistant.el ends here 359 | -------------------------------------------------------------------------------- /dired-ui.el: -------------------------------------------------------------------------------- 1 | ;;; dired-ui.el --- Additional or extended dired commands -*- lexical-binding: t -*- 2 | 3 | ;; Copyright (C) 2025 Matúš Goljer 4 | 5 | ;; Author: Matúš Goljer 6 | ;; Maintainer: Matúš Goljer 7 | ;; Version: 0.0.1 8 | ;; Created: 5th May 2025 9 | ;; Package-requires: ((f "0.19.0")) 10 | ;; Keywords: files 11 | 12 | ;; This program is free software; you can redistribute it and/or 13 | ;; modify it under the terms of the GNU General Public License 14 | ;; as published by the Free Software Foundation; either version 3 15 | ;; of the License, or (at your option) any later version. 16 | 17 | ;; This program is distributed in the hope that it will be useful, 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;; GNU General Public License for more details. 21 | 22 | ;; You should have received a copy of the GNU General Public License 23 | ;; along with this program. If not, see . 24 | 25 | ;;; Commentary: 26 | 27 | ;;; Code: 28 | 29 | (require 'dired) 30 | (require 'f) 31 | 32 | ;;;###autoload 33 | (defun dired-ui-dired-copy-filename-as-kill (&optional arg) 34 | "Copy name of file at point into the kill ring. 35 | 36 | This function works the same as `dired-copy-filename-as-kill' but 37 | adds the prefix option \\[universal-argument] to copy file name 38 | up to the project root as determined by `project-root'. 39 | 40 | The behaviour of \\[universal-argument] is changed from the 41 | original function, where it used to copy up to the default 42 | directory of the current buffer, which in case of inserted 43 | subdirectories was the \"main\" directory." 44 | (interactive "P") 45 | (if (consp arg) 46 | (let* ((result (dired-copy-filename-as-kill 0)) 47 | (root (project-root (project-current))) 48 | (relative-path (concat "./" (f-relative result root)))) 49 | (if (eq last-command 'kill-region) 50 | (kill-append relative-path nil) 51 | (kill-new relative-path) 52 | (message "%s" relative-path))) 53 | (dired-copy-filename-as-kill arg))) 54 | 55 | 56 | (provide 'dired-ui) 57 | ;;; dired-ui.el ends here 58 | -------------------------------------------------------------------------------- /tests/test-dired-collapse.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | 3 | (require 'assess) 4 | 5 | (require 'dired-collapse) 6 | 7 | (describe "Dired collapse" 8 | 9 | (describe "Collapse" 10 | 11 | (it "should collapse a nonempty directory when it only has a single child directory" 12 | (assess-with-filesystem '(("foo/bar/" ("baz" "baaz"))) 13 | (unwind-protect 14 | (shut-up 15 | (dired default-directory) 16 | (dired-collapse-mode) 17 | (goto-char (point-min)) 18 | (expect (search-forward "foo/bar" nil t) :to-be-truthy)) 19 | (dired-collapse-mode -1)))) 20 | 21 | (it "should collapse a nonempty directory when it only has a single child file" 22 | (assess-with-filesystem '(("foo/bar/" ("baz"))) 23 | (unwind-protect 24 | (shut-up 25 | (dired default-directory) 26 | (dired-collapse-mode) 27 | (goto-char (point-min)) 28 | (expect (search-forward "foo/bar/baz" nil t) :to-be-truthy)) 29 | (dired-collapse-mode -1))))) 30 | 31 | (describe "Overlay" 32 | 33 | (describe "When the leaf directory is empty" 34 | 35 | (it "should extend the shadow overlay over it when it is a root directory" 36 | (assess-with-filesystem '(("foo/")) 37 | (unwind-protect 38 | (shut-up 39 | (dired default-directory) 40 | (dired-collapse-mode) 41 | (goto-char (point-min)) 42 | (expect (search-forward "foo" nil t) :to-be-truthy) 43 | (backward-char 1) 44 | (expect (overlays-at (point)) :to-be-truthy)) 45 | (dired-collapse-mode -1)))) 46 | 47 | (it "should extend the shadow overlay over it when it is a nested directory" 48 | (assess-with-filesystem '(("foo/bar/")) 49 | (unwind-protect 50 | (shut-up 51 | (dired default-directory) 52 | (dired-collapse-mode) 53 | (goto-char (point-min)) 54 | (expect (search-forward "foo/bar" nil t) :to-be-truthy) 55 | (backward-char 1) 56 | (expect (overlays-at (point)) :to-be-truthy)) 57 | (dired-collapse-mode -1))))) 58 | 59 | (describe "When the leaf directory is not empty" 60 | 61 | (it "should not extend the shadow overlay over the single non-directory child of a directory" 62 | (assess-with-filesystem '(("foo/" ("bar"))) 63 | (unwind-protect 64 | (shut-up 65 | (dired default-directory) 66 | (dired-collapse-mode) 67 | (goto-char (point-min)) 68 | (expect (search-forward "foo/bar" nil t) :to-be-truthy) 69 | (backward-char 1) 70 | (expect (overlays-at (point)) :not :to-be-truthy)) 71 | (dired-collapse-mode -1)))) 72 | 73 | (it "should not extend the shadow overlay over the non-empty directory with multiple children" 74 | (assess-with-filesystem '(("foo/" ("bar" "baz"))) 75 | (unwind-protect 76 | (shut-up 77 | (dired default-directory) 78 | (dired-collapse-mode) 79 | (goto-char (point-min)) 80 | (expect (search-forward "foo" nil t) :to-be-truthy) 81 | (backward-char 1) 82 | (expect (overlays-at (point)) :not :to-be-truthy)) 83 | (dired-collapse-mode -1)))) 84 | 85 | (it "should not extend the shadow overlay over the single non-empty directory child of a directory" 86 | (assess-with-filesystem '(("foo/bar/" ("foo" "bar"))) 87 | (unwind-protect 88 | (shut-up 89 | (dired default-directory) 90 | (dired-collapse-mode) 91 | (goto-char (point-min)) 92 | (expect (search-forward "foo/bar" nil t) :to-be-truthy) 93 | (backward-char 1) 94 | (expect (overlays-at (point)) :not :to-be-truthy)) 95 | (dired-collapse-mode -1))))))) 96 | -------------------------------------------------------------------------------- /tests/test-dired-filter.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | 3 | (require 'assess) 4 | (require 'dash) 5 | (require 'shut-up) 6 | (require 'dired-filter) 7 | 8 | (put 'dir 'lisp-indent-function '1) 9 | 10 | (defmacro with-dired (filter-stack &rest body) 11 | (declare (indent 1)) 12 | `(shut-up 13 | (dired default-directory) 14 | (setq dired-filter-stack ,filter-stack) 15 | (dired-filter-mode 1) 16 | ,@body)) 17 | 18 | (defmacro with-dired-groups (filter-groups &rest body) 19 | (declare (indent 1)) 20 | `(shut-up 21 | (dired default-directory) 22 | (setq dired-filter-group-saved-groups ,filter-groups) 23 | (dired-filter-group-mode 1) 24 | ,@body)) 25 | 26 | (buttercup-define-matcher :to-be-file (file) 27 | (if (file-regular-p file) 28 | (cons t (format "Expected %S not to be a file" file)) 29 | (cons nil (format "Expected %S to be a file" file)))) 30 | 31 | (buttercup-define-matcher :to-be-directory (dir) 32 | (if (file-directory-p dir) 33 | (cons t (format "Expected %S not to be a directory" dir)) 34 | (cons nil (format "Expected %S to be a directory" dir)))) 35 | 36 | (buttercup-define-matcher :to-contain (file content) 37 | (if (with-temp-buffer 38 | (insert-file-contents file) 39 | (equal (buffer-string) content)) 40 | (cons t (format "Expected the content of %S not to `equal' %S" file content)) 41 | (cons nil (format "Expected the content of %S to `equal' %S" file content)))) 42 | 43 | (describe "Dired Filter" 44 | 45 | (describe "Dired dot-files filter" 46 | 47 | (it "should hide dotfiles we don't want to see" 48 | (assess-with-filesystem '(".foo" "bar") 49 | (with-dired '((dot-files)) 50 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar")))))) 51 | 52 | (describe "Dired name filter" 53 | 54 | (it "should keep lines matching the name" 55 | (assess-with-filesystem '("foo.o" "bar.a" "bar.h" "quux.c") 56 | (with-dired '((name . "bar")) 57 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.a" "bar.h")))))) 58 | 59 | (describe "Dired regexp filter" 60 | 61 | (it "should keep files matching the name as regexp" 62 | (assess-with-filesystem '("foo.o" "bar.a" "bar.h" "quux.c") 63 | (with-dired '((name . "b.r\\.")) 64 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.a" "bar.h"))))) 65 | 66 | (it "should use case-sensitive match if qualifier contains upper-case letters" 67 | (assess-with-filesystem '("foo.o" "FOO.o") 68 | (with-dired '((name . "F")) 69 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("FOO.o"))))) 70 | 71 | (it "should keep files or directories matching the name as regexp" 72 | (assess-with-filesystem '("foo.o" "bar.a" "bar.h" "quux.c" "bur.d/") 73 | (with-dired '((name . "b.r\\.")) 74 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.a" "bar.h" "bur.d"))))) 75 | 76 | (it "should be able to match extensions" 77 | (assess-with-filesystem '("foo.o" "bar.a" "bar.h" "quux.c") 78 | (with-dired '((name . "\\.a$")) 79 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.a")))))) 80 | 81 | (describe "Dired omit filter" 82 | 83 | (it "should hide ignored files" 84 | (assess-with-filesystem '("bar.o" "bar.a" "bar.h" "bar.c") 85 | (with-dired '((omit)) 86 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.h" "bar.c")))))) 87 | 88 | (describe "Dired and meta-filter" 89 | 90 | (describe "Combining positive filters" 91 | 92 | (it "should keep lines matching all the filters" 93 | (assess-with-filesystem '("foo" "bar" "bax/" "qux/") 94 | (with-dired '((file) (name . "bar")) 95 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar"))))) 96 | 97 | (it "should commute" 98 | (assess-with-filesystem '("foo" "bar" "bax/" "qux/") 99 | (let ((this (with-dired '((name . "bax") (directory)) 100 | (dired-utils-get-all-files :local))) 101 | (other (with-dired '((directory) (name . "bax")) 102 | (dired-utils-get-all-files :local)))) 103 | (expect this :to-have-same-items-as other)))) 104 | 105 | (it "should work with more than two filters" 106 | (assess-with-filesystem '("foo" "bar" "bax/" "qux/" "bar.c" "bar.h" "barfux.c" "barbara/") 107 | (with-dired '((name . "bar") (file) (extension . "c")) 108 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.c" "barfux.c")))))) 109 | 110 | (describe "Combining positive and negative filters" 111 | 112 | (it "should keep lines matching positive filters after removing those matched by negative filters" 113 | (assess-with-filesystem '(".bar" ".foo" "foo" "bar") 114 | (with-dired '((dot-files) (name . "bar")) 115 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar"))))) 116 | 117 | (it "should commute" 118 | (assess-with-filesystem '("bar.o" "bar.a" "bar.h" "bar.c" "foo.h" "foo.c" "foo.o") 119 | (let ((this (with-dired '((name . "bar") (omit)) 120 | (dired-utils-get-all-files :local))) 121 | (other (with-dired '((omit) (name . "bar")) 122 | (dired-utils-get-all-files :local)))) 123 | (expect this :to-have-same-items-as other)))) 124 | 125 | (it "should work as two positive filters if we negate the negative one" 126 | (assess-with-filesystem '(".bar" ".foo" "foo" "bar") 127 | (with-dired '((not (dot-files)) (name . "bar")) 128 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '(".bar")))))) 129 | 130 | (describe "Combining negative filters" 131 | 132 | (it "should remove lines matching any of the filters (deMorgan's law)" 133 | (assess-with-filesystem '(".bar" ".foo" "foo.o" "bar") 134 | (with-dired '((omit) (dot-files)) 135 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar"))))))) 136 | 137 | (describe "Dired or meta-filter" 138 | 139 | (describe "Combining positive filters" 140 | 141 | (it "should keep lines matching either of the filters" 142 | (assess-with-filesystem '("bar.o" "bar.a" "bar.h" "bar.c" "foo.h" "foo.c" "foo.o") 143 | (with-dired '((or (extension . "o") (name . "bar"))) 144 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar.a" "bar.o" "foo.o" "bar.h" "bar.c")))))) 145 | 146 | (describe "Combining negative and positive filters" 147 | 148 | (it "should create exceptions for negative filters" 149 | (assess-with-filesystem '(".bar" ".foo" "foo" "bar") 150 | ;; throw out all dotfiles except those having bar in the name 151 | (with-dired '((or (dot-files) (name . "bar"))) 152 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar" "foo" ".bar"))))) 153 | 154 | (it "should commute" 155 | (assess-with-filesystem '("bar.a" "foo.o" "foo" "bar") 156 | ;; throw out all dotfiles except those having bar in the name 157 | (let ((this (with-dired '((or (name . "bar") (omit))) 158 | (dired-utils-get-all-files :local))) 159 | (other (with-dired '((or (omit) (name . "bar"))) 160 | (dired-utils-get-all-files :local)))) 161 | (expect this :to-have-same-items-as other))))) 162 | 163 | 164 | (describe "Combining negative filters" 165 | 166 | (it "should remove lines matching both filters (deMorgan's law)" 167 | (assess-with-filesystem '(".bar.o" ".foo.txt" "foo" "bar") 168 | ;; throw out all dotfiles with "omit" extension 169 | (with-dired '((or (dot-files) (omit))) 170 | (expect (dired-utils-get-all-files :local) :to-have-same-items-as '("bar" "foo" ".foo.txt")))))))) 171 | 172 | (describe "Dired Filter Groups" 173 | 174 | (it "should group lines according to filters" 175 | (assess-with-filesystem '("foo/" "bar/" "baz.tex" "baz.bib" "normal-file.txt") 176 | (with-dired-groups '(("default" 177 | ("Directories" (directory)) 178 | ("LaTeX" (extension "tex" "bib")))) 179 | (let ((groups (dired-filter-group-get-groups))) 180 | (expect (gethash "Directories" groups) :to-have-same-items-as '("." ".." "foo" "bar")) 181 | (expect (gethash "LaTeX" groups) :to-have-same-items-as '("baz.tex" "baz.bib")))))) 182 | 183 | (it "should not create empty drawers when groups overlap [#57]" 184 | (assess-with-filesystem '("a.py" "b.py" "regular" "another") 185 | (with-dired-groups '(("default" 186 | ("Python" (extension "py")) 187 | ("B" (name . "b")))) 188 | (let ((groups (dired-filter-group-get-groups))) 189 | (expect (gethash "B" groups) :to-have-same-items-as '("b.py")) 190 | (expect (gethash "Python" groups) :to-have-same-items-as '("a.py")))) 191 | 192 | (with-dired-groups '(("default" 193 | ("B" (name . "b")) 194 | ("Python" (extension "py")))) 195 | (let ((groups (dired-filter-group-get-groups))) 196 | (expect (gethash "B" groups) :to-have-same-items-as nil) 197 | (expect (gethash "Python" groups) :to-have-same-items-as '("a.py" "b.py"))))))) 198 | -------------------------------------------------------------------------------- /tests/test-dired-utils.el: -------------------------------------------------------------------------------- 1 | ;; -*- lexical-binding: t -*- 2 | 3 | (require 'dash) 4 | (require 'dired-hacks-utils) 5 | 6 | (describe "Dired utils match filename regexp" 7 | 8 | (it "should match a pattern in the middle of the filename" 9 | (expect (dired-utils-match-filename-regexp 10 | "afooa" 11 | (list (cons "bar" 1) 12 | (cons "foo" 2) 13 | (cons "fo" 3))) 14 | :to-equal (cons "foo" 2))) 15 | 16 | (it "should match a filename against regexp pattern" 17 | (expect (dired-utils-match-filename-regexp 18 | "foo" 19 | (list (cons "bar" 1) 20 | (cons "f.o" 2) 21 | (cons "fod" 3))) 22 | :to-equal (cons "f.o" 2)) 23 | 24 | (expect (dired-utils-match-filename-regexp 25 | "foooo/baz" 26 | (list (cons "bar" 1) 27 | (cons "fo+" 2) 28 | (cons "fod" 3))) 29 | :to-equal (cons "fo+" 2)) 30 | 31 | (expect (dired-utils-match-filename-regexp 32 | "foooo/bar" 33 | (list (cons "bar" 1) 34 | (cons "fo+" 2) 35 | (cons "fod" 3))) 36 | :to-equal (cons "bar" 1)))) 37 | 38 | (describe "Dired utils match filename extension" 39 | 40 | (it "should match the file's extension against the pattern" 41 | (expect (dired-utils-match-filename-extension 42 | "foo.txt" 43 | (list (cons "c" 1) 44 | (cons "txt" 2) 45 | (cons "h" 3))) 46 | :to-equal (cons "txt" 2))) 47 | 48 | (it "should match not match the extension as a regexp" 49 | (expect (dired-utils-match-filename-extension 50 | "foo.*a" 51 | (list (cons "x" 1) 52 | (cons "*a" 2) 53 | (cons "y" 3))) 54 | :to-equal (cons "*a" 2)))) 55 | --------------------------------------------------------------------------------