daniel/emacs
1
2
Fork 0
Code Issues 7 Pull Requests Projects Releases Wiki Activity

update packages

Browse Source
This commit is contained in:
Daniel Weschke
2021-01-08 19:32:30 +01:00
parent ce8f24d28a
commit f5649dceab
467 changed files with 26642 additions and 22487 deletions
Download Patch File Download Diff File Expand all files Collapse all files

148
lisp/treemacs/treemacs-interface.el
View File

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2020 Alexander Miller
;; 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
@@ -30,8 +30,6 @@
(require 'treemacs-rendering)
(require 'treemacs-scope)
(require 'treemacs-follow-mode)
(require 'treemacs-tag-follow-mode)
(require 'treemacs-mouse-interface)
(require 'treemacs-customization)
(require 'treemacs-workspaces)
(require 'treemacs-persistence)
@@ -43,10 +41,22 @@
(require 'treemacs-macros))
(autoload 'ansi-color-apply-on-region "ansi-color")
(autoload 'aw-select "ace-window")
(treemacs-import-functions-from "cfrs"
cfrs-read)
(treemacs-import-functions-from "treemacs"
treemacs-select-window)
(treemacs-import-functions-from "treemacs-tags"
treemacs--expand-file-node
treemacs--collapse-file-node
treemacs--expand-tag-node
treemacs--collapse-tag-node
treemacs--goto-tag
treemacs--visit-or-expand/collapse-tag-node)
(defvar treemacs-valid-button-states
'(root-node-open
root-node-closed
@@ -60,7 +70,7 @@
"List of all valid values for treemacs buttons' :state property.")
(defun treemacs-next-line (&optional count)
"Goto next line.
"Go to next line.
A COUNT argument, moves COUNT lines down."
(interactive "p")
;; Move to EOL - if point is in the middle of a button, forward-button
@@ -75,7 +85,7 @@ A COUNT argument, moves COUNT lines down."
(treemacs--evade-image))
(defun treemacs-previous-line (&optional count)
"Goto previous line.
"Go to previous line.
A COUNT argument, moves COUNT lines up."
(interactive "p")
;; Move to the start of line - if point is in the middle of a button,
@@ -401,7 +411,7 @@ they will instead be wiped irreversibly."
(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 preselection for what directory to create in is based on the \"nearest\"
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)
@@ -424,7 +434,7 @@ be renamed."
(cl-defun treemacs-rename ()
"Rename the currently selected node.
Buffers visiting the renamed file or visiting a file inside a renamed directory
and windows showing them will be reloaded. The list of recent files will
and windows showing them will be reloaded. The list of recent files will
likewise be updated."
(interactive)
(treemacs-block
@@ -440,7 +450,7 @@ likewise be updated."
"Found nothing to rename here.")
(treemacs-error-return-if (not (file-exists-p old-path))
"The file to be renamed does not exist.")
(setq new-name (read-string "New name: " (file-name-nondirectory old-path))
(setq new-name (treemacs--read-string "New name: " (file-name-nondirectory old-path))
dir (f-dirname old-path)
new-path (f-join dir new-name))
(treemacs-error-return-if (file-exists-p new-path)
@@ -461,9 +471,9 @@ likewise be updated."
(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 preselection for what directory to create in is based on the \"nearest\"
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 pooint to grab."
itself, using $HOME when there is no path at or near point to grab."
(interactive)
(treemacs--create-file/dir nil))
@@ -497,21 +507,42 @@ With a prefix ARG simply reset the width of the treemacs window."
(read-number))))
(treemacs--set-width treemacs-width))
(defun treemacs-copy-path-at-point ()
(defun treemacs-copy-absolute-path-at-point ()
"Copy the absolute path of the node at point."
(interactive)
(--if-let (-some-> (treemacs--prop-at-point :path) (f-full) (kill-new))
(treemacs-pulse-on-success "Copied path: %s" (propertize it 'face 'font-lock-string-face))
(treemacs-pulse-on-failure "There is nothing to copy here")))
(treemacs-block
(-let [path (treemacs--prop-at-point :path)]
(treemacs-error-return-if (null path)
"There is nothing to copy here")
(treemacs-error-return-if (not (stringp path))
"Path at point is not a file.")
(-let [copied (-> path (f-full) (kill-new))]
(treemacs-pulse-on-success "Copied absolute path: %s" (propertize copied 'face 'font-lock-string-face))))))
(defun treemacs-copy-project-root ()
(defun treemacs-copy-relative-path-at-point ()
"Copy the path of the node at point relative to the project root."
(interactive)
(treemacs-block
(let ((path (treemacs--prop-at-point :path))
(project (treemacs-project-at-point)))
(treemacs-error-return-if (null path)
"There is nothing to copy here")
(treemacs-error-return-if (not (stringp path))
"Path at point is not a file.")
(-let [copied (-> path (f-full) (file-relative-name (treemacs-project->path project)) (kill-new))]
(treemacs-pulse-on-success "Copied relative path: %s" (propertize copied 'face 'font-lock-string-face))))))
(defun treemacs-copy-project-path-at-point ()
"Copy the absolute path of the current treemacs root."
(interactive)
(--if-let (treemacs-current-button)
(-let [path (-> it (treemacs--nearest-path) (treemacs--find-project-for-path) (treemacs-project->path))]
(kill-new path)
(treemacs-log "Copied project root: %s" (propertize path 'face 'font-lock-string-face)))
(treemacs-pulse-on-failure "There is no project to copy from here.")))
(treemacs-block
(-let [project (treemacs-project-at-point)]
(treemacs-error-return-if (null project)
"There is nothing to copy here")
(treemacs-error-return-if (not (stringp (treemacs-project->path project)))
"Project at point is not a file.")
(-let [copied (-> project (treemacs-project->path) (kill-new))]
(treemacs-pulse-on-success "Copied project path: %s" (propertize copied 'face 'font-lock-string-face))))))
(defun treemacs-delete-other-windows ()
"Same as `delete-other-windows', but will not delete the treemacs window.
@@ -600,7 +631,7 @@ entire treemacs view.
Temporary sorting will only stick around until the next refresh, either manual
or automatic via `treemacs-filewatch-mode'.
Instead of calling this with a prefix arg you can also direcrly call
Instead of calling this with a prefix arg you can also directly call
`treemacs-temp-resort-current-dir' and `treemacs-temp-resort-root'."
(interactive "P")
(pcase arg
@@ -645,7 +676,7 @@ For slower scrolling see `treemacs-next-line-other-window'"
(end-of-buffer (goto-char (point-max)))))))
(defun treemacs-previous-page-other-window (&optional count)
"Scroll baclward COUNT pages in `next-window'.
"Scroll backward COUNT pages in `next-window'.
For slower scrolling see `treemacs-previous-line-other-window'"
(interactive "p")
(treemacs-without-following
@@ -685,7 +716,7 @@ For slower scrolling see `treemacs-previous-line-other-window'"
(let* ((old-name (treemacs-project->name project))
(project-btn (treemacs-project->position project))
(state (treemacs-button-get project-btn :state))
(new-name (read-string "New name: " (treemacs-project->name project))))
(new-name (treemacs--read-string "New name: " (treemacs-project->name project))))
(treemacs-save-position
(progn
(treemacs-return-if (treemacs--is-name-invalid? new-name)
@@ -711,14 +742,14 @@ For slower scrolling see `treemacs-previous-line-other-window'"
(defun treemacs-add-project-to-workspace (path &optional name)
"Add a project at given PATH to the current workspace.
The PATH's directory name will be used as a NAME for a project. The NAME can
\(or must) be entered manully with either a prefix arg or if a project with the
\(or must) be entered manually with either a prefix arg or if a project with the
auto-selected name already exists."
(interactive "DProject root: ")
(let* ((default-name (treemacs--filename path))
(double-name (--first (string= default-name (treemacs-project->name it))
(treemacs-workspace->projects (treemacs-current-workspace)))))
(if (or current-prefix-arg double-name)
(setf name (read-string "Project Name: " (unless double-name (treemacs--filename path))))
(setf name (treemacs--read-string "Project Name: " (unless double-name (treemacs--filename path))))
(setf name default-name)))
(pcase (treemacs-do-add-project-to-workspace path name)
(`(success ,project)
@@ -753,20 +784,24 @@ auto-selected name already exists."
"Remove the project at point from the current workspace.
With a prefix ARG select project to remove by name."
(interactive "P")
(if (>= 1 (length (treemacs-workspace->projects (treemacs-current-workspace))))
(treemacs-pulse-on-failure "Cannot delete the last project.")
(let ((project (treemacs-project-at-point))
(save-pos))
(when (or arg (null project))
(setf project (treemacs--select-project-by-name)
save-pos (not (equal project (treemacs-project-at-point)))))
(if save-pos
(treemacs-save-position
(treemacs-do-remove-project-from-workspace project))
(treemacs-do-remove-project-from-workspace project))
(whitespace-cleanup)
(treemacs-pulse-on-success "Removed project %s from the workspace."
(propertize (treemacs-project->name project) 'face 'font-lock-type-face)))))
(let ((project (treemacs-project-at-point))
(save-pos))
(when (or arg (null project))
(setf project (treemacs--select-project-by-name)
save-pos (not (equal project (treemacs-project-at-point)))))
(pcase (if save-pos
(treemacs-save-position
(treemacs-do-remove-project-from-workspace project))
(treemacs-do-remove-project-from-workspace project))
(`success
(whitespace-cleanup)
(treemacs-pulse-on-success "Removed project %s from the workspace."
(propertize (treemacs-project->name project) 'face 'font-lock-type-face)))
(`cannot-delete-last-project
(treemacs-pulse-on-failure "Cannot delete the last project."))
(`(invalid-project ,reason)
(treemacs-pulse-on-failure "Cannot delete project: %s"
(propertize reason 'face 'font-lock-string-face))))))
(defun treemacs-create-workspace ()
"Create a new workspace."
@@ -785,22 +820,37 @@ With a prefix ARG select project to remove by name."
(defun treemacs-remove-workspace ()
"Delete a workspace."
(interactive)
(pcase (treemacs-do-remove-workspace :ask-to-confirm)
(pcase (treemacs-do-remove-workspace nil :ask-to-confirm)
('only-one-workspace
(treemacs-pulse-on-failure "You cannot delete the last workspace."))
(`(workspace-not-found ,name)
(treemacs-pulse-on-failure "Workspace with name '%s' does not exist"
(propertize name 'face 'font-lock-type-face)))
('user-cancel
(ignore))
(`(success ,deleted ,_)
(treemacs-pulse-on-success "Workspace %s was deleted."
(propertize (treemacs-workspace->name deleted) 'face 'font-lock-type-face)))))
(defun treemacs-switch-workspace ()
"Select a different workspace for treemacs."
(interactive)
(defun treemacs-switch-workspace (arg)
"Select a different workspace for treemacs.
With a prefix ARG clean up buffers after the switch. A single prefix argument
will delete all file visiting buffers, 2 prefix arguments will clean up all open
buffers (except for treemacs itself and the scratch and messages buffers).
Without a prefix argument `treemacs-workspace-switch-cleanup' will
be followed instead."
(interactive "P")
(pcase (treemacs-do-switch-workspace)
('only-one-workspace
(treemacs-pulse-on-failure "There are no other workspaces to select."))
(`(success ,workspace)
(treemacs--maybe-clean-buffers-on-workspace-switch
(pcase arg
(`(4) 'files)
(`(16) 'all)
(_ treemacs-workspace-switch-cleanup)))
(treemacs-pulse-on-success "Selected workspace %s."
(propertize (treemacs-workspace->name workspace))))))
@@ -924,7 +974,7 @@ Only works with a single project in the workspace."
(treemacs--no-messages t)
(treemacs-pulse-on-success nil))
(unless (treemacs-is-path old-root :same-as new-root)
(treemacs-do-remove-project-from-workspace project)
(treemacs-do-remove-project-from-workspace project :ignore-last-project-restriction)
(treemacs--reset-dom) ;; remove also the previous root's dom entry
(treemacs-do-add-project-to-workspace new-root new-name)
(treemacs-goto-file-node old-root))))))
@@ -944,7 +994,7 @@ Only works with a single project in the workspace."
(let ((new-root (treemacs-button-get btn :path))
(treemacs--no-messages t)
(treemacs-pulse-on-success nil))
(treemacs-do-remove-project-from-workspace (treemacs-project-at-point))
(treemacs-do-remove-project-from-workspace (treemacs-project-at-point) :ignore-last-project-restriction)
(treemacs--reset-dom) ;; remove also the previous root's dom entry
(treemacs-do-add-project-to-workspace new-root (file-name-nondirectory new-root))
(treemacs-goto-file-node new-root)
@@ -1173,7 +1223,7 @@ absolute path of the node (if it is present)."
"Select the scope for treemacs buffers.
The default (and only) option is scoping by frame, which means that every Emacs
frame (and only an Emacs frame) will have its own unique treemacs buffer.
Additional scope types can be enbaled by installing the appropriate package.
Additional scope types can be enabled by installing the appropriate package.
The following packages offer additional scope types:
* treemacs-persp
@@ -1199,7 +1249,7 @@ To programmatically set the scope type see `treemacs-set-scope-type'."
(interactive)
(switch-to-buffer (get-buffer-create "*Treemacs Icons*"))
(erase-buffer)
(dolist (theme treemacs--themes)
(dolist (theme (nreverse treemacs--themes))
(insert (format "* Theme %s\n\n" (treemacs-theme->name theme)))
(insert " |------+------------|\n")
(insert " | Icon | Extensions |\n")
@@ -1223,8 +1273,8 @@ To programmatically set the scope type see `treemacs-set-scope-type'."
(insert (apply #'concat (nreverse txt)))
(with-no-warnings
(org-mode)
(org-table-align))
(goto-char 0))))
(org-table-align))))
(goto-char 0))
(provide 'treemacs-interface)