update packages

This commit is contained in:
2021-01-08 19:32:30 +01:00
parent ce8f24d28a
commit f5649dceab
467 changed files with 26642 additions and 22487 deletions

View File

@@ -3,9 +3,23 @@
* Changelog
** current master
- Published ~treemacs-all-the-icons~
- Added ~treemacs-workspace-switch-cleanup~
- Added support for disabling the mode line
- Added ~treemacs-user-header-line-format~
- Added ~treemacs-display-current-project-exclusively~
- Added ~treemacs-icon-catalogue~
- Added ~treemacs-read-string-input~
- Split the helpful hydra in 2, so it can fit on smaller screens
- Replaced ~treemacs-select-hook~ with ~treemacs-select-functions~ because it is
now called with treemacs' previous visibility
- Added imenu support
+ Added ~treemacs-imenu-scope~
- Added ~treemacs-copy-relative-path-at-point~
- Added ~treemacs-expand-added-projects~
- Added ~treemacs-window-background-color~
- Added option to only show the fringe indicator when the treemacs window is
selected
- New icons
- Bug Fixes
** v2.8

Binary file not shown.

Before

Width:  |  Height:  |  Size: 14 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 24 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 16 KiB

After

Width:  |  Height:  |  Size: 846 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 19 KiB

After

Width:  |  Height:  |  Size: 1.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 18 KiB

After

Width:  |  Height:  |  Size: 1.1 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 17 KiB

After

Width:  |  Height:  |  Size: 1.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.9 KiB

After

Width:  |  Height:  |  Size: 816 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.0 KiB

After

Width:  |  Height:  |  Size: 676 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.3 KiB

After

Width:  |  Height:  |  Size: 890 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.3 KiB

After

Width:  |  Height:  |  Size: 830 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.1 KiB

After

Width:  |  Height:  |  Size: 684 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.5 KiB

After

Width:  |  Height:  |  Size: 642 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.9 KiB

After

Width:  |  Height:  |  Size: 1.1 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.7 KiB

After

Width:  |  Height:  |  Size: 1.3 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.7 KiB

After

Width:  |  Height:  |  Size: 652 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.7 KiB

After

Width:  |  Height:  |  Size: 957 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.0 KiB

After

Width:  |  Height:  |  Size: 1.1 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.4 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 937 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.4 KiB

After

Width:  |  Height:  |  Size: 1.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.8 KiB

After

Width:  |  Height:  |  Size: 981 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 2.0 KiB

After

Width:  |  Height:  |  Size: 843 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.8 KiB

After

Width:  |  Height:  |  Size: 641 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 1.2 KiB

Binary file not shown.

Before

Width:  |  Height:  |  Size: 1.9 KiB

After

Width:  |  Height:  |  Size: 576 B

Binary file not shown.

Before

Width:  |  Height:  |  Size: 3.3 KiB

After

Width:  |  Height:  |  Size: 1.2 KiB

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
@@ -35,7 +35,7 @@
(require 'inline)
(require 'treemacs-macros))
(defconst treemacs--dirs-to-collpase.py
(defconst treemacs--dirs-to-collapse.py
(if (member "treemacs-dirs-to-collapse.py" (directory-files treemacs-dir))
(f-join treemacs-dir "treemacs-dirs-to-collapse.py")
(f-join treemacs-dir "src/scripts/treemacs-dirs-to-collapse.py")))
@@ -58,9 +58,9 @@ If it does reach that size it will be cut back to 30 entries.")
"Stores the results of previous git status calls for directories.
Its effective type is HashMap<FilePath, HashMap<FilePath, Char>>.
These cached results are used as a standin during immediate rendering when
`treemacs-git-mode' is set to be deferred, so as to minimize the effect of large
face changes, epsecially when a full project is refreshed.
These cached results are used as a stand-in during immediate rendering when
`treemacs-git-mode' is set to be deferred, so as to minimise the effect of large
face changes, especially when a full project is refreshed.
Since this table is a global value that can effectively grow indefinitely its
value is limited by `treemacs--git-cache-max-size'.")
@@ -155,10 +155,7 @@ really left to do is pick up the cons list and put it in a hash table.
GIT-FUTURE: Pfuture"
(or (when git-future
(let* ((git-output (pfuture-await-to-finish git-future))
;; Check fboundp in case an old version of pfuture is used.
;; TODO: Remove the check when pfuture 1.7 has been widely adopted.
(git-stderr (when (fboundp 'pfuture-stderr)
(pfuture-stderr git-future))))
(git-stderr (pfuture-stderr git-future)))
;; Check stderr separately from parsing, often git status displays
;; warnings which do not affect the final result.
(unless (s-blank? git-stderr)
@@ -262,7 +259,7 @@ BUFFER: Buffer"
"Update the FILE node's git state, wrapped in `treemacs-save-position'.
Internally calls `treemacs-do-update-single-file-git-state'.
FILE: Filepath"
FILE: FilePath"
(treemacs-save-position
(treemacs-do-update-single-file-git-state file)))
@@ -280,7 +277,7 @@ cache entry.
When OVERRIDE-STATUS is non-nil the FILE's cached git status will not be used.
FILE: Filepath
FILE: FilePath
EXCLUDE-PARENTS: Boolean
OVERRIDE-STATUS: Boolean"
(let* ((local-buffer (current-buffer))
@@ -336,13 +333,13 @@ OVERRIDE-STATUS: Boolean"
(treemacs-log-err "\"%s\"" (treemacs--remove-trailing-newline err-str))))))))))
(defun treemacs--collapsed-dirs-process (path project)
"Start a new process to determine dirs to collpase under PATH.
"Start a new process to determine directories to collapse under PATH.
Only starts the process if PROJECT is locally accessible (i.e. exists, and
is not remote.)
Output format is an elisp list of string lists that's read directly.
Every string list consists of the following elements:
1) the extra text that must be appended in the view
2) The original full and uncollapsed path
2) The original full and non-collapsed path
3) a series of intermediate steps which are the result of appending the
collapsed path elements onto the original, ending in
4) the full path to the
@@ -359,13 +356,13 @@ Every string list consists of the following elements:
(-let [default-directory path]
(pfuture-new treemacs-python-executable
"-O"
treemacs--dirs-to-collpase.py
treemacs--dirs-to-collapse.py
path
(number-to-string treemacs-collapse-dirs)
(if treemacs-show-hidden-files "t" "x")))))
(defun treemacs--parse-collapsed-dirs (future)
"Parse the output of collpsed dirs FUTURE.
"Parse the output of collapsed dirs FUTURE.
Splits the output on newlines, splits every line on // and swallows the first
newline."
(when future
@@ -400,8 +397,9 @@ All versions run asynchronously and are optimized for not doing more work than
is necessary, so their performance cost should, for the most part, be the
constant time needed to fork a subprocess."
:init-value nil
:global t
:lighter nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-git-mode
(if (memq arg '(simple extended deferred))
(treemacs--setup-git-mode arg)

View File

@@ -1,6 +1,6 @@
;;; treemacs-bookmarks.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
@@ -17,6 +17,7 @@
;;; Commentary:
;;; Integrates treemacs with bookmark.el.
;;; NOTE: This module is lazy-loaded.
;;; Code:
@@ -80,7 +81,13 @@ With a prefix argument ARG treemacs will also open the bookmarked location."
;; error must be handled in bookmark.el.
(user-error "Treemacs--bookmark-handler invoked for a non-Treemacs bookmark"))
(treemacs-select-window)
(treemacs-goto-node path)
;; XXX temporary workaround for incorrect move to a saved tag node
;; must be fixed after tags were rewritten in new extension api
(if (and (listp path)
(stringp (car path))
(file-regular-p (car path)))
(treemacs-goto-node (car path))
(treemacs-goto-node path))
;; If the user has bookmarked a directory, they probably want to operate on
;; its contents. Expand it, and select the first child.
(treemacs-with-current-button
@@ -186,13 +193,13 @@ treemacs node is pointing to a valid buffer position."
"There is nothing to bookmark here."
(pcase (treemacs-button-get current-btn :state)
((or 'file-node-open 'file-node-closed 'dir-node-open 'dir-node-closed)
(-let [name (read-string "Bookmark name: ")]
(-let [name (treemacs--read-string "Bookmark name: ")]
(bookmark-store name `((filename . ,(treemacs-button-get current-btn :path))) nil)))
('tag-node
(-let [(tag-buffer . tag-pos) (treemacs--extract-position (treemacs-button-get current-btn :marker))]
(if (buffer-live-p tag-buffer)
(bookmark-store
(read-string "Bookmark name: ")
(treemacs--read-string "Bookmark name: ")
`((filename . ,(buffer-file-name tag-buffer))
(position . ,tag-pos))
nil)

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
@@ -52,9 +52,9 @@
(when (boundp 'indent-guide-inhibit-modes)
(push 'treemacs-mode indent-guide-inhibit-modes)))
(defun persp-after-load ()
(with-eval-after-load 'persp-mode
(defun treemacs--remove-treemacs-window-in-new-frames (persp-activated-for)
(when (or t(eq persp-activated-for 'frame))
(when (eq persp-activated-for 'frame)
(-when-let (w (--first (treemacs-is-treemacs-window? it)
(window-list)))
(unless (assoc (treemacs-scope->current-scope treemacs--current-scope-type) treemacs--scope-storage)
@@ -64,12 +64,16 @@
(add-to-list 'persp-activated-functions #'treemacs--remove-treemacs-window-in-new-frames)
(treemacs-log-failure "`persp-activated-functions' not defined - couldn't add compatibility.")))
(with-eval-after-load 'persp-mode
(persp-after-load))
(with-eval-after-load 'perspective
(persp-after-load))
(defun treemacs--remove-treemacs-window-in-new-frames (&rest _)
(-when-let (w (--first (treemacs-is-treemacs-window? it)
(window-list)))
(unless (assoc (treemacs-scope->current-scope treemacs--current-scope-type) treemacs--scope-storage)
(delete-window w))))
(declare-function treemacs--remove-treemacs-window-in-new-frames "treemacs-compatibility")
(if (boundp 'persp-activated-hook)
(add-to-list 'persp-activated-hook #'treemacs--remove-treemacs-window-in-new-frames)
(treemacs-log-failure "`persp-activated-hook' not defined - couldn't add compatibility.")))
(defun treemacs--split-window-advice (original-split-function &rest args)
"Advice to make sure window splits are sized correctly with treemacs.
@@ -107,6 +111,27 @@ width of the new window when the treemacs window is visible."
(when (boundp 'evil-escape-excluded-major-modes)
(add-to-list 'evil-escape-excluded-major-modes 'treemacs-mode)))
(defun treemacs-load-all-the-icons-with-workaround-font (font)
"Load the `treemacs-all-the-icons' package using a workaround FONT for tabs.
Use this if you experience the issue of icons jumping around when they are
closed or opened which can appear when using specific fonts.
FONT should be a simple string name, for example \"Hermit\".
Finding the right FONT is a matter of trial and error, you can quickly try
different fonts using `set-frame-font'.
The workaround will overwrite the values for `treemacs-indentation' and
`treemacs-indentation-string', using your own values for them is no longer
possible.
Can only work if the `treemacs-all-the-icons' module has not been loaded yet."
(defvar treemacs-all-the-icons-tab-font font)
(setf treemacs-indentation 1
treemacs-indentation-string (propertize "\t" 'face `((:family ,treemacs-all-the-icons-tab-font))))
(require 'treemacs-all-the-icons)
(treemacs-load-theme "all-the-icons"))
(provide 'treemacs-compatibility)
;;; treemacs-compatibility.el ends here

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
@@ -25,7 +25,6 @@
(require 's)
(require 'ht)
(require 'f)
(require 'ace-window)
(require 'pfuture)
(require 'treemacs-customization)
(require 'treemacs-logging)
@@ -35,6 +34,9 @@
(require 'cl-lib)
(require 'treemacs-macros))
(treemacs-import-functions-from "cfrs"
cfrs-read)
(treemacs-import-functions-from "treemacs-tags"
treemacs--expand-file-node
treemacs--collapse-file-node
@@ -272,6 +274,17 @@ button type on every call."
(inline-quote
(buffer-substring-no-properties (treemacs-button-start ,btn) (treemacs-button-end ,btn))))
(define-inline treemacs--tokenize-path (path exclude-prefix)
"Get the PATH's single elements, excluding EXCLUDE-PREFIX.
For example the input /A/B/C/D/E + /A/B will return [C D E].
PATH: File Path
EXCLUDE-PREFIX: File Path"
(declare (pure t) (side-effect-free t))
(inline-letevals (path exclude-prefix)
(inline-quote
(cdr (f-split (substring ,path (length ,exclude-prefix)))))))
(defun treemacs--replace-recentf-entry (old-file new-file)
"Replace OLD-FILE with NEW-FILE in the recent file list."
;; code taken from spacemacs - is-bound check due to being introduced after emacs24?
@@ -296,7 +309,7 @@ button type on every call."
(when (or treemacs-follow-after-init
(with-no-warnings treemacs-follow-mode))
(with-current-buffer buffer (treemacs--follow)))
(run-hooks 'treemacs-select-hook))))
(run-hook-with-args 'treemacs-select-functions 'exists))))
(define-inline treemacs--button-symbol-switch (new-sym)
"Replace icon in current line with NEW-SYM."
@@ -429,7 +442,7 @@ Simply collapses and re-expands the button (if it has not been closed)."
(goto-char (treemacs-button-start btn))
(treemacs--push-button btn))))))
(define-inline treemacs--canonical-path (path)
(define-inline treemacs-canonical-path (path)
"The canonical version of PATH for being handled by treemacs.
In practice this means expand PATH and remove its final slash."
(declare (pure t) (side-effect-free t))
@@ -437,6 +450,8 @@ In practice this means expand PATH and remove its final slash."
(inline-quote
(let (file-name-handler-alist)
(-> ,path (expand-file-name) (treemacs--unslash))))))
;; TODO(2020/12/28): alias is for backwards compatibility, remove it eventually
(defalias 'treemacs--canonical-path #'treemacs-canonical-path)
(define-inline treemacs-is-file-git-ignored? (file git-info)
"Determined if FILE is ignored by git by means of GIT-INFO."
@@ -489,13 +504,14 @@ buffer."
(make-obsolete #'treemacs--get-children-of #'treemacs-collect-child-nodes "v2.7"))
(defun treemacs--init (&optional root name)
"Initialize a treemacs buffer from the current workspace.
"Initialise a treemacs buffer from the current workspace.
Add a project for ROOT and NAME if they are non-nil."
(treemacs--maybe-load-workspaces)
(let ((origin-buffer (current-buffer))
(current-workspace (treemacs-current-workspace))
(run-hook? nil))
(pcase (treemacs-current-visibility)
(run-hook? nil)
(visibility (treemacs-current-visibility)))
(pcase visibility
('visible (treemacs--select-visible-window))
('exists (treemacs--select-not-visible-window))
('none
@@ -506,13 +522,13 @@ Add a project for ROOT and NAME if they are non-nil."
(treemacs--render-projects (treemacs-workspace->projects current-workspace))
(when (treemacs-workspace->is-empty?)
(let* ((path (-> (treemacs--read-first-project-path)
(treemacs--canonical-path)))
(treemacs-canonical-path)))
(name (treemacs--filename path)))
(treemacs-do-add-project-to-workspace path name)
(treemacs-log "Created first project.")))
(goto-char 2)
(setf run-hook? t)))
(when root (treemacs-do-add-project-to-workspace (treemacs--canonical-path root) name))
(when root (treemacs-do-add-project-to-workspace (treemacs-canonical-path root) name))
(with-no-warnings (setq treemacs--ready-to-follow t))
(when (or treemacs-follow-after-init (with-no-warnings treemacs-follow-mode))
(with-current-buffer origin-buffer
@@ -520,7 +536,7 @@ Add a project for ROOT and NAME if they are non-nil."
;; The hook should run at the end of the setup, but also only
;; if a new buffer was created, as the other cases are already covered
;; in their respective setup functions.
(when run-hook? (run-hooks 'treemacs-select-hook))))
(when run-hook? (run-hook-with-args 'treemacs-select-functions visibility))))
(defun treemacs--push-button (btn &optional recursive)
"Execute the appropriate action given the state of the pushed BTN.
@@ -586,7 +602,7 @@ IS-FILE?: Bool"
(treemacs-button-get :parent)
(treemacs-button-get :path)))
(treemacs-do-update-node created-under)))
(treemacs-goto-file-node (treemacs--canonical-path path-to-create) project)
(treemacs-goto-file-node (treemacs-canonical-path path-to-create) project)
(recenter))
(treemacs-pulse-on-success
"Created %s." (propertize path-to-create 'face 'font-lock-string-face)))))
@@ -772,7 +788,7 @@ failed. PROJECT is used for determining whether Git actions are appropriate."
"Find position of node at PATH.
Unlike `treemacs-find-node' this will not expand other nodes in the view, but
only look among those currently visible. The result however is the same: either
a marker ponting to the found node or nil.
a marker pointing to the found node or nil.
Unlike `treemacs-find-node', this function does not go to the node.
@@ -784,7 +800,7 @@ PATH: Node Path"
(defun treemacs-find-node (path &optional project)
"Find position of node identified by PATH under PROJECT in the current buffer.
Inspite the signature this function effectively supports two different calling
In spite of the signature this function effectively supports two different calling
conventions.
The first one is for movement towards a node that identifies a file. In this
@@ -807,7 +823,7 @@ a project extension, created with `treemacs-define-project-extension', the
first element of the path must instead be the keyword `:custom', followed by the
node's unique path. The second argument is therefore ignored in this case.
Either way this fuction will return a marker to the moved to position if it was
Either way this function will return a marker to the moved to position if it was
successful.
PATH: Filepath | Node Path
@@ -1033,7 +1049,7 @@ It needs to be moved aside in a way that works for all indent depths and
(forward-char 1)))))
(defun treemacs--read-first-project-path ()
"Read the first project on init with an empty workspace.
"Read the first project on start with an empty workspace.
This function is extracted here specifically so that treemacs-projectile can
overwrite it so as to present the project root instead of the current dir as the
first choice."
@@ -1042,7 +1058,7 @@ first choice."
(defun treemacs--sort-value-selection ()
"Interactive selection for a new `treemacs-sorting' value.
Retursns a cons cell of a descriptive string name and the sorting symbol."
Returns a cons cell of a descriptive string name and the sorting symbol."
(declare (side-effect-free t))
(let* ((sort-names '(("Sort Alphabetically Ascending" . alphabetic-asc)
("Sort Alphabetically Descending" . alphabetic-desc)
@@ -1169,7 +1185,7 @@ PATH: Node Path"
(defun treemacs--copy-or-move (action)
"Internal implementation for copying and moving files.
ACTION will be either `:copy' or `:move', depenting on whether we are calling
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)
@@ -1196,11 +1212,13 @@ from `treemacs-copy-file' or `treemacs-move-file'."
wrong-type-msg)
(let* ((source (treemacs-button-get node :path))
(source-name (treemacs--filename source))
(destination (treemacs--unslash (read-file-name prompt nil default-directory :must-match)))
(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 (f-join 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
@@ -1232,6 +1250,18 @@ exists it returns /file/name (Copy 2).ext etc."
(setf new-path (f-join dir (concat filename-no-ext (format template n) ext))))
new-path))
(defun treemacs--read-string (prompt &optional initial-input)
"Read a string with an interface based on `treemacs-read-string-input'.
PROMPT and INITIAL-INPUT will be passed on to the read function.
PROMPT: String
INITIAL-INPUT: String"
(declare (side-effect-free t))
(pcase treemacs-read-string-input
('from-child-frame (cfrs-read prompt initial-input))
('from-minibuffer (read-string prompt initial-input))
(other (user-error "Unknown read-string-input value: `%s'" other))))
(provide 'treemacs-core-utils)
;;; treemacs-core-utils.el ends here

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
@@ -31,18 +31,20 @@
"Determine the location of python 3."
(--if-let (executable-find "python3") it
(when (eq system-type 'windows-nt)
(->> "where python"
(shell-command-to-string)
(s-trim)
(s-lines)
(--first
(when (file-exists-p it)
(->> (concat (shell-quote-argument it) " --version")
(shell-command-to-string)
(s-trim)
(s-replace "Python " "")
(s-left 1)
(version<= "3"))))))))
(condition-case _
(->> "where python"
(shell-command-to-string)
(s-trim)
(s-lines)
(--first
(when (file-exists-p it)
(->> (concat (shell-quote-argument it) " --version")
(shell-command-to-string)
(s-trim)
(s-replace "Python " "")
(s-left 1)
(version<= "3")))))
(error nil)))))
(cl-macrolet
((define-action-widget (name include-default include-tab include-ret)
@@ -116,6 +118,21 @@ indentation will be a space INTEGER pixels wide."
(const :tag "" px)))
:group 'treemacs)
(defcustom treemacs-read-string-input 'from-child-frame
"The function treemacs uses to read user input.
Only applies to plaintext input, like when renaming a project, file or
workspace.
There are 2 options:
- `from-child-frame': will use the `cfrs' package to read input from a small
child frame pop-up. Only available in GUI frames, otherwise the default
minibuffer input is used.
- `from-minibuffer': will read input from the minibuffer, same as baseline
Emacs."
:type '(choice (const :tag "With Child Frame Popup" 'from-child-frame)
(const :tag "From the Minibuffer (Emacs Default)" 'from-minibuffer))
:group 'treemacs)
(defcustom treemacs-move-forward-on-expand nil
"When non-nil treemacs will move to the first child of an expanded node."
:type 'boolean
@@ -182,7 +199,7 @@ of how this config works and how to modify it."
(defcustom treemacs-default-visit-action
'treemacs-visit-node-no-split
"Defines the behavior of `treemacs-visit-node-default'."
"Defines the behaviour of `treemacs-visit-node-default'."
:type 'treemacs-default-action
:group 'treemacs)
@@ -221,24 +238,24 @@ To keep the alist clean changes should not be made directly, but with
Files will still always be shown after directories.
Valid values are:
* alphabetic-asc,
* alphabetic-desc,
* alphabetic-case-insensitive-asc,
* alphabetic-case-insensitive-desc,
* size-asc,
* size-desc,
* mod-time-asc,
* mod-time-desc
* `alphabetic-asc',
* `alphabetic-desc',
* `alphabetic-case-insensitive-asc',
* `alphabetic-case-insensitive-desc',
* `size-asc',
* `size-desc',
* `mod-time-asc',
* `mod-time-desc'
* a custom function
In the latter case it must be a function that can be passed to `sort' to sort
absolute filepaths. For an example see `treemacs--sort-alphabetic-asc'
Note about performance:
Treemacs does its best to optimize its performance critical path, it does so
Treemacs does its best to optimise its performance critical path, it does so
by doing as little work as possible and producing as little garbage as possible.
Deciding on the order in which its nodes are inserted is a part of this path.
As such certain tradeoffs need to be accounted far.
As such certain trade-offs need to be accounted far.
In plaintext: some sort settings are much slower than others. Alphabetic
sorting \(the default) is fastest and causes no additional overhead (even when
@@ -271,13 +288,13 @@ treemacs views containing hundreds or even thousands of nodes."
Ignored files will *never* be shown in the treemacs buffer (unlike dotfiles)
whose presence is controlled by `treemacs-show-hidden-files').
Each predicate is a function that takes 2 arguments: a files's name and its
Each predicate is a function that takes 2 arguments: a file's name and its
absolute path and returns t if the file should be ignored and nil otherwise. A
file which returns t for *any* function in this list counts as ignored.
By default this list contains `treemacs--std-ignore-file-predicate' which
filters out '.', '..', Emacs' lock files as well as flycheck's temp files, and
therefore should not be directly overwritten, but added to and removed from
filters out '.', '..', Emacs' lock files as well temp files created by flycheck,
and therefore should not be directly overwritten, but added to and removed from
instead.
Additionally `treemacs--mac-ignore-file-predicate' is also included on
Mac-derived operating systems (when `system-type' is `darwin')."
@@ -291,7 +308,7 @@ functions in this list will be called on files just before they would be
rendered, when the files' git status information is now available. This for
example allows to make files ignored by git invisible.
The functions in this list are therefore expected to have a different signature:
They must take two arguments - a file's absolute path and a hashtable that maps
They must take two arguments - a file's absolute path and a hash table that maps
files to their git status. The files' paths are the table's keys, its values are
characters (and not strings) indicating the file's git condition. The chars map
map as follows: (the pattern is derived from 'git status --porcelain')
@@ -323,19 +340,19 @@ See also `treemacs-filewatch-mode'."
:group 'treemacs)
(defcustom treemacs-goto-tag-strategy 'refetch-index
"Inidicates how to move to a tag when its buffer is dead.
"Indicates how to move to a tag when its buffer is dead.
The tags in the treemacs view store their position as markers (or overlays if
semantic mode is on) pointing to a buffer. If that buffer is killed, or has
never really been open, as treemacs kills buffer after fetching their tags if
they did no exist before, the stored positions become stale, and treemacs needs
to use a different method to move to that tag. This variale sets that method.
to use a different method to move to that tag. This variable sets that method.
Its possible values are:
* refetch-index
Call up the file's imenu index again and use its information to jump.
* call-xref
Call `xref-find-definitions' to find the tag. Only available since Emacs 25.
Call `xref-find-definitions' to find the tag.
* issue-warning
Just issue a warning that the tag's position pointer is invalid."
:type 'integer
@@ -349,7 +366,7 @@ directory.
The value determines how many directories can be collapsed at once, both as a
performance cap and to prevent too long directory names in the treemacs view.
To minimize this option's impact on display performace the search for
To minimise this option's impact on display performance the search for
directories to collapse is done asynchronously in a python script and will thus
only work when python installed. The script should work both on python 2 and 3."
:type 'integer
@@ -376,6 +393,11 @@ The change will apply the next time a treemacs buffer is created."
:type 'boolean
:group 'treemacs)
(defcustom treemacs-expand-added-projects t
"When non-nil newly added projects will be expanded."
:type 'boolean
:group 'treemacs)
(defcustom treemacs-recenter-after-project-jump 'always
"Decides when to recenter view after moving between projects.
Specifically applies to calling `treemacs-next-project' and
@@ -407,7 +429,7 @@ Possible values are:
(defcustom treemacs-pulse-on-success t
"When non-nil treemacs will pulse the current line as a success indicator.
This applies to actions like `treemacs-copy-path-at-point'."
This applies to actions like `treemacs-copy-relative-path-at-point'."
:type 'boolean
:group 'treemacs)
@@ -483,7 +505,9 @@ Note that this does *not* take `scroll-margin' into account."
2)))
"The value for `imenu-generic-expression' treemacs uses in elisp buffers.
More discriminating than the default as it distinguishes between functions,
inline functions, macros, faces, variables, customizations and types."
inline functions, macros, faces, variables, customisations and types.
Can be set to nil to use the default value."
:type 'alist
:group 'treemacs)
@@ -521,39 +545,17 @@ missing project will not appear in the project list next time Emacs is started."
(defcustom treemacs--fringe-indicator-bitmap
(if (fboundp 'define-fringe-bitmap)
(define-fringe-bitmap 'treemacs--fringe-indicator-bitmap
(vector #b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111
#b00000111))
(define-fringe-bitmap 'treemacs--fringe-indicator-bitmap-default (make-vector 200 #b00000111))
'vertical-bar)
"The fringe bitmap used by the fringe-indicator minor mode."
:type 'fringe-bitmap
:options (if (fboundp 'fringe-bitmaps)
(cons 'treemacs--fringe-indicator-bitmap fringe-bitmaps)
nil)
:type (append '(choice)
;; :type is evaluated before the call to define-fringe-bitmap
;; so 'treemacs--fringe-indicator-bitmap-default is not yet in
;; fringe-bitmaps
'((const treemacs--fringe-indicator-bitmap-default))
;; `fringe-bitmpas' is void in the CI build Emacs
(when (bound-and-true-p fringe-bitmaps)
(mapcar (lambda (sym) `(const ,sym)) fringe-bitmaps)))
:group 'treemacs)
(defcustom treemacs-show-cursor nil
@@ -661,7 +663,7 @@ not apply to the simple `treemacs-git-mode.'"
(defcustom treemacs-python-executable (treemacs--find-python3)
"The python executable used by treemacs.
An asynchronous python process is used in two optional feaures:
An asynchronous python process is used in two optional features:
`treemacs-collapse-dirs' and the extended variant of `treemacs-git-mode'.
There is generally only one reason to change this value: an extended
@@ -675,8 +677,8 @@ the python3 binary."
"Text to be appended to treemacs' git command.
With `treemacs-git-mode' the command `git status --porcelain --ignored .' is
run to fetch a directory's git information. The content of this variable will
be appended to this git command. This might be useful in cases when git's
output is so large that it leads to palpable delays, while setting
be appended to this git command. This might be useful in cases when the output
produced by git is so large that it leads to palpable delays, while setting
`treemacs-max-git-entries' leads to loss of information. In such a scenario an
additional filter statement (for example `| grep -v \"/vendor_dir/\"') can be
used to reduce the size of the output to a manageable volume for treemacs."
@@ -691,6 +693,14 @@ In practice means that treemacs will become invisible to commands like
:type 'boolean
:group 'treemacs-window)
(defcustom treemacs-window-background-color nil
"Custom background colours for the treemacs window.
Value must be a cons cell consisting of two colours: first the background of the
treemacs window proper, then a second colour for treemacs' `hl-line' overlay
marking the selected line."
:type '(cons color color)
:group 'treemacs-window)
(defcustom treemacs-width 35
"Width of the treemacs window."
:type 'integer
@@ -701,7 +711,7 @@ In practice means that treemacs will become invisible to commands like
On the one hand this will alleviate issues of unequally sized window splits when
treemacs is visible (since Emacs does not quite understand that treemacs has
fixed window size). On the other hand it may lead to issues with other packages
like shell-pop, as making treemacs a side-window makes it unsplittable."
like shell-pop, as making treemacs a side-window renders it un-splittable."
:type 'boolean
:group 'treemacs-window)
@@ -709,7 +719,7 @@ like shell-pop, as making treemacs a side-window makes it unsplittable."
"When non-nil treemacs will have the `no-delete-other-windows' parameter.
This parameter prevents the treemacs window from closing when calling
`delete-other-windows' or when a command like `magit-status' would launch a new
fullscreen buffer.
full-screen buffer.
Note that treemacs has its own delete-windows command with
`treemacs-delete-other-windows' that behaves the same as `delete-other-windows',
but won't close treemacs itself.
@@ -757,7 +767,7 @@ deleted."
(defcustom treemacs-rename-project-functions nil
"Hooks to run whenever a project is renamed.
Will be called with the renamed project and the old name as its argumens."
Will be called with the renamed project and the old name as its arguments."
:type 'hook
:group 'treemacs-hooks)
@@ -776,7 +786,7 @@ been deleted."
(defcustom treemacs-rename-workspace-functions nil
"Hooks to run whenever a workspace is renamed.
Will be called with the renamed workspace and the old name as its argumens."
Will be called with the renamed workspace and the old name as its arguments."
:type 'hook
:group 'treemacs-hooks)
@@ -860,10 +870,16 @@ The hooks will be run *after* the treemacs buffer was destroyed."
:type 'hook
:group 'treemacs-hooks)
(defcustom treemacs-select-hook nil
(define-obsolete-variable-alias 'treemacs-select-hook 'treemacs-select-functions "2.9")
(defcustom treemacs-select-functions nil
"Hooks to run when the treemacs window is selected.
This only applies to commands like `treemacs' or `treemacs-select-window', not
general window selection commands like `other-window'."
The hook should accept one argument which is a symbol describing treemacs'
visibility before the select was invoked, as it would have been returned by
`treemacs-current-visibility'.
This hook only applies to commands like `treemacs' or `treemacs-select-window',
not general window selection commands like `other-window'."
:type 'hook
:group 'treemacs-hooks)
@@ -880,7 +896,7 @@ current scope (frame or perspective) it was found for."
"Decides how treemacs determines a file's extension.
There are 2 options:
- An extension should be everything past the *last* period of the file name.
In this case this shoud be set to `treemacs-last-period-regex-value'
In this case this should be set to `treemacs-last-period-regex-value'
- An extension should be everything past the *first* period of the file name.
In this case this should be set to `treemacs-first-period-regex-value'"
:group 'treemacs
@@ -894,10 +910,37 @@ If nil treemacs will look for default value provided by `spaceline', `moody'
or `doom-modeline' in that order. Finally, if none of these packages is
available \"Treemacs\" text will be displayed.
Setting this to `none' will disable the modeline.
For more specific information about formatting mode line check `mode-line-format'."
:type 'sexp
:group 'treemacs)
(defcustom treemacs-workspace-switch-cleanup nil
"Indicates which, if any, buffers should be deleted on a workspace switch.
Only applies when interactively calling `treemacs-switch-workspace'.
Valid values are
- nil to do nothing
- `files' to delete buffers visiting files
- `all' to delete all buffers other than treemacs and the scratch buffer
In any case treemacs itself and the scratch and messages buffer will be
unaffected."
:type '(choice (const :tag "All Buffers" all)
(const :tag "Only File Buffers" files)
(const :tag "None" nil))
:group 'treemacs)
(defcustom treemacs-imenu-scope 'everything
"Determines which items treemacs' imenu function will collect.
There are 2 options:
- `everything' will collect entries from every project in the workspace.
- `current-project' will only gather the index for the project at point."
:type '(choice (const :tag "Everything" everything)
(const :tag "Current Project Only" current-project))
:group 'treemacs)
(provide 'treemacs-customization)
;;; treemacs-customization.el ends here

View File

@@ -1,6 +1,6 @@
;;; treemacs-diagnostics.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

View File

@@ -72,7 +72,7 @@ def main():
break
else:
break
if depth > 0:
if depth > 0 and not ('"' in collapsed or '\\' in collapsed):
final_dir = steps[-1]
display_suffix = final_dir[len(current_dir):]
out.write("(" + '"' + display_suffix + '" ' + '"' + current_dir + '" ' + '"' + '" "'.join(steps) + '")')

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
@@ -29,7 +29,8 @@
(require 'inline)
(require 'treemacs-macros))
(cl-declaim (optimize (speed 3) (safety 0)))
(eval-when-compile
(cl-declaim (optimize (speed 3) (safety 0))))
(defvar-local treemacs-dom nil)
@@ -90,6 +91,9 @@ SELF: Dom Node Struct"
(inline-quote
(progn
(ht-remove! treemacs-dom (treemacs-dom-node->key ,self))
(let ((parent (treemacs-dom-node->parent ,self)))
(setf (treemacs-dom-node->children parent)
(delete ,self (treemacs-dom-node->children parent))))
(dolist (key (treemacs-dom-node->collapse-keys ,self))
(ht-remove! treemacs-dom key))))))
@@ -201,7 +205,7 @@ DOM-NODE: Dom Node Struct"
(defun treemacs--on-rename (old-name new-name dont-rename-initial)
"Renames dom entries after a file was renamed from OLD-NAME to NEW-NAME.
Renames the initial dom entry (the one backing the file that was acutally
Renames the initial dom entry (the one backing the file that was actually
renamed) only if DONT-RENAME-INITIAL is nil in case the entry is required for
filewatch-mode to work.
@@ -239,9 +243,9 @@ levels the one currently visiting.
NODE: Dom Node Struct
FN: (Dom Node) -> Any"
(declare (indent 1))
(funcall fn node)
(dolist (it (treemacs-dom-node->children node))
(treemacs-walk-dom it fn))
(funcall fn node))
(treemacs-walk-dom it fn)))
(defun treemacs-walk-dom-exclusive (node fn)
"Same as `treemacs-walk-dom', but start NODE will not be passed to FN.
@@ -263,9 +267,9 @@ levels the one currently visiting.
NODE: Dom Node Struct
FN: (Dom Node) -> Any"
(declare (indent 1))
(funcall fn node)
(dolist (it (treemacs-dom-node->reentry-nodes node))
(treemacs-walk-reentry-dom it fn))
(funcall fn node))
(treemacs-walk-reentry-dom it fn)))
(defun treemacs-walk-reentry-dom-exclusive (node fn)
"Same as `treemacs-walk-reentry-dom', but start NODE will not be passed to FN.

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
@@ -25,6 +25,7 @@
(require 'treemacs-rendering)
(require 'treemacs-core-utils)
(require 'treemacs-fringe-indicator)
(require 'treemacs-mouse-interface)
(eval-when-compile
(require 'treemacs-macros)
@@ -174,11 +175,11 @@ Optionally include MORE-PROPERTIES (like `face' or `display')."
Meant to be used as a `:render-action' for `treemacs-define-expandable-node'.
ICON is a simple string serving as the node's icon, and must be created with
`treemacs-as-icon'. If the icon is for a file you can also use
`treemacs-as-icon'. If the icon is for a file you can also use
`treemacs-icon-for-file'.
LABEL-FORM must return the string that will serve as the node's label text,
based on the element that should be rendered being bound as `item'. So for
based on the element that should be rendered being bound as `item'. So for
example if rendering a list of buffers RENDER-FORM would look like
`(buffer-name item)'.
@@ -188,7 +189,7 @@ FACE is its face.
KEY-FORM is the form that will give the node a unique key, necessary for
the node's (and the full custom tree's) ability to stay expanded and visible
when the project is refreshed, but also for compatiblity and integration with
when the project is refreshed, but also for compatibility and integration with
`follow-mode' and `filewatch-mode.'
MORE-PROPERTIES is a plist of text properties that can arbitrarily added to the
@@ -219,16 +220,16 @@ node for quick retrieval later."
"Define a type of node that is a leaf and cannot be further expanded.
Based on the given NAME this macro will define a `treemacs-${name}-state' state
variable and a `treemacs-${name}-icon' icon variable. If the icon should not be
variable and a `treemacs-${name}-icon' icon variable. If the icon should not be
static, and should be instead computed every time this node is rendered in its
parent's :render-action use 'dynamic-icon as a value for ICON.
The ICON is a string that should be created with `treemacs-as-icon'. If the icon
The ICON is a string that should be created with `treemacs-as-icon'. If the icon
is for a file you can also use `treemacs-icon-for-file'.
RET-ACTION, TAB-ACTION and MOUSE1-ACTION are function references that will be
invoked when RET or TAB are pressed or mouse1 is double-clicked a node of this
type. VISIT-ACTION is used in `treemacs-visit-node-no-split' actions."
type. VISIT-ACTION is used in `treemacs-visit-node-no-split' actions."
(declare (indent 1))
(let ((state-name (intern (format "treemacs-%s-state" name)))
(icon-name (intern (format "treemacs-%s-icon" name))))
@@ -252,48 +253,48 @@ type. VISIT-ACTION is used in `treemacs-visit-node-no-split' actions."
icon-closed
icon-open-form
icon-closed-form
query-function
render-action
query-function
ret-action
visit-action
after-expand
after-collapse
top-level-marker
root-marker
root-label
root-face
root-key-form)
"Define a type of node that can be further expanded.
root-key-form
top-level-marker)
"Define a type of node with given NAME that can be further expanded.
ICON-OPEN and ICON-CLOSED are strings and must be created by `treemacs-as-icon'.
They will be defvar'd as 'treemacs-icon-${name}-open/closed'.
As an alternative to static icons you can also supply ICON-OPEN-FORM and
ICON-CLOSED-FORM that will be dynamically executed whenever a new icon is
needed. Keep in mind that, since child nodes are first rendered by their
parents, a CLOSED-ICON-FORM will need to be repeated in the parent's
needed. Keep in mind that, since child nodes are first rendered by their
parents, an ICON-CLOSED-FORM will need to be repeated in the parent's
RENDER-ACTION.
QUERY-FUNCTION is a form and will be invoked when the node is expanded. It must
QUERY-FUNCTION is a form and will be invoked when the node is expanded. It must
provide the list of elements that will be rendered with RENDER-ACTION.
RENDER-ACTION is another form that will render the single items provided by
QUERY-FUNCTION. For every RENDER-FORM invocation the element to be rendered is
bound under the name `item'. The form itself should end in a call to
QUERY-FUNCTION. For every RENDER-FORM invocation the element to be rendered is
bound under the name `item'. The form itself should end in a call to
`treemacs-render-node'.
RET-ACTION will define what function is called when RET is pressed on this type
of node. Only RET, without TAB and mouse1 can be defined since for expandable
nodes both TAB and RET should toggle expansion/collapse. VISIT-ACTION is used in
of node. Only RET, without TAB and mouse1 can be defined since for expandable
nodes both TAB and RET should toggle expansion/collapse. VISIT-ACTION is used in
`treemacs-visit-node-no-split' actions.
AFTER-EXPAND and AFTER-COLLAPSE are optional forms that will be called after a
node has been expanded or collapsed. The closed or opened node marker will be
node has been expanded or collapsed. The closed or opened node marker will be
visible under the name `node' in their scope.
ROOT-MARKER is a simple boolean. It indicates the special case that the node
being defined is a top level entry point. When this value is non-nil this macro
ROOT-MARKER is a simple boolean. It indicates the special case that the node
being defined is a top level entry point. When this value is non-nil this macro
will create an additional function in the form `treemacs-${NAME}-extension'
that can be passed to `treemacs-define-project-extension'. It also means that
that can be passed to `treemacs-define-project-extension'. It also means that
the following pieces of additional information are required to render this node:
ROOT-LABEL is the displayed label of the root node.
@@ -304,9 +305,9 @@ ROOT-KEY-FORM is the form that will give the root node its unique key, the same
way as the KEY-FORM argument in `treemacs-render-node'.
TOP-LEVEL-MARKER works much the same way as ROOT-MARKER (and is mutually
exclusive with it). The difference is that it declares the node defined here to
a top-level element with nothing above it, like a project, instead of a
top-level node *inside* a project. Other than that things work the same. Setting
exclusive with it). The difference is that it declares the node defined here to
a top level element with nothing above it, like a project, instead of a
top level node *inside* a project. Other than that things work the same. Setting
TOP-LEVEL-MARKER will define a function named `treemacs-${NAME}-extension' that
can be passed to `treemacs-define-root-extension', and it requires the same
additional keys."
@@ -516,7 +517,7 @@ additional keys."
query-function
render-action
root-key-form)
"Define a variadic top-level node with given NAME.
"Define a variadic top level node with given NAME.
The term \"variadic\" means that the node will produce an unknown amount of
child nodes when expanded. For example think of an extension that groups buffers
based on the major mode, with each major-mode being its own top-level group, so
@@ -536,7 +537,7 @@ rules apply for QUERY-FUNCTION, RENDER-ACTION and ROOT-KEY-FORM."
:root-key-form ,root-key-form))
(defun treemacs-initialize ()
"Initialize treemacs in an external buffer for extension use."
"Initialise treemacs in an external buffer for extension use."
(treemacs--disable-fringe-indicator)
(treemacs-with-writable-buffer
(erase-buffer))

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
@@ -123,12 +123,12 @@ variant), so it will only be used if git-mode is disabled or set to simple."
:group 'treemacs-faces)
(defface treemacs-on-failure-pulse-face
'((t :foreground "#111111" :background "#ab3737"))
'((t :foreground "#111111" :background "#ab3737" :extend t))
"Pulse face used when an error occurs or an action fails."
:group 'treemacs-faces)
(defface treemacs-on-success-pulse-face
'((t :foreground "#111111" :background "#669966"))
'((t :foreground "#111111" :background "#669966" :extend t))
"Pulse face used to signal a successful action."
:group 'treemacs-faces)

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,7 +30,7 @@
(require 'treemacs-core-utils)
(require 'treemacs-async)
(require 'treemacs-dom)
(require 'treemacs-tags)
(require 'treemacs-rendering)
(eval-when-compile
(require 'treemacs-macros)
(require 'inline))
@@ -62,6 +62,14 @@ buffers watching that path, its cdr is the watch descriptor.")
"Timer that will run a refresh after `treemacs-file-event-delay' ms.
Stored here to allow it to be cancelled by a manual refresh.")
(define-inline treemacs--start-filewatch-timer ()
"Start the filewatch timer if it is not already running."
(inline-quote
(unless treemacs--refresh-timer
(setf treemacs--refresh-timer
(run-with-timer (/ treemacs-file-event-delay 1000) nil
#'treemacs--process-file-events)))))
(define-inline treemacs--cancel-refresh-timer ()
"Cancel a the running refresh timer if it is active."
(inline-quote
@@ -170,10 +178,8 @@ Also start the refresh timer if it's not started already."
('changed
(when (eq ,type 'deleted)
(setf (cdr current-flag) 'deleted))))))
(unless treemacs--refresh-timer
(setf treemacs--refresh-timer
(run-with-timer (/ treemacs-file-event-delay 1000) nil
#'treemacs--process-file-events))))))))
(treemacs--start-filewatch-timer))))))
(defun treemacs--filewatch-callback (event)
"Add EVENT to the list of file change events.
@@ -283,6 +289,7 @@ turn off all existing file watch processes and outstanding refresh actions."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(unless treemacs-filewatch-mode
(treemacs--tear-down-filewatch-mode)))

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
@@ -59,7 +59,7 @@ not visible."
(current-buffer (current-buffer))
(current-file (or (buffer-file-name current-buffer)
(when (eq major-mode 'dired-mode)
(treemacs--canonical-path (dired-current-directory))))))
(treemacs-canonical-path (dired-current-directory))))))
(when (and treemacs-window
current-file
(not (s-starts-with? treemacs--buffer-name-prefix (buffer-name current-buffer)))
@@ -106,6 +106,7 @@ This functionality can also be manually invoked with `treemacs-find-file'."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-follow-mode
(treemacs--setup-follow-mode)
(treemacs--tear-down-follow-mode)))

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
@@ -31,6 +31,12 @@
(defvar-local treemacs--fringe-indicator-overlay nil)
(defconst treemacs--fringe-overlay-before-string
(propertize
" " 'display
`(left-fringe ,treemacs--fringe-indicator-bitmap treemacs-fringe-indicator-face))
"The `before-string' property value used by the fringe indicator overlay.")
(define-inline treemacs--move-fringe-indicator-to-point ()
"Move the fringe indicator to the position of point."
(inline-quote
@@ -41,13 +47,10 @@
(defun treemacs--enable-fringe-indicator ()
"Enabled the fringe indicator in the current buffer."
(unless treemacs--fringe-indicator-overlay
(setq-local treemacs--fringe-indicator-overlay
(-let [ov (make-overlay 1 1 (current-buffer))]
(overlay-put ov 'before-string
(propertize " " 'display '(left-fringe
treemacs--fringe-indicator-bitmap
treemacs-fringe-indicator-face)))
ov))
(setq-local
treemacs--fringe-indicator-overlay
(-doto (make-overlay 1 1 (current-buffer))
(overlay-put 'before-string treemacs--fringe-overlay-before-string)))
(treemacs--move-fringe-indicator-to-point)))
(defun treemacs--disable-fringe-indicator ()
@@ -56,25 +59,71 @@
(delete-overlay treemacs--fringe-indicator-overlay)
(setf treemacs--fringe-indicator-overlay nil)))
(defun treemacs--setup-fringe-indicator-mode ()
"Setup `treemacs-fringe-indicator-mode'."
(treemacs-run-in-all-derived-buffers (treemacs--enable-fringe-indicator)))
(defun treemacs--show-fringe-indicator-only-when-focused (window)
"Hook to ensure the fringe indicator not shown when treemacs is not selected.
WINDOW is the treemacs window that has just been focused or unfocused."
(if (eq treemacs--in-this-buffer t)
(when treemacs--fringe-indicator-overlay
(overlay-put
treemacs--fringe-indicator-overlay 'before-string
treemacs--fringe-overlay-before-string))
(with-selected-window window
(when treemacs--fringe-indicator-overlay
(overlay-put
treemacs--fringe-indicator-overlay
'before-string nil)))))
(defun treemacs--tear-down-fringe-indicator-mode ()
"Tear down `treemacs-fringe-indicator-mode'."
(treemacs-run-in-all-derived-buffers (treemacs--disable-fringe-indicator)))
(treemacs-run-in-all-derived-buffers
(treemacs--disable-fringe-indicator)
(remove-hook 'window-selection-change-functions
#'treemacs--show-fringe-indicator-only-when-focused
:local)))
(define-minor-mode treemacs-fringe-indicator-mode
"Toggle `treemacs-fringe-indicator-mode'.
When enabled, a visual indicator in the fringe will be displayed to highlight the selected line even more.
Useful if hl-line-mode doesn't stand out enough with your color theme"
When enabled, a visual indicator in the fringe will be displayed to highlight
the selected line in addition to hl-line-mode. Useful if hl-line-mode doesn't
stand out enough with your color theme.
Can be called with one of two arguments:
- `always' will always show the fringe indicator.
- `only-when-focused' will only show the fringe indicator when the treemacs
window is focused (only possible with Emacs 27+).
For backward compatibility just enabling this mode without an explicit argument
has the same effect as using `always'."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-fringe-indicator-mode
(treemacs--setup-fringe-indicator-mode)
(progn
(setf arg (or arg t))
(if (memq arg '(always only-when-focused t))
(treemacs--setup-fringe-indicator-mode arg)
(call-interactively #'treemacs--setup-fringe-indicator-mode)))
(treemacs--tear-down-fringe-indicator-mode)))
(defun treemacs--setup-fringe-indicator-mode (arg)
"Setup `treemacs-fringe-indicator-mode'.
When ARG is `only-when-focused' a hook will be set up to only display the
fringe indicator when the treemacs window is selected."
(interactive (list (->> (completing-read "Fringe Indicator" '("Always" "Only When Focused"))
(downcase)
(s-split " ")
(s-join "-")
(intern))))
(setf treemacs-fringe-indicator-mode arg)
(treemacs-run-in-all-derived-buffers
(treemacs--enable-fringe-indicator)
(when (memq arg '(t only-when-focused))
(add-hook 'window-selection-change-functions
#'treemacs--show-fringe-indicator-only-when-focused
nil :local))))
(treemacs-only-during-init (treemacs-fringe-indicator-mode))
(provide 'treemacs-fringe-indicator)

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
@@ -16,7 +16,7 @@
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Varations of header-line-format treemacs can use.
;;; Variations of header-line-format treemacs can use.
;;; Code:
@@ -67,12 +67,12 @@
(let* ((menu
(easy-menu-create-menu
nil
`(["Edit Workspaces" treemacs-edit-workspaces]
["Create Workspace" treemacs-create-workspace]
["Remove Worspace" treemacs-remove-workspace]
["Rename Workspace" treemacs-rename-workspace]
["Switch Worspaces" treemacs-switch-workspace]
["Set Fallback Worspace" treemacs-set-fallback-workspace])))
`(["Edit Workspaces" treemacs-edit-workspaces]
["Create Workspace" treemacs-create-workspace]
["Remove Workspace" treemacs-remove-workspace]
["Rename Workspace" treemacs-rename-workspace]
["Switch Workspace" treemacs-switch-workspace]
["Set Fallback Workspace" treemacs-set-fallback-workspace])))
(choice (x-popup-menu event menu)))
(when choice (call-interactively (lookup-key menu (apply 'vector choice))))) )
'face 'treemacs-header-button-face)
@@ -109,7 +109,7 @@
" " treemacs-header-workspace-button
" " treemacs-header-toggles-button)
"Possible value setting for `treemacs-header-line-format'.
Conisits for 4 different buttons:
Consists for 4 different buttons:
- `treemacs-header-close-button'
- `treemacs-header-projects-button'
- `treemacs-header-workspace-button'

View File

@@ -0,0 +1,291 @@
;;; 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:
;;; Definition for the Helpful Hydras.
;;; NOTE: This module is lazy-loaded.
;;; Code:
(require 'cl-lib)
(require 'dash)
(require 'treemacs-logging)
(require 'treemacs-scope)
(require 'treemacs-interface)
(require 'treemacs-bookmarks)
(eval-when-compile
(require 'treemacs-macros))
(treemacs-import-functions-from "treemacs"
treemacs-edit-workspaces
treemacs-version)
(treemacs-import-functions-from "treemacs-hydras"
treemacs--common-helpful-hydra/body
treemacs--advanced-helpful-hydra/body)
(cl-defun treemacs--find-keybind (func &optional (pad 8))
"Find the keybind for FUNC in treemacs.
Return of cons of the key formatted for inclusion in the hydra string, including
a minimum PAD width for alignment, and the key itself for the hydra heads.
Prefer evil keybinds, otherwise pick the first result."
(-if-let (keys (where-is-internal func))
(let ((key
(key-description
(-if-let (evil-keys (--first (eq 'treemacs-state (aref it 0)) keys))
(--map (aref evil-keys it) (number-sequence 1 (- (length evil-keys) 1)))
(--map (aref (car keys) it) (number-sequence 0 (- (length (car keys)) 1)))))))
(setf key
(s-replace-all
'(("<return>" . "RET")
("<left>" . "LEFT")
("<right>" . "RIGHT")
("<up>" . "UP")
("<down>" . "DOWN")
("^" . "C-")
("⇢⌥" . ">O-")
("" . "O-")
("⇢⌘" . ">#-")
("" . "#-")
("" . "S-"))
key))
(cons (s-pad-right pad " " (format "_%s_:" key)) key))
(cons (s-pad-right pad " " (format "_%s_:" " ")) " ")))
;;;###autoload
(defun treemacs-common-helpful-hydra ()
"Summon a helpful hydra to show you the treemacs keymap.
This hydra will show the most commonly used keybinds for treemacs. For the more
advanced (probably rarely used keybinds) see `treemacs-advanced-helpful-hydra'.
The keybinds shown in this hydra are not static, but reflect the actual
keybindings currently in use (including evil mode). If the hydra is unable to
find the key a command is bound to it will show a blank instead."
(interactive)
(-if-let (b (treemacs-get-local-buffer))
(with-current-buffer b
(let*
((title (format (propertize "Treemacs %s Common Helpful Hydra" 'face 'treemacs-help-title-face) (treemacs-version)))
(adv-hint (format "%s %s"
(propertize "For advanced keybinds see" 'face 'treemacs-help-title-face)
(propertize "treemacs-advanced-helpful-hydra" 'face 'font-lock-function-name-face)))
(column-nav (propertize "Navigation" 'face 'treemacs-help-column-face))
(column-nodes (propertize "Opening Nodes" 'face 'treemacs-help-column-face))
(column-toggles (propertize "Toggles " 'face 'treemacs-help-column-face))
(column-projects (propertize "Projects" 'face 'treemacs-help-column-face))
(key-adv-hydra (treemacs--find-keybind #'treemacs-advanced-helpful-hydra))
(key-root-up (treemacs--find-keybind #'treemacs-root-up))
(key-root-down (treemacs--find-keybind #'treemacs-root-down))
(key-next-line (treemacs--find-keybind #'treemacs-next-line))
(key-prev-line (treemacs--find-keybind #'treemacs-previous-line))
(key-next-neighbour (treemacs--find-keybind #'treemacs-next-neighbour))
(key-prev-neighbour (treemacs--find-keybind #'treemacs-previous-neighbour))
(key-goto-parent (treemacs--find-keybind #'treemacs-goto-parent-node))
(key-down-next-w (treemacs--find-keybind #'treemacs-next-line-other-window))
(key-up-next-w (treemacs--find-keybind #'treemacs-previous-line-other-window))
(key-ret (treemacs--find-keybind #'treemacs-RET-action))
(key-tab (treemacs--find-keybind #'treemacs-TAB-action))
(key-open (treemacs--find-keybind #'treemacs-visit-node-no-split))
(key-open-horiz (treemacs--find-keybind #'treemacs-visit-node-horizontal-split))
(key-open-vert (treemacs--find-keybind #'treemacs-visit-node-vertical-split))
(key-open-ace (treemacs--find-keybind #'treemacs-visit-node-ace))
(key-open-ace-h (treemacs--find-keybind #'treemacs-visit-node-ace-horizontal-split))
(key-open-ace-v (treemacs--find-keybind #'treemacs-visit-node-ace-vertical-split))
(key-open-ext (treemacs--find-keybind #'treemacs-visit-node-in-external-application))
(key-open-mru (treemacs--find-keybind #'treemacs-visit-node-in-most-recently-used-window))
(key-close-above (treemacs--find-keybind #'treemacs-collapse-parent-node))
(key-follow-mode (treemacs--find-keybind #'treemacs-follow-mode))
(key-fringe-mode (treemacs--find-keybind #'treemacs-fringe-indicator-mode))
(key-fwatch-mode (treemacs--find-keybind #'treemacs-filewatch-mode))
(key-git-mode (treemacs--find-keybind #'treemacs-git-mode))
(key-show-dotfiles (treemacs--find-keybind #'treemacs-toggle-show-dotfiles))
(key-toggle-width (treemacs--find-keybind #'treemacs-toggle-fixed-width))
(key-add-project (treemacs--find-keybind #'treemacs-add-project-to-workspace 12))
(key-remove-project (treemacs--find-keybind #'treemacs-remove-project-from-workspace 12))
(key-rename-project (treemacs--find-keybind #'treemacs-rename-project 12))
(hydra-str
(format
"
%s
%s (%s)
%s ^^^^^^^^│ %s ^^^^^^^^^^^│ %s ^^^^^^│ %s
――――――――――――――――――――――――┼――――――――――――――――――――――――――――┼―――――――――――――――――――――――――┼――――――――――――――――――――――――――
%s next Line ^^^^│ %s dwim TAB ^^^^│ %s follow mode ^^^^│ %s add project
%s prev line ^^^^│ %s dwim RET ^^^^│ %s filewatch mode ^^^^│ %s remove project
%s next neighbour ^^^^│ %s open no split ^^^^│ %s git mode ^^^^│ %s rename project
%s prev neighbour ^^^^│ %s open horizontal ^^^^│ %s show dotfiles ^^^^│
%s goto parent ^^^^│ %s open vertical ^^^^│ %s resizability ^^^^│
%s down next window ^^^^│ %s open ace ^^^^│ %s fringe indicator ^^^^│
%s up next window ^^^^│ %s open ace horizontal ^^^^│ │
%s root up ^^^^│ %s open ace vertical ^^^^│ │
%s root down ^^^^│ %s open mru window ^^^^│ │
│ %s open externally ^^^^│ │
│ %s close parent ^^^^│ │
"
title
adv-hint (car (s-split":" (car key-adv-hydra)))
column-nav column-nodes column-toggles column-projects
(car key-next-line) (car key-tab) (car key-follow-mode) (car key-add-project)
(car key-prev-line) (car key-ret) (car key-fwatch-mode) (car key-remove-project)
(car key-next-neighbour) (car key-open) (car key-git-mode) (car key-rename-project)
(car key-prev-neighbour) (car key-open-horiz) (car key-show-dotfiles)
(car key-goto-parent) (car key-open-vert) (car key-toggle-width)
(car key-down-next-w) (car key-open-ace) (car key-fringe-mode)
(car key-up-next-w) (car key-open-ace-h)
(car key-root-up) (car key-open-ace-v)
(car key-root-down) (car key-open-mru)
(car key-open-ext)
(car key-close-above))))
(eval
`(defhydra treemacs--common-helpful-hydra (:exit nil :hint nil :columns 4)
,hydra-str
(,(cdr key-adv-hydra) #'treemacs-advanced-helpful-hydra :exit t)
(,(cdr key-next-line) #'treemacs-next-line)
(,(cdr key-prev-line) #'treemacs-previous-line)
(,(cdr key-root-up) #'treemacs-root-up)
(,(cdr key-root-down) #'treemacs-root-down)
(,(cdr key-down-next-w) #'treemacs-next-line-other-window)
(,(cdr key-up-next-w) #'treemacs-previous-line-other-window)
(,(cdr key-next-neighbour) #'treemacs-next-neighbour)
(,(cdr key-prev-neighbour) #'treemacs-previous-neighbour)
(,(cdr key-goto-parent) #'treemacs-goto-parent-node)
(,(cdr key-ret) #'treemacs-RET-action)
(,(cdr key-tab) #'treemacs-TAB-action)
(,(cdr key-open) #'treemacs-visit-node-no-split)
(,(cdr key-open-horiz) #'treemacs-visit-node-horizontal-split)
(,(cdr key-open-vert) #'treemacs-visit-node-vertical-split)
(,(cdr key-open-ace) #'treemacs-visit-node-ace)
(,(cdr key-open-ace-h) #'treemacs-visit-node-ace-horizontal-split)
(,(cdr key-open-ace-v) #'treemacs-visit-node-ace-vertical-split)
(,(cdr key-open-mru) #'treemacs-visit-node-in-most-recently-used-window)
(,(cdr key-open-ext) #'treemacs-visit-node-in-external-application)
(,(cdr key-close-above) #'treemacs-collapse-parent-node)
(,(cdr key-follow-mode) #'treemacs-follow-mode)
(,(cdr key-show-dotfiles) #'treemacs-toggle-show-dotfiles)
(,(cdr key-toggle-width) #'treemacs-toggle-fixed-width)
(,(cdr key-fringe-mode) #'treemacs-fringe-indicator-mode)
(,(cdr key-git-mode) #'treemacs-git-mode)
(,(cdr key-fwatch-mode) #'treemacs-filewatch-mode)
(,(cdr key-add-project) #'treemacs-add-project-to-workspace)
(,(cdr key-remove-project) #'treemacs-remove-project-from-workspace)
(,(cdr key-rename-project) #'treemacs-rename-project)
("ESC" nil "Exit"))))
(treemacs--common-helpful-hydra/body))
(treemacs-log-failure "The helpful hydra cannot be summoned without an existing treemacs buffer.")))
(defalias 'treemacs-helpful-hydra #'treemacs-common-helpful-hydra)
;;;###autoload
(defun treemacs-advanced-helpful-hydra ()
"Summon a helpful hydra to show you the treemacs keymap.
This hydra will show the more advanced (rarely used) keybinds for treemacs. For
the more commonly used keybinds see `treemacs-common-helpful-hydra'.
The keybinds shown in this hydra are not static, but reflect the actual
keybindings currently in use (including evil mode). If the hydra is unable to
find the key a command is bound to it will show a blank instead."
(interactive)
(-if-let (b (treemacs-get-local-buffer))
(with-current-buffer b
(let*
((title (format (propertize "Treemacs %s Advanced Helpful Hydra" 'face 'treemacs-help-title-face) (treemacs-version)))
(column-files (propertize "File Management" 'face 'treemacs-help-column-face))
(column-ws (propertize "Workspaces" 'face 'treemacs-help-column-face))
(column-misc (propertize "Misc." 'face 'treemacs-help-column-face))
(common-hint (format "%s %s"
(propertize "For common keybinds see" 'face 'treemacs-help-title-face)
(propertize "treemacs-common-helpful-hydra" 'face 'font-lock-function-name-face)))
(key-common-hydra (treemacs--find-keybind #'treemacs-common-helpful-hydra))
(key-create-file (treemacs--find-keybind #'treemacs-create-file))
(key-create-dir (treemacs--find-keybind #'treemacs-create-dir))
(key-rename (treemacs--find-keybind #'treemacs-rename))
(key-delete (treemacs--find-keybind #'treemacs-delete))
(key-copy-file (treemacs--find-keybind #'treemacs-copy-file))
(key-move-file (treemacs--find-keybind #'treemacs-move-file))
(key-refresh (treemacs--find-keybind #'treemacs-refresh))
(key-set-width (treemacs--find-keybind #'treemacs-set-width))
(key-copy-path-abs (treemacs--find-keybind #'treemacs-copy-absolute-path-at-point))
(key-copy-path-rel (treemacs--find-keybind #'treemacs-copy-relative-path-at-point))
(key-copy-root (treemacs--find-keybind #'treemacs-copy-project-path-at-point))
(key-resort (treemacs--find-keybind #'treemacs-resort))
(key-bookmark (treemacs--find-keybind #'treemacs-add-bookmark))
(key-edit-ws (treemacs--find-keybind #'treemacs-edit-workspaces 12))
(key-create-ws (treemacs--find-keybind #'treemacs-create-workspace 12))
(key-remove-ws (treemacs--find-keybind #'treemacs-remove-workspace 12))
(key-rename-ws (treemacs--find-keybind #'treemacs-rename-workspace 12))
(key-switch-ws (treemacs--find-keybind #'treemacs-switch-workspace 12))
(key-fallback-ws (treemacs--find-keybind #'treemacs-set-fallback-workspace 12))
(hydra-str
(format
"
%s
%s (%s)
%s ^^^^^^^^^^^^^│ %s ^^^^^^^^│ %s
――――――――――――――――――――┼―――――――――――――――――――――――――――――┼―――――――――――――――――――――
%s create file ^^^^│ %s Edit Workspaces ^^^^^^^^│ %s refresh
%s create dir ^^^^│ %s Create Workspace ^^^^^^^^│ %s (re)set width
%s rename ^^^^│ %s Remove Workspace ^^^^^^^^│ %s copy path absolute
%s delete ^^^^│ %s Rename Workspace ^^^^^^^^│ %s copy path relative
%s copy ^^^^│ %s Switch Workspace ^^^^^^^^│ %s copy root path
%s move ^^^^│ %s Set Fallback ^^^^^^^^│ %s re-sort
│ │ %s bookmark
"
title
common-hint (car (s-split":" (car key-common-hydra)))
column-files column-ws column-misc
(car key-create-file) (car key-edit-ws) (car key-refresh)
(car key-create-dir) (car key-create-ws) (car key-set-width)
(car key-rename) (car key-remove-ws) (car key-copy-path-abs)
(car key-delete) (car key-rename-ws) (car key-copy-path-rel)
(car key-copy-file) (car key-switch-ws) (car key-copy-root)
(car key-move-file) (car key-fallback-ws) (car key-resort)
(car key-bookmark))))
(eval
`(defhydra treemacs--advanced-helpful-hydra (:exit nil :hint nil :columns 3)
,hydra-str
(,(cdr key-common-hydra) #'treemacs-common-helpful-hydra :exit t)
(,(cdr key-create-file) #'treemacs-create-file)
(,(cdr key-create-dir) #'treemacs-create-dir)
(,(cdr key-rename) #'treemacs-rename)
(,(cdr key-delete) #'treemacs-delete)
(,(cdr key-copy-file) #'treemacs-copy-file)
(,(cdr key-move-file) #'treemacs-move-file)
(,(cdr key-refresh) #'treemacs-refresh)
(,(cdr key-set-width) #'treemacs-set-width)
(,(cdr key-copy-path-rel) #'treemacs-copy-absolute-path-at-point)
(,(cdr key-copy-path-abs) #'treemacs-copy-relative-path-at-point)
(,(cdr key-copy-root) #'treemacs-copy-project-path-at-point)
(,(cdr key-resort) #'treemacs-resort)
(,(cdr key-bookmark) #'treemacs-add-bookmark)
(,(cdr key-edit-ws) #'treemacs-edit-workspaces)
(,(cdr key-create-ws) #'treemacs-create-workspace)
(,(cdr key-remove-ws) #'treemacs-remove-workspace)
(,(cdr key-rename-ws) #'treemacs-rename-workspace)
(,(cdr key-switch-ws) #'treemacs-switch-workspace)
(,(cdr key-fallback-ws) #'treemacs-set-fallback-workspace)
("ESC" nil "Exit"))))
(treemacs--advanced-helpful-hydra/body))
(treemacs-log-failure "The helpful hydra cannot be summoned without an existing treemacs buffer.")))
(provide 'treemacs-hydras)
;;; treemacs-hydras.el ends here

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
@@ -39,7 +39,7 @@
;; gap wherever treemacs places an icon, regardess of transparency.
;; Using xpm instead of png images is one way to work around this, but it degrades icon
;; quality to an unacceptable degree. Another way is to directly change images' :background
;; property. The backgrounds colors are derived from the current theme with `treemacs--setup-icon-highlight'
;; property. The backgrounds colours are derived from the current theme with `treemacs--setup-icon-highlight'
;; and saved in `treemacs--selected-icon-background' and `treemacs--not-selected-icon-background'.
;; Every icon string stores two images with the proper :background values in its properties
;; 'img-selected and 'img-unselected. The 'display property of the icon in the current line
@@ -53,12 +53,12 @@
(pcase (face-attribute 'default :background nil t)
('unspecified
(prog1 "#2d2d31"
(unless (boundp 'treemacs-no-load-time-warnings)
(message "[Treemacs] Warning: coudn't find default background color for icons, falling back on #2d2d31."))))
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: coudn't find default background colour for icons, falling back on #2d2d31."))))
('unspecified-bg
(prog1 "#2d2d31"
(unless (boundp 'treemacs-no-load-time-warnings)
(message "[Treemacs] Warning: background color is unspecified, icons will likely look wrong. Falling back on #2d2d31."))))
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: background colour is unspecified, icons will likely look wrong. Falling back on #2d2d31."))))
(other other)))
"Background for non-selected icons.")
@@ -67,7 +67,7 @@
(-let [bg (face-attribute 'hl-line :background nil t)]
(if (memq bg '(unspecified unspecified-b))
(prog1 treemacs--not-selected-icon-background
(unless (boundp 'treemacs-no-load-time-warnings)
(unless (or noninteractive (boundp 'treemacs-no-load-time-warnings))
(message "[Treemacs] Warning: couldn't find hl-line-mode's background color for icons, falling back on %s."
treemacs--not-selected-icon-background)))
bg)))
@@ -106,13 +106,24 @@ does not exist."
`(treemacs-theme->gui-icons theme))))
(ht-get icons ,ext)))
(define-inline treemacs--get-local-face-background (face)
"Get the `:background' of the given face.
Unlike `face-attribute' this will take the `faces-remapping-alist' into
account."
(declare (side-effect-free t))
(inline-letevals (face)
(inline-quote
(--if-let (car (alist-get ,face face-remapping-alist))
(plist-get it :background)
(face-attribute ,face :background nil t)))))
(defun treemacs--setup-icon-background-colors (&rest _)
"Align icon backgrounds with current Emacs theme.
Fetch the current Emacs theme's background & hl-line colors and inject them into
the gui icons of every theme in `treemacs--themes'.
Fetch the current Emacs theme's background & hl-line colours and inject them
into the gui icons of every theme in `treemacs--themes'.
Also called as advice after `load-theme', hence the ignored argument."
(let* ((default-background (face-attribute 'default :background nil t))
(hl-line-background (face-attribute 'hl-line :background nil t))
(let* ((default-background (treemacs--get-local-face-background 'default))
(hl-line-background (treemacs--get-local-face-background 'hl-line))
(test-icon (treemacs-get-icon-value 'dir-open))
(icon-background (treemacs--get-img-property (get-text-property 0 'img-unselected test-icon) :background))
(icon-hl-background (treemacs--get-img-property (get-text-property 0 'img-selected test-icon) :background)))
@@ -157,7 +168,7 @@ Aliased to the current theme's gui or tui icons.")
"List of icons with variables.
Every symbol S maps to a variable named \"treemacs-icons-S\". In addition S is
also the key for the icon in both `treemacs-gui-icons' and `treemacs-tui-icons'.
This combination alllows these icons-with-variables to be correctly changed in
This combination allows these icons-with-variables to be correctly changed in
`treemacs--select-icon-set'.")
(defvar treemacs--icon-size 22
@@ -181,11 +192,11 @@ Necessary since root icons are not rectangular."
(let ((height treemacs--icon-size)
(width treemacs--icon-size))
(when (and (integerp treemacs--icon-size)
(s-ends-with? "root.png" ,file-path))
(s-starts-with? "root-" ,file-path))
(treemacs--root-icon-size-adjust width height))
(if (and (integerp treemacs--icon-size) (image-type-available-p 'imagemagick))
(create-image ,file-path 'imagemagick nil :ascent 'center :width width :height height)
(create-image ,file-path 'png nil :ascent 'center))))))
(create-image ,file-path 'png nil :ascent 'center :width width :height height))))))
(define-inline treemacs--create-icon-strings (file fallback)
"Create propertized icon strings for a given FILE image and TUI FALLBACK."
@@ -215,17 +226,17 @@ Necessary since root icons are not rectangular."
(cl-defmacro treemacs-create-icon (&key file icon (fallback " ") icons-dir extensions)
"Create an icon for the current theme.
- FILE is a file path relative to the icon directory of the current theme.
- ICON is a string of an already created icon. Mutually exclusive with FILE.
- ICON is a string of an already created icon. Mutually exclusive with FILE.
- FALLBACK is the fallback string for situations where png images are
unavailable.
- ICONS-DIR can optionally be used to overwrite the path used to find icons.
Normally the current theme's icon-path is used, but it may be convenient to
use another when calling `treemacs-modify-theme'.
- FALLBACK is the fallback string for situations where png images are
unavailable.
- EXTENSIONS is a list of file extensions the icon should be used for.
Note that treemacs has a loose understanding of what constitutes an extension:
it's either the text past the last period or the entire filename, so names
like \".gitignore\" and \"Makefile\" can be matched as well.
An extension may also be a symbol instead of a string. In this case treemacs
An extension may also be a symbol instead of a string. In this case treemacs
will also create a variable named \"treemacs-icon-%s\" making it universally
accessible."
(treemacs-static-assert (or (null icon) (null file))
@@ -258,25 +269,28 @@ Necessary since root icons are not rectangular."
:config
(progn
;; directory and other icons
(treemacs-create-icon :file "vsc/root-closed.png" :extensions (root) :fallback "")
(treemacs-create-icon :file "vsc/dir-closed.png" :extensions (dir-closed) :fallback (propertize "+ " 'face 'treemacs-term-node-face))
(treemacs-create-icon :file "vsc/dir-open.png" :extensions (dir-open) :fallback (propertize "- " 'face 'treemacs-term-node-face))
(treemacs-create-icon :file "tags-leaf.png" :extensions (tag-leaf) :fallback (propertize "" 'face 'font-lock-constant-face))
(treemacs-create-icon :file "tags-open.png" :extensions (tag-open) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "tags-closed.png" :extensions (tag-closed) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "error.png" :extensions (error) :fallback (propertize "" 'face 'font-lock-string-face))
(treemacs-create-icon :file "warning.png" :extensions (warning) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "info.png" :extensions (info) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "mail.png" :extensions (mail) :fallback " ")
(treemacs-create-icon :file "bookmark.png" :extensions (bookmark) :fallback " ")
(treemacs-create-icon :file "svgrepo/screen.png" :extensions (screen) :fallback " ")
(treemacs-create-icon :file "svgrepo/house.png" :extensions (house) :fallback " ")
(treemacs-create-icon :file "svgrepo/list.png" :extensions (list) :fallback " ")
(treemacs-create-icon :file "svgrepo/repeat.png" :extensions (repeat) :fallback " ")
(treemacs-create-icon :file "svgrepo/suitcase.png" :extensions (suitcase) :fallback " ")
(treemacs-create-icon :file "svgrepo/close.png" :extensions (close) :fallback " ")
(treemacs-create-icon :file "svgrepo/cal.png" :extensions (calendar) :fallback " ")
(treemacs-create-icon :file "svgrepo/briefcase.png" :extensions (briefcase) :fallback " ")
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
(treemacs-create-icon :file "vsc/root-closed.png" :extensions (root) :fallback "")
(treemacs-create-icon :file "vsc/root-closed.png" :extensions (root-closed) :fallback "")
(treemacs-create-icon :file "vsc/root-open.png" :extensions (root-open) :fallback "")
(treemacs-create-icon :file "vsc/dir-closed.png" :extensions (dir-closed) :fallback (propertize "+ " 'face 'treemacs-term-node-face))
(treemacs-create-icon :file "vsc/dir-open.png" :extensions (dir-open) :fallback (propertize "- " 'face 'treemacs-term-node-face))
(treemacs-create-icon :file "tags-leaf.png" :extensions (tag-leaf) :fallback (propertize "" 'face 'font-lock-constant-face))
(treemacs-create-icon :file "tags-open.png" :extensions (tag-open) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "tags-closed.png" :extensions (tag-closed) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "error.png" :extensions (error) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "warning.png" :extensions (warning) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "info.png" :extensions (info) :fallback (propertize " " 'face 'font-lock-string-face))
(treemacs-create-icon :file "mail.png" :extensions (mail) :fallback " ")
(treemacs-create-icon :file "bookmark.png" :extensions (bookmark) :fallback " ")
(treemacs-create-icon :file "svgrepo/screen.png" :extensions (screen) :fallback " ")
(treemacs-create-icon :file "svgrepo/house.png" :extensions (house) :fallback " ")
(treemacs-create-icon :file "svgrepo/list.png" :extensions (list) :fallback " ")
(treemacs-create-icon :file "svgrepo/repeat.png" :extensions (repeat) :fallback " ")
(treemacs-create-icon :file "svgrepo/suitcase.png" :extensions (suitcase) :fallback " ")
(treemacs-create-icon :file "svgrepo/close.png" :extensions (close) :fallback " ")
(treemacs-create-icon :file "svgrepo/cal.png" :extensions (calendar) :fallback " ")
(treemacs-create-icon :file "svgrepo/briefcase.png" :extensions (briefcase) :fallback " ")
;; file icons
(treemacs-create-icon :file "txt.png" :extensions (fallback))
@@ -391,7 +405,7 @@ Necessary since root icons are not rectangular."
(treemacs-create-icon :file "vsc/locale.png" :extensions ("locale"))
(treemacs-create-icon :file "vsc/manifest.png" :extensions ("manifest"))
(treemacs-create-icon :file "vsc/maven.png" :extensions ("pom.xml" "maven.config" "extensions.xml" "settings.xml"))
(treemacs-create-icon :file "vsc/meson.png" :extensions ("meson"))
(treemacs-create-icon :file "vsc/meson.png" :extensions ("meson" "meson.build"))
(treemacs-create-icon :file "vsc/nginx.png" :extensions ("nginx.conf" "nginx"))
(treemacs-create-icon :file "vsc/npm.png" :extensions ("npmignore" "npmrc" "package.json" "package-lock.json" "npm-shrinwrap.json"))
(treemacs-create-icon :file "vsc/wasm.png" :extensions ("wasm" "wat"))
@@ -433,11 +447,10 @@ Uses `treemacs-icon-fallback' as fallback."
(inline-letevals (file)
(inline-quote
(let ((file-downcased (-> ,file (treemacs--filename) (downcase))))
(ht-get treemacs-icons
file-downcased
(ht-get treemacs-icons
(treemacs--file-extension file-downcased)
(with-no-warnings treemacs-icon-fallback)))))))
(or (ht-get treemacs-icons file-downcased)
(ht-get treemacs-icons
(treemacs--file-extension file-downcased)
(with-no-warnings treemacs-icon-fallback)))))))
;;;###autoload
(defun treemacs-resize-icons (size)
@@ -509,7 +522,7 @@ name if there is no period. This makes it possible to match file names like
'.gitignore' and 'Makefile'.
Additionally FILE-EXTENSIONS are also not case sensitive and will be stored in a
downcased state."
down-cased state."
(unless icon
(user-error "Custom icon cannot be nil"))
(dolist (ext file-extensions)
@@ -523,7 +536,7 @@ downcased state."
EXTENSIONS should be a list of file extensions such that they match the regex
stored in `auto-mode-alist', for example '\(\".cc\"\).
MODE-ICON-ALIST is an alist that maps which mode from `auto-mode-alist' should
be assigned which treemacs icon, for exmaple
be assigned which treemacs icon, for example
'\(\(c-mode . treemacs-icon-c\)
\(c++-mode . treemacs-icon-cpp\)\)"
(dolist (extension extensions)

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)

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
@@ -20,10 +20,26 @@
;;; Code:
(require 'treemacs-customization)
(defvar treemacs--saved-eldoc-display nil
"Stores the value of `treemacs-eldoc-display'.
The value is set to nil and stashed here with every log statement to prevent the
logged message being almost immediately overridden by the eldoc output.
The value is also stashed as a single-item-list which serves as a check make
sure it isn't stashed twice (thus stashing the already disabled nil value).")
(defvar treemacs--no-messages nil
"When set to t `treemacs-log' will produce no output.
Not used directly, but as part of `treemacs-without-messages'.")
(defun treemacs--restore-eldoc-after-log ()
"Restore the stashed value of `treemacs-eldoc-display'."
(remove-hook 'pre-command-hook #'treemacs--restore-eldoc-after-log)
(setf treemacs-eldoc-display (car treemacs--saved-eldoc-display)
treemacs--saved-eldoc-display nil))
(defmacro treemacs-without-messages (&rest body)
"Temporarily turn off messages to execute BODY."
(declare (debug t))
@@ -32,8 +48,13 @@ Not used directly, but as part of `treemacs-without-messages'.")
(defmacro treemacs--do-log (prefix msg &rest args)
"Print a log statement with the given PREFIX and MSG and format ARGS."
`(unless treemacs--no-messages
(message "%s %s" ,prefix (format ,msg ,@args))))
`(progn
(unless (listp treemacs--saved-eldoc-display)
(setf treemacs--saved-eldoc-display (list treemacs-eldoc-display)))
(setf treemacs-eldoc-display nil)
(unless treemacs--no-messages
(message "%s %s" ,prefix (format ,msg ,@args)))
(add-hook 'post-command-hook #'treemacs--restore-eldoc-after-log)))
(defmacro treemacs-log (msg &rest args)
"Write an info/success log statement given format string MSG and ARGS."

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
@@ -52,7 +52,7 @@ interfere with auto-completion."
(list ,@error-args)))))
(defmacro treemacs-with-writable-buffer (&rest body)
"Temporarily turn off read-ony mode to execute BODY."
"Temporarily turn off read-only mode to execute BODY."
(declare (debug t))
`(let (buffer-read-only)
,@body))
@@ -61,7 +61,7 @@ interfere with auto-completion."
"Safely extract BUTTON's PROPERTIES.
Using `button-get' on a button located in a buffer that is not the current
buffer does not work, so this function will run the property extaction from
buffer does not work, so this function will run the property extraction from
inside BUTTON's buffer."
`(with-current-buffer (marker-buffer ,button)
,(if (= 1 (length properties))
@@ -104,7 +104,8 @@ Log ERROR-MSG if no button is selected, otherwise run BODY."
,@body))
(cl-defmacro treemacs-do-for-button-state
(&key on-root-node-open
(&key no-error
on-root-node-open
on-root-node-closed
on-file-node-open
on-file-node-closed
@@ -113,12 +114,15 @@ Log ERROR-MSG if no button is selected, otherwise run BODY."
on-tag-node-open
on-tag-node-closed
on-tag-node-leaf
on-nil
no-error)
on-nil)
"Building block macro to execute a form based on the current node state.
Will bind to current button to 'btn' for the executon of the action forms.
Will bind to current button to 'btn' for the execution of the action forms.
When NO-ERROR is non-nil no error will be thrown if no match for the button
state is achieved."
state is achieved.
Otherwise either one of ON-ROOT-NODE-OPEN, ON-ROOT-NODE-CLOSED,
ON-FILE-NODE-OPEN, ON-FILE-NODE-CLOSED, ON-DIR-NODE-OPEN, ON-DIR-NODE-CLOSED,
ON-TAG-NODE-OPEN, ON-TAG-NODE-CLOSED, ON-TAG-NODE-LEAF or ON-NIL will be
executed."
(declare (debug (&rest [sexp form])))
`(-if-let (btn (treemacs-current-button))
(pcase (treemacs-button-get btn :state)
@@ -154,26 +158,33 @@ state is achieved."
,on-nil))
(cl-defmacro treemacs--execute-button-action
(&key save-window
ensure-window-split
split-function
(&key no-match-explanation
window
split-function
save-window
ensure-window-split
dir-action
file-action
tag-section-action
tag-action
no-match-explanation)
tag-action)
"Infrastructure macro for setting up actions on different button states.
Fetches the currently selected button and verifies it's in the correct state
based on the given state actions.
If it isn't it will log NO-MATCH-EXPLANATION, if it is it selects WINDOW (or
`next-window' if none is given) and splits it with SPLIT-FUNCTION if given.
DIR-ACTION, FILE-ACTION, TAG-SECTION-ACTION and TAG-ACTION are inserted into a
`pcase' statement matching the buttons state. Project root nodes are treated the
same common directory nodes.
If ENSURE-WINDOW-SPLIT is t treemacs will vertically split the window if
If SAVE-WINDOW is non-nil the selected window will remain selected after the
actions have been executed.
If ENSURE-WINDOW-SPLIT is non-nil treemacs will vertically split the window if
treemacs is the only window to make sure a buffer is opened next to it, not
under or below it."
under or below it.
DIR-ACTION, FILE-ACTION, TAG-SECTION-ACTION and TAG-ACTION are inserted into a
`pcase' statement matching the buttons state. Project root nodes are treated
the same common directory nodes."
(declare (debug (&rest [sexp form])))
(let ((valid-states (list)))
(when dir-action
@@ -240,7 +251,7 @@ the on-delete code will run twice."
Finally execute FINAL-FORM after the code to restore the position has run.
This macro is meant for cases where a simple `save-excursion' will not do, like
a refresh, which can potentially change the entire buffer layout. In pratice
a refresh, which can potentially change the entire buffer layout. In practice
this means attempt first to keep point on the same file/tag, and if that does
not work keep it on the same line."
(declare (debug (form body)))
@@ -309,9 +320,19 @@ not work keep it on the same line."
(set-window-point (selected-window) buffer-point))))
,@final-form)))
(defmacro treemacs-with-workspace (workspace &rest body)
"Use WORKSPACE as the current workspace when running BODY.
Specifically this means that calls to `treemacs-current-workspace' will return
WORKSPACE and if no workspace has been set for the current scope yet it will not
be set either."
(declare (indent 1) (debug (form body)))
`(let ((treemacs-override-workspace ,workspace))
(ignore treemacs-override-workspace)
,@body))
(defmacro treemacs-run-in-every-buffer (&rest body)
"Run BODY once locally in every treemacs buffer.
Only includes treemacs filetree buffers, not extensions.
Only includes treemacs file tree buffers, not extensions.
Sets `treemacs-override-workspace' so calls to `treemacs-current-workspace'
return the workspace of the active treemacs buffer."
(declare (debug t))
@@ -319,14 +340,13 @@ return the workspace of the active treemacs buffer."
(let ((buffer (treemacs-scope-shelf->buffer shelf))
(workspace (treemacs-scope-shelf->workspace shelf)))
(when (buffer-live-p buffer)
(-let [treemacs-override-workspace workspace]
(ignore treemacs-override-workspace)
(treemacs-with-workspace workspace
(with-current-buffer buffer
,@body))))))
(defmacro treemacs-run-in-all-derived-buffers (&rest body)
"Run BODY once locally in every treemacs buffer.
Inluceds *all* treemacs-mode-derived buffers, including extensions."
Includes *all* treemacs-mode-derived buffers, including extensions."
(declare (debug t))
`(dolist (buffer (buffer-list))
(when (buffer-local-value 'treemacs--in-this-buffer buffer)
@@ -421,7 +441,7 @@ workspace. OP can be one of the following:
default to calling `treemacs-current-workspace'.
LEFT and RIGHT are expected to be in treemacs canonical file path format (see
also `treemacs--canonical-path').
also `treemacs-canonical-path').
Even if LEFT or RIGHT should be a form and not a variable it is guaranteed that
they will be evaluated only once."

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
@@ -45,11 +45,18 @@
treemacs-refresh
treemacs-version
treemacs-edit-workspaces)
(treemacs-import-functions-from "treemacs-bookmarks"
treemacs-add-bookmark
treemacs--make-bookmark-record)
(declare-function treemacs--helpful-hydra/body "treemacs-mode")
(treemacs-import-functions-from "treemacs-hydras"
treemacs-helpful-hydra
treemacs-common-helpful-hydra
treemacs-advanced-helpful-hydra)
(treemacs-import-functions-from "treemacs-tags"
treemacs--create-imenu-index-functione)
(defvar bookmark-make-record-function)
@@ -76,183 +83,6 @@ Will be set by `treemacs--post-command'.")
ob)
"Treemacs' own eldoc obarray.")
(cl-defun treemacs--find-keybind (func &optional (pad 8))
"Find the keybind for FUNC in treemacs.
Return of cons of the key formatted for inclusion in the hydra string, including
a minimum width for alignment, and the key itself for the hydra heads.
Prefer evil keybinds, otherwise pick the first result."
(-if-let (keys (where-is-internal func))
(let ((key
(key-description
(-if-let (evil-keys (--first (eq 'treemacs-state (aref it 0)) keys))
(--map (aref evil-keys it) (number-sequence 1 (- (length evil-keys) 1)))
(--map (aref (car keys) it) (number-sequence 0 (- (length (car keys)) 1)))))))
(setf key
(s-replace-all
'(("<return>" . "RET")
("<left>" . "LEFT")
("<right>" . "RIGHT")
("<up>" . "UP")
("<down>" . "DOWN")
("^" . "C-")
("⇢⌥" . ">O-")
("" . "O-")
("⇢⌘" . ">#-")
("" . "#-")
("" . "S-"))
key))
(cons (s-pad-right pad " " (format "_%s_:" key)) key))
(cons (s-pad-right pad " " (format "_%s_:" " ")) " ")))
(defun treemacs-helpful-hydra ()
"Summon the helpful hydra to show you the treemacs keymap.
If the hydra, for whatever reason, is unable the find the key a command is bound
to it will instead show a blank."
(interactive)
(-if-let (b (treemacs-get-local-buffer))
(with-current-buffer b
(let*
((title (format (propertize "Treemacs %s Helpful Hydra" 'face 'treemacs-help-title-face) (treemacs-version)))
(column-nav (propertize "Navigation" 'face 'treemacs-help-column-face))
(column-nodes (propertize "Opening Nodes" 'face 'treemacs-help-column-face))
(column-files (propertize "File Management" 'face 'treemacs-help-column-face))
(column-toggles (propertize "Toggles " 'face 'treemacs-help-column-face))
(column-projects (propertize "Projects" 'face 'treemacs-help-column-face))
(column-ws (propertize "Workspaces" 'face 'treemacs-help-column-face))
(column-misc (propertize "Misc." 'face 'treemacs-help-column-face))
(key-root-up (treemacs--find-keybind #'treemacs-root-up))
(key-root-down (treemacs--find-keybind #'treemacs-root-down))
(key-next-line (treemacs--find-keybind #'treemacs-next-line))
(key-prev-line (treemacs--find-keybind #'treemacs-previous-line))
(key-next-neighbour (treemacs--find-keybind #'treemacs-next-neighbour))
(key-prev-neighbour (treemacs--find-keybind #'treemacs-previous-neighbour))
(key-goto-parent (treemacs--find-keybind #'treemacs-goto-parent-node))
(key-ret (treemacs--find-keybind #'treemacs-RET-action))
(key-tab (treemacs--find-keybind #'treemacs-TAB-action))
(key-open (treemacs--find-keybind #'treemacs-visit-node-no-split))
(key-open-horiz (treemacs--find-keybind #'treemacs-visit-node-horizontal-split))
(key-open-vert (treemacs--find-keybind #'treemacs-visit-node-vertical-split))
(key-open-ace (treemacs--find-keybind #'treemacs-visit-node-ace))
(key-open-ace-h (treemacs--find-keybind #'treemacs-visit-node-ace-horizontal-split))
(key-open-ace-v (treemacs--find-keybind #'treemacs-visit-node-ace-vertical-split))
(key-open-ext (treemacs--find-keybind #'treemacs-visit-node-in-external-application))
(key-open-mru (treemacs--find-keybind #'treemacs-visit-node-in-most-recently-used-window))
(key-create-file (treemacs--find-keybind #'treemacs-create-file))
(key-create-dir (treemacs--find-keybind #'treemacs-create-dir))
(key-rename (treemacs--find-keybind #'treemacs-rename))
(key-delete (treemacs--find-keybind #'treemacs-delete))
(key-follow-mode (treemacs--find-keybind #'treemacs-follow-mode))
(key-fringe-mode (treemacs--find-keybind #'treemacs-fringe-indicator-mode))
(key-fwatch-mode (treemacs--find-keybind #'treemacs-filewatch-mode))
(key-git-mode (treemacs--find-keybind #'treemacs-git-mode))
(key-show-dotfiles (treemacs--find-keybind #'treemacs-toggle-show-dotfiles))
(key-toggle-width (treemacs--find-keybind #'treemacs-toggle-fixed-width))
(key-refresh (treemacs--find-keybind #'treemacs-refresh))
(key-set-width (treemacs--find-keybind #'treemacs-set-width))
(key-copy-path (treemacs--find-keybind #'treemacs-copy-path-at-point))
(key-copy-root (treemacs--find-keybind #'treemacs-copy-project-root))
(key-copy-file (treemacs--find-keybind #'treemacs-copy-file))
(key-move-file (treemacs--find-keybind #'treemacs-move-file))
(key-resort (treemacs--find-keybind #'treemacs-resort))
(key-bookmark (treemacs--find-keybind #'treemacs-add-bookmark))
(key-down-next-w (treemacs--find-keybind #'treemacs-next-line-other-window))
(key-up-next-w (treemacs--find-keybind #'treemacs-previous-line-other-window))
(key-add-project (treemacs--find-keybind #'treemacs-add-project-to-workspace 12))
(key-remove-project (treemacs--find-keybind #'treemacs-remove-project-from-workspace 12))
(key-rename-project (treemacs--find-keybind #'treemacs-rename-project 12))
(key-close-above (treemacs--find-keybind #'treemacs-collapse-parent-node))
(key-edit-ws (treemacs--find-keybind #'treemacs-edit-workspaces 12))
(key-create-ws (treemacs--find-keybind #'treemacs-create-workspace 12))
(key-remove-ws (treemacs--find-keybind #'treemacs-remove-workspace 12))
(key-rename-ws (treemacs--find-keybind #'treemacs-rename-workspace 12))
(key-switch-ws (treemacs--find-keybind #'treemacs-switch-workspace 12))
(key-fallback-ws (treemacs--find-keybind #'treemacs-set-fallback-workspace 12))
(hydra-str
(format
"
%s
%s │ %s │ %s │ %s │ %s │ %s │ %s
―――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
%s next Line │ %s dwim TAB │ %s create file │ %s follow mode │ %s add project │ %s Edit Workspaces │ %s refresh
%s prev line │ %s dwim RET │ %s create dir │ %s filewatch mode │ %s remove project │ %s Create Workspace │ %s (re)set width
%s next neighbour │ %s open no split │ %s rename │ %s git mode │ %s rename project │ %s Remove Workspace │ %s copy path
%s prev neighbour │ %s open horizontal │ %s delete │ %s show dotfiles │ │ %s Rename Workspace │ %s copy root
%s goto parent │ %s open vertical │ %s copy │ %s resizability │ │ %s Switch Workspace │ %s re-sort
%s down next window │ %s open ace │ %s move │ %s fringe indicator │ │ %s Set Fallback │ %s bookmark
%s up next window │ %s open ace horizontal │ │ │ │ │
%s root up │ %s open ace vertical │ │ │ │ │
%s root down │ %s open mru window │ │ │ │ │
│ %s open externally │ │ │ │ │
│ %s close parent │ │ │ │ │
"
title
column-nav column-nodes column-files column-toggles column-projects column-ws column-misc
(car key-next-line) (car key-tab) (car key-create-file) (car key-follow-mode) (car key-add-project) (car key-edit-ws) (car key-refresh)
(car key-prev-line) (car key-ret) (car key-create-dir) (car key-fwatch-mode) (car key-remove-project) (car key-create-ws) (car key-set-width)
(car key-next-neighbour) (car key-open) (car key-rename) (car key-git-mode) (car key-rename-project) (car key-remove-ws) (car key-copy-path)
(car key-prev-neighbour) (car key-open-horiz) (car key-delete) (car key-show-dotfiles) (car key-rename-ws) (car key-copy-root)
(car key-goto-parent) (car key-open-vert) (car key-copy-file) (car key-toggle-width) (car key-switch-ws) (car key-resort)
(car key-down-next-w) (car key-open-ace) (car key-move-file) (car key-fringe-mode) (car key-fallback-ws) (car key-bookmark)
(car key-up-next-w) (car key-open-ace-h)
(car key-root-up) (car key-open-ace-v)
(car key-root-down) (car key-open-mru)
(car key-open-ext)
(car key-close-above)
)))
(eval
`(defhydra treemacs--helpful-hydra (:exit nil :hint nil :columns 5)
,hydra-str
(,(cdr key-next-line) #'treemacs-next-line)
(,(cdr key-prev-line) #'treemacs-previous-line)
(,(cdr key-root-up) #'treemacs-root-up)
(,(cdr key-root-down) #'treemacs-root-down)
(,(cdr key-down-next-w) #'treemacs-next-line-other-window)
(,(cdr key-up-next-w) #'treemacs-previous-line-other-window)
(,(cdr key-next-neighbour) #'treemacs-next-neighbour)
(,(cdr key-prev-neighbour) #'treemacs-previous-neighbour)
(,(cdr key-goto-parent) #'treemacs-goto-parent-node)
(,(cdr key-ret) #'treemacs-RET-action)
(,(cdr key-tab) #'treemacs-TAB-action)
(,(cdr key-open) #'treemacs-visit-node-no-split)
(,(cdr key-open-horiz) #'treemacs-visit-node-horizontal-split)
(,(cdr key-open-vert) #'treemacs-visit-node-vertical-split)
(,(cdr key-open-ace) #'treemacs-visit-node-ace)
(,(cdr key-open-ace-h) #'treemacs-visit-node-ace-horizontal-split)
(,(cdr key-open-ace-v) #'treemacs-visit-node-ace-vertical-split)
(,(cdr key-open-mru) #'treemacs-visit-node-in-most-recently-used-window)
(,(cdr key-open-ext) #'treemacs-visit-node-in-external-application)
(,(cdr key-create-file) #'treemacs-create-file)
(,(cdr key-create-dir) #'treemacs-create-dir)
(,(cdr key-rename) #'treemacs-rename)
(,(cdr key-delete) #'treemacs-delete)
(,(cdr key-follow-mode) #'treemacs-follow-mode)
(,(cdr key-show-dotfiles) #'treemacs-toggle-show-dotfiles)
(,(cdr key-toggle-width) #'treemacs-toggle-fixed-width)
(,(cdr key-fringe-mode) #'treemacs-fringe-indicator-mode)
(,(cdr key-refresh) #'treemacs-refresh)
(,(cdr key-set-width) #'treemacs-set-width)
(,(cdr key-copy-path) #'treemacs-copy-path-at-point)
(,(cdr key-copy-root) #'treemacs-copy-project-root)
(,(cdr key-copy-file) #'treemacs-copy-file)
(,(cdr key-move-file) #'treemacs-move-file)
(,(cdr key-git-mode) #'treemacs-git-mode)
(,(cdr key-fwatch-mode) #'treemacs-filewatch-mode)
(,(cdr key-resort) #'treemacs-resort)
(,(cdr key-bookmark) #'treemacs-add-bookmark)
(,(cdr key-add-project) #'treemacs-add-project-to-workspace)
(,(cdr key-remove-project) #'treemacs-remove-project-from-workspace)
(,(cdr key-rename-project) #'treemacs-rename-project)
(,(cdr key-close-above) #'treemacs-collapse-parent-node)
(,(cdr key-edit-ws) #'treemacs-edit-workspaces)
(,(cdr key-create-ws) #'treemacs-create-workspace)
(,(cdr key-remove-ws) #'treemacs-remove-workspace)
(,(cdr key-rename-ws) #'treemacs-rename-workspace)
(,(cdr key-switch-ws) #'treemacs-switch-workspace)
(,(cdr key-fallback-ws) #'treemacs-set-fallback-workspace)
("?" nil "Exit"))))
(treemacs--helpful-hydra/body))
(treemacs-log-failure "The helpful hydra cannot be summoned without an existing treemacs buffer.")))
;; no warning - we cannot require treemacs.el where all the autoloaded functions
;; are defined or we get a recursive require, so it's either this or an equally
;; large block of `declare-function'
@@ -301,14 +131,16 @@ to it will instead show a blank."
"Keymap for commands that toggle state in `treemacs-mode'.")
(defvar treemacs-copy-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "y") #'treemacs-copy-path-at-point)
(define-key map (kbd "r") #'treemacs-copy-project-root)
(define-key map (kbd "a") #'treemacs-copy-absolute-path-at-point)
(define-key map (kbd "r") #'treemacs-copy-relative-path-at-point)
(define-key map (kbd "p") #'treemacs-copy-project-path-at-point)
(define-key map (kbd "f") #'treemacs-copy-file)
map)
"Keymap for copy commands in `treemacs-mode'.")
(defvar treemacs-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "?") #'treemacs-helpful-hydra)
(define-key map (kbd "?") #'treemacs-common-helpful-hydra)
(define-key map (kbd "C-?") #'treemacs-advanced-helpful-hydra)
(define-key map [down-mouse-1] #'treemacs-leftclick-action)
(define-key map [drag-mouse-1] #'treemacs-dragleftclick-action)
(define-key map [double-mouse-1] #'treemacs-doubleclick-action)
@@ -361,7 +193,9 @@ to it will instead show a blank."
"Create either a simple modeline, or integrate into spaceline."
(setq mode-line-format
(cond (treemacs-user-mode-line-format
treemacs-user-mode-line-format)
(if (eq 'none treemacs-user-mode-line-format)
nil
treemacs-user-mode-line-format))
((fboundp 'spaceline-install)
(spaceline-install
"treemacs" '((workspace-number
@@ -429,8 +263,10 @@ Will simply return `treemacs--eldoc-msg'."
;; and make a switch to visual state
(setq-local double-click-fuzz 15)
(setq-local show-paren-mode nil)
(setq-local tab-width 1)
(setq-local eldoc-documentation-function #'treemacs--eldoc-function)
(setq-local eldoc-message-commands treemacs--eldoc-obarray)
(setq-local imenu-create-index-function #'treemacs--create-imenu-index-function)
;; integrate with bookmark.el
(setq-local bookmark-make-record-function #'treemacs--make-bookmark-record)
(electric-indent-local-mode -1)
@@ -452,6 +288,14 @@ Will simply return `treemacs--eldoc-msg'."
;; the window config was changed to show treemacs
(unless (member #'treemacs--on-window-config-change (default-value 'window-configuration-change-hook))
(treemacs--on-window-config-change))
;; set the parameter immediately so it can take effect when `treemacs' is called programatically
;; alongside other window layout chaning commands that might delete it again
(set-window-parameter (selected-window) 'no-delete-other-windows treemacs-no-delete-other-windows)
(when treemacs-window-background-color
(face-remap-add-relative 'default :background (car treemacs-window-background-color))
(face-remap-add-relative 'fringe :background (car treemacs-window-background-color))
(face-remap-add-relative 'hl-line :background (cdr treemacs-window-background-color)))
(add-hook 'window-configuration-change-hook #'treemacs--on-window-config-change)
(add-hook 'kill-buffer-hook #'treemacs--on-buffer-kill nil t)

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
@@ -17,6 +17,7 @@
;;; Commentary:
;;; Functions relating to using the mouse in treemacs.
;;; NOTE: This module is lazy-loaded.
;;; Code:
@@ -34,6 +35,26 @@
(require 'cl-lib)
(require 'treemacs-macros))
(treemacs-import-functions-from "treemacs-interface"
treemacs-add-project-to-workspace)
(defvar treemacs--mouse-project-list-functions
'(("Add Project.el project" . treemacs--builtin-project-mouse-selection-menu)))
(defun treemacs--builtin-project-mouse-selection-menu ()
"Build a mouse selection menu for project.el projects."
(if (eq project--list 'unset)
(list (vector "Project.el list is empty" #'ignore))
(-let [projects
(->> project--list
(--map (treemacs-canonical-path (car it)))
(--reject (treemacs-is-path it :in-workspace))
(-sort #'string<))]
(if (null projects)
(list (vector "All Project.el projects are alread in the workspace" #'ignore))
(--map (vector it (lambda () (interactive) (treemacs-add-project-to-workspace it))) projects)))))
;;;###autoload
(defun treemacs-leftclick-action (event)
"Move focus to the clicked line.
Must be bound to a mouse click, or EVENT will not be supplied."
@@ -53,8 +74,9 @@ Must be bound to a mouse click, or EVENT will not be supplied."
:no-error t))
(treemacs--evade-image)))
;;;###autoload
(defun treemacs-doubleclick-action (event)
"Run the appropriate doubeclick action for the current node.
"Run the appropriate double-click action for the current node.
In the default configuration this means to do the same as `treemacs-RET-action'.
This function's exact configuration is stored in
@@ -74,6 +96,7 @@ Must be bound to a mouse click, or EVENT will not be supplied."
(treemacs-pulse-on-failure "No double click action defined for node of type %s."
(propertize (format "%s" state) 'face 'font-lock-type-face))))))
;;;###autoload
(defun treemacs-single-click-expand-action (event)
"A modified single-leftclick action that expands the clicked nodes.
Can be bound to <mouse1> if you prefer to expand nodes with a single click
@@ -100,6 +123,7 @@ Clicking on icons will expand a file's tags, just like
(funcall (cdr (assoc state treemacs-doubleclick-actions-config)))))
(treemacs--evade-image)))
;;;###autoload
(defun treemacs-dragleftclick-action (event)
"Drag a file/dir node to be opened in a window.
Must be bound to a mouse click, or EVENT will not be supplied."
@@ -113,6 +137,7 @@ Must be bound to a mouse click, or EVENT will not be supplied."
(find-file path))
:no-match-action (ignore))))))
;;;###autoload
(defun treemacs-define-doubleclick-action (state action)
"Define the behaviour of `treemacs-doubleclick-action'.
Determines that a button with a given STATE should lead to the execution of
@@ -196,6 +221,7 @@ and ignore any prefix argument."
(propertize (treemacs-with-button-buffer btn (treemacs--get-label-of btn)) 'face 'treemacs-tags-face)))
(_ (error "[Treemacs] '%s' is an invalid value for treemacs-goto-tag-strategy" treemacs-goto-tag-strategy)))))))
;;;###autoload
(defun treemacs-rightclick-menu (event)
"Show a contextual right click menu based on click EVENT."
(interactive "e")
@@ -232,22 +258,27 @@ and ignore any prefix argument."
["--" #'ignore :visible ,(check node)]
["Rename" treemacs-rename :visible ,(check node)]
["Delete" treemacs-delete :visible ,(check node)]
["Copy" treemacs-copy-file :visible ,(check node)]
["Move" treemacs-move-file :visible ,(check node)]
("Copy"
["Copy File" treemacs-copy-file :visible ,(check node)]
["Copy Absolute Path" treemacs-copy-absolute-path-at-point :visible ,(check node)]
["Copy Relative Path" treemacs-copy-relative-path-at-point :visible ,(check node)]
["Copy Project Path" treemacs-copy-project-path-at-point :visible ,(check node)])
["--" #'ignore t]
("Projects"
["Add Project" treemacs-add-project]
["Add Projectile Project" treemacs-projectile :visible (featurep 'treemacs-projectile)]
["Remove Project" treemacs-remove-project-from-workspace :visible ,(check project)]
["Rename Project" treemacs-rename-project :visible ,(check project)])
["Add Project" treemacs-add-project]
,@(--map `(,(car it) ,@(funcall (cdr it)))
treemacs--mouse-project-list-functions)
["Remove Project" treemacs-remove-project-from-workspace :visible ,(check project)]
["Rename Project" treemacs-rename-project :visible ,(check project)])
("Workspaces"
["Edit Workspaces" treemacs-edit-workspaces]
["Create Workspace" treemacs-create-workspace]
["Remove Worspace" treemacs-remove-workspace]
["Rename Workspace" treemacs-rename-workspace]
["Switch Worspaces" treemacs-switch-workspace]
["Set Fallback Worspace" treemacs-set-fallback-workspace])
["Edit Workspaces" treemacs-edit-workspaces]
["Create Workspace" treemacs-create-workspace]
["Remove Workspace" treemacs-remove-workspace]
["Rename Workspace" treemacs-rename-workspace]
["Switch Workspace" treemacs-switch-workspace]
["Set Fallback Workspace" treemacs-set-fallback-workspace])
("Toggles"
[,(format "Dotfile Visibility (Currently %s)"
(if treemacs-show-hidden-files "Enabled" "Disabled"))
@@ -265,8 +296,16 @@ and ignore any prefix argument."
["Show Helpful Hydra" treemacs-helpful-hydra]
["Show Active Extensions" treemacs-show-extensions]
["Show Changelog" treemacs-show-changelog]))))
(choice (x-popup-menu event menu)))
(when choice (call-interactively (lookup-key menu (apply 'vector choice))))
(choice (x-popup-menu event menu))
(cmd (lookup-key menu (apply 'vector choice))))
;; In the terminal clicking on a nested menu item does not expand it, but actually
;; selects it as the chosen use option. So as a workaround we need to manually go
;; thtough the menus until we land on an executable command.
(while (not (commandp cmd))
(setf menu choice
choice (x-popup-menu event cmd)
cmd (lookup-key cmd (apply 'vector choice))))
(when cmd (call-interactively cmd))
(hl-line-highlight)))))
(provide 'treemacs-mouse-interface)

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
@@ -33,7 +33,8 @@
(require 'inline)
(require 'treemacs-macros))
(cl-declaim (optimize (speed 3) (safety 0)))
(eval-when-compile
(cl-declaim (optimize (speed 3) (safety 0))))
(defconst treemacs--org-edit-buffer-name "*Edit Treemacs Workspaces*"
"The name of the buffer used to edit treemacs' workspace.")
@@ -96,7 +97,7 @@ SELF: Treemacs-Iter struct."
(defun treemacs--read-workspaces (iter)
"Read a list of workspaces from the lines in ITER.
ITER: Treemacs-Iter struct."
ITER: Treemacs-Iter Struct."
(let (workspaces)
(while (s-matches? treemacs--persist-workspace-name-regex (treemacs-iter->peek iter))
(-let [workspace (treemacs-workspace->create!)]
@@ -110,13 +111,17 @@ ITER: Treemacs-Iter struct."
(defun treemacs--read-projects (iter)
"Read a list of projects from ITER until another section is found.
ITER: Treemacs-Iter struct"
ITER: Treemacs-Iter Struct"
(let (projects)
(while (s-matches? treemacs--persist-project-name-regex (treemacs-iter->peek iter))
(let ((kv-lines nil)
(project (treemacs-project->create!)))
(setf (treemacs-project->name project)
(substring (treemacs-iter->next! iter) 3))
(project (treemacs-project->create!))
(project-name (substring (treemacs-iter->next! iter) 3))
(comment-prefix "COMMENT "))
(when (s-starts-with? comment-prefix project-name)
(setf project-name (substring project-name (length comment-prefix))
(treemacs-project->is-disabled? project) t))
(setf (treemacs-project->name project) project-name)
(while (s-matches? treemacs--persist-kv-regex (treemacs-iter->peek iter))
(push (treemacs-iter->next! iter) kv-lines))
(if (null kv-lines)
@@ -127,7 +132,7 @@ ITER: Treemacs-Iter struct"
(-let [(key val) (s-split " :: " kv-line)]
(pcase (s-trim key)
("- path"
(setf (treemacs-project->path project) (treemacs--canonical-path val)))
(setf (treemacs-project->path project) (treemacs-canonical-path val)))
(_
(treemacs-log-failure "Encountered unknown project key-value in line [%s]" kv-line)))))
(let ((action 'retry))
@@ -181,7 +186,10 @@ ITER: Treemacs-Iter struct"
(treemacs-workspaces)))
(push (format "* %s\n" (treemacs-workspace->name ws)) txt)
(dolist (pr (treemacs-workspace->projects ws))
(push (format "** %s\n" (treemacs-project->name pr)) txt)
(push (format "** %s%s\n"
(if (treemacs-project->is-disabled? pr) "COMMENT " "")
(treemacs-project->name pr))
txt)
(push (format " - path :: %s\n" (abbreviate-file-name (treemacs-project->path pr))) txt)))
(delete-region (point-min) (point-max))
(insert (apply #'concat (nreverse txt)))
@@ -200,28 +208,42 @@ Will read all lines, except those that start with # or contain only whitespace."
(s-starts-with? "#" it)))))
(cl-defun treemacs--validate-persist-lines
(lines &optional (context :start) (prev nil) (paths nil))
(lines &optional (context :start) (prev nil) (paths nil) (proj-count 0))
"Recursively verify the make-up of the given LINES, based on their CONTEXT.
Lines must start with a workspace name, followed by a project name, followed by
the project's path property, followed by either the next project or the next
workspace. The previously looked at line type is given by CONTEXT. PATHS contains
all the project paths previously seen in the current workspace. These are used to
make sure that no file path appears in the workspaces more than once.
workspace.
The previously looked at line type is given by CONTEXT.
The previously looked at line is given by PREV.
PATHS contains all the project paths previously seen in the current workspace.
These are used to make sure that no file path appears in the workspaces more
than once.
PROJ-COUNT counts the number of non-disabled projects in a workspace to make
sure that there is at least of project that will be displayed.
A successful validation returns just the symbol 'success, in case of an error a
list of 3 items is returned: the symbol 'error, the exact line where the error
happened, and the error message. In some circumstances (for example when a
happened, and the error message. In some circumstances (for example when a
project is missing a path property) it makes sense to display the error not in
the currently looked at line, but the one above, which is why the previously
looked at line PREV is given as well.
LINES: List of Strings
CONTEXT: Keyword"
CONTEXT: Keyword
PREV: String
PATHS: List<String>
PROJ-COUNT: Int"
(treemacs-block
(cl-labels ((as-warning (txt) (propertize txt 'face 'warning)))
(treemacs-unless-let (line (car lines))
(pcase context
(:property
(treemacs-return-if (= 0 proj-count)
`(error ,prev ,(as-warning "Workspace must contain at least 1 project that is not disabled.")))
(treemacs-return
'success))
(:start
@@ -234,18 +256,20 @@ CONTEXT: Keyword"
(:start
(treemacs-return-if (not (s-matches? treemacs--persist-workspace-name-regex line))
`(error ,line ,(as-warning "First item must be a workspace name")))
(treemacs--validate-persist-lines (cdr lines) :workspace line nil))
(treemacs--validate-persist-lines (cdr lines) :workspace line nil 0))
(:workspace
(treemacs-return-if (not (s-matches? treemacs--persist-project-name-regex line))
`(error ,line ,(as-warning "Workspace name must be followed by project name")))
(treemacs--validate-persist-lines (cdr lines) :project line nil))
(-let [proj-is-disabled? (s-starts-with? "** COMMENT" line)]
(unless proj-is-disabled? (cl-incf proj-count))
(treemacs--validate-persist-lines (cdr lines) :project line nil proj-count)))
(:project
(treemacs-return-if (not (s-matches? treemacs--persist-kv-regex line))
`(error ,prev ,(as-warning "Project name must be followed by path declaration")))
(-let [path (cadr (s-split " :: " line))]
;; Path not existing is only a hard error when org-editing, when loading on boot
;; its significance is determined by the customization setting
;; treemacs-missing-project-action. Remote files are skipped to avoid opening
;; `treemacs-missing-project-action'. Remote files are skipped to avoid opening
;; Tramp connections.
(treemacs-return-if (and (string= treemacs--org-edit-buffer-name (buffer-name))
(not (file-remote-p path))
@@ -255,15 +279,19 @@ CONTEXT: Keyword"
(--any (treemacs-is-path it :in path) paths))
`(error ,line ,(format (as-warning "Path '%s' appears in the workspace more than once.")
(propertize path 'face 'font-lock-string-face))))
(treemacs--validate-persist-lines (cdr lines) :property line (cons path paths))))
(treemacs--validate-persist-lines (cdr lines) :property line (cons path paths) proj-count)))
(:property
(let ((line-is-workspace-name (s-matches? treemacs--persist-workspace-name-regex line))
(line-is-project-name (s-matches? treemacs--persist-project-name-regex line)))
(cond
(line-is-workspace-name
(treemacs--validate-persist-lines (cdr lines) :workspace line nil))
(treemacs-return-if (= 0 proj-count)
`(error ,prev ,(as-warning "Workspace must contain at least 1 project that is not disabled.")))
(treemacs--validate-persist-lines (cdr lines) :workspace line nil 0))
(line-is-project-name
(treemacs--validate-persist-lines (cdr lines) :project line paths))
(-let [proj-is-disabled? (s-starts-with? "** COMMENT" line)]
(unless proj-is-disabled? (cl-incf proj-count))
(treemacs--validate-persist-lines (cdr lines) :project line paths proj-count)))
(t
(treemacs-return-if (-none? #'identity (list line-is-workspace-name line-is-project-name))
`(error ,prev ,(as-warning "Path property must be followed by the next workspace or project"))))))))))))

View File

@@ -1,5 +1,5 @@
(define-package "treemacs" "20200625.2056" "A tree style file explorer package"
'((emacs "25.2")
(define-package "treemacs" "20210107.1251" "A tree style file explorer package"
'((emacs "26.1")
(cl-lib "0.5")
(dash "2.11.0")
(s "1.12.0")
@@ -7,8 +7,9 @@
(ace-window "0.9.0")
(pfuture "1.7")
(hydra "0.13.2")
(ht "2.2"))
:commit "1ce0bd487f0b9178744e19bbc48b6692c55c590c" :authors
(ht "2.2")
(cfrs "1.3.2"))
:commit "c1109b9bd79f29078183a85646b7d95408604c36" :authors
'(("Alexander Miller" . "alexanderm@web.de"))
:maintainer
'("Alexander Miller" . "alexanderm@web.de")

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
@@ -228,9 +228,9 @@ DEPTH indicates how deep in the filetree the current button is."
;; TODO document open-action return strings
(cl-defmacro treemacs--button-open (&key button new-state new-icon open-action post-open-action immediate-insert)
"Building block macro to open a BUTTON.
Gives the button a NEW-STATE, and, optionally, a NEW-ICON. Performs OPEN-ACTION
and, optionally, POST-OPEN-ACTION. If IMMEDIATE-INSERT is non-nil it will concat
and apply `insert' on the items returned from OPEN-ACTION. If it is nil either
Gives the button a NEW-STATE, and, optionally, a NEW-ICON. Performs OPEN-ACTION
and, optionally, POST-OPEN-ACTION. If IMMEDIATE-INSERT is non-nil it will concat
and apply `insert' on the items returned from OPEN-ACTION. If it is nil either
OPEN-ACTION or POST-OPEN-ACTION are expected to take over insertion."
`(prog1
(save-excursion
@@ -253,9 +253,9 @@ OPEN-ACTION or POST-OPEN-ACTION are expected to take over insertion."
(when (equal parent (treemacs-button-get child :parent))
(forward-line 1))))))
(cl-defmacro treemacs--create-buttons (&key nodes depth extra-vars node-action node-name)
"Building block macro for creating buttons from a list of items.
Will not making any insertions, but instead return a list of strings returned by
(cl-defmacro treemacs--create-buttons (&key nodes node-action depth extra-vars node-name)
"Building block macro for creating buttons from a list of NODES.
Will not making any insertions, but instead return a list of strings created by
NODE-ACTION, so that the list can be further manipulated and efficiently
inserted in one go.
NODES is the list to create buttons from.
@@ -284,7 +284,7 @@ correct cache entries.
DIRS: List of Collapse Paths. Each Collapse Path is a list of
1) the extra text that must be appended in the view,
2) The original full and uncollapsed path,
2) The original full and un-collapsed path,
3) a series of intermediate steps which are the result of appending the
collapsed path elements onto the original, ending in
4) the full path to the
@@ -333,7 +333,7 @@ DIRS: List of Collapse Paths. Each Collapse Path is a list of
'(face treemacs-directory-collapsed-face)))))))))))
(defmacro treemacs--inplace-map-when-unrolled (items interval &rest mapper)
"Unrolled in-place mappig operation.
"Unrolled in-place mapping operation.
Maps ITEMS at given index INTERVAL using MAPPER function."
(declare (indent 2))
(let ((l (make-symbol "list"))
@@ -400,7 +400,8 @@ set to PARENT."
;; produce an empty hash table
(pcase treemacs-git-mode
((or 'simple 'extended)
(setq git-info (treemacs--get-or-parse-git-result ,git-future)))
(setf git-info (treemacs--get-or-parse-git-result ,git-future))
(ht-set! treemacs--git-cache ,root git-info))
('deferred
(setq git-info (or (ht-get treemacs--git-cache ,root) (ht)))
(run-with-timer 0.5 nil #'treemacs--apply-deferred-git-state ,parent ,git-future (current-buffer)))
@@ -452,8 +453,9 @@ set to PARENT."
(treemacs--reentry ,root ,git-future))
(point-at-eol))))))
(cl-defmacro treemacs--button-close (&key button new-state new-icon post-close-action)
"Close node given by BUTTON, use NEW-ICON and set state of BUTTON to NEW-STATE."
(cl-defmacro treemacs--button-close (&key button new-icon new-state post-close-action)
"Close node given by BUTTON, use NEW-ICON and BUTTON's state to NEW-STATE.
Run POST-CLOSE-ACTION after everything else is done."
`(save-excursion
(treemacs-with-writable-buffer
,@(when new-icon
@@ -495,6 +497,8 @@ set to PARENT."
:immediate-insert nil
:button btn
:new-state 'root-node-open
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
:new-icon (or treemacs-icon-root-open treemacs-icon-root)
:open-action
(progn
;; TODO(2019/10/14): go back to post open
@@ -515,6 +519,8 @@ Remove all open entries below BTN when RECURSIVE is non-nil."
(treemacs--button-close
:button btn
:new-state 'root-node-closed
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
:new-icon (or treemacs-icon-root-closed treemacs-icon-root)
:post-close-action
(-let [path (treemacs-button-get btn :path)]
(treemacs--stop-watching path)
@@ -524,7 +530,7 @@ Remove all open entries below BTN when RECURSIVE is non-nil."
"Open the node given by BTN.
BTN: Button
GIT-FUTURE: Pfuture|Hashtable
GIT-FUTURE: Pfuture|HashMap
RECURSIVE: Bool"
(-let [path (treemacs-button-get btn :path)]
(if (not (f-readable? path))
@@ -579,7 +585,8 @@ Remove all open dir and tag entries under BTN when RECURSIVE."
"Insert a new root node for the given PROJECT node.
PROJECT: Project Struct"
(insert treemacs-icon-root)
;; TODO(2020/12/30): temporary workaround for issues like #752, to be removed in 2 months
(insert (or treemacs-icon-root-closed treemacs-icon-root))
(let* ((pos (point-marker))
(path (treemacs-project->path project))
(dom-node (treemacs-dom-node->create! :key path :position pos)))
@@ -602,7 +609,8 @@ PROJECT: Project Struct"
(treemacs-with-writable-buffer
(unless treemacs--projects-end
(setq treemacs--projects-end (make-marker)))
(let* ((current-workspace (treemacs-current-workspace))
(let* ((projects (-reject #'treemacs-project->is-disabled? projects))
(current-workspace (treemacs-current-workspace))
(has-previous (treemacs--apply-root-top-extensions current-workspace)))
(--each projects
@@ -736,7 +744,7 @@ Specifically this will return the node *after* which to make the new insert.
Mostly this means the position before the first node for whose path returns
SORT-FUNCTION returns non-nil, but files and directories must be handled
propery,and edge cases for inserting at the end of the project and buffer must
properly,and edge cases for inserting at the end of the project and buffer must
be taken into account.
PATH: File Path
@@ -772,6 +780,7 @@ SORT-FUNCTION: Button -> Boolean."
(treemacs-find-file-node (treemacs-dom-node->key it)))))
;; after parent
parent-btn)
;; insert file ...
(or
;; at first file that fits sort order
@@ -782,15 +791,15 @@ SORT-FUNCTION: Button -> Boolean."
(--when-let (-last-item files)
(or (treemacs-dom-node->position it)
(treemacs-find-file-node (treemacs-dom-node->key it))) )
;; before first dir
(--when-let (car dirs)
(previous-button (or (treemacs-dom-node->position it)
(treemacs-find-file-node (treemacs-dom-node->key it)))))
;; after last dir
(--when-let (-last-item dirs)
(or (treemacs-dom-node->position it)
(treemacs-find-file-node (treemacs-dom-node->key it))))
;; after parent
parent-btn))))
(defun treemacs-do-insert-single-node (path parent-path)
"Insert single file node at given PATH and PARENT-PATH.
"Insert single file node at given PATH and below PARENT-PATH.
PATH: File Path
PARENT-PATH: File Path"
@@ -798,46 +807,121 @@ PARENT-PATH: File Path"
;; file events can be chaotic to the point that something is "created"
;; that is already present
(unless (treemacs-find-in-dom path)
(-let [parent-btn (treemacs-dom-node->position parent-dom-node)]
(if (and (file-directory-p path)
(null (treemacs-first-child-node-where parent-btn t)))
(treemacs-insert-new-flattened-directory path parent-btn parent-dom-node)
(when (treemacs-is-node-expanded? parent-btn)
(treemacs-with-writable-buffer
(let* ((sort-function (treemacs--get-sort-fuction))
(insert-after (treemacs--determine-insert-position path parent-btn sort-function)))
(goto-char insert-after)
(end-of-line)
(insert "\n" (treemacs--create-string-for-single-insert
path parent-btn (1+ (button-get parent-btn :depth))))
(-let [new-dom-node (treemacs-dom-node->create! :key path :parent parent-dom-node)]
(treemacs-dom-node->insert-into-dom! new-dom-node)
(treemacs-dom-node->add-child! parent-dom-node new-dom-node))
(when treemacs-git-mode
(treemacs-do-update-single-file-git-state path :exclude-parents :override-status))))))))))
(let* ((parent-btn (treemacs-dom-node->position parent-dom-node))
(parent-flatten-info (treemacs-button-get parent-btn :collapsed)))
(treemacs-with-writable-buffer
(if parent-flatten-info
(treemacs--insert-node-in-flattened-directory
path parent-btn parent-dom-node parent-flatten-info)
(treemacs--insert-single-node
path parent-btn parent-dom-node)))))))
(defun treemacs-insert-new-flattened-directory (path parent-btn parent-dom-node)
"Insert PATH as new flattened directory under PARENT-BTN.
Create a new dom node as child of PARENT-DOM-NODE and start watching PATH.
(defun treemacs--insert-single-node (created-path parent-btn parent-dom-node)
"Insert new CREATED-PATH below non-flattened directory at PARENT-BTN.
Will find the correct insert location, insert the necessary strings, and make
the necessary dom entries and adjust PARENT-DOM-NODE."
(let* ((sort-function (treemacs--get-sort-fuction))
(insert-after (treemacs--determine-insert-position created-path parent-btn sort-function)))
(goto-char insert-after)
(end-of-line)
(insert "\n" (treemacs--create-string-for-single-insert
created-path parent-btn (1+ (button-get parent-btn :depth))))
(-let [new-dom-node (treemacs-dom-node->create! :key created-path :parent parent-dom-node)]
(treemacs-dom-node->insert-into-dom! new-dom-node)
(treemacs-dom-node->add-child! parent-dom-node new-dom-node))
(when treemacs-git-mode
(treemacs-do-update-single-file-git-state created-path :exclude-parents :override-status))))
(defun treemacs--insert-node-in-flattened-directory (created-path parent-btn parent-dom-node flatten-info)
"Insert new CREATED-PATH below flattened directory at PARENT-BTN.
Will take care of every part necessary for adding a new node under a flattened
directory - adjusting the label, the state PARENT-DOM-NODE, the FLATTEN-INFO and
path text properties, the filewatch entries. It will also differentiate between
creating new files and new directories and re-open the node accordingly.
PATH: File Path
PARENT-BTN: Button
PARENT-DOM-NODE: Dom Node Struct"
(treemacs-with-writable-buffer
(-let [current-path (treemacs-button-get parent-btn :path)]
(-if-let (collapse-info (treemacs-button-get parent-btn :collapsed))
(progn
(cl-incf (car collapse-info))
(setf (cdr collapse-info) (nconc (cdr collapse-info) (list path))))
(treemacs-button-put parent-btn :collapsed (list 2 current-path path)))
(treemacs-button-put parent-btn :path path)
(setf (treemacs-dom-node->collapse-keys parent-dom-node)
(cons path (treemacs-dom-node->collapse-keys parent-dom-node)))
(ht-set! treemacs-dom path parent-dom-node)
(treemacs--start-watching path :collapse)
(-let [props (text-properties-at parent-btn)]
(goto-char (treemacs-button-end parent-btn))
(insert (apply #'propertize (substring path (length current-path)) props))))))
PARENT-DOM-NODE: Dom Node Struct
FLATTEN-INFO [Int File Path...]"
(treemacs-block
(let ((is-file? (file-regular-p created-path))
(insert-at-end? (treemacs-is-path created-path :in (-last-item flatten-info)))
(is-expanded? (treemacs-is-node-expanded? parent-btn)))
;; Simple addition of a file
(treemacs-return-if (and is-file? insert-at-end? is-expanded?)
(treemacs--insert-single-node created-path parent-btn parent-dom-node))
;; Simple file addition at the end, but the node is collapsed so we do nothing
(treemacs-return-if (and is-file? insert-at-end? (not is-expanded?))
t)
(let* ((properties (text-properties-at parent-btn))
(current-base-path (treemacs-button-get parent-btn :key))
;; In case we either add a new file or a directory somewhere in the middle of the flattened paths
;; we move the `created-path' up a step because that means we do not simple add another directory to
;; the flattened path. Instead we remove everything *up to* the directory the new item was created in.
;; Pretending the `created-path' has moved up like is an easy way to make sure the new button label
;; and properties are determined correctly.
(created-path (if (or is-file? (not insert-at-end?))
(treemacs--parent-dir created-path)
created-path))
(new-path-tokens (treemacs--tokenize-path created-path current-base-path))
(new-button-label (substring created-path (1+ (length (treemacs--parent-dir current-base-path)))))
;; TODO(2020/10/02): Check again when exactly this count is actually used
;; maybe it can be removed by now
(new-flatten-info-count 0)
(new-flatten-info (list current-base-path))
(new-flatten-info-item current-base-path))
;; Do nothing if we add a new directory and we have already reached maximum length
(unless (and insert-at-end?
(>= (car flatten-info) treemacs-collapse-dirs)
(not is-file?))
;; Create the path items of the new `:collapsed' property
(dolist (token new-path-tokens)
(cl-incf new-flatten-info-count)
(setf new-flatten-info-item (f-join new-flatten-info-item token))
(push new-flatten-info-item new-flatten-info))
(setf new-flatten-info (nreverse new-flatten-info))
;; Take care of filewatch and dom entries for all paths added and removed
(let* ((old-flatten-paths (-difference (cdr flatten-info) new-flatten-info))
(new-flatten-paths (-difference new-flatten-info (cdr flatten-info))))
(dolist (old-flatten-path old-flatten-paths)
(treemacs--stop-watching old-flatten-path)
(ht-set! treemacs-dom old-flatten-path nil))
(dolist (new-flatten-path new-flatten-paths)
(treemacs--start-watching new-flatten-path :flatten)
(ht-set! treemacs-dom new-flatten-path parent-dom-node))
(setf (treemacs-dom-node->collapse-keys parent-dom-node) (copy-sequence (cdr new-flatten-info))))
;; Update text properties with new state
(setf new-flatten-info (when (> new-flatten-info-count 0)
(cons new-flatten-info-count new-flatten-info)))
(plist-put properties :collapsed new-flatten-info)
(plist-put properties :path created-path)
;; Insert new label
(goto-char parent-btn)
(delete-region (point) (point-at-eol))
(insert (apply #'propertize new-button-label properties))
;; Fixing marker probably necessary since it's also in the dom
(goto-char (- (point) (length new-button-label)))
(set-marker parent-btn (point))
(if (and insert-at-end? is-file?)
;; TODO(2020/10/01): this reopening is used multiple tims like this
;; it should be abstracted properly
(funcall (alist-get (treemacs-button-get parent-btn :state) treemacs-TAB-actions-config))
(funcall (alist-get (treemacs-button-get parent-btn :state) treemacs-TAB-actions-config))
(setf (treemacs-dom-node->refresh-flag parent-dom-node) nil)))))))
(define-inline treemacs--create-string-for-single-insert (path parent depth)
"Create the necessary strings to insert a new file node.
@@ -936,6 +1020,11 @@ parents' git status can be updated."
(treemacs-update-single-file-git-state path)))
('created
(treemacs-do-insert-single-node path (treemacs-dom-node->key node)))
('force-refresh
(setf recurse nil)
(if (null (treemacs-dom-node->parent node))
(treemacs-project->refresh! project)
(treemacs--refresh-dir (treemacs-dom-node->key node) project)))
(_
;; Renaming is handled as a combination of delete+create, so
;; this case should never be taken

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
@@ -36,7 +36,8 @@
(require 'treemacs-macros)
(require 'cl-lib))
(cl-declaim (optimize (speed 3) (safety 0)))
(eval-when-compile
(cl-declaim (optimize (speed 3) (safety 0))))
(treemacs-import-functions-from "treemacs-filewatch-mode"
treemacs--stop-filewatch-for-current-buffer)
@@ -64,7 +65,7 @@ The car is the name seen in interactive selection. The cdr is the eieio class
name.")
(defvar treemacs--current-scope-type 'treemacs-frame-scope
"The general type of objects/items treemacs is curretly scoped to.")
"The general type of objects/items treemacs is currently scoped to.")
(defvar treemacs--scope-storage nil
"Alist of all active scopes mapped to their buffers & workspaces.
@@ -113,30 +114,38 @@ Can be used with `setf'."
(defclass treemacs-scope () () :abstract t)
(cl-defmethod treemacs-scope->current-scope ((_ (subclass treemacs-scope)))
"Get the current scope."
(error "Default `current-scope' implementation was called"))
(cl-defmethod treemacs-scope->current-scope-name ((_ (subclass treemacs-scope)) scope)
"Get the name of the given SCOPE."
(ignore scope)
nil)
(cl-defmethod treemacs-scope->setup ((_ (subclass treemacs-scope)))
"Setup for a scope type."
nil)
(cl-defmethod treemacs-scope->cleanup ((_ (subclass treemacs-scope)))
"Tear-down for a scope type."
nil)
(defclass treemacs-frame-scope (treemacs-scope) () :abstract t)
(cl-defmethod treemacs-scope->current-scope ((_ (subclass treemacs-frame-scope)))
"Get the current scope."
(selected-frame))
(cl-defmethod treemacs-scope->current-scope-name ((_ (subclass treemacs-frame-scope)) frame)
"Prints the given FRAME."
(prin1-to-string frame))
(cl-defmethod treemacs-scope->setup ((_ (subclass treemacs-frame-scope)))
"Frame-scope setup."
(add-hook 'delete-frame-functions #'treemacs--on-scope-kill))
(cl-defmethod treemacs-scope->cleanup ((_ (subclass treemacs-frame-scope)))
"Frame-scope tear-down."
(remove-hook 'delete-frame-functions #'treemacs--on-scope-kill))
(defun treemacs-set-scope-type (new-scope-type)
@@ -214,7 +223,7 @@ NEW-SCOPE-TYPE: T: treemacs-scope"
(treemacs-scope-shelf->buffer)
(get-buffer-window)
(select-window))
(run-hooks 'treemacs-select-hook))
(run-hook-with-args 'treemacs-select-functions 'visible))
(defun treemacs-get-local-buffer ()
"Return the treemacs buffer local to the current scope-type.

View File

@@ -16,6 +16,9 @@ IS_TRACKED_CMD = "git ls-files --error-unmatch "
IS_CHANGED_CMD = "git diff-index --quiet HEAD "
def main():
if '"' in FILE or '\\' in FILE:
sys.exit(2)
new_state = determine_file_git_state()
# nothing to do

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
@@ -26,6 +26,7 @@
;; * Find the last tag whose position begins before point
;; * Jump to that tag path
;; * No jump when there's no buffer file, or no imenu, or buffer file is not seen in treemacs etc.
;;; NOTE: This module is lazy-loaded.
;;; Code:
@@ -46,7 +47,7 @@
(defvar treemacs--tag-follow-timer nil
"The idle timer object for `treemacs-tag-follow-mode'.
Active while tag follow mode is enabled and nil/canceled otherwise.")
Active while tag follow mode is enabled and nil/cancelled otherwise.")
(defvar-local treemacs--previously-followed-tag-position nil
"Records the last node and path whose tags were expanded by tag follow mode.
@@ -73,35 +74,37 @@ saved.")
The tags are sorted into the order in which they appear, reguardless of section
or nesting depth."
(inline-quote
(let* ((imenu-auto-rescan t)
(org? (eq major-mode 'org-mode))
(index (-> (buffer-file-name) (treemacs--get-imenu-index)))
(flat-index (if org?
(treemacs--flatten-org-mode-imenu-index index)
(treemacs--flatten-imenu-index index)))
(first (caar flat-index))
;; in org mode buffers the first item may not be a cons since its position
;; is still stored as a text property
(semantic? (and (consp first) (overlayp (cdr first))))
(compare-func (if (memq major-mode '(markdown-mode adoc-mode))
#'treemacs--compare-markdown-tag-paths
#'treemacs--compare-tag-paths)))
(cond
(semantic?
;; go ahead and just transform semantic overlays into markers so we dont
;; have trouble with comparisons when searching a position
(dolist (tag-path flat-index)
(let ((leaf (car tag-path))
(marker (make-marker)))
(setcdr leaf (move-marker marker (overlay-start (cdr leaf)))))))
;; same goes for an org index, since headlines with children store their
;; positions as text properties
(org?
(dolist (tag-path flat-index)
(let ((leaf (car tag-path)))
(when (stringp leaf)
(setcar tag-path (cons leaf (get-text-property 0 'org-imenu-marker leaf))))))))
(sort flat-index compare-func))))
(if (eq major-mode 'pdf-view-mode)
'unsupported
(let* ((imenu-auto-rescan t)
(org? (eq major-mode 'org-mode))
(index (-> (buffer-file-name) (treemacs--get-imenu-index)))
(flat-index (if org?
(treemacs--flatten-org-mode-imenu-index index)
(treemacs--flatten-imenu-index index)))
(first (caar flat-index))
;; in org mode buffers the first item may not be a cons since its position
;; is still stored as a text property
(semantic? (and (consp first) (overlayp (cdr first))))
(compare-func (if (memq major-mode '(markdown-mode adoc-mode))
#'treemacs--compare-markdown-tag-paths
#'treemacs--compare-tag-paths)))
(cond
(semantic?
;; go ahead and just transform semantic overlays into markers so we dont
;; have trouble with comparisons when searching a position
(dolist (tag-path flat-index)
(let ((leaf (car tag-path))
(marker (make-marker)))
(setcdr leaf (move-marker marker (overlay-start (cdr leaf)))))))
;; same goes for an org index, since headlines with children store their
;; positions as text properties
(org?
(dolist (tag-path flat-index)
(let ((leaf (car tag-path)))
(when (stringp leaf)
(setcar tag-path (cons leaf (get-text-property 0 'org-imenu-marker leaf))))))))
(sort flat-index compare-func)))))
(defun treemacs--flatten-imenu-index (index &optional path)
"Flatten a nested imenu INDEX to a flat list of tag paths.
@@ -125,7 +128,7 @@ PATH: String List"
result))
(defun treemacs--flatten-org-mode-imenu-index (index &optional path)
"Specialization of `treemacs--flatten-imenu-index' for org mode.
"Specialisation of `treemacs--flatten-imenu-index' for org mode.
An index produced in an `org-mode' buffer is special in that tag sections act
not just as a means of grouping tags (being bags of functions, classes etc).
Each tag section is instead also a headline which can be moved to. The
@@ -183,8 +186,8 @@ LIST: Sorted Tag Path List"
(t (treemacs--binary-index-search point list))))))
(cl-defun treemacs--binary-index-search (point list &optional (start 0) (end (1- (length list))))
"Finds the position of POINT in LIST using a binary search.
Continuation of `treemacs--find-index-pos'. Search LIST between START & END.
"Find the position of POINT in LIST using a binary search.
Continuation of `treemacs--find-index-pos'. Search LIST between START & END.
POINT: Integer
LIST: Sorted Tag Path List
@@ -220,21 +223,10 @@ PROJECT: Project Struct"
(with-selected-window treemacs-window
(setq btn (treemacs-current-button))
(if btn
(progn
;; first move to the nearest file when we're on a tag
(when (memq (treemacs-button-get btn :state) '(tag-node-open tag-node-closed tag-node))
;; first move to the nearest file when we're on a tag
(if (memq (treemacs-button-get btn :state) '(tag-node-open tag-node-closed tag-node))
(while (not (memq (treemacs-button-get btn :state) file-states))
(setq btn (treemacs-button-get btn :parent))))
;; close the button that was opened on the previous follow
(when (and treemacs--previously-followed-tag-position
(not (eq (car treemacs--previously-followed-tag-position) btn)))
(-let [(prev-followed-pos . prev-followed-path) treemacs--previously-followed-tag-position]
(save-excursion
(goto-char prev-followed-pos)
(when (and (treemacs-is-path (-some-> (treemacs-current-button) (treemacs-button-get :path))
:same-as prev-followed-path)
(eq 'file-node-open (treemacs-button-get prev-followed-pos :state)))
(treemacs--collapse-file-node prev-followed-pos)))))
(setq btn (treemacs-button-get btn :parent)))
;; when that doesnt work move manually to the correct file
(-let [btn-path (treemacs-button-get btn :path)]
(unless (and (stringp btn-path) (treemacs-is-path buffer-file :same-as btn-path))
@@ -243,10 +235,11 @@ PROJECT: Project Struct"
;; also move manually when there is no button at point
(treemacs-goto-file-node buffer-file project)
(setq btn (treemacs-current-button)))
;; close the button that was opened on the previous follow
(goto-char (treemacs-button-start btn))
(setq treemacs--previously-followed-tag-position (cons btn (treemacs-button-get btn :path)))
;; imenu already rescanned when fetching the tag path
(let ((imenu-auto-rescan nil))
(let ((imenu-auto-rescan nil)
(new-file-btn))
;; make a copy since this tag-path will be saved as cache, and the two modifications made here
;; make it impossible to find the current position in `treemacs--find-index-pos'
(let* ((tag-path (copy-sequence tag-path))
@@ -260,8 +253,17 @@ PROJECT: Project Struct"
;; path has a dom entry with a valid position, but this is not the case when moving to tags
;; in a previously never-expanded file node, so we first find the file to make sure its
;; position is known
(treemacs-find-file-node buffer-file)
(treemacs-goto-node tag-path)))
(setf new-file-btn (treemacs-find-file-node buffer-file))
(treemacs-goto-node tag-path)
(when (and treemacs--previously-followed-tag-position
(not (equal (car treemacs--previously-followed-tag-position) new-file-btn)))
(-let [(prev-followed-pos . _) treemacs--previously-followed-tag-position]
(save-excursion
(when (eq 'file-node-open (treemacs-button-get prev-followed-pos :state))
(goto-char prev-followed-pos)
(treemacs--collapse-file-node prev-followed-pos)))))
(setf treemacs--previously-followed-tag-position
(cons new-file-btn (treemacs-button-get new-file-btn :path)))))
(hl-line-highlight)
(treemacs--evade-image)
(when treemacs-recenter-after-tag-follow
@@ -278,9 +280,10 @@ PROJECT: Project Struct"
(condition-case e
(-when-let (index (or treemacs--imenu-cache
(treemacs--flatten&sort-imenu-index)))
(unless (buffer-modified-p)
(setq-local treemacs--imenu-cache (copy-sequence index)))
(treemacs--do-follow-tag index treemacs-window buffer-file project))
(unless (eq index 'unsupported)
(unless (buffer-modified-p)
(setq-local treemacs--imenu-cache (copy-sequence index)))
(treemacs--do-follow-tag index treemacs-window buffer-file project)))
(imenu-unavailable (ignore e))
(error (treemacs-log-err "Encountered error while following tag at point: %s" e))))))
@@ -300,6 +303,7 @@ PROJECT: Project Struct"
(when treemacs--tag-follow-timer
(cancel-timer treemacs--tag-follow-timer)))
;;;###autoload
(define-minor-mode treemacs-tag-follow-mode
"Toggle `treemacs-tag-follow-mode'.
@@ -325,6 +329,7 @@ longer than it really does."
:init-value nil
:global t
:lighter nil
:group 'treemacs
(if treemacs-tag-follow-mode
(treemacs--setup-tag-follow-mode)
(treemacs--tear-down-tag-follow-mode)))

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
@@ -20,6 +20,7 @@
;;; Need to be very careful here - many of the functions in this module need to be run inside the treemacs buffer, while
;;; the `treemacs--execute-button-action' macro that runs them will switch windows before doing so. Heavy use of
;;; `treemacs-safe-button-get' or `treemacs-with-button-buffer' is necessary.
;;; NOTE: This module is lazy-loaded.
;;; Code:
@@ -44,7 +45,11 @@
(treemacs-import-functions-from "treemacs"
treemacs-select-window)
(treemacs-import-functions-from "org-comat"
org-imenu-get-tree)
;; TODO(2019/10/17): rebuild this module using the extension api
;; TODO(2020/12/14): Improve special-casing of org-mode & especially pdf-tools
(defun treemacs--partition-imenu-index (index default-name)
"Put top level leaf nodes in INDEX under DEFAULT-NAME."
@@ -90,7 +95,9 @@ should be placed under."
(let ((buff)
(result)
(mode)
(existing-buffer (get-file-buffer file)))
(existing-buffer (get-file-buffer file))
(org-imenu-depth (max 10 (or 0 (and (boundp 'org-imenu-depth) org-imenu-depth)))))
(ignore org-imenu-depth)
(if existing-buffer
(setq buff existing-buffer)
(cl-letf (((symbol-function 'run-mode-hooks) (symbol-function 'ignore)))
@@ -98,14 +105,22 @@ should be placed under."
(condition-case e
(when (buffer-live-p buff)
(with-current-buffer buff
(when (eq major-mode 'emacs-lisp-mode)
(setq-local imenu-generic-expression treemacs-elisp-imenu-expression))
(setq result (and (or imenu-generic-expression imenu-create-index-function) (imenu--make-index-alist t))
mode major-mode))
(let ((imenu-generic-expression
(if (eq major-mode 'emacs-lisp-mode)
(or treemacs-elisp-imenu-expression
imenu-generic-expression)
imenu-generic-expression))
(imenu-create-index-function
(if (eq major-mode 'org-mode)
#'org-imenu-get-tree
imenu-create-index-function)))
(setf result (and (or imenu-generic-expression imenu-create-index-function)
(imenu--make-index-alist t))
mode major-mode)))
(unless existing-buffer (kill-buffer buff))
(when result
(when (string= "*Rescan*" (car (car result)))
(setq result (cdr result)))
(when (string= "*Rescan*" (caar result))
(setf result (cdr result)))
(unless (equal result '(nil))
(treemacs--post-process-index result mode))))
(imenu-unavailable (ignore e))
@@ -161,6 +176,7 @@ DEPTH: Int"
:depth ,depth
:index (cdr ,node))))))
;;;###autoload
(defun treemacs--expand-file-node (btn &optional recursive)
"Open tag items for file BTN.
Recursively open all tags below BTN when RECURSIVE is non-nil."
@@ -202,6 +218,7 @@ Recursively open all tags below BTN when RECURSIVE is non-nil."
(treemacs--expand-tag-node it t))))))
(treemacs-pulse-on-failure "No tags found for %s" (propertize path 'face 'font-lock-string-face)))))
;;;###autoload
(defun treemacs--collapse-file-node (btn &optional recursive)
"Close node given by BTN.
Remove all open tag entries under BTN when RECURSIVE."
@@ -210,6 +227,7 @@ Remove all open tag entries under BTN when RECURSIVE."
:new-state 'file-node-closed
:post-close-action (treemacs-on-collapse (treemacs-button-get btn :path) recursive)))
;;;###autoload
(defun treemacs--visit-or-expand/collapse-tag-node (btn arg find-window)
"Visit tag section BTN if possible, expand or collapse it otherwise.
Pass prefix ARG on to either visit or toggle action.
@@ -219,7 +237,7 @@ context and decides whether to find the window to display in (if the tag is
visited instead of the node being expanded).
On the one hand it can be called based on `treemacs-RET-actions-config' (or
TAB). The functions in these configs are expected to find the windows they need
TAB). The functions in these configs are expected to find the windows they need
to display in themselves, so FIND-WINDOW must be t. On the other hand this
function is also called from the top level vist-node functions like
`treemacs-visit-node-vertical-split' which delegates to the
@@ -274,6 +292,7 @@ the display window."
('tag-node-open (treemacs--collapse-tag-node btn arg))
('tag-node-closed (treemacs--expand-tag-node btn arg)))))))
;;;###autoload
(defun treemacs--expand-tag-node (btn &optional recursive)
"Open tags node items for BTN.
Open all tag section under BTN when call is RECURSIVE."
@@ -326,6 +345,7 @@ button from cache. Easiest way is to just do it manually here."
(goto-char (treemacs-button-start btn))
(treemacs--collapse-tag-node btn))
;;;###autoload
(defun treemacs--collapse-tag-node (btn &optional recursive)
"Close tags node at BTN.
Remove all open tag entries under BTN when RECURSIVE."
@@ -338,38 +358,41 @@ Remove all open tag entries under BTN when RECURSIVE."
:post-close-action
(treemacs-on-collapse (treemacs-button-get btn :path)))))
(define-inline treemacs--extract-position (item)
"Extract a tag's buffer and position stored in ITEM.
(defun treemacs--extract-position (item file)
"Extract a tag's position stored in ITEM and FILE.
The position can be stored in the following ways:
* ITEM is a marker pointing to a tag provided by imenu.
* ITEM is an overlay pointing to a tag provided by imenu with semantic mode.
* ITEM is a raw number pointing to a buffer position.
* ITEM is a cons: special case for imenu elements of an `org-mode' buffer.
ITEM is an imenu subtree and the position is stored as a marker in the first
ITEM is an imenu sub-tree and the position is stored as a marker in the first
element's 'org-imenu-marker text property.
Either way the return value is a const consisting of the buffer and the position
of the tag. They might also be nil if the pointed-to buffer does not exist."
* ITEM is a cons: special case for imenu elements of an `pdfview-mode' buffer.
In this case no position is stored directly, navigation to the tag must happen
via callback"
(declare (side-effect-free t))
(inline-letevals (item)
(inline-quote
(pcase (type-of ,item)
('marker
(cons (marker-buffer ,item) (marker-position ,item)))
('overlay
(cons (overlay-buffer ,item) (overlay-start ,item)))
('integer
(cons nil ,item))
('cons
(-when-let (org-marker (get-text-property 0 'org-imenu-marker (car ,item)))
(cons (marker-buffer org-marker) (marker-position org-marker))))))))
(pcase (type-of item)
('marker
(cons (marker-buffer item) (marker-position item)))
('overlay
(cons (overlay-buffer item) (overlay-start item)))
('integer
(cons nil item))
('cons
(cond
((eq 'pdf-outline-imenu-activate-link (cadr item))
(with-no-warnings
(cons (find-buffer-visiting file) (lambda () (apply #'pdf-outline-imenu-activate-link item)))))
((get-text-property 0 'org-imenu-marker (car item))
(-let [org-marker (get-text-property 0 'org-imenu-marker (car item))]
(cons (marker-buffer org-marker) (marker-position org-marker))))))))
(defun treemacs--call-imenu-and-goto-tag (tag-path &optional org?)
"Call the imenu index of the tag at TAG-PATH and go to its position.
ORG? should be t when this function is called for an org buffer and index since
org requires a slightly different position extraction because the position of a
headline with subelements is saved in an 'org-imenu-marker' text property."
headline with sub-elements is saved in an 'org-imenu-marker' text property."
(let* ((file (car tag-path))
(path (-butlast (cdr tag-path)))
(tag (-last-item tag-path)))
@@ -383,11 +406,14 @@ headline with subelements is saved in an 'org-imenu-marker' text property."
(-let [item (--first
(equal (car it) tag)
index)]
(if org? item (cdr item))))]
(if org? item (cdr item)))
(car tag-path))]
;; some imenu implementations, like markdown, will only provide
;; a raw buffer position (an int) to move to
(switch-to-buffer (or buf (get-file-buffer file)))
(goto-char pos)
(if (functionp pos)
(funcall pos)
(goto-char pos))
;; a little bit of convenience - reveal those nested headlines
(when (and (eq major-mode 'org-mode)
(fboundp 'org-reveal))
@@ -397,36 +423,87 @@ headline with subelements is saved in an 'org-imenu-marker' text property."
(propertize tag 'face 'treemacs-tags-face)
e)))))
;;;###autoload
(defun treemacs--goto-tag (btn)
"Go to the tag at BTN."
;; The only code currently calling this is run through `treemacs--execute-button-action' which always
;; switches windows before running it, so we need to be really careful here when querying any button
;; properties.
(-let [(tag-buf . tag-pos)
(treemacs-with-button-buffer btn
(-> btn (treemacs-button-get :marker) (treemacs--extract-position)))]
(if tag-buf
(progn
(switch-to-buffer tag-buf nil t)
(goto-char tag-pos)
;; a little bit of convenience - reveal those nested headlines
(when (and (eq major-mode 'org-mode)
(fboundp 'org-reveal))
(org-reveal)))
(pcase treemacs-goto-tag-strategy
('refetch-index
(treemacs--call-imenu-and-goto-tag
(with-current-buffer (marker-buffer btn)
(treemacs-button-get btn :path))))
('call-xref
(xref-find-definitions
(treemacs-with-button-buffer btn
(treemacs--get-label-of btn))))
('issue-warning
(treemacs-pulse-on-failure
"Tag '%s' is located in a buffer that does not exist."
(propertize (treemacs-with-button-buffer btn (treemacs--get-label-of btn)) 'face 'treemacs-tags-face)))
(_ (error "[Treemacs] '%s' is an invalid value for treemacs-goto-tag-strategy" treemacs-goto-tag-strategy))))))
(let* ((tag-buffer) (tag-pos))
(treemacs-with-button-buffer btn
(-let [info (treemacs--extract-position
(treemacs-button-get btn :marker)
(car (treemacs-button-get btn :path)))]
(setf tag-buffer (car info)
tag-pos (cdr info))))
(if (not (buffer-live-p tag-buffer))
(pcase treemacs-goto-tag-strategy
('refetch-index
(treemacs--call-imenu-and-goto-tag
(treemacs-safe-button-get btn :path)))
('call-xref
(xref-find-definitions
(treemacs-with-button-buffer btn
(treemacs--get-label-of btn))))
('issue-warning
(treemacs-pulse-on-failure
"Tag '%s' is located in a buffer that does not exist."
(propertize (treemacs-with-button-buffer btn (treemacs--get-label-of btn)) 'face 'treemacs-tags-face)))
(_ (error "[Treemacs] '%s' is an invalid value for treemacs-goto-tag-strategy" treemacs-goto-tag-strategy)))
(progn
(switch-to-buffer tag-buffer nil t)
;; special case for pdf mode buffers - their imenu tags do not store a marker
;; movement must happen via a special callback
(cond
((numberp tag-pos)
(goto-char tag-pos))
((functionp tag-pos)
(funcall tag-pos)))
;; a little bit of convenience - reveal those nested headlines
(when (and (eq major-mode 'org-mode) (fboundp 'org-reveal))
(org-reveal))))))
;;;###autoload
(defun treemacs--create-imenu-index-function ()
"The `imenu-create-index-function' for treemacs buffers."
(declare (side-effect-free t))
(let (index)
(pcase treemacs-imenu-scope
('everything
(dolist (project (treemacs-workspace->projects (treemacs-current-workspace)))
(let ((project-name (treemacs-project->name project))
(root-dom-node (treemacs-find-in-dom (treemacs-project->path project))))
(-when-let (index-items (treemacs--get-imenu-index-items root-dom-node))
(push (cons project-name index-items) index)))))
('current-project
(treemacs-unless-let (project (treemacs-project-at-point))
(treemacs-pulse-on-failure "Cannot create imenu index because there is no project at point")
(let ((project-name (treemacs-project->name project))
(root-dom-node (treemacs-find-in-dom (treemacs-project->path project))))
(-when-let (index-items (treemacs--get-imenu-index-items root-dom-node))
(push (cons project-name index-items) index)))))
(other (error "Invalid imenu scope value `%s'" other)))
(nreverse index)))
(defun treemacs--get-imenu-index-items (project-dom-node)
"Collects the imenu index items for the given PROJECT-DOM-NODE."
(declare (side-effect-free t))
(let (result)
(treemacs-walk-dom project-dom-node
(lambda (node)
(push (list (file-relative-name (treemacs-dom-node->key node) (treemacs-dom-node->key project-dom-node))
(or (treemacs-dom-node->position node) -1)
#'treemacs--imenu-goto-node-wrapper
(treemacs-dom-node->key node))
result)))
(nreverse result)))
(define-inline treemacs--imenu-goto-node-wrapper (_name _pos key)
"Thin wrapeer around `treemacs-goto-node'.
Used by imenu to move to the node with the given KEY."
(inline-letevals (key)
(inline-quote
(treemacs-goto-node ,key))))
(provide 'treemacs-tags)

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
@@ -31,7 +31,8 @@
(require 'treemacs-macros)
(require 'cl-lib))
(cl-declaim (optimize (speed 3) (safety 0)))
(eval-when-compile
(cl-declaim (optimize (speed 3) (safety 0))))
(treemacs-import-functions-from "treemacs-icons"
treemacs--select-icon-set)
@@ -61,6 +62,7 @@
(cl-defmacro treemacs-create-theme (name &key icon-directory extends config)
"Create a new (bare) theme with the given NAME.
- ICON-DIRECTORY is the (mandatory) theme's location.
- EXTENDS is the theme to be extended.
- BASED-ON is the name of a theme whose icons this one should start with.
- CONFIG is a code block to fill the created theme with icons via
`treemacs-create-icon'."
@@ -87,16 +89,16 @@
(cl-defmacro treemacs-modify-theme (theme &key icon-directory config)
"Modify an existing THEME.
- CONFIG will be applied to the THEME in the same manner as in
`treemacs-create-theme'.
- THEME can either be a treemacs-theme object or the name of a theme.
- For the scope of the modification an alternative ICON-DIRECTORY can also be
used."
used.
- CONFIG will be applied to the THEME in the same manner as in
`treemacs-create-theme'."
(declare (indent 1))
(treemacs-static-assert (not (null theme))
"Theme may not be null.")
`(treemacs-unless-let (theme (if (stringp ,theme) (treemacs--find-theme ,theme) ,theme))
(user-error "Theme %s does not exist" ,theme)
(user-error "Theme '%s' does not exist" ,theme)
(let* ((treemacs--current-theme theme)
(original-icon-dir (treemacs-theme->path theme))
(new-icon-dir (if ,icon-directory ,icon-directory original-icon-dir)))

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
@@ -65,7 +65,7 @@
(advice-remove #'disable-theme #'treemacs--setup-icon-background-colors)))
(defun treemacs--update-icon-selection ()
"Highlight current icon, unhighlight `treemacs--last-highlight'."
"Highlight current icon, un-highlight `treemacs--last-highlight'."
(when treemacs--in-this-buffer
(condition-case e
(progn
@@ -87,7 +87,7 @@
(treemacs-log-err "Error on highlight, this shouldn't happen: %s" e)))))
(defun treemacs--pulse-png-advice (&rest _)
"Make sure icons' background are pusled alongside the entire line."
"Make sure icons' background are pulsed alongside the entire line."
(when (eq 'treemacs-mode major-mode)
(treemacs-with-writable-buffer
(-when-let (btn (treemacs-current-button))
@@ -112,7 +112,7 @@
(defsubst treemacs-pulse-on-success (&rest log-args)
"Pulse current line with `treemacs-on-success-pulse-face'.
Optionally issue a log statment with LOG-ARGS."
Optionally issue a log statement with LOG-ARGS."
(declare (indent 1))
(when log-args
(treemacs-log (apply #'format log-args)))
@@ -121,7 +121,7 @@ Optionally issue a log statment with LOG-ARGS."
(defsubst treemacs-pulse-on-failure (&rest log-args)
"Pulse current line with `treemacs-on-failure-pulse-face'.
Optionally issue a log statment with LOG-ARGS."
Optionally issue a log statement with LOG-ARGS."
(declare (indent 1))
(when log-args
(treemacs-log-failure (apply #'format log-args)))

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

View File

@@ -1,9 +1,9 @@
;;; treemacs.el --- A tree style file explorer package -*- lexical-binding: t -*-
;; Copyright (C) 2020 Alexander Miller
;; Copyright (C) 2021 Alexander Miller
;; Author: Alexander Miller <alexanderm@web.de>
;; Package-Requires: ((emacs "25.2") (cl-lib "0.5") (dash "2.11.0") (s "1.12.0") (f "0.11.0") (ace-window "0.9.0") (pfuture "1.7") (hydra "0.13.2") (ht "2.2"))
;; Package-Requires: ((emacs "26.1") (cl-lib "0.5") (dash "2.11.0") (s "1.12.0") (f "0.11.0") (ace-window "0.9.0") (pfuture "1.7") (hydra "0.13.2") (ht "2.2") (cfrs "1.3.2"))
;; Homepage: https://github.com/Alexander-Miller/treemacs
;; Version: 2.8
@@ -41,10 +41,7 @@
(require 'treemacs-filewatch-mode)
(require 'treemacs-mode)
(require 'treemacs-interface)
(require 'treemacs-mouse-interface)
(require 'treemacs-persistence)
(require 'treemacs-tags)
(require 'treemacs-tag-follow-mode)
(require 'treemacs-async)
(require 'treemacs-compatibility)
(require 'treemacs-workspaces)
@@ -52,15 +49,16 @@
(require 'treemacs-header-line)
(require 'treemacs-extensions)
(eval-when-compile
(require 'treemacs-macros))
(defconst treemacs-version
(eval-when-compile
(format "v2.8 (installed %s) @ Emacs %s"
(format-time-string "%Y.%m.%d" (current-time))
emacs-version)))
(treemacs-import-functions-from "treemacs-tag-follow-mode"
treemacs--flatten&sort-imenu-index
treemacs--do-follow-tag)
;;;###autoload
(defun treemacs-version ()
"Return the `treemacs-version'."
@@ -71,7 +69,7 @@
;;;###autoload
(defun treemacs ()
"Initialize or toggle treemacs.
"Initialise or toggle treemacs.
* If the treemacs window is visible hide it.
* If a treemacs buffer exists, but is not visible show it.
* If no treemacs buffer exists for the current frame create and show it.
@@ -97,7 +95,7 @@ For the most part only useful when `treemacs-follow-mode' is not active."
(setq manually-entered t
path (->> (--if-let (treemacs-current-button) (treemacs--nearest-path it))
(read-file-name "File to find: ")
(treemacs--canonical-path))))
(treemacs-canonical-path))))
(treemacs-unless-let (project (treemacs--find-project-for-path path))
(treemacs-pulse-on-failure (format "%s does not fall under any project in the workspace."
(propertize path 'face 'font-lock-string-face)))
@@ -112,7 +110,7 @@ For the most part only useful when `treemacs-follow-mode' is not active."
;;;###autoload
(defun treemacs-find-tag ()
"Find and move point to the tag at point in the treemacs view.
Most likley to be useful when `treemacs-tag-follow-mode' is not active.
Most likely to be useful when `treemacs-tag-follow-mode' is not active.
Will ask to change the treemacs root if the file to find is not under the
root. If no treemacs buffer exists it will be created with the current file's
@@ -129,6 +127,8 @@ visiting a file or Emacs cannot find any tags for the current file."
"Current buffer is not visiting a file.")
(treemacs-error-return-if (null index)
"Current buffer has no tags.")
(treemacs-error-return-if (eq index 'unsupported)
"Treemacs does not support following tags in this major mode.")
(treemacs-error-return-if (null project)
"%s does not fall under any project in the workspace."
(propertize buffer-file 'face 'font-lock-string-face))
@@ -144,7 +144,7 @@ visiting a file or Emacs cannot find any tags for the current file."
(defun treemacs-select-window ()
"Select the treemacs window if it is visible.
Bring it to the foreground if it is not visible.
Initialize a new treemacs buffer as calling `treemacs' would if there is no
Initialise a new treemacs buffer as calling `treemacs' would if there is no
treemacs buffer for this frame."
(interactive)
(pcase (treemacs-current-visibility)
@@ -186,7 +186,7 @@ treemacs buffer for this frame."
(defun treemacs-display-current-project-exclusively ()
"Display the current project, and *only* the current project.
Like `treemacs-add-and-display-current-project' this will add the current
project to treemacs based on either projectile or the built projectl.el.
project to treemacs based on either projectile or the built-in project.el.
However the 'exclusive' part means that it will make the current project the
only project, all other projects *will be removed* from the current workspace."
(interactive)
@@ -194,7 +194,7 @@ only project, all other projects *will be removed* from the current workspace."
(treemacs-unless-let (root (treemacs--find-current-user-project))
(treemacs-error-return-if (null root)
"Not in a project.")
(let* ((path (treemacs--canonical-path root))
(let* ((path (treemacs-canonical-path root))
(name (treemacs--filename path))
(ws (treemacs-current-workspace)))
(treemacs-return-if (and (= 1 (length (treemacs-workspace->projects ws)))
@@ -232,7 +232,7 @@ An error message is displayed if the current buffer is not part of any project."
(treemacs-unless-let (root (treemacs--find-current-user-project))
(treemacs-error-return-if (null root)
"Not in a project.")
(let* ((path (treemacs--canonical-path root))
(let* ((path (treemacs-canonical-path root))
(name (treemacs--filename path)))
(unless (treemacs-current-workspace)
(treemacs--find-workspace))