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

treemacs update

Browse Source
This commit is contained in:
Daniel Weschke
2022-12-29 12:40:49 +01:00
parent 4fe9a6b7e1
commit d95f45d049
10 changed files with 1599 additions and 59 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/magit/magit-version.el
View File

@@ -1,6 +1,6 @@
;;; magit-version.el --- the Magit version you are using
(setq magit-version 3.3.0)
(setq magit-version "3.3.0")
(provide 'migit-version)

83
lisp/posframe/posframe-benchmark.el Normal file
View File

@@ -0,0 +1,83 @@
;;; posframe-benchmark.el --- Benchmark tool for posframe -*- lexical-binding:t -*-
;; Copyright (C) 2018-2020 Free Software Foundation, Inc.
;; Author: Feng Shu <tumashu@163.com>
;; Maintainer: Feng Shu <tumashu@163.com>
;; URL: https://github.com/tumashu/posframe
;; Version: 1.0.3
;; Keywords: convenience, tooltip
;; Package-Requires: ((emacs "26"))
;; This file is part of GNU Emacs.
;; GNU Emacs 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.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'cl-lib)
(require 'posframe)
(defvar posframe-benchmark-alist
(let ((str (with-temp-buffer
(insert-file-contents (locate-library "posframe.el"))
(buffer-string))))
`((font-at
(font-at (point-min)))
(redraw-display
(redraw-display))
(redraw-frame
(redraw-frame (window-frame)))
(remove-text-properties
(let ((string ,str))
(remove-text-properties
0 (length string) '(read-only t)
string)))
(mouse-position
(mouse-position))
(default-font-width
(default-font-width))
(posframe--get-font-height
(posframe--get-font-height (point-min)))
(frame-parameter
(frame-parameter (window-frame) 'no-accept-focus))
(set-mouse-position
(set-mouse-position (window-frame) 0 0))
(posn-at-point
(posn-at-point))
(posn-x-y
(posn-x-y (posn-at-point)))
(posn-object-x-y
(posn-object-x-y (posn-at-point)))
(set-frame-parameter
(set-frame-parameter (window-frame) 'test 1))
(raise-frame
(raise-frame (window-frame))))))
;;;###autoload
(defun posframe-benchmark ()
"Benchmark tool for posframe."
(interactive)
(let ((n 1000))
(message "\n* Posframe Benchmark")
(dolist (x posframe-benchmark-alist)
(message "\n** Benchmark `%S' %s times ..." (car x) n)
(benchmark n (car (cdr x))))
(message "\n* Finished.")))
(provide 'posframe-benchmark)
;;; posframe.el ends here

12
lisp/posframe/posframe-pkg.el Normal file
View File

@@ -0,0 +1,12 @@
(define-package "posframe" "20221220.544" "Pop a posframe (just a frame) at point"
'((emacs "26.1"))
:commit "aa88860a16e28a311f81e18f1d9ed2e7d9e33991" :authors
'(("Feng Shu" . "tumashu@163.com"))
:maintainer
'("Feng Shu" . "tumashu@163.com")
:keywords
'("convenience" "tooltip")
:url "https://github.com/tumashu/posframe")
;; Local Variables:
;; no-byte-compile: t
;; End:

1450
lisp/posframe/posframe.el Normal file
View File

File diff suppressed because it is too large Load Diff

53
lisp/treemacs/treemacs-annotations.el
View File

@@ -129,7 +129,7 @@ SOURCE: String"
(treemacs-annotation->face-value ann)
(append (mapcar #'cdr new-faces) git-face))
(setf
(treemacs-annotation->face ann) 'deleted
(treemacs-annotation->face ann) nil
(treemacs-annotation->face-value ann) git-face)))))))
(defun treemacs-clear-annotation-faces (source)
@@ -277,38 +277,25 @@ GIT-FACE is taken from the latest git cache, or nil if it's not known."
(old-git-face (treemacs-annotation->git-face ann)))
;; Faces
(if (eq 'deleted faces)
;; face annotation was deleted - only the git face remains
;; as the annotation value
(progn
(setf
(treemacs-annotation->face ann) nil
(treemacs-annotation->face-value ann) ,git-face
(treemacs-annotation->git-face ann) ,git-face)
(unless ,git-face
(treemacs--remove-annotation-if-empty ann path))
(put-text-property
btn-start btn-end 'face
,git-face))
;; annotations are present, value needs updating if the git face
;; has changed
(let ((new-face-value
(or
(cond
((and ,git-face (not (equal ,git-face old-git-face)))
(append (mapcar #'cdr faces)
(list ,git-face)))
((and old-git-face (null ,git-face))
(mapcar #'cdr faces))
(t face-value))
(treemacs-button-get ,btn :default-face))))
(setf (treemacs-annotation->face-value ann)
new-face-value
(treemacs-annotation->git-face ann)
,git-face)
(put-text-property
btn-start btn-end 'face
new-face-value)))
;; annotations are present, value needs updating if the git face
;; has changed
(let ((new-face-value
(or
(cond
((and ,git-face (not (equal ,git-face old-git-face)))
(append (mapcar #'cdr faces)
(list ,git-face)))
((and old-git-face (null ,git-face))
(mapcar #'cdr faces))
(t face-value))
(treemacs-button-get ,btn :default-face))))
(setf (treemacs-annotation->face-value ann)
new-face-value
(treemacs-annotation->git-face ann)
,git-face)
(put-text-property
btn-start btn-end 'face
new-face-value))
;; Suffix
(goto-char ,btn)

4
lisp/treemacs/treemacs-hydras.el
View File

@@ -241,7 +241,7 @@ find the key a command is bound to it will show a blank instead."
(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))
(column-window (propertize "Other Window." 'face 'treemacs-help-column-face))
(column-window (propertize "Other Window" '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)))
@@ -278,7 +278,7 @@ find the key a command is bound to it will show a blank instead."
%s
%s (%s)
%s ^^^^^^^^^^^^^│ %s ^^^^^^^^│ %s ^^^^^^^^^^^│ %s
%s ^^^^^^^^^^^^^│ %s ^^^^^^^^│ %s ^^^^^^^^^^│ %s
―――――――――――――――――――――┼―――――――――――――――――――――――――――――┼――――――――――――――――――――┼――――――――――――――――――――――
%s create file ^^^^│ %s Edit Workspaces ^^^^^^^^│ %s peek ^^^^^^│ %s refresh
%s create dir ^^^^│ %s Create Workspace ^^^^^^^^│ %s line down ^^^^^^│ %s (re)set width

4
lisp/treemacs/treemacs-pkg.el
View File

@@ -1,4 +1,4 @@
(define-package "treemacs" "20221107.2105" "A tree style file explorer package"
(define-package "treemacs" "20221221.1301" "A tree style file explorer package"
'((emacs "26.1")
(cl-lib "0.5")
(dash "2.11.0")
@@ -8,7 +8,7 @@
(hydra "0.13.2")
(ht "2.2")
(cfrs "1.3.2"))
:commit "b19060f25e55514f3d798d9f5af2dcd5b94a6026" :authors
:commit "71e5df66b99ffe16de65fb4783e7484b05aae6cb" :authors
'(("Alexander Miller" . "alexanderm@web.de"))
:maintainer
'("Alexander Miller" . "alexanderm@web.de")

10
lisp/treemacs/treemacs-rendering.el
View File

@@ -468,13 +468,14 @@ set to PARENT."
(treemacs-dom-node->insert-into-dom! it))
(treemacs--inplace-map-when-unrolled dir-strings 2
(-if-let (ann (treemacs-get-annotation (concat ,root "/" it)))
(-if-let* ((ann (treemacs-get-annotation (concat ,root "/" it)))
(face (treemacs-annotation->face-value ann)))
(progn
(put-text-property
0
(length it)
'face
(treemacs-annotation->face-value ann)
face
it)
(concat it (treemacs-annotation->suffix-value ann)))
(put-text-property
@@ -489,13 +490,14 @@ set to PARENT."
(end-of-line)
(setf file-strings
(treemacs--inplace-map-when-unrolled file-strings 3
(-if-let (ann (treemacs-get-annotation (concat ,root "/" it)))
(-if-let* ((ann (treemacs-get-annotation (concat ,root "/" it)))
(face (treemacs-annotation->face-value ann)))
(progn
(put-text-property
0
(length it)
'face
(treemacs-annotation->face-value ann)
face
it)
(concat it (treemacs-annotation->suffix-value ann)))
(put-text-property

18
lisp/treemacs/treemacs-treelib.el
View File

@@ -742,7 +742,7 @@ If a prefix ARG is provided expand recursively."
(treemacs--do-expand-extension-node
btn ext async-cache arg)
(unless busy?
(treemacs-update-async-node path))))
(treemacs-update-async-node path (marker-buffer btn)))))
((treemacs-extension->async? ext)
(treemacs--do-expand-async-extension-node btn ext arg))
(t
@@ -956,8 +956,9 @@ EXPAND-DEPTH: Int"
(goto-char (treemacs-button-start it))
(treemacs-expand-extension-node expand-depth))))))))
(defun treemacs-update-async-node (path)
"Update an asynchronous node at the given PATH.
(defun treemacs-update-async-node (path buffer)
"Update an asynchronous node at PATH in the given BUFFER.
The update process will asynchronously pre-compute the children for every node
currently expanded under PATH. The results of this computation will be cached
and then used to update the UI in one go."
@@ -973,7 +974,7 @@ and then used to update the UI in one go."
children-fn btn item
(lambda (items)
(treemacs--async-update-part-complete
path item-path items)))))))
path item-path items buffer)))))))
(defun treemacs--get-async-update-items (path)
"Get the items needed for an async update at the given PATH.
@@ -988,18 +989,19 @@ extensions instance."
(push (cons key ext) items))))
items))
(defun treemacs--async-update-part-complete (top-path updated-path items)
(defun treemacs--async-update-part-complete (top-path updated-path items buffer)
"Partial completion for an asynchronous update.
TOP-PATH is the path of the node the update was called for.
UPDATED-PATH is the path of one of top node's children (may also be TOP-PATH)
whose content has just been computed.
ITEMS are the new items for the UPDATED-PATH that will be cached for the next
update."
update.
BUFFER is the buffer where the node is located."
(ht-set! treemacs--async-update-cache updated-path (or items 'nothing))
(-let [count (cl-decf (ht-get treemacs--async-update-count top-path))]
(when (= 0 count)
(--when-let (treemacs-get-local-buffer)
(with-current-buffer it
(--when-let (buffer-live-p buffer)
(with-current-buffer buffer
(treemacs-with-writable-buffer
(treemacs-update-node top-path)
(treemacs-button-put (treemacs-find-node updated-path) :busy nil)))))))