add lisp packages

lisp/treemacs/treemacs-bookmarks.el

@@ -0,0 +1,205 @@
+;;; treemacs-bookmarks.el --- A tree style file viewer package -*- lexical-binding: t -*-
+
+;; Copyright (C) 2020 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.
+
+;;; Code:
+
+(require 'bookmark)
+(require 'dash)
+(require 'f)
+(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
+   (-let [bookmarks
+          (cl-loop
+           for b in bookmark-alist
+           for name = (car b)
+           for location = (bookmark-location b)
+           when (or (f-file? location) (f-directory? 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 (f-long (get-text-property 0 'location (--first (string= it bookmark) bookmarks))))
+            (dir (if (f-directory? location) location (f-dirname 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)
+    (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 (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: ")
+             `((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