305 lines
14 KiB
EmacsLisp
305 lines
14 KiB
EmacsLisp
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2021 Alexander Miller
|
|
|
|
;; 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 <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; Everything related to file management.
|
|
|
|
;; NOTE: This module is lazy-loaded.
|
|
|
|
|
|
;;; Code:
|
|
|
|
(require 'dash)
|
|
(require 'treemacs-core-utils)
|
|
(require 'treemacs-visuals)
|
|
(require 'treemacs-filewatch-mode)
|
|
(require 'treemacs-logging)
|
|
(require 'treemacs-rendering)
|
|
|
|
(eval-when-compile
|
|
(require 'inline)
|
|
(require 'treemacs-macros))
|
|
|
|
(with-eval-after-load 'recentf
|
|
|
|
(declare-function recentf-remove-if-non-kept "recentf")
|
|
(declare-function treemacs--remove-from-recentf-after-move/rename "treemacs-file-management")
|
|
|
|
(defun treemacs--remove-from-recentf-after-move/rename (path _)
|
|
"Remove PATH from recentf after the file was moved or renamed."
|
|
(recentf-remove-if-non-kept path))
|
|
|
|
(add-hook 'treemacs-rename-file-functions #'treemacs--remove-from-recentf-after-move/rename)
|
|
(add-hook 'treemacs-move-file-functions #'treemacs--remove-from-recentf-after-move/rename)
|
|
(add-hook 'treemacs-delete-file-functions #'recentf-remove-if-non-kept))
|
|
|
|
(defconst treemacs--file-node-states
|
|
'(file-node-open file-node-closed dir-node-open dir-node-closed)
|
|
"List of node states treemacs is able to rename/delete etc.")
|
|
|
|
(define-inline treemacs--is-node-file-manageable? (btn)
|
|
"Determines whether BTN is a file node treemacs can rename/delete."
|
|
(declare (side-effect-free t))
|
|
(inline-letevals (btn)
|
|
(inline-quote
|
|
(memq (treemacs-button-get ,btn :state)
|
|
treemacs--file-node-states))))
|
|
|
|
;;;###autoload
|
|
(defun treemacs-delete-file (&optional arg)
|
|
"Delete node at point.
|
|
A delete action must always be confirmed. Directories are deleted recursively.
|
|
By default files are deleted by moving them to the trash. With a prefix ARG
|
|
they will instead be wiped irreversibly."
|
|
(interactive "P")
|
|
(treemacs-block
|
|
(treemacs-unless-let (btn (treemacs-current-button))
|
|
(treemacs-pulse-on-failure "Nothing to delete here.")
|
|
(treemacs-error-return-if (not (memq (treemacs-button-get btn :state)
|
|
'(file-node-open file-node-closed dir-node-open dir-node-closed)))
|
|
"Only files and directories can be deleted.")
|
|
(treemacs--without-filewatch
|
|
(let* ((delete-by-moving-to-trash (not arg))
|
|
(path (treemacs--select-file-from-btn btn "Delete: "))
|
|
(file-name (propertize (treemacs--filename path) 'face 'font-lock-string-face)))
|
|
(cond
|
|
((file-symlink-p path)
|
|
(if (yes-or-no-p (format "Remove link '%s -> %s' ? "
|
|
file-name
|
|
(propertize (file-symlink-p path) 'face 'font-lock-face)))
|
|
(delete-file path delete-by-moving-to-trash)
|
|
(treemacs-return (treemacs-log "Cancelled."))))
|
|
((file-regular-p path)
|
|
(if (yes-or-no-p (format "Delete '%s' ? " file-name))
|
|
(delete-file path delete-by-moving-to-trash)
|
|
(treemacs-return (treemacs-log "Cancelled."))))
|
|
((file-directory-p path)
|
|
(if (yes-or-no-p (format "Recursively delete '%s' ? " file-name))
|
|
(delete-directory path t delete-by-moving-to-trash)
|
|
(treemacs-return (treemacs-log "Cancelled."))))
|
|
(t
|
|
(treemacs-error-return
|
|
(treemacs-pulse-on-failure
|
|
"Item is neither a file, a link or a directory - treemacs does not know how to delete it. (Maybe it no longer exists?)"))))
|
|
(treemacs--on-file-deletion path)
|
|
(treemacs-without-messages
|
|
(treemacs-run-in-every-buffer
|
|
(treemacs-delete-single-node path)))
|
|
(run-hook-with-args 'treemacs-delete-file-functions path)
|
|
(treemacs-log "Deleted %s."
|
|
(propertize path 'face 'font-lock-string-face))))
|
|
(treemacs--evade-image))))
|
|
(defalias 'treemacs-delete #'treemacs-delete-file)
|
|
(make-obsolete #'treemacs-delete #'treemacs-delete-file "v2.9.3")
|
|
|
|
;;;###autoload
|
|
(defun treemacs-move-file ()
|
|
"Move file (or directory) at point.
|
|
Destination may also be a filename, in which case the moved file will also
|
|
be renamed."
|
|
(interactive)
|
|
(treemacs--copy-or-move :move))
|
|
|
|
;;;###autoload
|
|
(defun treemacs-copy-file ()
|
|
"Copy file (or directory) at point.
|
|
Destination may also be a filename, in which case the copied file will also
|
|
be renamed."
|
|
(interactive)
|
|
(treemacs--copy-or-move :copy))
|
|
|
|
(defun treemacs--copy-or-move (action)
|
|
"Internal implementation for copying and moving files.
|
|
ACTION will be either `:copy' or `:move', depending on whether we are calling
|
|
from `treemacs-copy-file' or `treemacs-move-file'."
|
|
(let ((no-node-msg)
|
|
(wrong-type-msg)
|
|
(prompt)
|
|
(action-function)
|
|
(finish-msg))
|
|
(pcase action
|
|
(:copy
|
|
(setf no-node-msg "There is nothing to copy here."
|
|
wrong-type-msg "Only files and directories can be copied."
|
|
prompt "Copy to: "
|
|
action-function (lambda (from to)
|
|
(if (file-directory-p from)
|
|
(copy-directory from to)
|
|
(copy-file from to)))
|
|
finish-msg "Copied %s to %s"))
|
|
(:move
|
|
(setf no-node-msg "There is nothing to move here."
|
|
wrong-type-msg "Only files and directories can be moved."
|
|
prompt "Move to: "
|
|
action-function #'rename-file
|
|
finish-msg "Moved %s to %s")))
|
|
(treemacs-block
|
|
(treemacs-unless-let (node (treemacs-node-at-point))
|
|
(treemacs-error-return no-node-msg)
|
|
(treemacs-error-return-if (not (treemacs-is-node-file-or-dir? node))
|
|
wrong-type-msg)
|
|
(let* ((source (treemacs--select-file-from-btn
|
|
node (if (eq action :copy "File to copy: " "File to move: "))))
|
|
(source-name (treemacs--filename source))
|
|
(destination (treemacs--unslash (read-file-name prompt nil default-directory)))
|
|
(target-is-dir? (file-directory-p destination))
|
|
(target-name (if target-is-dir? (treemacs--filename source) (treemacs--filename destination)))
|
|
(destination-dir (if target-is-dir? destination (treemacs--parent-dir destination)))
|
|
(target (treemacs--find-repeated-file-name (treemacs-join-path destination-dir target-name))))
|
|
(unless (file-exists-p destination-dir)
|
|
(make-directory destination-dir :parents))
|
|
(when (eq action :move)
|
|
;; do the deletion *before* moving the file, otherwise it will no longer exist and treemacs will
|
|
;; not recognize it as a file path
|
|
(treemacs-do-delete-single-node source))
|
|
(treemacs--without-filewatch
|
|
(funcall action-function source target))
|
|
;; no waiting for filewatch, if we copied to an expanded directory refresh it immediately
|
|
(-let [parent (treemacs--parent target)]
|
|
(when (treemacs-is-path-visible? parent)
|
|
(treemacs-do-update-node parent)))
|
|
(treemacs-goto-file-node target)
|
|
(run-hook-with-args
|
|
(pcase action
|
|
(:copy 'treemacs-copy-file-functions)
|
|
(:move 'treemacs-move-file-functions))
|
|
source target)
|
|
(treemacs-pulse-on-success finish-msg
|
|
(propertize source-name 'face 'font-lock-string-face)
|
|
(propertize destination 'face 'font-lock-string-face)))))))
|
|
|
|
;;;###autoload
|
|
(cl-defun treemacs-rename-file ()
|
|
"Rename the file/directory at point.
|
|
|
|
Buffers visiting the renamed file or visiting a file inside the renamed
|
|
directory and windows showing them will be reloaded. The list of recent files
|
|
will likewise be updated."
|
|
(interactive)
|
|
(treemacs-block
|
|
(treemacs-unless-let (btn (treemacs-current-button))
|
|
(treemacs-pulse-on-failure "Nothing to rename here.")
|
|
(-let [old-path (treemacs--select-file-from-btn btn "Rename: ")]
|
|
(treemacs-error-return-if (null old-path)
|
|
"Found nothing to rename here.")
|
|
(treemacs-error-return-if (not (treemacs--is-node-file-manageable? btn))
|
|
"Only files and directories can be deleted.")
|
|
(treemacs-error-return-if (not (file-exists-p old-path))
|
|
"The file to be renamed does not exist.")
|
|
(let* ((old-name (treemacs--filename old-path))
|
|
(new-name (treemacs--read-string
|
|
"New name: " (file-name-nondirectory old-path)))
|
|
(dir (treemacs--parent-dir old-path))
|
|
(new-path (treemacs-join-path dir new-name))
|
|
(parent (treemacs-button-get btn :parent)))
|
|
(treemacs-error-return-if
|
|
(and (file-exists-p new-path)
|
|
(or (not (eq 'darwin system-type))
|
|
(not (string= old-name new-name))))
|
|
"A file named %s already exists."
|
|
(propertize new-name 'face font-lock-string-face))
|
|
(treemacs--without-filewatch
|
|
(rename-file old-path new-path)
|
|
(treemacs--replace-recentf-entry old-path new-path)
|
|
(-let [treemacs-silent-refresh t]
|
|
(treemacs-run-in-every-buffer
|
|
(treemacs--on-rename old-path new-path treemacs-filewatch-mode)
|
|
(treemacs-update-node (treemacs-button-get parent :path)))))
|
|
(treemacs--reload-buffers-after-rename old-path new-path)
|
|
(run-hook-with-args
|
|
'treemacs-rename-file-functions
|
|
old-path new-path)
|
|
(treemacs-pulse-on-success "Renamed %s to %s."
|
|
(propertize (treemacs--filename old-path) 'face font-lock-string-face)
|
|
(propertize new-name 'face font-lock-string-face)))))))
|
|
|
|
(defalias 'treemacs-rename #'treemacs-rename-file)
|
|
(make-obsolete #'treemacs-rename #'treemacs-rename-file "v2.9.3")
|
|
|
|
;;;###autoload
|
|
(defun treemacs-create-file ()
|
|
"Create a new file.
|
|
Enter first the directory to create the new file in, then the new file's name.
|
|
The pre-selection for what directory to create in is based on the \"nearest\"
|
|
path to point - the containing directory for tags and files or the directory
|
|
itself, using $HOME when there is no path at or near point to grab."
|
|
(interactive)
|
|
(treemacs--create-file/dir t))
|
|
|
|
;;;###autoload
|
|
(defun treemacs-create-dir ()
|
|
"Create a new directory.
|
|
Enter first the directory to create the new dir in, then the new dir's name.
|
|
The pre-selection for what directory to create in is based on the \"nearest\"
|
|
path to point - the containing directory for tags and files or the directory
|
|
itself, using $HOME when there is no path at or near point to grab."
|
|
(interactive)
|
|
(treemacs--create-file/dir nil))
|
|
|
|
(defun treemacs--create-file/dir (is-file?)
|
|
"Interactively create either a file or directory, depending on IS-FILE.
|
|
|
|
IS-FILE?: Bool"
|
|
(interactive)
|
|
(let* ((curr-path (--if-let (treemacs-current-button)
|
|
(treemacs--select-file-from-btn it "Create in: ")
|
|
(expand-file-name "~")))
|
|
(path-to-create (treemacs-canonical-path
|
|
(read-file-name
|
|
(if is-file? "Create File: " "Create Directory: ")
|
|
(treemacs--add-trailing-slash
|
|
(if (file-directory-p curr-path)
|
|
curr-path
|
|
(treemacs--parent-dir curr-path)))))))
|
|
(treemacs-block
|
|
(treemacs-error-return-if (file-exists-p path-to-create)
|
|
"%s already exists." (propertize path-to-create 'face 'font-lock-string-face))
|
|
(treemacs--without-filewatch
|
|
(if is-file?
|
|
(-let [dir (treemacs--parent-dir path-to-create)]
|
|
(unless (file-exists-p dir)
|
|
(make-directory dir t))
|
|
(write-region "" nil path-to-create nil 0))
|
|
(make-directory path-to-create t))
|
|
(run-hook-with-args 'treemacs-create-file-functions path-to-create))
|
|
(-when-let (project (treemacs--find-project-for-path path-to-create))
|
|
(-when-let* ((created-under (treemacs--parent path-to-create))
|
|
(created-under-btn (treemacs-find-visible-node created-under)))
|
|
;; update only the part that changed to keep things smooth
|
|
;; for files that's just their parent, for directories we have to take
|
|
;; flattening into account
|
|
(if (treemacs-button-get created-under-btn :collapsed)
|
|
(treemacs-update-node (treemacs-button-get (treemacs-button-get created-under-btn :parent) :path))
|
|
(treemacs-update-node (treemacs-button-get created-under-btn :path))))
|
|
(treemacs-goto-file-node path-to-create project)
|
|
(recenter))
|
|
(treemacs-pulse-on-success
|
|
"Created %s." (propertize path-to-create 'face 'font-lock-string-face)))))
|
|
|
|
(defun treemacs--select-file-from-btn (btn prompt)
|
|
"Select the file represented by BTN for file management.
|
|
Offer a specifying dialogue with PROMPT when BTN is flattened."
|
|
(declare (side-effect-free t))
|
|
(-if-let (collapse-info (treemacs-button-get btn :collapsed))
|
|
(completing-read prompt collapse-info nil :require-match)
|
|
(treemacs-button-get btn :key)))
|
|
|
|
(provide 'treemacs-file-management)
|
|
|
|
;;; treemacs-file-management.el ends here
|