From: Andreas Gerler Date: Thu, 23 Nov 2023 18:57:09 +0000 (+0100) Subject: update dired X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=9fdc4a0ee828ab1c0a99b4b4fe74a7f0465e78f7;p=emacsconfig.git update dired Signed-off-by: Andreas Gerler --- diff --git a/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils-autoloads.el b/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils-autoloads.el deleted file mode 100644 index cc077296..00000000 --- a/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils-autoloads.el +++ /dev/null @@ -1,16 +0,0 @@ -;;; dired-hacks-utils-autoloads.el --- automatically extracted autoloads -;; -;;; Code: -(add-to-list 'load-path (directory-file-name (or (file-name-directory #$) (car load-path)))) - -;;;### (autoloads nil nil ("dired-hacks-utils.el") (23994 46776 937195 -;;;;;; 494000)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; End: -;;; dired-hacks-utils-autoloads.el ends here diff --git a/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils-pkg.el b/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils-pkg.el deleted file mode 100644 index b14d0108..00000000 --- a/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- 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.goljer@gmail.com")) :maintainer '("Matúš Goljer" . "matus.goljer@gmail.com")) diff --git a/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils.el b/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils.el deleted file mode 100644 index 18bacecb..00000000 --- a/elpa/dired-hacks-utils-20190522.950/dired-hacks-utils.el +++ /dev/null @@ -1,274 +0,0 @@ -;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection - -;; Copyright (C) 2014-2015 Matúš Goljer - -;; Author: Matúš Goljer -;; Maintainer: Matúš Goljer -;; 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 . - -;;; 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))))) - - -;;; 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))) - - -;;; 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 diff --git a/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils-autoloads.el b/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils-autoloads.el new file mode 100644 index 00000000..08ba947a --- /dev/null +++ b/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils-autoloads.el @@ -0,0 +1,27 @@ +;;; 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)))) + + +;;;### (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-")) + +;;;*** + +;;;### (autoloads nil nil ("dired-hacks-utils-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; dired-hacks-utils-autoloads.el ends here diff --git a/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils-pkg.el b/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils-pkg.el new file mode 100644 index 00000000..9ecc4c98 --- /dev/null +++ b/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils-pkg.el @@ -0,0 +1,13 @@ +(define-package "dired-hacks-utils" "20230512.1107" "Utilities and helpers for dired-hacks collection" + '((dash "2.5.0")) + :commit "523f51b4152a3bf4e60fe57f512732c698b5c96f" :authors + '(("Matúš Goljer" . "matus.goljer@gmail.com")) + :maintainers + '(("Matúš Goljer" . "matus.goljer@gmail.com")) + :maintainer + '("Matúš Goljer" . "matus.goljer@gmail.com") + :keywords + '("files")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils.el b/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils.el new file mode 100644 index 00000000..d283312f --- /dev/null +++ b/elpa/dired-hacks-utils-20230512.1107/dired-hacks-utils.el @@ -0,0 +1,273 @@ +;;; dired-hacks-utils.el --- Utilities and helpers for dired-hacks collection + +;; Copyright (C) 2014-2015 Matúš Goljer + +;; Author: Matúš Goljer +;; Maintainer: Matúš Goljer +;; 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 . + +;;; 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))))) + + +;;; 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))) + + +;;; 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 diff --git a/elpa/dired-narrow-20181114.1723/dired-narrow-autoloads.el b/elpa/dired-narrow-20181114.1723/dired-narrow-autoloads.el deleted file mode 100644 index 6fdc2793..00000000 --- a/elpa/dired-narrow-20181114.1723/dired-narrow-autoloads.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; dired-narrow-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (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-"))) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; dired-narrow-autoloads.el ends here diff --git a/elpa/dired-narrow-20181114.1723/dired-narrow-pkg.el b/elpa/dired-narrow-20181114.1723/dired-narrow-pkg.el deleted file mode 100644 index f40be819..00000000 --- a/elpa/dired-narrow-20181114.1723/dired-narrow-pkg.el +++ /dev/null @@ -1,2 +0,0 @@ -;;; -*- 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.goljer@gmail.com")) :maintainer '("Matúš Goljer" . "matus.goljer@gmail.com")) diff --git a/elpa/dired-narrow-20181114.1723/dired-narrow.el b/elpa/dired-narrow-20181114.1723/dired-narrow.el deleted file mode 100644 index e4d2d8a1..00000000 --- a/elpa/dired-narrow-20181114.1723/dired-narrow.el +++ /dev/null @@ -1,351 +0,0 @@ -;;; dired-narrow.el --- Live-narrowing of search results for dired - -;; Copyright (C) 2014-2015 Matúš Goljer - -;; Author: Matúš Goljer -;; Maintainer: Matúš Goljer -;; 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 . - -;;; 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' ( or C-n) - move the point to the -;; next file -;; * `dired-narrow-previous-file' ( or C-p) - move the point to the -;; previous file -;; * `dired-narrow-enter-directory' ( 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 "") 'dired-narrow-previous-file) - (define-key map (kbd "") 'dired-narrow-next-file) - (define-key map (kbd "") '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 "") '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) - - -;; 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))) - - -;; 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)))))) - - -;; 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 diff --git a/elpa/dired-narrow-20230512.1107/dired-narrow-autoloads.el b/elpa/dired-narrow-20230512.1107/dired-narrow-autoloads.el new file mode 100644 index 00000000..e0eafb85 --- /dev/null +++ b/elpa/dired-narrow-20230512.1107/dired-narrow-autoloads.el @@ -0,0 +1,45 @@ +;;; 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)))) + + +;;;### (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-")) + +;;;*** + +;;;### (autoloads nil nil ("dired-narrow-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; dired-narrow-autoloads.el ends here diff --git a/elpa/dired-narrow-20230512.1107/dired-narrow-pkg.el b/elpa/dired-narrow-20230512.1107/dired-narrow-pkg.el new file mode 100644 index 00000000..7a3f4177 --- /dev/null +++ b/elpa/dired-narrow-20230512.1107/dired-narrow-pkg.el @@ -0,0 +1,14 @@ +(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.goljer@gmail.com")) + :maintainers + '(("Matúš Goljer" . "matus.goljer@gmail.com")) + :maintainer + '("Matúš Goljer" . "matus.goljer@gmail.com") + :keywords + '("files")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/dired-narrow-20230512.1107/dired-narrow.el b/elpa/dired-narrow-20230512.1107/dired-narrow.el new file mode 100644 index 00000000..e041ab57 --- /dev/null +++ b/elpa/dired-narrow-20230512.1107/dired-narrow.el @@ -0,0 +1,356 @@ +;;; dired-narrow.el --- Live-narrowing of search results for dired + +;; Copyright (C) 2014-2015 Matúš Goljer + +;; Author: Matúš Goljer +;; Maintainer: Matúš Goljer +;; 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 . + +;;; 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' ( or C-n) - move the point to the +;; next file +;; * `dired-narrow-previous-file' ( or C-p) - move the point to the +;; previous file +;; * `dired-narrow-enter-directory' ( 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 "") 'dired-narrow-previous-file) + (define-key map (kbd "") 'dired-narrow-next-file) + (define-key map (kbd "") '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 "") '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) + + +;; 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))) + + +;; 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)))))) + + +;; 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 diff --git a/elpa/direx-20170422.1327/direx-autoloads.el b/elpa/direx-20170422.1327/direx-autoloads.el deleted file mode 100644 index 6a634271..00000000 --- a/elpa/direx-20170422.1327/direx-autoloads.el +++ /dev/null @@ -1,53 +0,0 @@ -;;; direx-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - -(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path)))) - - -;;;### (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:"))) - -;;;*** - -;;;### (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:"))) - -;;;*** - -;;;### (autoloads nil nil ("direx-pkg.el") (0 0 0 0)) - -;;;*** - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; direx-autoloads.el ends here diff --git a/elpa/direx-20170422.1327/direx-pkg.el b/elpa/direx-20170422.1327/direx-pkg.el deleted file mode 100644 index 5c845145..00000000 --- a/elpa/direx-20170422.1327/direx-pkg.el +++ /dev/null @@ -1,9 +0,0 @@ -(define-package "direx" "20170422.1327" "Simple Directory Explorer" 'nil :keywords - '("convenience") - :authors - '(("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) - :maintainer - '("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/direx-20170422.1327/direx-project.el b/elpa/direx-20170422.1327/direx-project.el deleted file mode 100644 index 6c156866..00000000 --- a/elpa/direx-20170422.1327/direx-project.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; direx-project.el --- Project Module for Direx - -;; Copyright (C) 2012-2015 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; 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 . - -;;; 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 diff --git a/elpa/direx-20170422.1327/direx.el b/elpa/direx-20170422.1327/direx.el deleted file mode 100644 index ce34f17a..00000000 --- a/elpa/direx-20170422.1327/direx.el +++ /dev/null @@ -1,1024 +0,0 @@ -;;; direx.el --- Simple Directory Explorer - -;; Copyright (C) 2011-2015 Tomohiro Matsuyama - -;; Author: Tomohiro Matsuyama -;; 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 . - -;;; 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) - - - -;;; 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))))))) - - - -;;; 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) - ()) - - - -;;; 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))) - - - -;;; 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)) - - - -;;; 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)))) - - - -;;; 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 "") 'direx:next-item) - (define-key map (kbd "p") 'direx:previous-item) - (define-key map (kbd "C-p") 'direx:previous-item) - (define-key map (kbd "") 'direx:previous-item) - (define-key map (kbd "C-M-n") 'direx:next-sibling-item) - (define-key map (kbd "C-M-") 'direx:next-sibling-item) - (define-key map (kbd "C-M-p") 'direx:previous-sibling-item) - (define-key map (kbd "C-M-") '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-") 'direx:up-item) - (define-key map (kbd "C-M-d") 'direx:down-item) - (define-key map (kbd "C-M-") '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)) - - - -;;; 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 diff --git a/elpa/direx-20230409.1425/direx-autoloads.el b/elpa/direx-20230409.1425/direx-autoloads.el new file mode 100644 index 00000000..0d0e3082 --- /dev/null +++ b/elpa/direx-20230409.1425/direx-autoloads.el @@ -0,0 +1,41 @@ +;;; 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)))) + + +;;;### (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:")) + +;;;*** + +;;;### (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:")) + +;;;*** + +;;;### (autoloads nil nil ("direx-pkg.el") (0 0 0 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; direx-autoloads.el ends here diff --git a/elpa/direx-20230409.1425/direx-pkg.el b/elpa/direx-20230409.1425/direx-pkg.el new file mode 100644 index 00000000..cfc98081 --- /dev/null +++ b/elpa/direx-20230409.1425/direx-pkg.el @@ -0,0 +1,11 @@ +(define-package "direx" "20230409.1425" "Simple Directory Explorer" 'nil :commit "935d2010234c02c93e22d6e1cc72d595341ba855" :authors + '(("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) + :maintainers + '(("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) + :maintainer + '("Tomohiro Matsuyama" . "m2ym.pub@gmail.com") + :keywords + '("convenience")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/direx-20230409.1425/direx-project.el b/elpa/direx-20230409.1425/direx-project.el new file mode 100644 index 00000000..8ba5ffca --- /dev/null +++ b/elpa/direx-20230409.1425/direx-project.el @@ -0,0 +1,79 @@ +;;; direx-project.el --- Project Module for Direx -*- lexical-binding:t -*- + +;; Copyright (C) 2012-2015 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama +;; 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 . + +;;; 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 diff --git a/elpa/direx-20230409.1425/direx.el b/elpa/direx-20230409.1425/direx.el new file mode 100644 index 00000000..9cffc736 --- /dev/null +++ b/elpa/direx-20230409.1425/direx.el @@ -0,0 +1,1015 @@ +;;; direx.el --- Simple Directory Explorer -*- lexical-binding:t -*- + +;; Copyright (C) 2011-2015 Tomohiro Matsuyama + +;; Author: Tomohiro Matsuyama +;; 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 . + +;;; 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) + + + +;;; 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))))))) + + + +;;; 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) + ()) + + + +;;; 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))) + + + +;;; 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)) + + + +;;; 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)))) + + + +;;; 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 "") 'direx:next-item) + (define-key map (kbd "p") 'direx:previous-item) + (define-key map (kbd "C-p") 'direx:previous-item) + (define-key map (kbd "") 'direx:previous-item) + (define-key map (kbd "C-M-n") 'direx:next-sibling-item) + (define-key map (kbd "C-M-") 'direx:next-sibling-item) + (define-key map (kbd "C-M-p") 'direx:previous-sibling-item) + (define-key map (kbd "C-M-") '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-") 'direx:up-item) + (define-key map (kbd "C-M-d") 'direx:down-item) + (define-key map (kbd "C-M-") '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)) + + + +;;; 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