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

update of packages

Browse Source
This commit is contained in:
Daniel Weschke
2023-11-04 19:26:41 +01:00
parent e162a12b58
commit 3b54a3236d
726 changed files with 297673 additions and 34585 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@@ -1,6 +1,6 @@
;;; treemacs.el --- A tree style file viewer package -*- lexical-binding: t -*-
;; Copyright (C) 2022 Alexander Miller
;; Copyright (C) 2023 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
@@ -125,6 +125,18 @@ the height of treemacs' icons must be taken into account."
(inline-letevals (f1 f2)
(inline-quote (string-lessp ,f2 ,f1))))
(define-inline treemacs--sort-alphabetic-numeric-asc (f1 f2)
"Sort F1 and F2 alphabetically and numerically ascending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-version-lessp ,f1 ,f2))))
(define-inline treemacs--sort-alphabetic-numeric-desc (f1 f2)
"Sort F1 and F2 alphabetically and numerically descending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-version-lessp ,f2 ,f1))))
(define-inline treemacs--sort-alphabetic-case-insensitive-asc (f1 f2)
"Sort F1 and F2 case insensitive alphabetically ascending."
(declare (pure t) (side-effect-free t))
@@ -137,6 +149,18 @@ the height of treemacs' icons must be taken into account."
(inline-letevals (f1 f2)
(inline-quote (string-lessp (downcase ,f2) (downcase ,f1)))))
(define-inline treemacs--sort-alphabetic-numeric-case-insensitive-asc (f1 f2)
"Sort F1 and F2 case insensitive alphabetically and numerically ascending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-version-lessp (downcase ,f1) (downcase ,f2)))))
(define-inline treemacs--sort-alphabetic-numeric-case-insensitive-desc (f1 f2)
"Sort F1 and F2 case insensitive alphabetically and numerically descending."
(declare (pure t) (side-effect-free t))
(inline-letevals (f1 f2)
(inline-quote (string-version-lessp (downcase ,f2) (downcase ,f1)))))
(define-inline treemacs--sort-size-asc (f1 f2)
"Sort F1 and F2 by size ascending."
(declare (side-effect-free t))
@@ -176,8 +200,12 @@ the height of treemacs' icons must be taken into account."
(pcase treemacs-sorting
('alphabetic-asc #'treemacs--sort-alphabetic-asc)
('alphabetic-desc #'treemacs--sort-alphabetic-desc)
('alphabetic-numeric-asc #'treemacs--sort-alphabetic-numeric-asc)
('alphabetic-numeric-desc #'treemacs--sort-alphabetic-numeric-desc)
('alphabetic-case-insensitive-asc #'treemacs--sort-alphabetic-case-insensitive-asc)
('alphabetic-case-insensitive-desc #'treemacs--sort-alphabetic-case-insensitive-desc)
('alphabetic-numeric-case-insensitive-asc #'treemacs--sort-alphabetic-numeric-case-insensitive-asc)
('alphabetic-numeric-case-insensitive-desc #'treemacs--sort-alphabetic-numeric-case-insensitive-desc)
('size-asc #'treemacs--sort-size-asc)
('size-desc #'treemacs--sort-size-desc)
('mod-time-asc #'treemacs--sort-mod-time-asc)
@@ -202,23 +230,24 @@ the height of treemacs' icons must be taken into account."
PREFIX is a string inserted as indentation.
PARENT is the (optional) button under which this one is inserted.
DEPTH indicates how deep in the filetree the current button is."
;; for directories the icon is included in the prefix since it's always known
(inline-letevals (path prefix parent depth)
(inline-quote
(list
,prefix
(propertize (->> ,path file-name-nondirectory (funcall treemacs-directory-name-transformer))
'button '(t)
'category 'default-button
'help-echo nil
'keymap nil
:default-face 'treemacs-directory-face
:state 'dir-node-closed
:path ,path
:key ,path
:symlink (file-symlink-p ,path)
:parent ,parent
:depth ,depth)))))
(let ((dir-name (file-name-nondirectory ,path)))
(list
,prefix
(treemacs-icon-for-dir dir-name 'closed)
(propertize (->> dir-name (funcall treemacs-directory-name-transformer))
'button '(t)
'category 'default-button
'help-echo nil
'keymap nil
:default-face 'treemacs-directory-face
:state 'dir-node-closed
:path ,path
:key ,path
:symlink (file-symlink-p ,path)
:parent ,parent
:depth ,depth))))))
(define-inline treemacs--create-file-button-strings (path prefix parent depth)
"Return the text to insert for a file button for PATH.
@@ -346,10 +375,18 @@ DIRS: List of Collapse Paths. Each Collapse Path is a list of
(-let [beg (point)]
(insert label-to-add)
(add-text-properties beg (point) props)
(unless (memq treemacs--git-mode '(deferred extended))
(unless (treemacs--non-simple-git-mode-enabled)
(add-text-properties
beg (point)
'(face treemacs-directory-collapsed-face)))))))))))
'(face treemacs-directory-collapsed-face)))
(-when-let* ((ann (treemacs-get-annotation new-path))
(git-cache
(->> original-path
(treemacs--parent-dir)
(ht-get treemacs--git-cache))))
(treemacs-button-put
b 'face
(treemacs-annotation->face-value ann)))))))))))
(defmacro treemacs--inplace-map-when-unrolled (items interval &rest mapper)
"Unrolled in-place mapping operation.
@@ -390,10 +427,9 @@ set to PARENT."
(setq dir-strings
(treemacs--create-buttons
:nodes dirs
:extra-vars ((dir-prefix (concat prefix treemacs-icon-dir-closed)))
:depth ,depth
:node-name node
:node-action (treemacs--create-dir-button-strings node dir-prefix ,parent ,depth)))
:node-action (treemacs--create-dir-button-strings node prefix ,parent ,depth)))
(setq file-strings
(treemacs--create-buttons
:nodes files
@@ -446,13 +482,14 @@ set to PARENT."
(-let [result nil]
(while dir-strings
(let* ((prefix (car dir-strings))
(dirname (cadr dir-strings))
(icon (cadr dir-strings))
(dirname (caddr dir-strings))
(dirpath (concat ,root "/" dirname)))
(unless (--any? (funcall it dirpath git-info) treemacs-pre-file-insert-predicates)
(setq result (cons dirname (cons prefix result)))
(setq result (cons dirname (cons icon (cons prefix result))))
(push (treemacs-dom-node->create! :parent parent-node :key dirpath)
dir-dom-nodes)))
(setq dir-strings (cddr dir-strings)))
(setq dir-strings (cdddr dir-strings)))
(setq dir-strings (nreverse result))))
(setf
file-dom-nodes
@@ -467,24 +504,25 @@ set to PARENT."
(dolist (it (treemacs-dom-node->children parent-node))
(treemacs-dom-node->insert-into-dom! it))
(treemacs--inplace-map-when-unrolled dir-strings 2
(-if-let* ((ann (treemacs-get-annotation (concat ,root "/" it)))
(face (treemacs-annotation->face-value ann)))
(progn
(put-text-property
0
(length it)
'face
face
it)
(concat it (treemacs-annotation->suffix-value ann)))
(put-text-property
0
(length it)
'face
'treemacs-directory-face
it)
it))
(setf dir-strings
(treemacs--inplace-map-when-unrolled dir-strings 3
(-if-let* ((ann (treemacs-get-annotation (concat ,root "/" it)))
(face (treemacs-annotation->face-value ann)))
(progn
(put-text-property
0
(length it)
'face
face
it)
(concat it (treemacs-annotation->suffix-value ann)))
(put-text-property
0
(length it)
'face
'treemacs-directory-face
it)
it)))
(insert (apply #'concat dir-strings))
(end-of-line)
@@ -512,7 +550,8 @@ set to PARENT."
(save-excursion
(treemacs--flatten-dirs (treemacs--parse-collapsed-dirs ,collapse-process))
(treemacs--reentry ,root ,git-future))
(line-end-position))))))
(with-no-warnings
(line-end-position)))))))
(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.
@@ -614,12 +653,13 @@ RECURSIVE: Bool"
(treemacs--git-status-process (file-truename path) project)
(or git-future (treemacs--git-status-process path project))))
(collapse-future (treemacs--collapsed-dirs-process path project))
(recursive (treemacs--prefix-arg-to-recurse-depth recursive)))
(recursive (treemacs--prefix-arg-to-recurse-depth recursive))
(dir-name (treemacs--filename path)))
(treemacs--button-open
:immediate-insert nil
:button btn
:new-state 'dir-node-open
:new-icon treemacs-icon-dir-open
:new-icon (treemacs-icon-for-dir dir-name 'open)
:open-action
(progn
;; do on-expand first so buttons that need collapsing can quickly find their parent
@@ -640,14 +680,15 @@ RECURSIVE: Bool"
(defun treemacs--collapse-dir-node (btn &optional recursive)
"Close node given by BTN.
Remove all open dir and tag entries under BTN when RECURSIVE."
(treemacs--button-close
:button btn
:new-state 'dir-node-closed
:new-icon treemacs-icon-dir-closed
:post-close-action
(-let [path (treemacs-button-get btn :path)]
(treemacs--stop-watching path)
(treemacs-on-collapse path recursive))))
(-let [path (treemacs-button-get btn :path)]
(treemacs--button-close
:button btn
:new-state 'dir-node-closed
:new-icon (treemacs-icon-for-dir (treemacs--filename path) 'closed)
:post-close-action
(progn
(treemacs--stop-watching path)
(treemacs-on-collapse path recursive)))))
(defun treemacs--root-face (project)
"Get the face to be used for PROJECT."
@@ -1021,13 +1062,12 @@ DEPTH: Int"
(let* ((strs)
(face))
(if (file-directory-p ,path)
(setf strs (treemacs--create-dir-button-strings
,path
(concat prefix treemacs-icon-dir-closed)
,parent
,depth)
face 'treemacs-directory-face)
(setf strs (treemacs--create-file-button-strings ,path prefix ,parent ,depth)
(setf
strs (treemacs--create-dir-button-strings
,path prefix ,parent ,depth)
face 'treemacs-directory-face)
(setf strs (treemacs--create-file-button-strings
,path prefix ,parent ,depth)
face 'treemacs-file-face))
(-let [last (-last-item strs)]
(put-text-property 0 (length last) 'face face last))
@@ -1168,7 +1208,7 @@ GIT-INFO is passed through from the previous branch build."
('file-node-closed (treemacs--expand-file-node btn))
('tag-node-closed (treemacs--expand-tag-node btn))
('root-node-closed (treemacs--expand-root-node btn))
(other (funcall (alist-get other treemacs-TAB-actions-config) btn))))
(other (funcall (alist-get other treemacs-TAB-actions-config)))))
(defun treemacs--show-single-project (path name)
"Show only a project for the given PATH and NAME in the current workspace."