+++ /dev/null
-;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path))))
-\f
-;;;### (autoloads nil nil ("dired-hacks-utils.el") (23994 46776 937195
-;;;;;; 494000))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; End:
-;;; dired-hacks-utils-autoloads.el ends here
+++ /dev/null
-;;; -*- no-byte-compile: t -*-
-(define-package "dired-hacks-utils" "20190522.950" "Utilities and helpers for dired-hacks collection" '((dash "2.5.0")) :commit "ae39981d7cc58206cfeb377d6621bdd9000fd472" :keywords '("files") :authors '(("Matúš Goljer" . "matus.goljerNOSPAMgmail.com")) :maintainer '("Matúš Goljer" . "matus.goljerNOSPAMgmail.com"))
+++ /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: 20190522.950
-;; 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
-;; * `dired-utils-format-information-line-mode' - Format the information
-;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576).
-
-
-;; 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-")
-
-(defcustom dired-hacks-file-size-formatter 'file-size-human-readable
- "The function used to format file sizes.
-
-See `dired-utils-format-file-sizes'."
- :type 'symbol
- :group 'dired-hacks)
-
-(defcustom dired-hacks-datetime-regexp
- "\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)"
- "A regexp matching the date/time in the dired listing.
-
-It is used to determine where the filename starts. It should
-*not* match any characters after the last character of the
-timestamp. It is assumed that the timestamp is preceded and
-followed by at least one space character. You should only use
-shy groups (prefixed with ?:) because the first group is used by
-the font-lock to determine what portion of the name should be
-colored."
- :type 'string
- :group 'dired-hacks)
-
-(defalias 'dired-utils--string-trim
- (if (and (require 'subr-x nil t)
- (fboundp 'string-trim))
- #'string-trim
- (lambda (string)
- (let ((s string))
- (when (string-match "\\`[ \t\n\r]+" s)
- (setq s (replace-match "" t t s)))
- (when (string-match "[ \t\n\r]+\\'" s)
- (setq s (replace-match "" t t s)))
- s)))
- "Trim STRING of trailing whitespace.
-
-\(fn STRING)")
-
-(defun dired-utils-get-filename (&optional localp)
- "Like `dired-get-filename' but never signal an error.
-
-Optional arg LOCALP with value `no-dir' means don't include
-directory name in result."
- (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)
- "Get file information about 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.
-
-KEYWORDS is a list of attributes to query.
-
-When querying for one attribute, its value is returned. When
-querying for more than one, a list of results is returned.
-
-The available keywords 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)) "\\'") filename)
- (setq done it)))
- done))
-
-(defun dired-utils-format-information-line ()
- "Format the disk space on the Dired information line."
- (save-excursion
- (goto-char (point-min))
- (forward-line)
- (let ((inhibit-read-only t)
- (limit (line-end-position)))
- (while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+\\>\\)" nil t)
- (replace-match
- (save-match-data
- (propertize (dired-utils--string-trim
- (funcall dired-hacks-file-size-formatter
- (* 1024 (string-to-number (match-string 1))) t))
- 'invisible 'dired-hide-details-information))
- t nil nil 1)))))
-
-\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"))))
-
-(define-minor-mode dired-utils-format-information-line-mode
- "Toggle formatting of disk space in the Dired information line."
- :group 'dired-utils
- :lighter ""
- (if dired-utils-format-information-line-mode
- (add-hook 'dired-after-readin-hook #'dired-utils-format-information-line)
- (remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line)))
-
-(provide 'dired-hacks-utils)
-
-;;; dired-hacks-utils.el ends here
--- /dev/null
+;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "dired-hacks-utils" "dired-hacks-utils.el"
+;;;;;; (0 0 0 0))
+;;; Generated autoloads from dired-hacks-utils.el
+
+(register-definition-prefixes "dired-hacks-utils" '("dired-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("dired-hacks-utils-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; dired-hacks-utils-autoloads.el ends here
--- /dev/null
+(define-package "dired-hacks-utils" "20230512.1107" "Utilities and helpers for dired-hacks collection"
+ '((dash "2.5.0"))
+ :commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
+ '(("Matúš Goljer" . "matus.goljerNOSPAMgmail.com"))
+ :maintainers
+ '(("Matúš Goljer" . "matus.goljerNOSPAMgmail.com"))
+ :maintainer
+ '("Matúš Goljer" . "matus.goljerNOSPAMgmail.com")
+ :keywords
+ '("files"))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /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
+;; 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
+;; * `dired-utils-format-information-line-mode' - Format the information
+;; (summary) line file sizes to be human readable (e.g. 1GB instead of 1048576).
+
+
+;; 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-")
+
+(defcustom dired-hacks-file-size-formatter #'file-size-human-readable
+ "The function used to format file sizes.
+
+See `dired-utils-format-file-sizes'."
+ :type 'function
+ :group 'dired-hacks)
+
+(defcustom dired-hacks-datetime-regexp
+ "\\sw\\sw\\sw....\\(?:[0-9][0-9]:[0-9][0-9]\\|.[0-9]\\{4\\}\\)"
+ "A regexp matching the date/time in the dired listing.
+
+It is used to determine where the filename starts. It should
+*not* match any characters after the last character of the
+timestamp. It is assumed that the timestamp is preceded and
+followed by at least one space character. You should only use
+shy groups (prefixed with ?:) because the first group is used by
+the font-lock to determine what portion of the name should be
+colored."
+ :type 'regexp
+ :group 'dired-hacks)
+
+(defalias 'dired-utils--string-trim
+ (if (and (require 'subr-x nil t)
+ (fboundp 'string-trim))
+ #'string-trim
+ (lambda (string)
+ (let ((s string))
+ (when (string-match "\\`[ \t\n\r]+" s)
+ (setq s (replace-match "" t t s)))
+ (when (string-match "[ \t\n\r]+\\'" s)
+ (setq s (replace-match "" t t s)))
+ s)))
+ "Trim STRING of trailing whitespace.
+
+\(fn STRING)")
+
+(defun dired-utils-get-filename (&optional localp)
+ "Like `dired-get-filename' but never signal an error.
+
+Optional arg LOCALP with value `no-dir' means don't include
+directory name in result."
+ (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)
+ "Get file information about 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.
+
+KEYWORDS is a list of attributes to query.
+
+When querying for one attribute, its value is returned. When
+querying for more than one, a list of results is returned.
+
+The available keywords 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)) "\\'") filename)
+ (setq done it)))
+ done))
+
+(defun dired-utils-format-information-line ()
+ "Format the disk space on the Dired information line."
+ (save-excursion
+ (goto-char (point-min))
+ (forward-line)
+ (let ((inhibit-read-only t)
+ (limit (line-end-position)))
+ (while (re-search-forward "\\(?:directory\\|available\\) \\(\\<[0-9]+$\\>\\)" nil t)
+ (replace-match
+ (save-match-data
+ (propertize (dired-utils--string-trim
+ (funcall dired-hacks-file-size-formatter
+ (* 1024 (string-to-number (match-string 1))) t))
+ 'invisible 'dired-hide-details-information))
+ t nil nil 1)))))
+
+\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"))))
+
+(define-minor-mode dired-utils-format-information-line-mode
+ "Toggle formatting of disk space in the Dired information line."
+ :group 'dired-utils
+ :lighter ""
+ (if dired-utils-format-information-line-mode
+ (add-hook 'dired-after-readin-hook #'dired-utils-format-information-line)
+ (remove-hook 'dired-after-readin-hook #'dired-utils-format-information-line)))
+
+(provide 'dired-hacks-utils)
+
+;;; dired-hacks-utils.el ends here
+++ /dev/null
-;;; dired-narrow-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "dired-narrow" "dired-narrow.el" (0 0 0 0))
-;;; Generated autoloads from dired-narrow.el
-
-(autoload 'dired-narrow-regexp "dired-narrow" "\
-Narrow a dired buffer to the files matching a regular expression.
-
-\(fn)" t nil)
-
-(autoload 'dired-narrow "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\".
-
-\(fn)" t nil)
-
-(autoload 'dired-narrow-fuzzy "dired-narrow" "\
-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.
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "dired-narrow" '("dired-narrow-")))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; dired-narrow-autoloads.el ends here
+++ /dev/null
-;;; -*- no-byte-compile: t -*-
-(define-package "dired-narrow" "20181114.1723" "Live-narrowing of search results for dired" '((dash "2.7.0") (dired-hacks-utils "0.0.1")) :commit "c7184dc8f6ed3f2330db8d8f21f01c4b08056dd3" :keywords '("files") :authors '(("Matúš Goljer" . "matus.goljerNOSPAMgmail.com")) :maintainer '("Matúš Goljer" . "matus.goljerNOSPAMgmail.com"))
+++ /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: 20181114.1723
-;; 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> or C-n) - move the point to the
-;; next file
-;; * `dired-narrow-previous-file' (<up> or C-p) - move the point to the
-;; previous file
-;; * `dired-narrow-enter-directory' (<right> or C-j) - 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-p") 'dired-narrow-previous-file)
- (define-key map (kbd "C-n") 'dired-narrow-next-file)
- (define-key map (kbd "C-j") '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)
-
-(defcustom dired-narrow-exit-when-one-left nil
- "If there is only one file left while narrowing,
-exit minibuffer and call `dired-narrow-exit-action'."
- :type 'boolean
- :group 'dired-narrow)
-
-(defcustom dired-narrow-enable-blinking t
- "If set to true highlight the chosen file shortly.
-This feature works only when `dired-narrow-exit-when-one-left' is true."
- :type 'boolean
- :group 'dired-narrow)
-
-(defcustom dired-narrow-blink-time 0.2
- "How long should be highlighted a chosen file.
-Units are seconds."
- :type 'float
- :group 'dired-narrow)
-
-(defface dired-narrow-blink
- '((t :background "#eadc62"
- :foreground "black"))
- "The face used to highlight a chosen file
-when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are true."
- :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.
- Return the count of visible files that are left after update."
-
- (let ((inhibit-read-only t)
- (visible-files-cnt 0))
- (save-excursion
- (goto-char (point-min))
- ;; 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)
- (progn
- (setq visible-files-cnt (1+ visible-files-cnt))
- (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))
- visible-files-cnt))
-
-(defun dired-narrow--restore ()
- "Restore the invisible files of the current buffer."
- (let ((inhibit-read-only t))
- (remove-list-of-text-properties (point-min) (point-max)
- '(invisible :dired-narrow))
- (when (fboundp 'dired-insert-set-properties)
- (dired-insert-set-properties (point-min) (point-max)))))
-
-
-(defun dired-narrow--blink-current-file ()
- (let* ((beg (line-beginning-position))
- (end (line-end-position))
- (overlay (make-overlay beg end)))
- (overlay-put overlay 'face 'dired-narrow-blink)
- (redisplay)
- (sleep-for dired-narrow-blink-time)
- (discard-input)
- (delete-overlay overlay)))
-
-\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))
- visible-files-cnt)
- (with-current-buffer dired-narrow-buffer
- (setq visible-files-cnt
- (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))
-
- (when (and dired-narrow-exit-when-one-left
- visible-files-cnt
- (= visible-files-cnt 1))
- (when dired-narrow-enable-blinking
- (dired-narrow--blink-current-file))
- (exit-minibuffer))))))
-
-(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)
- (condition-case nil
- (string-match-p filter (dired-utils-get-filename 'no-dir))
- ;; Return t if your regexp is incomplete/has errors, thus
- ;; filtering nothing until you fix the regexp.
- (invalid-regexp 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
--- /dev/null
+;;; dired-narrow-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "dired-narrow" "dired-narrow.el" (0 0 0 0))
+;;; Generated autoloads from dired-narrow.el
+
+(autoload 'dired-narrow-regexp "dired-narrow" "\
+Narrow a dired buffer to the files matching a regular expression." t nil)
+
+(autoload 'dired-narrow "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\"." t nil)
+
+(autoload 'dired-narrow-fuzzy "dired-narrow" "\
+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." t nil)
+
+(register-definition-prefixes "dired-narrow" '("dired-narrow-"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("dired-narrow-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; dired-narrow-autoloads.el ends here
--- /dev/null
+(define-package "dired-narrow" "20230512.1107" "Live-narrowing of search results for dired"
+ '((dash "2.7.0")
+ (dired-hacks-utils "0.0.1"))
+ :commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors
+ '(("Matúš Goljer" . "matus.goljerNOSPAMgmail.com"))
+ :maintainers
+ '(("Matúš Goljer" . "matus.goljerNOSPAMgmail.com"))
+ :maintainer
+ '("Matúš Goljer" . "matus.goljerNOSPAMgmail.com")
+ :keywords
+ '("files"))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /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
+;; 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> or C-n) - move the point to the
+;; next file
+;; * `dired-narrow-previous-file' (<up> or C-p) - move the point to the
+;; previous file
+;; * `dired-narrow-enter-directory' (<right> or C-j) - 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-p") 'dired-narrow-previous-file)
+ (define-key map (kbd "C-n") 'dired-narrow-next-file)
+ (define-key map (kbd "C-j") '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)
+
+(defcustom dired-narrow-exit-when-one-left nil
+ "If there is only one file left while narrowing,
+exit minibuffer and call `dired-narrow-exit-action'."
+ :type 'boolean
+ :group 'dired-narrow)
+
+(defcustom dired-narrow-enable-blinking t
+ "If non-nil, highlight the chosen file shortly.
+Only works when `dired-narrow-exit-when-one-left' is non-nil."
+ :type 'boolean
+ :group 'dired-narrow)
+
+(defcustom dired-narrow-blink-time 0.2
+ "How many seconds should a chosen file be highlighted."
+ :type 'number
+ :group 'dired-narrow)
+
+(defface dired-narrow-blink
+ '((t :background "#eadc62"
+ :foreground "black"))
+ "The face used to highlight a chosen file
+when `dired-narrow-exit-when-one-left' and `dired-narrow-enable-blinking' are true."
+ :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.
+ Return the count of visible files that are left after update."
+
+ (let ((inhibit-read-only t)
+ (visible-files-cnt 0))
+ (save-excursion
+ (goto-char (point-min))
+ ;; 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)
+ (progn
+ (setq visible-files-cnt (1+ visible-files-cnt))
+ (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))
+ visible-files-cnt))
+
+(defun dired-narrow--restore ()
+ "Restore the invisible files of the current buffer."
+ (let ((inhibit-read-only t))
+ (remove-list-of-text-properties (point-min) (point-max)
+ '(invisible :dired-narrow))
+ (when (fboundp 'dired-insert-set-properties)
+ (dired-insert-set-properties (point-min) (point-max)))))
+
+
+(defun dired-narrow--blink-current-file ()
+ (let* ((beg (line-beginning-position))
+ (end (line-end-position))
+ (overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'dired-narrow-blink)
+ (redisplay)
+ (sleep-for dired-narrow-blink-time)
+ (discard-input)
+ (delete-overlay overlay)))
+
+\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))
+ visible-files-cnt)
+ (with-current-buffer dired-narrow-buffer
+ (setq visible-files-cnt
+ (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))
+
+ (when (and dired-narrow-exit-when-one-left
+ visible-files-cnt
+ (= visible-files-cnt 1))
+ (when dired-narrow-enable-blinking
+ (dired-narrow--blink-current-file))
+ (exit-minibuffer))))))
+
+(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
+ (pcase dired-narrow-filter-function
+ ('dired-narrow--regexp-filter
+ "Regex Filter:\s")
+ ('dired-narrow--fuzzy-filter
+ "Fuzzy Filter:\s")
+ (t "Filter:\s"))
+ 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)
+ (condition-case nil
+ (string-match-p filter (dired-utils-get-filename 'no-dir))
+ ;; Return t if your regexp is incomplete/has errors, thus
+ ;; filtering nothing until you fix the regexp.
+ (invalid-regexp 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
+++ /dev/null
-;;; direx-autoloads.el --- automatically extracted autoloads
-;;
-;;; Code:
-
-(add-to-list 'load-path (directory-file-name
- (or (file-name-directory #$) (car load-path))))
-
-\f
-;;;### (autoloads nil "direx" "direx.el" (0 0 0 0))
-;;; Generated autoloads from direx.el
-
-(autoload 'direx:jump-to-directory "direx" "\
-
-
-\(fn)" t nil)
-
-(autoload 'direx:jump-to-directory-other-window "direx" "\
-
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "direx" '("direx:")))
-
-;;;***
-\f
-;;;### (autoloads nil "direx-project" "direx-project.el" (0 0 0 0))
-;;; Generated autoloads from direx-project.el
-
-(autoload 'direx-project:jump-to-project-root "direx-project" "\
-
-
-\(fn)" t nil)
-
-(autoload 'direx-project:jump-to-project-root-other-window "direx-project" "\
-
-
-\(fn)" t nil)
-
-(if (fboundp 'register-definition-prefixes) (register-definition-prefixes "direx-project" '("direx-project:")))
-
-;;;***
-\f
-;;;### (autoloads nil nil ("direx-pkg.el") (0 0 0 0))
-
-;;;***
-\f
-;; Local Variables:
-;; version-control: never
-;; no-byte-compile: t
-;; no-update-autoloads: t
-;; coding: utf-8
-;; End:
-;;; direx-autoloads.el ends here
+++ /dev/null
-(define-package "direx" "20170422.1327" "Simple Directory Explorer" 'nil :keywords
- '("convenience")
- :authors
- '(("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com"))
- :maintainer
- '("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com"))
-;; Local Variables:
-;; no-byte-compile: t
-;; End:
+++ /dev/null
-;;; direx-project.el --- Project Module for Direx
-
-;; Copyright (C) 2012-2015 Tomohiro Matsuyama
-
-;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
-;; Keywords: convenience
-
-;; 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:
-
-;;
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'direx)
-
-(defgroup direx-project nil
- "Project Module for Direx."
- :group 'direx
- :prefix "direx-project:")
-
-(defcustom direx-project:project-root-predicate-functions
- '(direx-project:vc-root-p)
- "The list of functions which predicate whether the directory is
-a project root or not."
- :type '(repeat function)
- :group 'direx-project)
-
-(defun direx-project:vc-root-p (dirname)
- (cl-loop for vc-dir in '(".git" ".hg" ".bzr")
- thereis (file-exists-p (expand-file-name vc-dir dirname))))
-
-(defun direx-project:project-root-p (dirname)
- (cl-some (lambda (fun) (funcall fun dirname))
- direx-project:project-root-predicate-functions))
-
-(defun direx-project:find-project-root-noselect (filename)
- (interactive)
- (cl-loop for parent-dirname in (if (file-directory-p filename)
- (cons filename
- (direx:directory-parents filename))
- (direx:directory-parents filename))
- if (direx-project:project-root-p parent-dirname)
- return (direx:find-directory-noselect parent-dirname)))
-
-(defun direx-project:jump-to-project-root-noselect ()
- (interactive)
- (let ((buffer (direx-project:find-project-root-noselect
- (or buffer-file-name default-directory))))
- (if buffer
- (direx:maybe-goto-current-buffer-item buffer)
- (error "Project root not found"))
- buffer))
-
-;;;###autoload
-(defun direx-project:jump-to-project-root ()
- (interactive)
- (switch-to-buffer (direx-project:jump-to-project-root-noselect)))
-
-;;;###autoload
-(defun direx-project:jump-to-project-root-other-window ()
- (interactive)
- (switch-to-buffer-other-window (direx-project:jump-to-project-root-noselect)))
-
-(provide 'direx-project)
-;;; direx-project.el ends here
+++ /dev/null
-;;; direx.el --- Simple Directory Explorer
-
-;; Copyright (C) 2011-2015 Tomohiro Matsuyama
-
-;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
-;; Keywords: convenience
-;; Version: 1.0.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:
-
-;;
-
-;;; Code:
-
-(require 'cl-lib)
-(eval-when-compile (require 'cl))
-(require 'eieio)
-(require 'dired)
-(require 'regexp-opt)
-
-(defconst direx:version "1.0.0")
-
-(defgroup direx nil
- "Directory Explorer."
- :group 'convenience
- :prefix "direx:")
-
-(defcustom direx:leaf-icon " "
- ""
- :type 'string
- :group 'direx)
-
-(defcustom direx:open-icon "[-]"
- ""
- :type 'string
- :group 'direx)
-
-(defcustom direx:closed-icon "[+]"
- ""
- :type 'string
- :group 'direx)
-
-(defcustom direx:ignored-files-regexp
- (concat "\\(?:" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
- ""
- :type 'string
- :group 'direx)
-
-\f
-
-;;; Utilities
-
-(defmacro direx:aif (test then &rest else)
- (declare (indent 2))
- `(let ((it ,test)) (if it ,then ,@else)))
-
-(defmacro direx:awhen (test &rest body)
- (declare (indent 1))
- `(let ((it ,test)) (when it ,@body)))
-
-(defun direx:apply-partially (fun &rest args)
- (if (fboundp 'apply-partially)
- (apply 'apply-partially fun args)
- (require 'cl)
- (lexical-let ((fun fun) (args args))
- (lambda (&rest restargs)
- (apply fun (append args restargs))))))
-
-(defun direx:starts-with (x y)
- (and (<= (length y) (length x))
- (equal (substring x 0 (length y)) y)))
-
-(defun direx:walk-tree (fun object)
- (if (atom object)
- (funcall fun object)
- (direx:walk-tree fun (car object))
- (direx:walk-tree fun (cdr object))))
-
-(defun direx:canonical-filename (filename)
- (expand-file-name filename))
-
-(defun direx:canonical-dirname (dirname)
- (file-name-as-directory (expand-file-name dirname)))
-
-(defun direx:directory-basename (dirname)
- (file-name-nondirectory
- (directory-file-name
- (direx:canonical-dirname dirname))))
-
-(defun direx:directory-dirname (dirname)
- (file-name-directory
- (directory-file-name
- (direx:canonical-dirname dirname))))
-
-(defun direx:directory-parents (filename)
- (cl-loop for current-dirname = (direx:canonical-filename filename) then parent-dirname
- for parent-dirname = (direx:directory-dirname current-dirname)
- while (and parent-dirname (< (length parent-dirname) (length current-dirname)))
- collect parent-dirname))
-
-(defmacro direx:save-excursion-from-error (&rest body)
- (let ((point (cl-gensym "point"))
- (error (cl-gensym "error")))
- `(let ((,point (point)))
- (condition-case ,error
- (progn ,@body)
- (error
- (goto-char ,point)
- (signal (car ,error) (cdr ,error)))))))
-
-\f
-
-;;; Trees
-
-(defclass direx:tree ()
- ((name :initarg :name
- :accessor direx:tree-name)))
-
-(defgeneric direx:tree-equals (x y)
- "Returns t if X is equal to Y.")
-
-(defmethod direx:tree-equals (x y)
- (eq x y))
-
-(defgeneric direx:tree-status (tree)
- "Returns a status of TREE in string.")
-
-(defmethod direx:tree-status (tree)
- "")
-
-(defclass direx:node (direx:tree)
- ())
-
-(defgeneric direx:node-children (node)
- "Returns the children of the NODE.")
-
-(defmethod direx:node-children (node)
- nil)
-
-(defgeneric direx:node-contains (node descendant)
- "Returns t if the NODE has the DESCENDANT. The default
-implementation of this generic function uses
-`direx:node-children' to expand the descendants of the NODE
-recursively and check if the DESCENDANT is a member of the
-descendants. You may add a heuristic method for speed.")
-
-(defmethod direx:node-contains (node descendant)
- (cl-loop for child in (direx:node-children node) thereis
- (or (direx:tree-equals child descendant)
- (and (cl-typep child 'direx:node)
- (direx:node-contains child descendant)))))
-
-(defclass direx:leaf (direx:tree)
- ())
-
-\f
-
-;;; Tree Widgets
-
-(defclass direx:item ()
- ((tree :initarg :tree
- :accessor direx:item-tree)
- (parent :initarg :parent
- :accessor direx:item-parent)
- (children :accessor direx:item-children)
- (face :initarg :face
- :accessor direx:item-face)
- (keymap :initarg :keymap
- :accessor direx:item-keymap)
- (overlay :accessor direx:item-overlay)
- (open :accessor direx:item-open)))
-
-(defgeneric direx:generic-find-item (item not-this-window))
-
-(defgeneric direx:generic-view-item (item not-this-window))
-
-(defgeneric direx:generic-display-item (item))
-
-(defgeneric direx:make-item (tree parent)
- "Returns a item of the TREE.")
-
-(defmethod direx:make-item (tree parent)
- (make-instance 'direx:item :tree tree :parent parent))
-
-(defun direx:make-item-children (item)
- (cl-loop for child-tree in (direx:node-children (direx:item-tree item))
- collect (direx:make-item child-tree item)))
-
-(defun direx:item-equals (x y)
- (direx:tree-equals (direx:item-tree x) (direx:item-tree y)))
-
-(defun direx:item-name (item)
- (direx:tree-name (direx:item-tree item)))
-
-(defun direx:item-leaf-p (item)
- (cl-typep (direx:item-tree item) 'direx:leaf))
-
-(defun direx:item-node-p (item)
- (cl-typep (direx:item-tree item) 'direx:node))
-
-(defun direx:item-depth (item)
- (direx:aif (direx:item-parent item)
- (1+ (direx:item-depth it))
- 0))
-
-(defun direx:item-start (item)
- (overlay-start (direx:item-overlay item)))
-
-(defun direx:item-end (item)
- (let ((children (direx:item-children item)))
- (if children
- (direx:item-end (car (last children)))
- (overlay-end (direx:item-overlay item)))))
-
-(defun direx:item-root (item)
- (direx:aif (direx:item-parent item)
- (direx:item-root it)
- item))
-
-(defun direx:item-buffer (item)
- (overlay-buffer (direx:item-overlay item)))
-
-;; Rendering
-
-(defun direx:item-icon-part-offset (item)
- (* (direx:item-depth item) (length direx:open-icon)))
-
-(defun direx:item-name-part-offset (item)
- (+ (direx:item-icon-part-offset item) (length direx:open-icon)))
-
-(defun direx:item-render-indent-part (item)
- (make-string (direx:item-icon-part-offset item) ? ))
-
-(defun direx:item-render-icon-part (item)
- (if (direx:item-leaf-p item)
- direx:leaf-icon
- direx:closed-icon))
-
-(defun direx:item-render-name-part (item)
- (propertize (direx:item-name item)
- 'face (direx:item-face item)
- 'mouse-face 'hightlight
- 'help-echo "mouse-1: toggle or find this node
-mouse-2: find this node in other window"))
-
-(defun direx:item-render (item)
- (concat (direx:item-render-indent-part item)
- (direx:item-render-icon-part item)
- (direx:item-render-name-part item)
- "\n"))
-
-(defun direx:item-make-overlay (item start end)
- (let ((overlay (make-overlay start end nil t nil)))
- (overlay-put overlay 'direx:item item)
- (overlay-put overlay 'keymap (direx:item-keymap item))
- (setf (direx:item-overlay item) overlay)
- overlay))
-
-(defun direx:item-insert (item)
- (let ((start (point))
- (buffer-read-only nil))
- (insert (direx:item-render item))
- (direx:item-make-overlay item start (point))
- item))
-
-(defun direx:item-insert-children (item)
- (let ((children (direx:make-item-children item)))
- (setf (direx:item-children item) children)
- (save-excursion
- (goto-char (overlay-end (direx:item-overlay item)))
- (dolist (child children)
- (direx:item-insert child)))))
-
-(defun direx:item-ensure-children (item)
- (unless (direx:item-children item)
- (direx:item-insert-children item)))
-
-(cl-defun direx:item-delete (item)
- (let* ((overlay (direx:item-overlay item))
- (start (overlay-start overlay))
- (end (overlay-end overlay))
- (buffer-read-only nil))
- (delete-region start end)
- (delete-overlay overlay)))
-
-(defun direx:item-delete-recursively (item)
- (direx:item-delete item)
- (unless (direx:item-leaf-p item)
- (dolist (child (direx:item-children item))
- (direx:item-delete-recursively child))))
-
-(defun direx:item-change-icon (item new-icon)
- (let ((buffer-read-only nil))
- (save-excursion
- ;; Insert the icon carefully with consideration of the
- ;; front-advance overlay.
- (goto-char (+ (direx:item-start item)
- (direx:item-name-part-offset item)))
- (insert new-icon)
- ;; Then delete the icon.
- (goto-char (+ (line-beginning-position)
- (direx:item-icon-part-offset item)))
- (delete-char (length new-icon)))))
-
-(defun direx:item-visible-p (item)
- (not (overlay-get (direx:item-overlay item) 'invisible)))
-
-(defun direx:item-show (item)
- (overlay-put (direx:item-overlay item) 'invisible nil))
-
-(defun direx:item-hide (item)
- (overlay-put (direx:item-overlay item) 'invisible t))
-
-(defun direx:item-show-children (item)
- (when (and (not (direx:item-leaf-p item))
- (direx:item-open item))
- (dolist (child (direx:item-children item))
- (direx:item-show child)
- (direx:item-show-children child))))
-
-(defun direx:item-hide-children (item)
- (unless (direx:item-leaf-p item)
- (dolist (child (direx:item-children item))
- (direx:item-hide child)
- (direx:item-hide-children child))))
-
-(defun direx:item-expand (item)
- (unless (direx:item-leaf-p item)
- (setf (direx:item-open item) t)
- (direx:item-ensure-children item)
- (direx:item-show-children item)
- (direx:item-change-icon item direx:open-icon)))
-
-(defun direx:item-ensure-open (item)
- (unless (direx:item-open item)
- (direx:item-expand item)))
-
-(defun direx:item-expand-recursively (item)
- (direx:item-expand item)
- (dolist (child (direx:item-children item))
- (direx:item-expand-recursively child)))
-
-(defun direx:item-collapse (item)
- (unless (direx:item-leaf-p item)
- (setf (direx:item-open item) nil)
- (direx:item-hide-children item)
- (direx:item-change-icon item direx:closed-icon)))
-
-(defun direx:item-ensure-closed (item)
- (when (direx:item-open item)
- (direx:item-collapse item)))
-
-(defun direx:item-toggle (item)
- (if (direx:item-open item)
- (direx:item-collapse item)
- (direx:item-expand item)))
-
-(defmethod direx:item-refresh ((item direx:item))
- (when (and (not (direx:item-leaf-p item))
- (direx:item-children item))
- (cl-loop with point = (overlay-end (direx:item-overlay item))
- with old-children = (direx:item-children item)
- for new-child in (direx:make-item-children item)
- for old-child = (cl-find-if (direx:apply-partially
- 'direx:item-equals new-child)
- old-children)
- if old-child
- do (setq new-child old-child
- old-children (delq old-child old-children))
- else
- do (save-excursion
- (goto-char point)
- (direx:item-insert new-child))
- do (setq point (direx:item-end new-child))
- collect new-child into new-children
- finally
- (dolist (old-child old-children)
- (direx:item-delete-recursively old-child))
- (setf (direx:item-children item) new-children))))
-
-(defun direx:item-refresh-recursively (item)
- (direx:item-refresh item)
- (dolist (child (direx:item-children item))
- (direx:item-refresh-recursively child)))
-
-(cl-defun direx:item-refresh-parent (item &key recursive)
- (direx:awhen (direx:item-parent item)
- (direx:item-refresh-recursively it)))
-
-\f
-
-;;; File System
-
-;; Trees
-
-(defclass direx:file (direx:tree)
- ((full-name :initarg :full-name
- :accessor direx:file-full-name)))
-
-(defmethod direx:tree-equals ((x direx:file) y)
- (or (eq x y)
- (and (cl-typep y 'direx:file)
- (equal (direx:file-full-name x) (direx:file-full-name y)))))
-
-(defmethod direx:tree-status ((file direx:file))
- (let* ((filename (direx:file-full-name file))
- (dired-actual-switches "-la")
- (file-list (list (if (direx:regular-file-item-p file)
- (file-name-nondirectory filename)
- (direx:directory-basename filename))))
- (default-directory (direx:directory-dirname filename)))
- (with-temp-buffer
- (dired-insert-directory default-directory
- dired-actual-switches
- file-list)
- (goto-char (point-min))
- (buffer-substring-no-properties (point) (line-end-position)))))
-
-(defclass direx:regular-file (direx:file direx:leaf)
- ())
-
-(defun direx:make-regular-file (filename)
- (make-instance 'direx:regular-file
- :name (file-name-nondirectory filename)
- :full-name (direx:canonical-filename filename)))
-
-(defclass direx:directory (direx:file direx:node)
- ())
-
-(defun direx:make-directory (dirname)
- (let* ((dirname (direx:canonical-dirname dirname))
- (basename (direx:directory-basename dirname))
- (name (if (zerop (length basename)) dirname basename)))
- (make-instance 'direx:directory
- :name name
- :full-name dirname)))
-
-(defmethod direx:node-children ((dir direx:directory))
- (cl-loop with dirname = (direx:file-full-name dir)
- for filename in (directory-files dirname t)
- for basename = (file-name-nondirectory filename)
- unless (string-match dired-trivial-filenames basename)
- if (file-directory-p filename)
- collect (direx:make-directory filename)
- else
- collect (direx:make-regular-file filename)))
-
-(defmethod direx:node-contains ((dir direx:directory) file)
- (and (cl-typep file 'direx:file)
- (direx:starts-with (direx:file-full-name file)
- (direx:file-full-name dir))))
-
-;; Tree Items
-
-(defclass direx:file-item (direx:item)
- ())
-
-(defvar direx:file-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "R") 'direx:do-rename-file)
- (define-key map (kbd "C") 'direx:do-copy-files)
- (define-key map (kbd "D") 'direx:do-delete-files)
- (define-key map (kbd "+") 'direx:create-directory)
- (define-key map (kbd "M") 'direx:do-chmod-file)
- (define-key map (kbd "L") 'direx:do-load-file)
- (define-key map (kbd "B") 'direx:do-byte-compile-file)
- (define-key map (kbd "G") 'direx:do-chgrp)
- (define-key map (kbd "O") 'direx:do-chown)
- (define-key map (kbd "T") 'direx:do-touch)
- map))
-
-(defun direx:do-rename-file ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (file-full-name (direx:file-full-name file))
- (dir-name (file-name-directory file-full-name))
- (file-name (file-name-nondirectory file-full-name))
- (to (read-file-name (format "Rename %s to " file-name) dir-name file-name)))
- (dired-rename-file file-full-name to nil)
- (direx:item-refresh-parent item)
- (direx:move-to-item-name-part item)))
-
-(defun direx:do-copy-files ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (file-full-name (direx:file-full-name file))
- (dir-name (file-name-directory file-full-name))
- (file-name (file-name-nondirectory file-full-name))
- (to (read-directory-name (format "Copy %s to " file-name) dir-name file-name)))
- (dired-copy-file file-full-name to nil)
- (direx:item-refresh-parent item)
- (direx:move-to-item-name-part item)))
-
-(defun direx:do-delete-files ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (file-full-name (direx:file-full-name file)))
- (when (yes-or-no-p (format "Delete %s" (direx:tree-name file)))
- (dired-delete-file file-full-name dired-recursive-deletes t)
- (direx:item-refresh-parent item)
- (direx:move-to-item-name-part item)
- (dired-clean-up-after-deletion file-full-name))))
-
-(defun direx:create-directory ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (parent-dir
- (if (cl-typep file 'direx:directory)
- (direx:file-full-name file)
- (direx:directory-dirname
- (direx:file-full-name file))))
- (dir (read-directory-name "Create directory: " parent-dir)))
- (when (file-exists-p dir)
- (error "Can't create directory %s: file exists" dir))
- (make-directory dir t)
- (direx:item-refresh-parent item)
- (direx:move-to-item-name-part item)))
-
-(defun direx:do-chmod-file ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (filename (file-name-nondirectory (direx:file-full-name file)))
- (orig-modes (file-modes filename))
- (modes (read-string (format "Change mode of %s to: " filename)))
- (new-modes (if (string-match "^[0-7]+" modes)
- (string-to-number modes 8)
- (file-modes-symbolic-to-number modes orig-modes))))
- (set-file-modes filename new-modes)))
-
-(defun direx:do-load-file ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (filename (direx:file-full-name file))
- (failure nil))
- (when (y-or-n-p (format "Load %s?" (file-name-nondirectory filename)))
- (condition-case err
- (load filename nil nil t)
- (error (setq failure err)))
- (when failure
- (message "Load error for %s:\n%s\n" file failure)))))
-
-(defun direx:do-byte-compile-file ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (filename (direx:file-full-name file))
- (dest-file (byte-compile-dest-file filename))
- (failure nil))
- (when (y-or-n-p (format "Byte-Compile %s?" (file-name-nondirectory filename)))
- (condition-case err
- (save-excursion (byte-compile-file filename))
- (error (setq failure err)))
- (or (file-exists-p dest-file)
- (setq failure t))
- (if failure
- (error "Byte compile error for %s\n%s\n" filename failure)
- (progn
- (direx:item-refresh-parent item)
- (direx:next-item))))))
-
-(defun direx:exec-command (program args)
- (unless (executable-find program)
- (error "Command '%s' not found" program))
- (with-temp-buffer
- (unless (zerop (apply 'call-process program nil t nil args))
- (message "%s" (replace-regexp-in-string "[\r\n]+\\'" ""
- (buffer-string))))))
-
-(defun direx:do-chxxx (program attr filename)
- (let* ((prompt (format "Change %s of %s to: "
- attr (file-name-nondirectory filename)))
- (new-attr (read-string prompt))
- (args (list new-attr filename)))
- (direx:exec-command program args)))
-
-(defun direx:do-chgrp ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (filename (direx:file-full-name file)))
- (direx:do-chxxx "chgrp" "Group" filename)))
-
-(defun direx:do-chown ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (filename (direx:file-full-name file)))
- (direx:do-chxxx "chown" "Owner" filename)))
-
-(defun direx:do-touch ()
- (interactive)
- (let* ((item (direx:item-at-point!))
- (file (direx:item-tree item))
- (filename (direx:file-full-name file))
- (default (format-time-string "%Y%m%d%H%M.%S"
- (nth 5 (file-attributes filename))))
- (prompt (format "Change Timestamp of %s to (default now): "
- (file-name-nondirectory filename)))
- (new-time (read-string prompt))
- (args (if (string= new-time "")
- (list filename)
- (list "-t" new-time filename))))
- (direx:exec-command "touch" args)))
-
-(defclass direx:regular-file-item (direx:file-item)
- ())
-
-(defmethod direx:generic-find-item ((item direx:regular-file-item) not-this-window)
- (let ((filename (direx:file-full-name (direx:item-tree item))))
- (if not-this-window
- (find-file-other-window filename)
- (find-file filename))))
-
-(defmethod direx:generic-view-item ((item direx:regular-file-item) not-this-window)
- (let ((filename (direx:file-full-name (direx:item-tree item))))
- (if not-this-window
- (view-file-other-window filename)
- (view-file filename))))
-
-(defmethod direx:generic-display-item ((item direx:regular-file-item))
- (let ((filename (direx:file-full-name (direx:item-tree item))))
- (display-buffer (find-file-noselect filename))))
-
-(defmethod direx:make-item ((file direx:regular-file) parent)
- (let* ((filename (direx:file-full-name file))
- (face (when (string-match direx:ignored-files-regexp filename)
- 'dired-ignored)))
- (make-instance 'direx:regular-file-item
- :tree file
- :parent parent
- :face face
- :keymap direx:file-keymap)))
-
-(defclass direx:directory-item (direx:file-item)
- ())
-
-(defmethod direx:generic-find-item ((item direx:directory-item) not-this-window)
- (let ((dirname (direx:file-full-name (direx:item-tree item))))
- (if not-this-window
- (dired-other-window dirname)
- (dired dirname))))
-
-(defmethod direx:generic-display-item ((item direx:directory-item))
- (let ((dirname (direx:file-full-name (direx:item-tree item))))
- (display-buffer (dired-noselect dirname))))
-
-(defmethod direx:make-item ((dir direx:directory) parent)
- (make-instance 'direx:directory-item
- :tree dir
- :parent parent
- :face 'dired-directory
- :keymap direx:file-keymap))
-
-\f
-
-;;; Tree Buffers
-
-(defvar direx:root-item nil)
-
-(defun direx:item-at-point (&optional point)
- (get-char-property (or point (point)) 'direx:item))
-
-(defun direx:item-at-point! (&optional point)
- (or (direx:item-at-point point)
- (error "No item at point")))
-
-(defun direx:item-at-event (event)
- (direx:awhen (posn-window (event-end event))
- (with-selected-window it
- (direx:item-at-point (posn-point (event-end event))))))
-
-(defun direx:find-root-item-if (predicate)
- (cl-find-if predicate
- (mapcar (direx:apply-partially 'buffer-local-value 'direx:root-item)
- (direx:buffer-list))))
-
-(defun direx:find-root-item-for-root (root)
- (direx:find-root-item-if
- (lambda (item) (direx:tree-equals root (direx:item-tree item)))))
-
-(defun direx:buffer-live-p (buffer)
- (and (buffer-live-p buffer)
- (eq (buffer-local-value 'major-mode buffer) 'direx:direx-mode)))
-
-(defun direx:buffer-list ()
- (cl-remove-if-not 'direx:buffer-live-p (buffer-list)))
-
-(defgeneric direx:make-buffer (root))
-
-(defmethod direx:make-buffer ((root direx:tree))
- (let ((buffer (generate-new-buffer (direx:tree-name root))))
- (with-current-buffer buffer
- (direx:direx-mode)
- (setq default-directory (direx:file-full-name root))
- (setq-local revert-buffer-function 'direx:revert-buffer))
- buffer))
-
-(defmethod direx:make-buffer ((dir direx:directory))
- (with-current-buffer (call-next-method)
- (set (make-local-variable 'dired-directory)
- (direx:file-full-name dir))
- (current-buffer)))
-
-(defun direx:revert-buffer (ignore-auto noconfirm)
- (direx:refresh-whole-tree))
-
-(defun direx:make-buffer-for-root (root)
- (let ((buffer (direx:make-buffer root)))
- (direx:add-root-into-buffer root buffer)
- buffer))
-
-(defun direx:ensure-buffer-for-root (root)
- (or (direx:find-buffer-for-root root)
- (direx:make-buffer-for-root root)))
-
-(defun direx:find-buffer-for-root (root)
- (direx:awhen (direx:find-root-item-for-root root)
- (direx:item-buffer it)))
-
-(defun direx:add-root-into-buffer (root buffer &optional noexpand)
- (with-current-buffer buffer
- (let ((root-item (direx:make-item root nil))
- (buffer-read-only nil))
- (goto-char (point-max))
- (direx:item-insert root-item)
- (setq direx:root-item root-item)
- (unless noexpand
- (direx:item-expand root-item)
- (direx:move-to-item-name-part root-item)))))
-
-(defun direx:goto-item-for-tree-1 (tree)
- (goto-char (point-min))
- (cl-loop for item = (direx:item-at-point)
- for item-tree = (and item (direx:item-tree item))
- while item-tree
- if (direx:tree-equals item-tree tree)
- return (direx:move-to-item-name-part item)
- else if (and (cl-typep item-tree 'direx:node)
- (direx:node-contains item-tree tree))
- do (direx:down-item)
- else
- do (direx:next-sibling-item)
- finally (error "Item not found")))
-
-(defun direx:goto-item-for-tree (tree)
- (ignore-errors
- (direx:save-excursion-from-error
- (direx:goto-item-for-tree-1 tree))))
-
-\f
-
-;;; Major Mode
-
-(defun direx:ensure-item-visible (item))
-
-(defun direx:move-to-item-name-part (&optional item)
- (unless item
- (setq item (direx:item-at-point)))
- (when (and item (direx:item-start item))
- (goto-char (+ (direx:item-start item)
- (direx:item-name-part-offset item)))
- (direx:ensure-item-visible item)))
-
-(defun direx:next-item (&optional arg)
- (interactive "p")
- (cl-loop unless (zerop (forward-line arg))
- do (error (if (cl-plusp arg) "End of buffer" "Beginning of buffer"))
- for item = (direx:item-at-point!)
- when (direx:item-visible-p item)
- return (direx:move-to-item-name-part item)))
-
-(defun direx:previous-item (&optional arg)
- (interactive "p")
- (direx:next-item (if (null arg) -1 (- arg))))
-
-(defun direx:up-item-1 (item)
- (cl-loop with parent = (direx:item-parent item)
- while (and (zerop (forward-line -1))
- (not (eq (direx:item-at-point) parent)))
- finally (direx:move-to-item-name-part)))
-
-(defun direx:up-item ()
- (interactive)
- (direx:aif (direx:item-at-point)
- (direx:up-item-1 it)
- (goto-char (point-min))))
-
-(defun direx:down-item ()
- (interactive)
- (direx:awhen (direx:item-at-point)
- (unless (direx:item-node-p it) (error "No children"))
- (direx:item-ensure-open it)
- (unless (direx:item-children it) (error "No children")))
- (direx:next-item))
-
-(defun direx:next-sibling-item-1 (item arg)
- (cl-loop with parent = (direx:item-parent item)
- with siblings = (when parent (direx:item-children parent))
- with ordered-siblings = (if (cl-plusp arg) siblings (reverse siblings))
- with sibling = (cadr (memq item ordered-siblings))
- with point = (point)
- with item
- while (and sibling
- (zerop (forward-line arg))
- (setq item (direx:item-at-point)))
- if (eq item sibling)
- return (direx:move-to-item-name-part item)
- finally
- (goto-char point)
- (error "No sibling")))
-
-(defun direx:next-sibling-item (&optional arg)
- (interactive "p")
- (setq arg (if (or (null arg) (> arg 0)) 1 -1))
- (direx:aif (direx:item-at-point)
- (direx:next-sibling-item-1 it arg)
- (direx:next-item arg)))
-
-(defun direx:previous-sibling-item (&optional arg)
- (interactive "p")
- (direx:next-sibling-item (if (or (null arg) (> arg 0)) -1 1)))
-
-(defun direx:refresh-whole-tree (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point) direx:root-item))
- (direx:item-refresh-recursively (direx:item-root item))
- (direx:move-to-item-name-part item))
-
-(defun direx:echo-item ()
- (interactive)
- (message "%s" (direx:tree-status (direx:item-tree (direx:item-at-point)))))
-
-(defun direx:find-item (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:generic-find-item item nil))
-
-(defun direx:find-item-other-window (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:generic-find-item item t))
-
-(defun direx:view-item (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:generic-view-item item nil))
-
-(defun direx:view-item-other-window (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:generic-view-item item t))
-
-(defun direx:display-item (&optional item)
- "Open ITEM at point without changing focus."
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:generic-display-item item))
-
-(defun direx:maybe-find-item (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (if (direx:item-leaf-p item)
- (direx:find-item item)
- (direx:toggle-item item)))
-
-(defun direx:expand-item (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:item-expand item)
- (let ((children (direx:item-children item)))
- (when (and (= (length children) 1)
- (direx:item-node-p (car children)))
- ;; Also expands the sub directory
- (direx:expand-item (car children))))
- (direx:move-to-item-name-part item))
-
-(defun direx:expand-item-recursively (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:item-expand-recursively item)
- (direx:move-to-item-name-part item))
-
-(defun direx:collapse-item (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (direx:item-collapse item)
- (direx:move-to-item-name-part item))
-
-(defun direx:toggle-item (&optional item)
- (interactive)
- (setq item (or item (direx:item-at-point!)))
- (if (direx:item-open item)
- (direx:collapse-item item)
- (direx:expand-item item))
- (direx:move-to-item-name-part item))
-
-(defun direx:mouse-1 (event)
- (interactive "e")
- (direx:awhen (direx:item-at-event event)
- (direx:maybe-find-item it)))
-
-(defun direx:mouse-2 (event)
- (interactive "e")
- (direx:awhen (direx:item-at-event event)
- (direx:find-item-other-window it)))
-
-(defvar direx:direx-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (kbd "n") 'direx:next-item)
- (define-key map (kbd "C-n") 'direx:next-item)
- (define-key map (kbd "<down>") 'direx:next-item)
- (define-key map (kbd "p") 'direx:previous-item)
- (define-key map (kbd "C-p") 'direx:previous-item)
- (define-key map (kbd "<up>") 'direx:previous-item)
- (define-key map (kbd "C-M-n") 'direx:next-sibling-item)
- (define-key map (kbd "C-M-<down>") 'direx:next-sibling-item)
- (define-key map (kbd "C-M-p") 'direx:previous-sibling-item)
- (define-key map (kbd "C-M-<up>") 'direx:previous-sibling-item)
- (define-key map (kbd "^") 'direx:up-item)
- (define-key map (kbd "C-M-u") 'direx:up-item)
- (define-key map (kbd "C-M-<left>") 'direx:up-item)
- (define-key map (kbd "C-M-d") 'direx:down-item)
- (define-key map (kbd "C-M-<right>") 'direx:up-item)
- (define-key map (kbd "e") 'direx:echo-item)
- (define-key map (kbd "f") 'direx:find-item)
- (define-key map (kbd "o") 'direx:find-item-other-window)
- (define-key map (kbd "v") 'direx:view-item)
- (define-key map (kbd "V") 'direx:view-item-other-window)
- (define-key map (kbd "C-o") 'direx:display-item)
- (define-key map (kbd "RET") 'direx:maybe-find-item)
- (define-key map (kbd "TAB") 'direx:toggle-item)
- (define-key map (kbd "i") 'direx:toggle-item)
- (define-key map (kbd "E") 'direx:expand-item-recursively)
- (define-key map (kbd "g") 'direx:refresh-whole-tree)
- (define-key map [mouse-1] 'direx:mouse-1)
- (define-key map [mouse-2] 'direx:mouse-2)
- map))
-
-(define-derived-mode direx:direx-mode special-mode "Direx"
- ""
- (set (make-local-variable 'direx:root-item) nil)
- (setq buffer-read-only t
- truncate-lines t)
- (use-local-map direx:direx-mode-map))
-
-\f
-
-;;; Directory
-
-(defun direx:find-directory-noselect (dirname)
- (interactive "DDirex (directory): ")
- (direx:ensure-buffer-for-root (direx:make-directory dirname)))
-
-(defun direx:find-directory (dirname)
- (interactive "DDirex (directory): ")
- (switch-to-buffer (direx:find-directory-noselect dirname)))
-
-(defun direx:find-directory-other-window (dirname)
- (interactive "DDirex (directory): ")
- (switch-to-buffer-other-window (direx:find-directory-noselect dirname)))
-
-(defun direx:find-directory-reuse-noselect (dirname)
- (interactive "DDirex (directory): ")
- (cl-loop for current-dirname = dirname then parent-dirname
- for parent-dirname in (direx:directory-parents dirname)
- for dir = (direx:make-directory current-dirname)
- for buffer = (direx:find-buffer-for-root dir)
- if buffer return buffer
- finally return (direx:find-directory-noselect dirname)))
-
-(defun direx:find-directory-reuse (dirname)
- (interactive "DDirex (directory): ")
- (switch-to-buffer (direx:find-directory-reuse-noselect dirname)))
-
-(defun direx:find-directory-reuse-other-window (dirname)
- (interactive "DDirex (directory): ")
- (switch-to-buffer-other-window (direx:find-directory-reuse-noselect dirname)))
-
-(defun direx:maybe-goto-current-buffer-item (buffer)
- (let ((filename buffer-file-name)
- (dirname default-directory))
- (with-current-buffer buffer
- (cond (filename
- (direx:goto-item-for-tree (direx:make-regular-file filename)))
- (dirname
- (direx:goto-item-for-tree (direx:make-directory dirname)))))))
-
-(defun direx:jump-to-directory-noselect ()
- (interactive)
- (let ((buffer (direx:find-directory-reuse-noselect default-directory)))
- (direx:maybe-goto-current-buffer-item buffer)
- buffer))
-
-;;;###autoload
-(defun direx:jump-to-directory ()
- (interactive)
- (switch-to-buffer (direx:jump-to-directory-noselect)))
-
-;;;###autoload
-(defun direx:jump-to-directory-other-window ()
- (interactive)
- (switch-to-buffer-other-window (direx:jump-to-directory-noselect)))
-
-(provide 'direx)
-;;; direx.el ends here
--- /dev/null
+;;; direx-autoloads.el --- automatically extracted autoloads -*- lexical-binding: t -*-
+;;
+;;; Code:
+
+(add-to-list 'load-path (directory-file-name
+ (or (file-name-directory #$) (car load-path))))
+
+\f
+;;;### (autoloads nil "direx" "direx.el" (0 0 0 0))
+;;; Generated autoloads from direx.el
+
+(autoload 'direx:jump-to-directory "direx" nil t nil)
+
+(autoload 'direx:jump-to-directory-other-window "direx" nil t nil)
+
+(register-definition-prefixes "direx" '("direx:"))
+
+;;;***
+\f
+;;;### (autoloads nil "direx-project" "direx-project.el" (0 0 0 0))
+;;; Generated autoloads from direx-project.el
+
+(autoload 'direx-project:jump-to-project-root "direx-project" nil t nil)
+
+(autoload 'direx-project:jump-to-project-root-other-window "direx-project" nil t nil)
+
+(register-definition-prefixes "direx-project" '("direx-project:"))
+
+;;;***
+\f
+;;;### (autoloads nil nil ("direx-pkg.el") (0 0 0 0))
+
+;;;***
+\f
+;; Local Variables:
+;; version-control: never
+;; no-byte-compile: t
+;; no-update-autoloads: t
+;; coding: utf-8
+;; End:
+;;; direx-autoloads.el ends here
--- /dev/null
+(define-package "direx" "20230409.1425" "Simple Directory Explorer" 'nil :commit "935d2010234c02c93e22d6e1cc72d595341ba855" :authors
+ '(("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com"))
+ :maintainers
+ '(("Tomohiro Matsuyama" . "m2ym.pub@gmail.com"))
+ :maintainer
+ '("Tomohiro Matsuyama" . "m2ym.pubNOSPAMgmail.com")
+ :keywords
+ '("convenience"))
+;; Local Variables:
+;; no-byte-compile: t
+;; End:
--- /dev/null
+;;; direx-project.el --- Project Module for Direx -*- lexical-binding:t -*-
+
+;; Copyright (C) 2012-2015 Tomohiro Matsuyama
+
+;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
+;; Keywords: convenience
+
+;; 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:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'direx)
+
+(defgroup direx-project nil
+ "Project Module for Direx."
+ :group 'direx
+ :prefix "direx-project:")
+
+(defcustom direx-project:project-root-predicate-functions
+ '(direx-project:vc-root-p)
+ "The list of functions which predicate whether the directory is
+a project root or not."
+ :type '(repeat function)
+ :group 'direx-project)
+
+(defun direx-project:vc-root-p (dirname)
+ (cl-loop for vc-dir in '(".git" ".hg" ".bzr")
+ thereis (file-exists-p (expand-file-name vc-dir dirname))))
+
+(defun direx-project:project-root-p (dirname)
+ (cl-some (lambda (fun) (funcall fun dirname))
+ direx-project:project-root-predicate-functions))
+
+(defun direx-project:find-project-root-noselect (filename)
+ (interactive)
+ (cl-loop for parent-dirname in (if (file-directory-p filename)
+ (cons filename
+ (direx:directory-parents filename))
+ (direx:directory-parents filename))
+ if (direx-project:project-root-p parent-dirname)
+ return (direx:find-directory-noselect parent-dirname)))
+
+(defun direx-project:jump-to-project-root-noselect ()
+ (interactive)
+ (let ((buffer (direx-project:find-project-root-noselect
+ (or buffer-file-name default-directory))))
+ (if buffer
+ (direx:maybe-goto-current-buffer-item buffer)
+ (error "Project root not found"))
+ buffer))
+
+;;;###autoload
+(defun direx-project:jump-to-project-root ()
+ (interactive)
+ (switch-to-buffer (direx-project:jump-to-project-root-noselect)))
+
+;;;###autoload
+(defun direx-project:jump-to-project-root-other-window ()
+ (interactive)
+ (switch-to-buffer-other-window (direx-project:jump-to-project-root-noselect)))
+
+(provide 'direx-project)
+;;; direx-project.el ends here
--- /dev/null
+;;; direx.el --- Simple Directory Explorer -*- lexical-binding:t -*-
+
+;; Copyright (C) 2011-2015 Tomohiro Matsuyama
+
+;; Author: Tomohiro Matsuyama <m2ym.pubNOSPAMgmail.com>
+;; Keywords: convenience
+;; Version: 1.0.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:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'dired)
+(require 'regexp-opt)
+
+(defconst direx:version "1.0.0")
+
+(defgroup direx nil
+ "Directory Explorer."
+ :group 'convenience
+ :prefix "direx:")
+
+(defcustom direx:leaf-icon " "
+ ""
+ :type 'string
+ :group 'direx)
+
+(defcustom direx:open-icon "[-]"
+ ""
+ :type 'string
+ :group 'direx)
+
+(defcustom direx:closed-icon "[+]"
+ ""
+ :type 'string
+ :group 'direx)
+
+(defcustom direx:ignored-files-regexp
+ (concat "\\(?:" (regexp-opt completion-ignored-extensions) "\\|#\\)$")
+ ""
+ :type 'string
+ :group 'direx)
+
+\f
+
+;;; Utilities
+
+(defmacro direx:aif (test then &rest else)
+ (declare (indent 2))
+ `(let ((it ,test)) (if it ,then ,@else)))
+
+(defmacro direx:awhen (test &rest body)
+ (declare (indent 1))
+ `(let ((it ,test)) (when it ,@body)))
+
+(defun direx:starts-with (x y)
+ (and (<= (length y) (length x))
+ (equal (substring x 0 (length y)) y)))
+
+(defun direx:walk-tree (fun object)
+ (if (atom object)
+ (funcall fun object)
+ (direx:walk-tree fun (car object))
+ (direx:walk-tree fun (cdr object))))
+
+(defun direx:canonical-filename (filename)
+ (expand-file-name filename))
+
+(defun direx:canonical-dirname (dirname)
+ (file-name-as-directory (expand-file-name dirname)))
+
+(defun direx:directory-basename (dirname)
+ (file-name-nondirectory
+ (directory-file-name
+ (direx:canonical-dirname dirname))))
+
+(defun direx:directory-dirname (dirname)
+ (file-name-directory
+ (directory-file-name
+ (direx:canonical-dirname dirname))))
+
+(defun direx:directory-parents (filename)
+ (cl-loop for current-dirname = (direx:canonical-filename filename) then parent-dirname
+ for parent-dirname = (direx:directory-dirname current-dirname)
+ while (and parent-dirname (< (length parent-dirname) (length current-dirname)))
+ collect parent-dirname))
+
+(defmacro direx:save-excursion-from-error (&rest body)
+ (let ((point (cl-gensym "point"))
+ (error (cl-gensym "error")))
+ `(let ((,point (point)))
+ (condition-case ,error
+ (progn ,@body)
+ (error
+ (goto-char ,point)
+ (signal (car ,error) (cdr ,error)))))))
+
+\f
+
+;;; Trees
+
+(defclass direx:tree ()
+ ((name :initarg :name
+ :accessor direx:tree-name)))
+
+(cl-defgeneric direx:tree-equals (x y)
+ "Returns t if X is equal to Y.")
+
+(cl-defmethod direx:tree-equals (x y)
+ (eq x y))
+
+(cl-defgeneric direx:tree-status (tree)
+ "Returns a status of TREE in string.")
+
+(cl-defmethod direx:tree-status (tree)
+ "")
+
+(defclass direx:node (direx:tree)
+ ())
+
+(cl-defgeneric direx:node-children (node)
+ "Returns the children of the NODE.")
+
+(cl-defmethod direx:node-children (node)
+ nil)
+
+(cl-defgeneric direx:node-contains (node descendant)
+ "Returns t if the NODE has the DESCENDANT. The default
+implementation of this generic function uses
+`direx:node-children' to expand the descendants of the NODE
+recursively and check if the DESCENDANT is a member of the
+descendants. You may add a heuristic method for speed.")
+
+(cl-defmethod direx:node-contains (node descendant)
+ (cl-loop for child in (direx:node-children node) thereis
+ (or (direx:tree-equals child descendant)
+ (and (cl-typep child 'direx:node)
+ (direx:node-contains child descendant)))))
+
+(defclass direx:leaf (direx:tree)
+ ())
+
+\f
+
+;;; Tree Widgets
+
+(defclass direx:item ()
+ ((tree :initarg :tree
+ :accessor direx:item-tree)
+ (parent :initarg :parent
+ :accessor direx:item-parent)
+ (children :accessor direx:item-children)
+ (face :initarg :face
+ :accessor direx:item-face)
+ (keymap :initarg :keymap
+ :accessor direx:item-keymap)
+ (overlay :accessor direx:item-overlay)
+ (open :accessor direx:item-open)))
+
+(cl-defgeneric direx:generic-find-item (item not-this-window))
+
+(cl-defgeneric direx:generic-view-item (item not-this-window))
+
+(cl-defgeneric direx:generic-display-item (item))
+
+(cl-defgeneric direx:make-item (tree parent)
+ "Returns a item of the TREE.")
+
+(cl-defmethod direx:make-item (tree parent)
+ (make-instance 'direx:item :tree tree :parent parent))
+
+(defun direx:make-item-children (item)
+ (cl-loop for child-tree in (direx:node-children (direx:item-tree item))
+ collect (direx:make-item child-tree item)))
+
+(defun direx:item-equals (x y)
+ (direx:tree-equals (direx:item-tree x) (direx:item-tree y)))
+
+(defun direx:item-name (item)
+ (direx:tree-name (direx:item-tree item)))
+
+(defun direx:item-leaf-p (item)
+ (cl-typep (direx:item-tree item) 'direx:leaf))
+
+(defun direx:item-node-p (item)
+ (cl-typep (direx:item-tree item) 'direx:node))
+
+(defun direx:item-depth (item)
+ (direx:aif (direx:item-parent item)
+ (1+ (direx:item-depth it))
+ 0))
+
+(defun direx:item-start (item)
+ (overlay-start (direx:item-overlay item)))
+
+(defun direx:item-end (item)
+ (let ((children (direx:item-children item)))
+ (if children
+ (direx:item-end (car (last children)))
+ (overlay-end (direx:item-overlay item)))))
+
+(defun direx:item-root (item)
+ (direx:aif (direx:item-parent item)
+ (direx:item-root it)
+ item))
+
+(defun direx:item-buffer (item)
+ (overlay-buffer (direx:item-overlay item)))
+
+;; Rendering
+
+(defun direx:item-icon-part-offset (item)
+ (* (direx:item-depth item) (length direx:open-icon)))
+
+(defun direx:item-name-part-offset (item)
+ (+ (direx:item-icon-part-offset item) (length direx:open-icon)))
+
+(defun direx:item-render-indent-part (item)
+ (make-string (direx:item-icon-part-offset item) ? ))
+
+(defun direx:item-render-icon-part (item)
+ (if (direx:item-leaf-p item)
+ direx:leaf-icon
+ direx:closed-icon))
+
+(defun direx:item-render-name-part (item)
+ (propertize (direx:item-name item)
+ 'face (direx:item-face item)
+ 'mouse-face 'hightlight
+ 'help-echo "mouse-1: toggle or find this node
+mouse-2: find this node in other window"))
+
+(defun direx:item-render (item)
+ (concat (direx:item-render-indent-part item)
+ (direx:item-render-icon-part item)
+ (direx:item-render-name-part item)
+ "\n"))
+
+(defun direx:item-make-overlay (item start end)
+ (let ((overlay (make-overlay start end nil t nil)))
+ (overlay-put overlay 'direx:item item)
+ (overlay-put overlay 'keymap (direx:item-keymap item))
+ (setf (direx:item-overlay item) overlay)
+ overlay))
+
+(defun direx:item-insert (item)
+ (let ((start (point))
+ (buffer-read-only nil))
+ (insert (direx:item-render item))
+ (direx:item-make-overlay item start (point))
+ item))
+
+(defun direx:item-insert-children (item)
+ (let ((children (direx:make-item-children item)))
+ (setf (direx:item-children item) children)
+ (save-excursion
+ (goto-char (overlay-end (direx:item-overlay item)))
+ (dolist (child children)
+ (direx:item-insert child)))))
+
+(defun direx:item-ensure-children (item)
+ (unless (direx:item-children item)
+ (direx:item-insert-children item)))
+
+(cl-defun direx:item-delete (item)
+ (let* ((overlay (direx:item-overlay item))
+ (start (overlay-start overlay))
+ (end (overlay-end overlay))
+ (buffer-read-only nil))
+ (delete-region start end)
+ (delete-overlay overlay)))
+
+(defun direx:item-delete-recursively (item)
+ (direx:item-delete item)
+ (unless (direx:item-leaf-p item)
+ (dolist (child (direx:item-children item))
+ (direx:item-delete-recursively child))))
+
+(defun direx:item-change-icon (item new-icon)
+ (let ((buffer-read-only nil))
+ (save-excursion
+ ;; Insert the icon carefully with consideration of the
+ ;; front-advance overlay.
+ (goto-char (+ (direx:item-start item)
+ (direx:item-name-part-offset item)))
+ (insert new-icon)
+ ;; Then delete the icon.
+ (goto-char (+ (line-beginning-position)
+ (direx:item-icon-part-offset item)))
+ (delete-char (length new-icon)))))
+
+(defun direx:item-visible-p (item)
+ (not (overlay-get (direx:item-overlay item) 'invisible)))
+
+(defun direx:item-show (item)
+ (overlay-put (direx:item-overlay item) 'invisible nil))
+
+(defun direx:item-hide (item)
+ (overlay-put (direx:item-overlay item) 'invisible t))
+
+(defun direx:item-show-children (item)
+ (when (and (not (direx:item-leaf-p item))
+ (direx:item-open item))
+ (dolist (child (direx:item-children item))
+ (direx:item-show child)
+ (direx:item-show-children child))))
+
+(defun direx:item-hide-children (item)
+ (unless (direx:item-leaf-p item)
+ (dolist (child (direx:item-children item))
+ (direx:item-hide child)
+ (direx:item-hide-children child))))
+
+(defun direx:item-expand (item)
+ (unless (direx:item-leaf-p item)
+ (setf (direx:item-open item) t)
+ (direx:item-ensure-children item)
+ (direx:item-show-children item)
+ (direx:item-change-icon item direx:open-icon)))
+
+(defun direx:item-ensure-open (item)
+ (unless (direx:item-open item)
+ (direx:item-expand item)))
+
+(defun direx:item-expand-recursively (item)
+ (direx:item-expand item)
+ (dolist (child (direx:item-children item))
+ (direx:item-expand-recursively child)))
+
+(defun direx:item-collapse (item)
+ (unless (direx:item-leaf-p item)
+ (setf (direx:item-open item) nil)
+ (direx:item-hide-children item)
+ (direx:item-change-icon item direx:closed-icon)))
+
+(defun direx:item-ensure-closed (item)
+ (when (direx:item-open item)
+ (direx:item-collapse item)))
+
+(defun direx:item-toggle (item)
+ (if (direx:item-open item)
+ (direx:item-collapse item)
+ (direx:item-expand item)))
+
+(cl-defmethod direx:item-refresh ((item direx:item))
+ (when (and (not (direx:item-leaf-p item))
+ (direx:item-children item))
+ (cl-loop with point = (overlay-end (direx:item-overlay item))
+ with old-children = (direx:item-children item)
+ for new-child in (direx:make-item-children item)
+ for old-child = (cl-find-if (apply-partially
+ 'direx:item-equals new-child)
+ old-children)
+ if old-child
+ do (setq new-child old-child
+ old-children (delq old-child old-children))
+ else
+ do (save-excursion
+ (goto-char point)
+ (direx:item-insert new-child))
+ do (setq point (direx:item-end new-child))
+ collect new-child into new-children
+ finally
+ (dolist (old-child old-children)
+ (direx:item-delete-recursively old-child))
+ (setf (direx:item-children item) new-children))))
+
+(defun direx:item-refresh-recursively (item)
+ (direx:item-refresh item)
+ (dolist (child (direx:item-children item))
+ (direx:item-refresh-recursively child)))
+
+(cl-defun direx:item-refresh-parent (item &key recursive)
+ (direx:awhen (direx:item-parent item)
+ (direx:item-refresh-recursively it)))
+
+\f
+
+;;; File System
+
+;; Trees
+
+(defclass direx:file (direx:tree)
+ ((full-name :initarg :full-name
+ :accessor direx:file-full-name)))
+
+(cl-defmethod direx:tree-equals ((x direx:file) y)
+ (or (eq x y)
+ (and (cl-typep y 'direx:file)
+ (equal (direx:file-full-name x) (direx:file-full-name y)))))
+
+(cl-defmethod direx:tree-status ((file direx:file))
+ (let* ((filename (direx:file-full-name file))
+ (dired-actual-switches "-la")
+ (file-list (list (if (direx:regular-file-item-p file)
+ (file-name-nondirectory filename)
+ (direx:directory-basename filename))))
+ (default-directory (direx:directory-dirname filename)))
+ (with-temp-buffer
+ (dired-insert-directory default-directory
+ dired-actual-switches
+ file-list)
+ (goto-char (point-min))
+ (buffer-substring-no-properties (point) (line-end-position)))))
+
+(defclass direx:regular-file (direx:file direx:leaf)
+ ())
+
+(defun direx:make-regular-file (filename)
+ (make-instance 'direx:regular-file
+ :name (file-name-nondirectory filename)
+ :full-name (direx:canonical-filename filename)))
+
+(defclass direx:directory (direx:file direx:node)
+ ())
+
+(defun direx:make-directory (dirname)
+ (let* ((dirname (direx:canonical-dirname dirname))
+ (basename (direx:directory-basename dirname))
+ (name (if (zerop (length basename)) dirname basename)))
+ (make-instance 'direx:directory
+ :name name
+ :full-name dirname)))
+
+(cl-defmethod direx:node-children ((dir direx:directory))
+ (cl-loop with dirname = (direx:file-full-name dir)
+ for filename in (directory-files dirname t)
+ for basename = (file-name-nondirectory filename)
+ unless (string-match dired-trivial-filenames basename)
+ if (file-directory-p filename)
+ collect (direx:make-directory filename)
+ else
+ collect (direx:make-regular-file filename)))
+
+(cl-defmethod direx:node-contains ((dir direx:directory) file)
+ (and (cl-typep file 'direx:file)
+ (direx:starts-with (direx:file-full-name file)
+ (direx:file-full-name dir))))
+
+;; Tree Items
+
+(defclass direx:file-item (direx:item)
+ ())
+
+(defvar direx:file-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "R") 'direx:do-rename-file)
+ (define-key map (kbd "C") 'direx:do-copy-files)
+ (define-key map (kbd "D") 'direx:do-delete-files)
+ (define-key map (kbd "+") 'direx:create-directory)
+ (define-key map (kbd "M") 'direx:do-chmod-file)
+ (define-key map (kbd "L") 'direx:do-load-file)
+ (define-key map (kbd "B") 'direx:do-byte-compile-file)
+ (define-key map (kbd "G") 'direx:do-chgrp)
+ (define-key map (kbd "O") 'direx:do-chown)
+ (define-key map (kbd "T") 'direx:do-touch)
+ map))
+
+(defun direx:do-rename-file ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (file-full-name (direx:file-full-name file))
+ (dir-name (file-name-directory file-full-name))
+ (file-name (file-name-nondirectory file-full-name))
+ (to (read-file-name (format "Rename %s to " file-name) dir-name file-name)))
+ (dired-rename-file file-full-name to nil)
+ (direx:item-refresh-parent item)
+ (direx:move-to-item-name-part item)))
+
+(defun direx:do-copy-files ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (file-full-name (direx:file-full-name file))
+ (dir-name (file-name-directory file-full-name))
+ (file-name (file-name-nondirectory file-full-name))
+ (to (read-directory-name (format "Copy %s to " file-name) dir-name file-name)))
+ (dired-copy-file file-full-name to nil)
+ (direx:item-refresh-parent item)
+ (direx:move-to-item-name-part item)))
+
+(defun direx:do-delete-files ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))h
+ (file-full-name (direx:file-full-name file)))
+ (when (yes-or-no-p (format "Delete %s" (direx:tree-name file)))
+ (dired-delete-file file-full-name dired-recursive-deletes t)
+ (direx:item-refresh-parent item)
+ (direx:move-to-item-name-part item)
+ (dired-clean-up-after-deletion file-full-name))))
+
+(defun direx:create-directory ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (parent-dir
+ (if (cl-typep file 'direx:directory)
+ (direx:file-full-name file)
+ (direx:directory-dirname
+ (direx:file-full-name file))))
+ (dir (read-directory-name "Create directory: " parent-dir)))
+ (when (file-exists-p dir)
+ (error "Can't create directory %s: file exists" dir))
+ (make-directory dir t)
+ (direx:item-refresh-parent item)
+ (direx:move-to-item-name-part item)))
+
+(defun direx:do-chmod-file ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (filename (file-name-nondirectory (direx:file-full-name file)))
+ (orig-modes (file-modes filename))
+ (modes (read-string (format "Change mode of %s to: " filename)))
+ (new-modes (if (string-match "^[0-7]+" modes)
+ (string-to-number modes 8)
+ (file-modes-symbolic-to-number modes orig-modes))))
+ (set-file-modes filename new-modes)))
+
+(defun direx:do-load-file ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (filename (direx:file-full-name file))
+ (failure nil))
+ (when (y-or-n-p (format "Load %s?" (file-name-nondirectory filename)))
+ (condition-case err
+ (load filename nil nil t)
+ (error (setq failure err)))
+ (when failure
+ (message "Load error for %s:\n%s\n" file failure)))))
+
+(defun direx:do-byte-compile-file ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (filename (direx:file-full-name file))
+ (dest-file (byte-compile-dest-file filename))
+ (failure nil))
+ (when (y-or-n-p (format "Byte-Compile %s?" (file-name-nondirectory filename)))
+ (condition-case err
+ (save-excursion (byte-compile-file filename))
+ (error (setq failure err)))
+ (or (file-exists-p dest-file)
+ (setq failure t))
+ (if failure
+ (error "Byte compile error for %s\n%s\n" filename failure)
+ (progn
+ (direx:item-refresh-parent item)
+ (direx:next-item))))))
+
+(defun direx:exec-command (program args)
+ (unless (executable-find program)
+ (error "Command '%s' not found" program))
+ (with-temp-buffer
+ (unless (zerop (apply 'call-process program nil t nil args))
+ (message "%s" (replace-regexp-in-string "[\r\n]+\\'" ""
+ (buffer-string))))))
+
+(defun direx:do-chxxx (program attr filename)
+ (let* ((prompt (format "Change %s of %s to: "
+ attr (file-name-nondirectory filename)))
+ (new-attr (read-string prompt))
+ (args (list new-attr filename)))
+ (direx:exec-command program args)))
+
+(defun direx:do-chgrp ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (filename (direx:file-full-name file)))
+ (direx:do-chxxx "chgrp" "Group" filename)))
+
+(defun direx:do-chown ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (filename (direx:file-full-name file)))
+ (direx:do-chxxx "chown" "Owner" filename)))
+
+(defun direx:do-touch ()
+ (interactive)
+ (let* ((item (direx:item-at-point!))
+ (file (direx:item-tree item))
+ (filename (direx:file-full-name file))
+ (default (format-time-string "%Y%m%d%H%M.%S"
+ (nth 5 (file-attributes filename))))
+ (prompt (format "Change Timestamp of %s to (default now): "
+ (file-name-nondirectory filename)))
+ (new-time (read-string prompt))
+ (args (if (string= new-time "")
+ (list filename)
+ (list "-t" new-time filename))))
+ (direx:exec-command "touch" args)))
+
+(defclass direx:regular-file-item (direx:file-item)
+ ())
+
+(cl-defmethod direx:generic-find-item ((item direx:regular-file-item) not-this-window)
+ (let ((filename (direx:file-full-name (direx:item-tree item))))
+ (if not-this-window
+ (find-file-other-window filename)
+ (find-file filename))))
+
+(cl-defmethod direx:generic-view-item ((item direx:regular-file-item) not-this-window)
+ (let ((filename (direx:file-full-name (direx:item-tree item))))
+ (if not-this-window
+ (view-file-other-window filename)
+ (view-file filename))))
+
+(cl-defmethod direx:generic-display-item ((item direx:regular-file-item))
+ (let ((filename (direx:file-full-name (direx:item-tree item))))
+ (display-buffer (find-file-noselect filename))))
+
+(cl-defmethod direx:make-item ((file direx:regular-file) parent)
+ (let* ((filename (direx:file-full-name file))
+ (face (when (string-match direx:ignored-files-regexp filename)
+ 'dired-ignored)))
+ (make-instance 'direx:regular-file-item
+ :tree file
+ :parent parent
+ :face face
+ :keymap direx:file-keymap)))
+
+(defclass direx:directory-item (direx:file-item)
+ ())
+
+(cl-defmethod direx:generic-find-item ((item direx:directory-item) not-this-window)
+ (let ((dirname (direx:file-full-name (direx:item-tree item))))
+ (if not-this-window
+ (dired-other-window dirname)
+ (dired dirname))))
+
+(cl-defmethod direx:generic-display-item ((item direx:directory-item))
+ (let ((dirname (direx:file-full-name (direx:item-tree item))))
+ (display-buffer (dired-noselect dirname))))
+
+(cl-defmethod direx:make-item ((dir direx:directory) parent)
+ (make-instance 'direx:directory-item
+ :tree dir
+ :parent parent
+ :face 'dired-directory
+ :keymap direx:file-keymap))
+
+\f
+
+;;; Tree Buffers
+
+(defvar direx:root-item nil)
+
+(defun direx:item-at-point (&optional point)
+ (get-char-property (or point (point)) 'direx:item))
+
+(defun direx:item-at-point! (&optional point)
+ (or (direx:item-at-point point)
+ (error "No item at point")))
+
+(defun direx:item-at-event (event)
+ (direx:awhen (posn-window (event-end event))
+ (with-selected-window it
+ (direx:item-at-point (posn-point (event-end event))))))
+
+(defun direx:find-root-item-if (predicate)
+ (cl-find-if predicate
+ (mapcar (apply-partially 'buffer-local-value 'direx:root-item)
+ (direx:buffer-list))))
+
+(defun direx:find-root-item-for-root (root)
+ (direx:find-root-item-if
+ (lambda (item) (direx:tree-equals root (direx:item-tree item)))))
+
+(defun direx:buffer-live-p (buffer)
+ (and (buffer-live-p buffer)
+ (eq (buffer-local-value 'major-mode buffer) 'direx:direx-mode)))
+
+(defun direx:buffer-list ()
+ (cl-remove-if-not 'direx:buffer-live-p (buffer-list)))
+
+(cl-defgeneric direx:make-buffer (root))
+
+(cl-defmethod direx:make-buffer ((root direx:tree))
+ (let ((buffer (generate-new-buffer (direx:tree-name root))))
+ (with-current-buffer buffer
+ (direx:direx-mode)
+ (setq default-directory (direx:file-full-name root))
+ (setq-local revert-buffer-function 'direx:revert-buffer))
+ buffer))
+
+(cl-defmethod direx:make-buffer ((dir direx:directory))
+ (with-current-buffer (cl-call-next-method)
+ (set (make-local-variable 'dired-directory)
+ (direx:file-full-name dir))
+ (current-buffer)))
+
+(defun direx:revert-buffer (ignore-auto noconfirm)
+ (direx:refresh-whole-tree))
+
+(defun direx:make-buffer-for-root (root)
+ (let ((buffer (direx:make-buffer root)))
+ (direx:add-root-into-buffer root buffer)
+ buffer))
+
+(defun direx:ensure-buffer-for-root (root)
+ (or (direx:find-buffer-for-root root)
+ (direx:make-buffer-for-root root)))
+
+(defun direx:find-buffer-for-root (root)
+ (direx:awhen (direx:find-root-item-for-root root)
+ (direx:item-buffer it)))
+
+(defun direx:add-root-into-buffer (root buffer &optional noexpand)
+ (with-current-buffer buffer
+ (let ((root-item (direx:make-item root nil))
+ (buffer-read-only nil))
+ (goto-char (point-max))
+ (direx:item-insert root-item)
+ (setq direx:root-item root-item)
+ (unless noexpand
+ (direx:item-expand root-item)
+ (direx:move-to-item-name-part root-item)))))
+
+(defun direx:goto-item-for-tree-1 (tree)
+ (goto-char (point-min))
+ (cl-loop for item = (direx:item-at-point)
+ for item-tree = (and item (direx:item-tree item))
+ while item-tree
+ if (direx:tree-equals item-tree tree)
+ return (direx:move-to-item-name-part item)
+ else if (and (cl-typep item-tree 'direx:node)
+ (direx:node-contains item-tree tree))
+ do (direx:down-item)
+ else
+ do (direx:next-sibling-item)
+ finally (error "Item not found")))
+
+(defun direx:goto-item-for-tree (tree)
+ (ignore-errors
+ (direx:save-excursion-from-error
+ (direx:goto-item-for-tree-1 tree))))
+
+\f
+
+;;; Major Mode
+
+(defun direx:ensure-item-visible (item))
+
+(defun direx:move-to-item-name-part (&optional item)
+ (unless item
+ (setq item (direx:item-at-point)))
+ (when (and item (direx:item-start item))
+ (goto-char (+ (direx:item-start item)
+ (direx:item-name-part-offset item)))
+ (direx:ensure-item-visible item)))
+
+(defun direx:next-item (&optional arg)
+ (interactive "p")
+ (cl-loop unless (zerop (forward-line arg))
+ do (error (if (cl-plusp arg) "End of buffer" "Beginning of buffer"))
+ for item = (direx:item-at-point!)
+ when (direx:item-visible-p item)
+ return (direx:move-to-item-name-part item)))
+
+(defun direx:previous-item (&optional arg)
+ (interactive "p")
+ (direx:next-item (if (null arg) -1 (- arg))))
+
+(defun direx:up-item-1 (item)
+ (cl-loop with parent = (direx:item-parent item)
+ while (and (zerop (forward-line -1))
+ (not (eq (direx:item-at-point) parent)))
+ finally (direx:move-to-item-name-part)))
+
+(defun direx:up-item ()
+ (interactive)
+ (direx:aif (direx:item-at-point)
+ (direx:up-item-1 it)
+ (goto-char (point-min))))
+
+(defun direx:down-item ()
+ (interactive)
+ (direx:awhen (direx:item-at-point)
+ (unless (direx:item-node-p it) (error "No children"))
+ (direx:item-ensure-open it)
+ (unless (direx:item-children it) (error "No children")))
+ (direx:next-item))
+
+(defun direx:next-sibling-item-1 (item arg)
+ (cl-loop with parent = (direx:item-parent item)
+ with siblings = (when parent (direx:item-children parent))
+ with ordered-siblings = (if (cl-plusp arg) siblings (reverse siblings))
+ with sibling = (cadr (memq item ordered-siblings))
+ with point = (point)
+ with item
+ while (and sibling
+ (zerop (forward-line arg))
+ (setq item (direx:item-at-point)))
+ if (eq item sibling)
+ return (direx:move-to-item-name-part item)
+ finally
+ (goto-char point)
+ (error "No sibling")))
+
+(defun direx:next-sibling-item (&optional arg)
+ (interactive "p")
+ (setq arg (if (or (null arg) (> arg 0)) 1 -1))
+ (direx:aif (direx:item-at-point)
+ (direx:next-sibling-item-1 it arg)
+ (direx:next-item arg)))
+
+(defun direx:previous-sibling-item (&optional arg)
+ (interactive "p")
+ (direx:next-sibling-item (if (or (null arg) (> arg 0)) -1 1)))
+
+(defun direx:refresh-whole-tree (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point) direx:root-item))
+ (direx:item-refresh-recursively (direx:item-root item))
+ (direx:move-to-item-name-part item))
+
+(defun direx:echo-item ()
+ (interactive)
+ (message "%s" (direx:tree-status (direx:item-tree (direx:item-at-point)))))
+
+(defun direx:find-item (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:generic-find-item item nil))
+
+(defun direx:find-item-other-window (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:generic-find-item item t))
+
+(defun direx:view-item (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:generic-view-item item nil))
+
+(defun direx:view-item-other-window (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:generic-view-item item t))
+
+(defun direx:display-item (&optional item)
+ "Open ITEM at point without changing focus."
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:generic-display-item item))
+
+(defun direx:maybe-find-item (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (if (direx:item-leaf-p item)
+ (direx:find-item item)
+ (direx:toggle-item item)))
+
+(defun direx:expand-item (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:item-expand item)
+ (let ((children (direx:item-children item)))
+ (when (and (= (length children) 1)
+ (direx:item-node-p (car children)))
+ ;; Also expands the sub directory
+ (direx:expand-item (car children))))
+ (direx:move-to-item-name-part item))
+
+(defun direx:expand-item-recursively (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:item-expand-recursively item)
+ (direx:move-to-item-name-part item))
+
+(defun direx:collapse-item (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (direx:item-collapse item)
+ (direx:move-to-item-name-part item))
+
+(defun direx:toggle-item (&optional item)
+ (interactive)
+ (setq item (or item (direx:item-at-point!)))
+ (if (direx:item-open item)
+ (direx:collapse-item item)
+ (direx:expand-item item))
+ (direx:move-to-item-name-part item))
+
+(defun direx:mouse-1 (event)
+ (interactive "e")
+ (direx:awhen (direx:item-at-event event)
+ (direx:maybe-find-item it)))
+
+(defun direx:mouse-2 (event)
+ (interactive "e")
+ (direx:awhen (direx:item-at-event event)
+ (direx:find-item-other-window it)))
+
+(defvar direx:direx-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "n") 'direx:next-item)
+ (define-key map (kbd "C-n") 'direx:next-item)
+ (define-key map (kbd "<down>") 'direx:next-item)
+ (define-key map (kbd "p") 'direx:previous-item)
+ (define-key map (kbd "C-p") 'direx:previous-item)
+ (define-key map (kbd "<up>") 'direx:previous-item)
+ (define-key map (kbd "C-M-n") 'direx:next-sibling-item)
+ (define-key map (kbd "C-M-<down>") 'direx:next-sibling-item)
+ (define-key map (kbd "C-M-p") 'direx:previous-sibling-item)
+ (define-key map (kbd "C-M-<up>") 'direx:previous-sibling-item)
+ (define-key map (kbd "^") 'direx:up-item)
+ (define-key map (kbd "C-M-u") 'direx:up-item)
+ (define-key map (kbd "C-M-<left>") 'direx:up-item)
+ (define-key map (kbd "C-M-d") 'direx:down-item)
+ (define-key map (kbd "C-M-<right>") 'direx:up-item)
+ (define-key map (kbd "e") 'direx:echo-item)
+ (define-key map (kbd "f") 'direx:find-item)
+ (define-key map (kbd "o") 'direx:find-item-other-window)
+ (define-key map (kbd "v") 'direx:view-item)
+ (define-key map (kbd "V") 'direx:view-item-other-window)
+ (define-key map (kbd "C-o") 'direx:display-item)
+ (define-key map (kbd "RET") 'direx:maybe-find-item)
+ (define-key map (kbd "TAB") 'direx:toggle-item)
+ (define-key map (kbd "i") 'direx:toggle-item)
+ (define-key map (kbd "E") 'direx:expand-item-recursively)
+ (define-key map (kbd "g") 'direx:refresh-whole-tree)
+ (define-key map [mouse-1] 'direx:mouse-1)
+ (define-key map [mouse-2] 'direx:mouse-2)
+ map))
+
+(define-derived-mode direx:direx-mode special-mode "Direx"
+ ""
+ (set (make-local-variable 'direx:root-item) nil)
+ (setq buffer-read-only t
+ truncate-lines t)
+ (use-local-map direx:direx-mode-map))
+
+\f
+
+;;; Directory
+
+(defun direx:find-directory-noselect (dirname)
+ (interactive "DDirex (directory): ")
+ (direx:ensure-buffer-for-root (direx:make-directory dirname)))
+
+(defun direx:find-directory (dirname)
+ (interactive "DDirex (directory): ")
+ (switch-to-buffer (direx:find-directory-noselect dirname)))
+
+(defun direx:find-directory-other-window (dirname)
+ (interactive "DDirex (directory): ")
+ (switch-to-buffer-other-window (direx:find-directory-noselect dirname)))
+
+(defun direx:find-directory-reuse-noselect (dirname)
+ (interactive "DDirex (directory): ")
+ (cl-loop for current-dirname = dirname then parent-dirname
+ for parent-dirname in (direx:directory-parents dirname)
+ for dir = (direx:make-directory current-dirname)
+ for buffer = (direx:find-buffer-for-root dir)
+ if buffer return buffer
+ finally return (direx:find-directory-noselect dirname)))
+
+(defun direx:find-directory-reuse (dirname)
+ (interactive "DDirex (directory): ")
+ (switch-to-buffer (direx:find-directory-reuse-noselect dirname)))
+
+(defun direx:find-directory-reuse-other-window (dirname)
+ (interactive "DDirex (directory): ")
+ (switch-to-buffer-other-window (direx:find-directory-reuse-noselect dirname)))
+
+(defun direx:maybe-goto-current-buffer-item (buffer)
+ (let ((filename buffer-file-name)
+ (dirname default-directory))
+ (with-current-buffer buffer
+ (cond (filename
+ (direx:goto-item-for-tree (direx:make-regular-file filename)))
+ (dirname
+ (direx:goto-item-for-tree (direx:make-directory dirname)))))))
+
+(defun direx:jump-to-directory-noselect ()
+ (interactive)
+ (let ((buffer (direx:find-directory-reuse-noselect default-directory)))
+ (direx:maybe-goto-current-buffer-item buffer)
+ buffer))
+
+;;;###autoload
+(defun direx:jump-to-directory ()
+ (interactive)
+ (switch-to-buffer (direx:jump-to-directory-noselect)))
+
+;;;###autoload
+(defun direx:jump-to-directory-other-window ()
+ (interactive)
+ (switch-to-buffer-other-window (direx:jump-to-directory-noselect)))
+
+(provide 'direx)
+;;; direx.el ends here
projects / emacsconfig.git / commitdiff