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

295
lisp/treemacs/treemacs-workspaces.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
@@ -32,7 +32,8 @@
(require 'inline)
(require 'treemacs-macros))
(cl-declaim (optimize (speed 3) (safety 0)))
(eval-when-compile
(cl-declaim (optimize (speed 3) (safety 0))))
(treemacs-import-functions-from "treemacs"
treemacs-select-window)
@@ -63,7 +64,8 @@
(:constructor treemacs-project->create!))
name
path
path-status)
path-status
is-disabled?)
(cl-defstruct (treemacs-workspace
(:conc-name treemacs-workspace->)
@@ -100,7 +102,7 @@ To be called whenever a project or workspace changes."
(defun treemacs--default-current-user-project-function ()
"Find the current project.el project."
(declare (side-effect-free t))
(-some-> (project-current) (cdr) (file-truename) (treemacs--canonical-path)))
(-some-> (project-current) (cdr) (file-truename) (treemacs-canonical-path)))
(define-inline treemacs-workspaces ()
"Return the list of all workspaces in treemacs."
@@ -109,12 +111,12 @@ To be called whenever a project or workspace changes."
(defun treemacs-current-workspace ()
"Get the current workspace.
The return value can be overriden by let-binding `treemacs-override-workspace'.
The return value can be overridden by let-binding `treemacs-override-workspace'.
This will happen when using `treemacs-run-in-every-buffer' to make sure that
this function returns the right workspace for the iterated-over buffers.
If no workspace is assigned to the current scope the persisted workspaces will
be loaded and a workspace will be found based on the `currebt-buffer'.
be loaded and a workspace will be found based on the `current-buffer'.
This function can be used with `setf'."
(or treemacs-override-workspace
@@ -147,6 +149,7 @@ PATH: String"
treemacs--workspaces)
(car treemacs--workspaces))))))
;; TODO(2020/11/25): NAME
(define-inline treemacs--find-project-for-buffer (&optional buffer-file)
"In the current workspace find the project current buffer's file falls under.
Optionally supply the BUFFER-FILE in case it is not available by calling
@@ -302,7 +305,7 @@ Return values may be as follows:
- the symbol `success'
- the created workspace"
(treemacs-block
(-let [name (or name (read-string "Workspace name: "))]
(-let [name (or name (treemacs--read-string "Workspace name: "))]
(treemacs-return-if (treemacs--is-name-invalid? name)
`(invalid-name ,name))
(-when-let (ws (--first (string= name (treemacs-workspace->name it))
@@ -314,16 +317,21 @@ Return values may be as follows:
(run-hook-with-args 'treemacs-create-workspace-functions workspace)
`(success ,workspace)))))
(defun treemacs-do-remove-workspace (&optional ask-to-confirm)
"Delete a workspace.
(defun treemacs-do-remove-workspace (&optional workspace ask-to-confirm)
"Delete a WORKSPACE.
Ask the user to confirm the deletion when ASK-TO-CONFIRM is t (it will be when
this is called from `treemacs-remove-workspace').
If no WORKSPACE name is given it will be selected interactively.
Return values may be as follows:
* If only a single workspace remains:
- the symbol `only-one-workspace'
* If the user cancel the deletion:
- the symbol `user-cancel'
* If the workspace cannot be found:
- the symbol `workspace-not-found'
* If everything went well:
- the symbol `success'
- the deleted workspace
@@ -331,22 +339,24 @@ Return values may be as follows:
(treemacs-block
(treemacs-return-if (= 1 (length treemacs--workspaces))
'only-one-workspace)
(let* ((names->workspaces (--map (cons (treemacs-workspace->name it) it) treemacs--workspaces))
(name (completing-read "Delete: " names->workspaces nil t))
(to-delete (cdr (assoc name names->workspaces))))
(when (and ask-to-confirm
(not (yes-or-no-p (format "Delete workspace %s and all its projects?"
(propertize (treemacs-workspace->name to-delete)
'face 'font-lock-type-face)))))
(treemacs-return 'user-cancel))
(let* ((name (or workspace
(completing-read "Delete: " (-map #'treemacs-workspace->name treemacs--workspaces) nil t)))
(to-delete (treemacs-find-workspace-by-name name)))
(treemacs-return-if
(and ask-to-confirm
(not (yes-or-no-p (format "Delete workspace %s and all its projects?"
(propertize (treemacs-workspace->name to-delete)
'face 'font-lock-type-face)))))
'user-cancel)
(treemacs-return-if (null to-delete)
`(workspace-not-found ,name))
(setq treemacs--workspaces (delete to-delete treemacs--workspaces))
(treemacs--persist)
(treemacs--invalidate-buffer-project-cache)
(dolist (frame (frame-list))
(with-selected-frame frame
(-when-let (current-ws (treemacs-current-workspace))
(when (eq current-ws to-delete)
(treemacs--rerender-after-workspace-change)))))
(treemacs-run-in-every-buffer
(let ((current-ws (treemacs-current-workspace)))
(when (eq current-ws to-delete)
(treemacs--rerender-after-workspace-change))))
(run-hook-with-args 'treemacs-delete-workspace-functions to-delete)
`(success ,to-delete ,treemacs--workspaces))))
@@ -452,10 +462,11 @@ NAME: String"
(treemacs-block
(treemacs-error-return-if (null path)
`(invalid-path "Path is nil."))
(let ((path-status (treemacs--get-path-status path)))
(let ((path-status (treemacs--get-path-status path))
(added-in-workspace (treemacs-current-workspace)))
(treemacs-error-return-if (not (file-readable-p path))
`(invalid-path "Path is not readable does not exist."))
(setq path (-> path (file-truename) (treemacs--canonical-path)))
(setq path (-> path (file-truename) (treemacs-canonical-path)))
(-when-let (project (treemacs--find-project-for-path path))
(treemacs-return `(duplicate-project ,project)))
(treemacs-return-if (treemacs--is-name-invalid? name)
@@ -470,25 +481,28 @@ NAME: String"
(treemacs--add-project-to-current-workspace project)
(treemacs--invalidate-buffer-project-cache)
(treemacs-run-in-every-buffer
(treemacs-with-writable-buffer
(goto-char (treemacs--projects-end))
(cond
;; Inserting the first and only button - no need to add spacing
((not (treemacs-current-button)))
;; Inserting before a button. This happens when only bottom extensions exist.
((bolp)
(save-excursion (treemacs--insert-root-separator))
;; Unlock the marker - when the marker is at the beginning of the buffer,
;; expanding/collapsing extension nodes would move the marker and it was thus locked.
(set-marker-insertion-type (treemacs--projects-end) t))
;; Inserting after a button (the standard case)
;; We should already be at EOL, but play it safe.
(t
(end-of-line)
(treemacs--insert-root-separator)))
(treemacs--add-root-element project)
(treemacs-dom-node->insert-into-dom!
(treemacs-dom-node->create! :key path :position (treemacs-project->position project)))))
(when (eq added-in-workspace workspace)
(treemacs-with-writable-buffer
(goto-char (treemacs--projects-end))
(cond
;; Inserting the first and only button - no need to add spacing
((not (treemacs-current-button)))
;; Inserting before a button. This happens when only bottom extensions exist.
((bolp)
(save-excursion (treemacs--insert-root-separator))
;; Unlock the marker - when the marker is at the beginning of the buffer,
;; expanding/collapsing extension nodes would move the marker and it was thus locked.
(set-marker-insertion-type (treemacs--projects-end) t))
;; Inserting after a button (the standard case)
;; We should already be at EOL, but play it safe.
(t
(end-of-line)
(treemacs--insert-root-separator)))
(treemacs--add-root-element project)
(treemacs-dom-node->insert-into-dom!
(treemacs-dom-node->create! :key path :position (treemacs-project->position project)))
(when treemacs-expand-added-projects
(treemacs--expand-root-node (treemacs-project->position project))))))
(treemacs--persist)
(run-hook-with-args 'treemacs-create-project-functions project)
`(success ,project)))))
@@ -497,60 +511,94 @@ NAME: String"
(with-no-warnings
(make-obsolete #'treemacs-add-project-at #'treemacs-do-add-project-to-workspace "v.2.2.1"))
(defun treemacs-do-remove-project-from-workspace (project)
(defun treemacs-do-remove-project-from-workspace (project &optional ignore-last-project-restriction)
"Add the given PROJECT to the current workspace.
PROJECT: Project Struct"
(treemacs-run-in-every-buffer
(treemacs-with-writable-buffer
(let* ((project-pos (goto-char (treemacs-project->position project)))
(prev-project-pos (move-marker (make-marker) (treemacs--prev-project-pos)))
(next-project-pos (move-marker (make-marker) (treemacs--next-project-pos))))
(when (treemacs-project->is-expanded? project)
(treemacs--collapse-root-node project-pos t))
(treemacs--remove-project-from-current-workspace project)
(treemacs--invalidate-buffer-project-cache)
(let ((previous-button (previous-button project-pos))
(next-button (next-button project-pos)))
(cond
;; Previous button exists. Delete from the end of the current line to
;; the end of the previous button's line. If the `treemacs--projects-end'
;; is at the EOL of the it will move to EOL of the previous button.
(previous-button
(delete-region (treemacs-button-end previous-button) (point-at-eol))
(when next-button (forward-button 1)))
;; Previous project does not exist, but a next button exists. Delete from
;; BOL to the start of the next buttons line.
(next-button
(when (> next-button (treemacs--projects-end))
;; The first item after the deletion will be bottom extensions. Project
;; end will be at its BOL, making it move upon expand/collapse. Lock the marker.
(set-marker-insertion-type (treemacs--projects-end) nil))
(delete-region (point-at-bol) (progn (goto-char next-button) (forward-line 0) (point))))
PROJECT may either be a `treemacs-project' instance or a string path. In the
latter case the project containing the path will be selected.
;; Neither the previous nor the next button exists. Simply delete the
;; current line.
(t
(delete-region (point-at-bol) (point-at-eol)))))
(if (equal (point-min) prev-project-pos)
(goto-char next-project-pos)
(goto-char prev-project-pos)))
When IGNORE-LAST-PROJECT-RESTRICTION removing the last project will not count
as an error. This is meant to be used in non-interactive code, where another
project is immediately added afterwards, as leaving the project list empty is
probably a bad idea.
(treemacs--forget-last-highlight)
(--when-let (treemacs-get-local-window)
(with-selected-window it
(recenter)))
(treemacs--evade-image)
(hl-line-highlight)))
(run-hook-with-args 'treemacs-delete-project-functions project)
(treemacs--persist))
Return values may be as follows:
(defun treemacs-do-switch-workspace ()
"Switch to a new workspace.
* If the given path is invalid (is nil or does not exist):
- the symbol `invalid-project'
- a string describing the problem
* If there is only one project:
- the symbol `cannot-delete-last-project'
* If everything went well:
- the symbol `success'"
(treemacs-block
(unless ignore-last-project-restriction
(treemacs-error-return-if (>= 1 (length (treemacs-workspace->projects (treemacs-current-workspace))))
'cannot-delete-last-project))
(treemacs-error-return-if (null project)
`(invalid-project "Project is nil"))
;; when used from outside treemacs it is much easier to supply a path string than to
;; look up the project instance
(when (stringp project)
(setf project (treemacs-is-path (treemacs-canonical-path project) :in-workspace)))
(treemacs-error-return-if (null project)
`(invalid-project "Given path is not in the workspace"))
(treemacs-run-in-every-buffer
(treemacs-with-writable-buffer
(let* ((project-path (treemacs-project->path project))
(project-pos (goto-char (treemacs-project->position project-path)))
(prev-project-pos (move-marker (make-marker) (treemacs--prev-project-pos)))
(next-project-pos (move-marker (make-marker) (treemacs--next-project-pos))))
(when (treemacs-project->is-expanded? project)
(treemacs--collapse-root-node project-pos t))
(treemacs--remove-project-from-current-workspace project)
(treemacs--invalidate-buffer-project-cache)
(let ((previous-button (previous-button project-pos))
(next-button (next-button project-pos)))
(cond
;; Previous button exists. Delete from the end of the current line to
;; the end of the previous button's line. If the `treemacs--projects-end'
;; is at the EOL of the it will move to EOL of the previous button.
(previous-button
(delete-region (treemacs-button-end previous-button) (point-at-eol))
(when next-button (forward-button 1)))
;; Previous project does not exist, but a next button exists. Delete from
;; BOL to the start of the next buttons line.
(next-button
(when (> next-button (treemacs--projects-end))
;; The first item after the deletion will be bottom extensions. Project
;; end will be at its BOL, making it move upon expand/collapse. Lock the marker.
(set-marker-insertion-type (treemacs--projects-end) nil))
(delete-region (point-at-bol) (progn (goto-char next-button) (forward-line 0) (point))))
;; Neither the previous nor the next button exists. Simply delete the
;; current line.
(t
(delete-region (point-at-bol) (point-at-eol)))))
(if (equal (point-min) prev-project-pos)
(goto-char next-project-pos)
(goto-char prev-project-pos)))
(treemacs--forget-last-highlight)
(--when-let (treemacs-get-local-window)
(with-selected-window it
(recenter)))
(treemacs--evade-image)
(hl-line-highlight)))
(run-hook-with-args 'treemacs-delete-project-functions project)
(treemacs--persist)
'success))
(defun treemacs-do-switch-workspace (&optional workspace)
"Switch to a new WORKSPACE.
Workspace may either be a workspace name, a workspace object, or be left out.
In the latter case the workspace to switch to will be selected interactively.
Return values may be as follows:
* If there are no workspaces to switch to:
- the symbol `only-one-workspace'
* If the given workspace could not be found (if WORKSPACE was a name string)
- the symbol `workspace-not-found'
- the given workspace name
* If everything went well:
- the symbol `success'
- the selected workspace"
@@ -558,17 +606,26 @@ Return values may be as follows:
(treemacs-block
(treemacs-return-if (= 1 (length treemacs--workspaces))
'only-one-workspace)
(let* ((workspaces (->> treemacs--workspaces
(--reject (eq it (treemacs-current-workspace)))
(--map (cons (treemacs-workspace->name it) it))))
(name (completing-read "Switch to: " workspaces nil t))
(selected (cdr (--first (string= (car it) name) workspaces))))
(setf (treemacs-current-workspace) selected)
(let (new-workspace)
(cond
((treemacs-workspace-p workspace)
(setf new-workspace workspace))
((stringp workspace)
(setf new-workspace (treemacs-find-workspace-by-name workspace))
(treemacs-return-if (null new-workspace)
`(workspace-not-found ,workspace)))
((null workspace)
(let* ((workspaces (->> treemacs--workspaces
(--reject (eq it (treemacs-current-workspace)))
(--map (cons (treemacs-workspace->name it) it))))
(name (completing-read "Switch to: " workspaces nil :require-match)))
(setf new-workspace (cdr (--first (string= (car it) name) workspaces))))))
(setf (treemacs-current-workspace) new-workspace)
(treemacs--invalidate-buffer-project-cache)
(treemacs--rerender-after-workspace-change)
(run-hooks 'treemacs-switch-workspace-hook)
(treemacs-return
`(success ,selected)))))
`(success ,new-workspace)))))
(defun treemacs-do-rename-workspace ()
"Rename a workspace.
@@ -588,7 +645,7 @@ Return values may be as follows:
(sort (lambda (n _) (string= (car n) old-name)))))
(str-to-rename (completing-read "Rename: " name-map))
(ws-to-rename (cdr (assoc str-to-rename name-map)))
(new-name (read-string "New name: ")))
(new-name (treemacs--read-string "New name: ")))
(treemacs-return-if (treemacs--is-name-invalid? new-name)
`(invalid-name ,new-name))
(setf (treemacs-workspace->name ws-to-rename) new-name)
@@ -716,7 +773,8 @@ PROJECT: Project Struct"
(treemacs-return it)))))
(defun treemacs--select-workspace-by-name (&optional name)
"Interactivly select the workspace with the given NAME."
"Interactively select the workspace with the given NAME."
(treemacs--maybe-load-workspaces)
(-let [name (or name
(completing-read
"Workspace: "
@@ -725,6 +783,49 @@ PROJECT: Project Struct"
(--first (string= name (treemacs-workspace->name it))
treemacs--workspaces)))
(defun treemacs--maybe-clean-buffers-on-workspace-switch (which)
"Delete buffers depending on the value of WHICH.
- When it is nil do nothing.
- When it is `files' delete all buffers visiting files.
- When it is `all' delete all buffers
In any case treemacs itself, and the scratch and messages buffers will be left
alive."
(when which
(let* ((scratch (get-buffer-create "*scratch*"))
(messages (get-buffer "*Messages*"))
(no-delete-test
(pcase which
('files (lambda (b) (null (buffer-file-name b))))
('all (lambda (_) nil)))))
(dolist (buffer (buffer-list))
(unless (or (eq t (buffer-local-value 'treemacs--in-this-buffer buffer))
(eq buffer scratch)
(eq buffer messages)
(funcall no-delete-test buffer))
(kill-buffer buffer))))))
(defun treemacs-find-workspace-by-name (name)
"Find a workspace with the given NAME.
The check is case-sensitive. nil is returned when no workspace is found."
(declare (side-effect-free t))
(--first (string= name (treemacs-workspace->name it))
treemacs--workspaces))
(defun treemacs-find-workspace-by-path (path)
"Find a workspace with a project containing the given PATH.
nil is returned when no workspace is found."
(declare (side-effect-free t))
(--first (treemacs-is-path path :in-workspace it)
treemacs--workspaces))
(defun treemacs-find-workspace-where (predicate)
"Find a workspace matching the given PREDICATE.
Predicate should be a function that takes a `treemacs-workspace' as its single
argument. nil is returned when no workspace is found."
(--first (funcall predicate it) treemacs--workspaces))
(provide 'treemacs-workspaces)
;;; treemacs-workspaces.el ends here