--- /dev/null
+;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection
+
+;; Copyright (C) 2014-2015 Matúš Goljer
+
+;; Author: Matúš Goljer <matus.goljerNOSPAMgmail.com>
+;; Maintainer: Matúš Goljer <matus.goljerNOSPAMgmail.com>
+;; Keywords: files
+;; Package-Version: 20150819.948
+;; Version: 0.0.1
+;; Created: 14th February 2014
+;; Package-requires: ((dash "2.5.0"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Utilities and helpers for `dired-hacks' collection of dired
+;; improvements.
+
+;; This package also provides these interactive functions:
+;; * `dired-hacks-next-file' - go to next file, skipping empty and non-file lines
+;; * `dired-hacks-previous-file' - go to previous file, skipping empty
+;; and non-file lines
+
+;; See https://github.com/Fuco1/dired-hacks for the entire collection
+
+;;; Code:
+
+(require 'dash)
+(require 'dired)
+
+(defgroup dired-hacks ()
+ "Collection of useful dired additions."
+ :group 'dired
+ :prefix "dired-hacks-")
+
+(defun dired-utils-get-filename (&optional localp)
+ "Like `dired-get-filename' but never signal an error."
+ (dired-get-filename localp t))
+
+(defun dired-utils-get-all-files (&optional localp)
+ "Return all files in this dired buffer as a list.
+
+LOCALP has same semantics as in `dired-get-filename'."
+ (save-excursion
+ (goto-char (point-min))
+ (let (r)
+ (while (= 0 (forward-line))
+ (--when-let (dired-utils-get-filename localp)
+ (push it r)))
+ (nreverse r))))
+
+(defconst dired-utils-file-attributes-keywords
+ '(:isdir :nlinks :uid :gid :atime :mtime :ctime :size :modes :gidchg :inode :devnum)
+ "List of keywords to map with `file-attributes'.")
+
+(defconst dired-utils-info-keywords
+ `(:name :issym :target ,@dired-utils-file-attributes-keywords)
+ "List of keywords available for `dired-utils-get-info'.")
+
+(defun dired-utils--get-keyword-info (keyword)
+ (let ((filename (dired-utils-get-filename)))
+ (cl-case keyword
+ (:name filename)
+ (:isdir (file-directory-p filename))
+ (:issym (and (file-symlink-p filename) t))
+ (:target (file-symlink-p filename))
+ (t
+ (nth (-elem-index keyword dired-utils-file-attributes-keywords)
+ (file-attributes filename))))))
+
+(defun dired-utils-get-info (&rest keywords)
+ "Query for info about the file at point.
+
+When querying for one attribute, its value is returned. When
+querying for more than one, a list of results is returned.
+
+The available attributes are listed in
+`dired-utils-info-keywords'."
+ (let ((attributes (mapcar 'dired-utils--get-keyword-info keywords)))
+ (if (> (length attributes) 1)
+ attributes
+ (car attributes))))
+
+(defun dired-utils-goto-line (filename)
+ "Go to line describing FILENAME in listing.
+
+Should be absolute file name matched against
+`dired-get-filename'."
+ (goto-char (point-min))
+ (let (stop)
+ (while (and (not stop)
+ (= (forward-line) 0))
+ (when (equal filename (dired-utils-get-filename))
+ (setq stop t)
+ (dired-move-to-filename)))
+ stop))
+
+(defun dired-utils-match-filename-regexp (filename alist)
+ "Match FILENAME against each car in ALIST and return first matched cons.
+
+Each car in ALIST is a regular expression.
+
+The matching is done using `string-match-p'."
+ (let (match)
+ (--each-while alist (not match)
+ (when (string-match-p (car it) filename)
+ (setq match it)))
+ match))
+
+(defun dired-utils-match-filename-extension (filename alist)
+ "Match FILENAME against each car in ALIST and return first matched cons.
+
+Each car in ALIST is a string representing file extension
+*without* the delimiting dot."
+ (let (done)
+ (--each-while alist (not done)
+ (when (string-match-p (concat "\\." (regexp-quote (car it)) "\\'") file)
+ (setq done it)))
+ done))
+
+\f
+;;; Predicates
+(defun dired-utils-is-file-p ()
+ "Return non-nil if the line at point is a file or a directory."
+ (dired-utils-get-filename 'no-dir))
+
+(defun dired-utils-is-dir-p ()
+ "Return non-nil if the line at point is a directory."
+ (--when-let (dired-utils-get-filename)
+ (file-directory-p it)))
+
+\f
+;;; Interactive
+;; TODO: add wrap-around option
+(defun dired-hacks-next-file (&optional arg)
+ "Move point to the next file.
+
+Optional prefix ARG says how many lines to move; default is one
+line."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (if (< arg 0)
+ (dired-hacks-previous-file (- arg))
+ (--dotimes arg
+ (forward-line)
+ (while (and (or (not (dired-utils-is-file-p))
+ (get-text-property (point) 'invisible))
+ (= (forward-line) 0))))
+ (if (not (= (point) (point-max)))
+ (dired-move-to-filename)
+ (forward-line -1)
+ (dired-move-to-filename)
+ nil)))
+
+(defun dired-hacks-previous-file (&optional arg)
+ "Move point to the previous file.
+
+Optional prefix ARG says how many lines to move; default is one
+line."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (if (< arg 0)
+ (dired-hacks-next-file (- arg))
+ (--dotimes arg
+ (forward-line -1)
+ (while (and (or (not (dired-utils-is-file-p))
+ (get-text-property (point) 'invisible))
+ (= (forward-line -1) 0))))
+ (if (not (= (point) (point-min)))
+ (dired-move-to-filename)
+ (dired-hacks-next-file)
+ nil)))
+
+(defun dired-hacks-compare-files (file-a file-b)
+ "Test if two files FILE-A and FILE-B are the (probably) the same."
+ (interactive (let ((other-dir (dired-dwim-target-directory)))
+ (list (read-file-name "File A: " default-directory (car (dired-get-marked-files)) t)
+ (read-file-name "File B: " other-dir (with-current-buffer (cdr (assoc other-dir dired-buffers))
+ (car (dired-get-marked-files))) t))))
+ (let ((md5-a (with-temp-buffer
+ (shell-command (format "md5sum %s" file-a) (current-buffer))
+ (buffer-string)))
+ (md5-b (with-temp-buffer
+ (shell-command (format "md5sum %s" file-b) (current-buffer))
+ (buffer-string))))
+ (message "%s%sFiles are %s." md5-a md5-b
+ (if (equal (car (split-string md5-a))
+ (car (split-string md5-b)))
+ "probably the same" "different"))))
+
+(provide 'dired-hacks-utils)
+
+;;; dired-hacks-utils.el ends here
--- /dev/null
+;;; dired-narrow.el --- Live-narrowing of search results for dired
+
+;; Copyright (C) 2014-2015 Matúš Goljer
+
+;; Author: Matúš Goljer <matus.goljerNOSPAMgmail.com>
+;; Maintainer: Matúš Goljer <matus.goljerNOSPAMgmail.com>
+;; Version: 0.0.1
+;; Package-Version: 20160130.845
+;; Created: 14th February 2014
+;; Package-requires: ((dash "2.7.0") (dired-hacks-utils "0.0.1"))
+;; Keywords: files
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License
+;; as published by the Free Software Foundation; either version 3
+;; of the License, or (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This package provides live filtering of files in dired buffers. In
+;; general, after calling the respective narrowing function you type a
+;; filter string into the minibuffer. After each change the changes
+;; automatically reflect in the buffer. Typing C-g will cancel the
+;; narrowing and restore the original view, typing RET will exit the
+;; live filtering mode and leave the dired buffer in the narrowed
+;; state. To bring it back to the original view, you can call
+;; `revert-buffer' (usually bound to `g').
+
+;; During the filtering process, several special functions are
+;; available. You can customize the binding by changing
+;; `dired-narrow-map'.
+
+;; * `dired-narrow-next-file' (<down>) - move the point to the next file
+;; * `dired-narrow-previous-file' (<up>) - move the point to the
+;; previous file
+;; * `dired-narrow-enter-directory' (<right>) - descend into the
+;; directory under point and immediately go back to narrowing mode
+
+;; You can customize what happens after exiting the live filtering
+;; mode by customizing `dired-narrow-exit-action'.
+
+;; These narrowing functions are provided:
+
+;; * `dired-narrow'
+;; * `dired-narrow-regexp'
+;; * `dired-narrow-fuzzy'
+
+;; You can also create your own narrowing functions quite easily. To
+;; define new narrowing function, use `dired-narrow--internal' and
+;; pass it an apropriate filter. The filter should take one argument
+;; which is the filter string from the minibuffer. It is then called
+;; at each line that describes a file with point at the beginning of
+;; the file name. If the filter returns nil, the file is removed from
+;; the view. As an inspiration, look at the built-in functions
+;; mentioned above.
+
+;; See https://github.com/Fuco1/dired-hacks for the entire collection.
+
+;;; Code:
+
+(require 'dash)
+(require 'dired-hacks-utils)
+
+(require 'delsel)
+
+(defgroup dired-narrow ()
+ "Live-narrowing of search results for dired."
+ :group 'dired-hacks
+ :prefix "dired-narrow-")
+
+(defvar dired-narrow-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "<up>") 'dired-narrow-previous-file)
+ (define-key map (kbd "<down>") 'dired-narrow-next-file)
+ (define-key map (kbd "<right>") 'dired-narrow-enter-directory)
+ (define-key map (kbd "C-g") 'minibuffer-keyboard-quit)
+ (define-key map (kbd "RET") 'exit-minibuffer)
+ (define-key map (kbd "<return>") 'exit-minibuffer)
+ map)
+ "Keymap used while `dired-narrow' is reading the pattern.")
+
+(defcustom dired-narrow-exit-action 'ignore
+ "Function to call after exiting minibuffer.
+
+Function takes no argument and is called with point over the file
+we should act on."
+ :type '(choice (const :tag "Open file under point" dired-narrow-find-file)
+ (function :tag "Use custom function."))
+ :group 'dired-narrow)
+
+\f
+;; Utils
+
+;; this is `gnus-remove-text-with-property'
+(defun dired-narrow--remove-text-with-property (prop)
+ "Delete all text in the current buffer with text property PROP."
+ (let ((start (point-min))
+ end)
+ (unless (get-text-property start prop)
+ (setq start (next-single-property-change start prop)))
+ (while start
+ (setq end (text-property-any start (point-max) prop nil))
+ (delete-region start (or end (point-max)))
+ (setq start (when end
+ (next-single-property-change start prop))))))
+
+(defvar dired-narrow-filter-function 'identity
+ "Filter function used to filter the dired view.")
+
+(defvar dired-narrow--current-file nil
+ "Value of point just before exiting minibuffer.")
+
+(defun dired-narrow--update (filter)
+ "Make the files not matching the FILTER invisible."
+ (save-excursion
+ (goto-char (point-min))
+ (let ((inhibit-read-only t))
+ ;; TODO: we might want to call this only if the filter gets less
+ ;; specialized.
+ (dired-narrow--restore)
+ (while (dired-hacks-next-file)
+ (if (funcall dired-narrow-filter-function filter)
+ (when (fboundp 'dired-insert-set-properties)
+ (dired-insert-set-properties (line-beginning-position) (1+ (line-end-position))))
+ (put-text-property (line-beginning-position) (1+ (line-end-position)) :dired-narrow t)
+ (put-text-property (line-beginning-position) (1+ (line-end-position)) 'invisible :dired-narrow)))))
+ (unless (dired-hacks-next-file)
+ (dired-hacks-previous-file))
+ (unless (dired-utils-get-filename)
+ (dired-hacks-previous-file)))
+
+(defun dired-narrow--restore ()
+ "Restore the invisible files of the current buffer."
+ (let ((inhibit-read-only t))
+ (remove-text-properties (point-min) (point-max) '(invisible))
+ (when (fboundp 'dired-insert-set-properties)
+ (dired-insert-set-properties (point-min) (point-max)))))
+
+\f
+;; Live filtering
+
+(defvar dired-narrow-buffer nil
+ "Dired buffer we are currently filtering.")
+
+(defvar dired-narrow--minibuffer-content ""
+ "Content of the minibuffer during narrowing.")
+
+(defun dired-narrow--minibuffer-setup ()
+ "Set up the minibuffer for live filtering."
+ (when dired-narrow-buffer
+ (add-hook 'post-command-hook 'dired-narrow--live-update nil :local)))
+
+(add-hook 'minibuffer-setup-hook 'dired-narrow--minibuffer-setup)
+
+(defun dired-narrow--live-update ()
+ "Update the dired buffer based on the contents of the minibuffer."
+ (when dired-narrow-buffer
+ (let ((current-filter (minibuffer-contents-no-properties)))
+ (with-current-buffer dired-narrow-buffer
+ (unless (equal current-filter dired-narrow--minibuffer-content)
+ (dired-narrow--update current-filter))
+ (setq dired-narrow--minibuffer-content current-filter)
+ (setq dired-narrow--current-file (dired-utils-get-filename))
+ (set-window-point (get-buffer-window (current-buffer)) (point))))))
+
+(defun dired-narrow--internal (filter-function)
+ "Narrow a dired buffer to the files matching a filter.
+
+The function FILTER-FUNCTION is called on each line: if it
+returns non-nil, the line is kept, otherwise it is removed. The
+function takes one argument, which is the current filter string
+read from minibuffer."
+ (let ((dired-narrow-buffer (current-buffer))
+ (dired-narrow-filter-function filter-function)
+ (disable-narrow nil))
+ (unwind-protect
+ (progn
+ (dired-narrow-mode 1)
+ (add-to-invisibility-spec :dired-narrow)
+ (setq disable-narrow (read-from-minibuffer "Filter: " nil dired-narrow-map))
+ (let ((inhibit-read-only t))
+ (dired-narrow--remove-text-with-property :dired-narrow))
+ ;; If the file no longer exists, we can't do anything, so
+ ;; set to nil
+ (unless (dired-utils-goto-line dired-narrow--current-file)
+ (setq dired-narrow--current-file nil)))
+ (with-current-buffer dired-narrow-buffer
+ (unless disable-narrow (dired-narrow-mode -1))
+ (remove-from-invisibility-spec :dired-narrow)
+ (dired-narrow--restore))
+ (when (and disable-narrow
+ dired-narrow--current-file
+ dired-narrow-exit-action)
+ (funcall dired-narrow-exit-action))
+ (cond
+ ((equal disable-narrow "dired-narrow-enter-directory")
+ (dired-narrow--internal filter-function))))))
+
+\f
+;; Interactive
+
+(defun dired-narrow--regexp-filter (filter)
+ (re-search-forward filter (line-end-position) t))
+
+;;;###autoload
+(defun dired-narrow-regexp ()
+ "Narrow a dired buffer to the files matching a regular expression."
+ (interactive)
+ (dired-narrow--internal 'dired-narrow--regexp-filter))
+
+(defun dired-narrow--string-filter (filter)
+ (let ((words (split-string filter " ")))
+ (--all? (save-excursion (search-forward it (line-end-position) t)) words)))
+
+(defun dired-narrow-next-file ()
+ "Move point to the next file."
+ (interactive)
+ (with-current-buffer dired-narrow-buffer
+ (dired-hacks-next-file)))
+
+(defun dired-narrow-previous-file ()
+ "Move point to the previous file."
+ (interactive)
+ (with-current-buffer dired-narrow-buffer
+ (dired-hacks-previous-file)))
+
+(defun dired-narrow-find-file ()
+ "Run `dired-find-file' or any remapped action on file under point."
+ (interactive)
+ (let ((function (or (command-remapping 'dired-find-file)
+ 'dired-find-file)))
+ (funcall function)))
+
+(defun dired-narrow-enter-directory ()
+ "Descend into directory under point and initiate narrowing."
+ (interactive)
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "dired-narrow-enter-directory"))
+ (exit-minibuffer))
+
+;;;###autoload
+(defun dired-narrow ()
+ "Narrow a dired buffer to the files matching a string.
+
+If the string contains spaces, then each word is matched against
+the file name separately. To succeed, all of them have to match
+but the order does not matter.
+
+For example \"foo bar\" matches filename \"bar-and-foo.el\"."
+ (interactive)
+ (dired-narrow--internal 'dired-narrow--string-filter))
+
+(defun dired-narrow--fuzzy-filter (filter)
+ (re-search-forward
+ (mapconcat 'regexp-quote
+ (mapcar 'char-to-string (string-to-list filter))
+ ".*")
+ (line-end-position) t))
+
+;;;###autoload
+(defun dired-narrow-fuzzy ()
+ "Narrow a dired buffer to the files matching a fuzzy string.
+
+A fuzzy string is constructed from the filter string by inserting
+\".*\" between each letter. This is then matched as regular
+expression against the file name."
+ (interactive)
+ (dired-narrow--internal 'dired-narrow--fuzzy-filter))
+
+(define-minor-mode dired-narrow-mode
+ "Minor mode for indicating when narrowing is in progress."
+ :lighter " dired-narrow")
+
+(defun dired-narrow--disable-on-revert ()
+ "Disable `dired-narrow-mode' after revert."
+ (dired-narrow-mode -1))
+
+(add-hook 'dired-after-readin-hook 'dired-narrow--disable-on-revert)
+
+(provide 'dired-narrow)
+;;; dired-narrow.el ends here
projects / emacsconfig.git / commitdiff