216 lines
9.1 KiB
EmacsLisp
216 lines
9.1 KiB
EmacsLisp
;;; treemacs-bookmarks.el --- A tree style file viewer package -*- lexical-binding: t -*-
|
|
|
|
;; Copyright (C) 2024 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:
|
|
|
|
;; Integrates treemacs with bookmark.el.
|
|
|
|
;; NOTE: This module is lazy-loaded.
|
|
|
|
;;; Code:
|
|
|
|
(require 'bookmark)
|
|
(require 'dash)
|
|
(require 'treemacs-follow-mode)
|
|
(require 'treemacs-interface)
|
|
(require 'treemacs-scope)
|
|
(require 'treemacs-logging)
|
|
(require 'treemacs-tags)
|
|
(require 'treemacs-workspaces)
|
|
|
|
(eval-when-compile
|
|
(require 'cl-lib)
|
|
(require 'treemacs-macros))
|
|
|
|
(treemacs-import-functions-from "treemacs"
|
|
treemacs-select-window)
|
|
|
|
;;;###autoload
|
|
(defun treemacs-bookmark (&optional arg)
|
|
"Find a bookmark in treemacs.
|
|
Only bookmarks marking either a file or a directory are offered for selection.
|
|
Treemacs will try to find and focus the given bookmark's location, in a similar
|
|
fashion to `treemacs-find-file'.
|
|
|
|
With a prefix argument ARG treemacs will also open the bookmarked location."
|
|
(interactive "P")
|
|
(treemacs-block
|
|
(bookmark-maybe-load-default-file)
|
|
(-let [bookmarks
|
|
(cl-loop
|
|
for b in bookmark-alist
|
|
for name = (car b)
|
|
for location = (treemacs-canonical-path (bookmark-location b))
|
|
when (or (file-regular-p location) (file-directory-p location))
|
|
collect (propertize name 'location location))]
|
|
(treemacs-error-return-if (null bookmarks)
|
|
"Didn't find any bookmarks pointing to files.")
|
|
(let* ((bookmark (completing-read "Bookmark: " bookmarks))
|
|
(location (treemacs-canonical-path (get-text-property 0 'location (--first (string= it bookmark) bookmarks))))
|
|
(dir (if (file-directory-p location) location (treemacs--parent-dir location)))
|
|
(project (treemacs--find-project-for-path dir)))
|
|
(treemacs-error-return-if (null project)
|
|
"Bookmark at %s does not fall under any project in the workspace."
|
|
(propertize location 'face 'font-lock-string-face))
|
|
(pcase (treemacs-current-visibility)
|
|
('visible (treemacs--select-visible-window))
|
|
('exists (treemacs--select-not-visible-window))
|
|
('none (treemacs--init)))
|
|
(treemacs-goto-file-node location project)
|
|
(treemacs-pulse-on-success)
|
|
(when arg (treemacs-visit-node-no-split))))))
|
|
|
|
;;;###autoload
|
|
(defun treemacs--bookmark-handler (record)
|
|
"Open Treemacs into a bookmark RECORD."
|
|
(let ((path (bookmark-prop-get record 'treemacs-bookmark-path)))
|
|
(unless path
|
|
;; Don't rely on treemacs-pulse-on-failure to display the error, since the
|
|
;; error must be handled in bookmark.el.
|
|
(user-error "Treemacs--bookmark-handler invoked for a non-Treemacs bookmark"))
|
|
(treemacs-select-window)
|
|
;; 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
|
|
"Could not select the current bookmark"
|
|
(when (eq (treemacs-button-get current-btn :state) 'dir-node-closed)
|
|
(treemacs-TAB-action))
|
|
(when (eq (treemacs-button-get current-btn :state) 'dir-node-open)
|
|
(let ((depth (treemacs-button-get current-btn :depth))
|
|
(next-button (next-button current-btn)))
|
|
(when (and next-button (> (treemacs-button-get next-button :depth) depth))
|
|
(treemacs-next-line 1)))))))
|
|
|
|
(defun treemacs--format-bookmark-title (btn)
|
|
"Format the bookmark title for BTN with `treemacs-bookmark-title-template'."
|
|
(s-format
|
|
treemacs-bookmark-title-template
|
|
(lambda (pattern)
|
|
(or
|
|
(cond
|
|
;; ${label} - Label of the current button
|
|
((string= pattern "label")
|
|
(treemacs--get-label-of btn))
|
|
|
|
;; ${label:1} - Label of Nth parent
|
|
((s-starts-with? "label:" pattern)
|
|
(let ((depth (string-to-number (s-chop-prefix "label:" pattern)))
|
|
(current-button btn))
|
|
(dotimes (_ depth)
|
|
(setq current-button (when current-button (treemacs-button-get current-button :parent))))
|
|
(when current-button
|
|
(treemacs--get-label-of current-button))))
|
|
|
|
;; ${label-path} and ${label-path:4} - Path of labels, optionally limited by a number.
|
|
((or (string= pattern "label-path") (s-starts-with? "label-path:" pattern))
|
|
(let ((depth (when (s-starts-with? "label-path:" pattern)
|
|
(string-to-number (s-chop-prefix "label-path:" pattern))))
|
|
(current-button btn)
|
|
(path))
|
|
(while (and current-button (not (eq 0 depth)))
|
|
(push (treemacs--get-label-of current-button) path)
|
|
(when depth (cl-decf depth))
|
|
(setq current-button (treemacs-button-get current-button :parent)))
|
|
(s-join "/" path)))
|
|
|
|
;; ${project} - Label of the project or top-level extension node.
|
|
((string= pattern "project")
|
|
;; Find the root button by iterating - don't use `treemacs-project-of-node`
|
|
;; to make this work for variadic top-level extensions.
|
|
(let ((current-button btn))
|
|
(while (> (treemacs-button-get current-button :depth) 0)
|
|
(setq current-button (treemacs-button-get current-button :parent)))
|
|
(treemacs--get-label-of current-button)))
|
|
|
|
;; ${file-path} - Filesystem path.
|
|
((string= pattern "file-path")
|
|
(treemacs--nearest-path btn))
|
|
|
|
;; ${file-path:3} - N components of the file path
|
|
((s-starts-with? "file-path:" pattern)
|
|
(let ((n (string-to-number (s-chop-prefix "file-path:" pattern))))
|
|
(-when-let (path (treemacs--nearest-path btn))
|
|
(let ((components (last (s-split "/" path) (1+ n))))
|
|
;; Add the leading slash for absolute paths
|
|
(when (and (> (length components) n) (not (string= "" (car components))))
|
|
(pop components))
|
|
(s-join "/" components)))))
|
|
|
|
(t
|
|
;; Don't rely on treemacs-pulse-on-failure to display the error, since the
|
|
;; error must be handled in bookmark.el.
|
|
(treemacs-pulse-on-failure)
|
|
(user-error "Bookmark template pattern %s was not recognized" pattern)))
|
|
""))))
|
|
|
|
(defun treemacs--make-bookmark-record ()
|
|
"Make a bookmark record for the current Treemacs button.
|
|
|
|
This function is installed as the `bookmark-make-record-function'."
|
|
(treemacs-unless-let (current-btn (treemacs-current-button))
|
|
(progn
|
|
;; Don't rely on treemacs-pulse-on-failure to display the error, since the
|
|
;; error must be handled in bookmark.el.
|
|
(treemacs-pulse-on-failure)
|
|
(user-error "Nothing to bookmark here"))
|
|
(let* ((path (treemacs-button-get current-btn :path)))
|
|
(unless path
|
|
(treemacs-pulse-on-failure)
|
|
(user-error "Could not find the path of the current button"))
|
|
|
|
`((defaults . (,(treemacs--format-bookmark-title current-btn)))
|
|
(treemacs-bookmark-path . ,path)
|
|
(handler . treemacs--bookmark-handler)
|
|
,@(when (stringp path) `((filename . ,path)))))))
|
|
|
|
;;;###autoload
|
|
(defun treemacs-add-bookmark ()
|
|
"Add the current node to Emacs' list of bookmarks.
|
|
For file and directory nodes their absolute path is saved. Tag nodes
|
|
additionally also save the tag's position. A tag can only be bookmarked if the
|
|
treemacs node is pointing to a valid buffer position."
|
|
(interactive)
|
|
(treemacs-with-current-button
|
|
"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 (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) nil)]
|
|
(if (buffer-live-p tag-buffer)
|
|
(bookmark-store
|
|
(treemacs--read-string "Bookmark name: ")
|
|
`((filename . ,(buffer-file-name tag-buffer))
|
|
(position . ,tag-pos))
|
|
nil)
|
|
(treemacs-log-failure "Tag info can not be saved because it is not pointing to a live buffer."))))
|
|
((or 'tag-node-open 'tag-node-closed)
|
|
(treemacs-pulse-on-failure "There is nothing to bookmark here.")))))
|
|
|
|
(provide 'treemacs-bookmarks)
|
|
|
|
;;; treemacs-bookmarks.el ends here
|