sqrtminusone/sqrtminusone.github.io
1
0
Fork 0
mirror of https://github.com/SqrtMinusOne/sqrtminusone.github.io.git synced 2025-12-10 15:53:03 +03:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #4 from SqrtMinusOne/index

Browse source 
Index
This commit is contained in:
Pavel Korytov 2023-11-11 12:51:42 +03:00 • committed by GitHub
commit e10cb2ee55
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
5 changed files with 1957 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
assets/sass/researcher.scss
View file

@ -257,6 +257,17 @@ $toc-left-width: $toc-width + $max-width + 25px;
margin-bottom: 0px; margin-bottom: 0px;
} }
} }
.abstract {
margin-top: 12px;
margin-bottom: 12px;
padding-left: 72px;
padding-right: 72px;
p:first-of-type::before {
content: "Abstract: ";
font-weight: bold;
}
}
} }
#footer { #footer {
a { a {

1004
content/posts/2023-11-11-index.md Normal file
View file

File diff suppressed because it is too large Load diff

942
org/2023-11-11-index.org Normal file
View file

@ -0,0 +1,942 @@
#+HUGO_SECTION: posts
#+HUGO_BASE_DIR: ../
#+TITLE: Declarative filesystem management with Emacs & Org Mode
#+DATE: 2023-11-11
#+HUGO_TAGS: emacs
#+HUGO_TAGS: orgmode
#+HUGO_DRAFT: true
#+begin_abstract
The post describes a Johnny.Decimal-inspired filesystem structure, declared in an org file and synchronized across machines. Different folders are available on different machines.
#+end_abstract
* Intro
My filesystem is, shall we say, not the most orderly place.
#+begin_export html
<center>
<iframe src="https://emacs.ch/@sqrtminusone/110514686718545191/embed" class="mastodon-embed" style="max-width: 100%; border: 0" width="500" allowfullscreen="allowfullscreen"></iframe><script src="https://emacs.ch/embed.js" async="async"></script>
</center>
#+end_export
It's been somewhat messy, and messy in different ways across my three machines. For instance, my laptop had work projects in =~/Code/Job=, my work machine had just =~/Code=, and so forth.
Strangely, I couldn't find and existing solution to that problem. Surely, I can't be the only one facing that issue, can I?
Fortunately, I'm well-acquainted (make-yourself-a) Swiss Army Knife of computing called [[https://www.gnu.org/software/emacs/][Emacs]], so... below is my attempt to make something of it. And another addition to the already substantial list of my Emacs uses.
Also, my =M-x magit-log-buffer-file= shows I've created that file on the same day I had written the embedded toot, so this must be the longest Emacs thing I've been figuring out. And it's probably the least portable, but I nevertheless hope you find it useful.
* Idea
[[./static/images/index/index.png]]
So, I decided to try declarative filesystem management.
At the core is my work-in-progress adaptation of [[https://johnnydecimal.com/][Johnny.Decimal]][fn:1]. Essentially, it suggests prefixing your folders with numbers like =12.34=, where:
- the first digit is the "[[https://johnnydecimal.com/10-19-concepts/11-core/11.02-areas-and-categories/][category]]";
- the second digit is the "[[https://johnnydecimal.com/10-19-concepts/11-core/11.02-areas-and-categories/][area]]";
- the last two digits are the [[https://johnnydecimal.com/10-19-concepts/11-core/11.03-ids/][ID]].
The point is to organize your folder structure, limiting its depth for quicker and more straightforward access. Check the website for a more thorough description.
So, what I want is to:
- define a Jonny.Decimal-esque file tree in a single [[https://orgmode.org/][Org]] file;
- have different nodes of that file tree active on different machines, e.g. I don't want [[https://github.com/SqrtMinusOne?tab=repositories&q=&type=&language=emacs+lisp&sort=][my Emacs stuff]] on my work machine;
- use different tools to sync different nodes (currently [[https://git-scm.com/][git]], [[https://mega.nz/][MEGA]], and "nothing").
** Folder structure
As I said, I tried (and still trying) to adapt the proposed scheme to better suit my needs. Here's a subset of my current tree:
#+begin_example
10-19 Code
10 [REDACTED]
10.02 Digital Schedule ; project root
10.03 Digital Trajectories ; project root
12 My Emacs Packages
12.01 lyrics-fetcher.el ; managed by git
12.02 pomm.el ; managed by git
15 Other Projects
15.04 ZMU_2022 ; I'm done with this and don't need it on any machine
20-29 Education
24 Publications ; the entrire area is managed by MEGA
24.Y20.01 [bibtex code]
24.Y20.02 [bibtex code]
26 Students
26.Y22.01 [student name]
30-39 Life
32 org-mode
33 Library
#+end_example
The root of the tree is my =$HOME=. The entry at the third (or second) level can be either an entity itself (such as a git repository), or a "project root".
In several places, I use year references (=Y20=) instead of the plain =AC.ID=. This is mainly to group things by academic years, e.g. to find all my publications or students in a specific year, which I need for occasional reports. I also have semester references (=SEM10=) for my undergraduate studies.
The project structure is more or less standard. Johnny.Decimal [[https://johnnydecimal.com/10-19-concepts/13-multiple-projects/13.01-introduction/][proposes]] using =PRO.AC.ID= to manage multiple projects, but this doesn't seem to fit quite as well in my case. So I came up with the following:
#+begin_example
10.03 Digital Trajectories ; project root
10.03.A Artifacts ; managed by MEGA
10.03.A.04 library queries (Jan 23)
10.03.D Documents ; managed by MEGA
10.03.D.01 Initial design
10.03.R Repos
10.03.R.00 digital-trajectories-deploy ; managed by MEGA
10.03.R.01 digital-trajectories-backend ; managed by git
10.03.U Dumps ; managed by nothing, no need to sync this
#+end_example
I also use year references on the third level for courses I happen to teach across multiple academic years.
Perhaps this is too verbose (=10.03.R.01=), but it works for now.
** Tools choice
As I mentioned earlier, my current options to manage a particular node are:
- [[https://git-scm.com/][git]];
- [[https://mega.nz/][MEGA]] - for files that don't fit into git, such as DOCX documents, photos, etc.;
- "nothing" - for something that I don't need to sync across machines, e.g. database dumps.
Another tool I considered was [[https://github.com/restic/restic][restic]]. It's an interesting backup & sync solution with built-in encryption, snapshots, etc.
However, a challenge I encountered is that its repositories are only accessible via restic. So, even if I use something like MEGA as a backend, I won't be able to use the MEGA file-sharing features, which I occasionally want for document or photo folders. Hence, for now, I'm more interested in synchronizing the file tree in MEGA with [[https://github.com/meganz/MEGAcmd][MEGAcmd]] (and also clean up the mess up there).
Another interesting tool is [[https://rclone.org/][rclone]], which provides a single interface for multiple services like Google Drive, Dropbox, S3, WebDAV. It also supports MEGA, but it requires turning off the two-factor authentication, which I don't want.
* Implementation
** Dependencies
We'll need lexical binding.
#+begin_src emacs-lisp
;;; -*- lexical-binding: t -*-
#+end_src
And a package called [[https://github.com/daniel-ness/ini.el][ini.el]] to parse INI files.
#+begin_src emacs-lisp
(use-package ini
:straight (:host github :repo "daniel-ness/ini.el"))
#+end_src
The rest is built into Emacs.
** Org tree
*** Tree definitions
The root is my =$HOME= directory.
#+begin_src emacs-lisp
(defvar my/index-root (concat (getenv "HOME") "/"))
#+end_src
The org tree is located in my =org-mode= folder in a file called =index.org=:
#+begin_src emacs-lisp
(defvar my/index-file
(concat org-directory "/misc/index.org"))
#+end_src
Each "area" is an Org header with the =folder= tag; the Org hierarchy forms the file tree. A header can have the following properties:
- =machine= - a list of hostnames for which the node is active (or =nil=)
- =kind= - =mega=, =git=, or =dummy=
- =remote= - remote URL for =git=
- =symlink= - in case the folder has to be symlinked somewhere else[fn:2]
E.g. a part of the tree above:
#+begin_src org
,* 10-19 Code :folder:
,** 10 [REDACTED]
,*** 10.03 Digital Trajectories
:PROPERTIES:
:machine: indigo eminence
:project: t
:END:
,**** 10.03.A Artifacts
:PROPERTIES:
:kind: mega
:END:
,**** 10.03.D Documents
:PROPERTIES:
:kind: mega
:END:
,**** 10.03.R Repos
,***** 10.03.R.00 digital-trajectories-deploy
:PROPERTIES:
:kind: mega
:END:
,***** 10.03.R.01 digital-trajectories-backend
:PROPERTIES:
:kind: git
:remote: [REACTED]
:END:
,**** 10.03.U Dumps
:PROPERTIES:
:kind: dummy
:END:
#+end_src
*** Parse tree
So, let's parse the Org tree. This is done by recursively traversing the tree returned by =org-element-parse-buffer=.
#+begin_src emacs-lisp
(defun my/index--tree-get-recursive (heading &optional path)
"Read the index tree recursively from HEADING.
HEADING is an org-element of type `headline'.
If PATH is provided, it is the path to the current node. If not
provided, it is assumed to be the root of the index.
The return value is an alist; see `my/index--tree-get' for details."
(when (eq (org-element-type heading) 'headline)
(let (val
(new-path (concat
(or path my/index-root)
(org-element-property :raw-value heading)
"/")))
(when-let* ((children (thread-last
(org-element-contents heading)
(mapcar (lambda (e)
(my/index--tree-get-recursive
e new-path)))
(seq-filter #'identity))))
(setf (alist-get :children val) children))
(when-let ((machine (org-element-property :MACHINE heading)))
(setf (alist-get :machine val) (split-string machine)))
(when-let ((symlink (org-element-property :SYMLINK heading)))
(setf (alist-get :symlink val) symlink))
(when (org-element-property :PROJECT heading)
(setf (alist-get :project val) t))
(when-let* ((kind-str (org-element-property :KIND heading))
(kind (intern kind-str)))
(setf (alist-get :kind val) kind)
(when (equal kind 'git)
(let ((remote (org-element-property :REMOTE heading)))
(unless remote
(user-error "No remote for %s" (alist-get :name val)))
(setf (alist-get :remote val) remote))))
(setf (alist-get :name val) (org-element-property :raw-value heading)
(alist-get :path val) new-path)
val)))
(defun my/index--tree-get ()
"Read the index tree from the current org buffer.
The return value is a list of alists, each representing a
folder/node. Alists can have the following keys:
- `:name'
- `:path'
- `:children' - child nodes
- `:machine' - list of machines on which the node is active
- `:symlink' - a symlink to create
- `:kind' - one of \"git\", \"mega\", or \"dummy\"
- `:remote' - the remote to use for git nodes"
(let* ((tree
(thread-last
(org-element-map (org-element-parse-buffer) 'headline #'identity)
(seq-filter (lambda (el)
(and
(= (org-element-property :level el) 1)
(seq-contains-p
(mapcar #'substring-no-properties (org-element-property :tags el))
"folder"))))
(mapcar #'my/index--tree-get-recursive))))
tree))
#+end_src
*** Verify tree
I also want to make sure that I didn't mess up the numbers, i.e., didn't place =10.02= under =11=, and so on.
To do that, we first need to extract the number from the name:
#+begin_src emacs-lisp
(defun my/index--extact-number (name)
"Extract the number from the index NAME.
NAME is a string. The number is the first sequence of digits, e.g.:
- 10-19
- 10.01
- 10.01.Y22.01"
(save-match-data
(string-match (rx bos (+ (| num alpha "." "-"))) name)
(match-string 0 name)))
#+end_src
Then, we can recursively verify the numbers:
#+begin_src emacs-lisp
(defun my/tree--verfify-recursive (elem &optional current)
"Verify that ELEM is a valid tree element.
CURRENT is the current number or name of the parent element."
(let* ((name (alist-get :name elem))
(number (my/index--extact-number name)))
(unless number
(user-error "Can't find number: %s" name))
(cond
((and (listp current) (not (null current)))
(unless (seq-some (lambda (cand) (string-prefix-p cand name)) current)
(user-error "Name: %s doesn't match: %s" name current)))
((stringp current)
(unless (string-prefix-p current name)
(user-error "Name: %s doesn't match: %s" name current))))
(let ((recur-value
(if (string-match-p (rx (+ num) "-" (+ num)) number)
(let* ((borders (split-string number "-"))
(start (string-to-number (nth 0 borders)))
(end (string-to-number (nth 1 borders))))
(cl-loop for i from start to (1- end) collect (number-to-string i)))
number)))
(mapcar (lambda (e) (my/tree--verfify-recursive e recur-value))
(alist-get :children elem))))
t)
(defun my/index--tree-verify (tree)
"Verify that TREE is a valid tree.
Return t if it is valid, otherwise raise an error.
See `my/index--tree-get' for the format of TREE."
(mapcar #'my/tree--verfify-recursive tree))
#+end_src
*** Narrow tree
Finally, we need to narrow the tree to only leave nodes that are active for the current machine.
#+begin_src emacs-lisp
(defun my/index--tree-narrow-recursive (elem machine)
"Remove all children of ELEM that are not active on MACHINE."
(unless (when-let ((elem-machines (alist-get :machine elem)))
(not (seq-some (lambda (elem-machine)
(string-equal elem-machine machine))
elem-machines)))
(setf (alist-get :children elem)
(seq-filter
#'identity
(mapcar (lambda (e)
(my/index--tree-narrow-recursive e machine))
(alist-get :children elem))))
elem))
(defun my/index--tree-narrow (tree)
"Remove all elements of TREE that are not active on machine."
(seq-filter
#'identity
(mapcar
(lambda (elem) (my/index--tree-narrow-recursive elem (system-name)))
(copy-tree tree))))
#+end_src
#+RESULTS:
: my/index--tree-narrow
** Commands
Next, apply the tree to the filesystem.
I've decided to implement this by generating a bash script and executing it with =bash +x=. This way, I can check the required changes in advance and avert potential data loss if something unexpected happens.
One command for the script will be a list like:
- =(<command> <category> <priority>)=
*** Filesystem
First, we need to create non-existing folders and remove folders that aren't supposed to exist.
To do that, we need to find all such folders:
#+begin_src emacs-lisp
(defun my/index--filesystem-tree-mapping (full-tree tree &optional active-paths)
"Return a \"sync state\" between the filesystem and the tree.
FULL-TREE and TREE are forms as defined by `my/index--tree-get'. TREE
is the narrowed FULL-TREE (returned by `my/index--tree-narrow').
ACTIVE-PATHS is a list of paths that are currently active. If not
provided, it is computed from TREE.
The return value is a list of alists with the following keys:
- path - the path of the folder
- exists - whether the folder exists on the filesystem
- has-to-exist - whether the folder exists in the tree
- extra - if the folder exists in the filesystem but not in the tree.
- children - a list of alists with the same keys for the children of
the folder."
(let ((active-paths (or active-paths (my/index--tree-get-paths tree))))
(cl-loop for elem in full-tree
for path = (alist-get :path elem)
for extra-folders = (when (and (alist-get :children elem)
(file-directory-p path))
(seq-difference
(mapcar (lambda (d) (if (file-directory-p d)
(concat d "/")
d))
(directory-files path t (rx (not ".") eos)))
(cl-loop for child in (alist-get :children elem)
collect (alist-get :path child))))
for folder-exists = (file-directory-p path)
for folder-has-to-exist = (seq-contains-p active-paths path)
collect `((path . ,path)
(exists . ,folder-exists)
(has-to-exist . ,folder-has-to-exist)
(children . ,(append
(cl-loop for f in extra-folders
collect `((path . ,f)
(exists . t)
(has-to-exist . nil)
(extra . t)))
(my/index--filesystem-tree-mapping
(alist-get :children elem) tree active-paths)))))))
#+end_src
And generate commands from the results of the above:
#+begin_src emacs-lisp
(defun my/index--filesystem-commands (mapping)
"Get commands to sync filesystem with the tree.
MAPPING is a form generated by `my/index--filesystem-tree-mapping'
that describes the \"sync state\" between the filesystem and the
tree.
The return value is a list of commands as defined by
`my/index--commands-display'."
(cl-loop for elem in mapping
for path = (alist-get 'path elem)
for exists = (alist-get 'exists elem)
for has-to-exist = (alist-get 'has-to-exist elem)
for extra = (alist-get 'extra elem)
when (and (not exists) has-to-exist)
collect (list (format "mkdir \"%s\"" path) "Make directories" 1)
when (and exists (not has-to-exist))
collect (list (format "rm -rf \"%s\"" path)
(if extra "Remove extra files" "Remove directories")
(if extra 20 10))
append (my/index--filesystem-commands (alist-get 'children elem))))
#+end_src
*** MEGA
As I said above, MEGA provides [[https://github.com/meganz/MEGAcmd][MEGAcmd]], which is a convenient way to access MEGA via CLI.
To initialize the session, run
#+begin_src bash
mega-login <login> <password>
#+end_src
Then you'll be able to run the rest of =mega-*= commands.
The command I want to run, =mega-sync=, prints the results in a table-like way. So let's parse that.
#+begin_src emacs-lisp
(defun my/parse-table-str (string)
"Convert a table-like STRING into alist.
The input format is as follows:
HEADER1 HEADER2 HEADER3
value1 value2 3
value4 value5 6
Which creates the following output:
\(((HEADER1. \"value1\") (HEADER2 . \"value2\") (HEADER3 . \"3\"))
((HEADER1. \"value4\") (HEADER2 . \"value5\") (HEADER3 . \"6\")))
The functions also skips lines in [square brackets] and ones that
start with more than 3 spaces."
(when-let* ((lines (seq-filter
(lambda (s) (not (or (string-empty-p s)
(string-match-p (rx bos "[" (* nonl) "]") s)
(string-match-p (rx bos (>= 3 " ")) s))))
(split-string string "\n")))
(first-line (car lines))
(headers (split-string first-line))
(header-indices (mapcar
(lambda (header)
(cl-search header first-line))
headers)))
(cl-loop for line in (cdr lines)
collect (cl-loop for header in headers
for start in header-indices
for end in (append (cdr header-indices)
(list (length line)))
collect (cons
(intern header)
(string-trim
(substring line start end)))))))
#+end_src
Now we can invoke =mega-sync= to get the current sync status. =--path-display-size=10000= disables truncation of long paths.
#+begin_src emacs-lisp
(defun my/index--mega-data-from-sync ()
"Get the current MEGA sync status.
The return value is a list of alists with the following keys:
- path - path to file or directory
- enabled - whether the file or directory is enabled for sync"
(let ((mega-result (my/parse-table-str
(shell-command-to-string "mega-sync --path-display-size=10000"))))
(cl-loop for value in mega-result
for localpath = (alist-get 'LOCALPATH value)
collect `((path . ,(if (file-directory-p localpath)
(concat localpath "/")
localpath))
(enabled . ,(string-equal (alist-get 'ACTIVE value)
"Enabled"))))))
#+end_src
And get the same data from the tree.
#+begin_src emacs-lisp
(defun my/index--tree-get-paths (tree &optional kind)
"Get paths from TREE.
TREE is a form a defined by `my/index--tree-get'. KIND is either a
filter by the kind attribute or nil, in which case all paths are
returned.
The return value is a list of strings."
(cl-loop for elem in tree
when (or (null kind) (eq (alist-get :kind elem) kind))
collect (alist-get :path elem)
append (my/index--tree-get-paths
(alist-get :children elem) kind)))
#+end_src
With that information, we can generate commands to synchronize the required and actual sync paths.
#+begin_src emacs-lisp
(defun my/index--mega-local-path (path)
"Get path in the MEGA cloud by the local path PATH."
(string-replace my/index-root "/" path))
(defun my/index--mega-commands (full-tree tree)
"Get commands to sync the mega-sync state with TREE.
FULL-TREE and TREE are forms as defined by `my/index--tree-get'. TREE
is the narrowed FULL-TREE (returned by `my/index--tree-narrow').
The return value is a list of commands as defined by
`my/index--commands-display'."
(let* ((paths-all (my/index--tree-get-paths full-tree))
(mega-paths-to-enable (my/index--tree-get-paths tree 'mega))
(mega-info (my/index--mega-data-from-sync))
(mega-paths-enabled (seq-map
(lambda (e) (alist-get 'path e))
(seq-filter (lambda (e) (alist-get 'enabled e))
mega-info)))
(mega-paths-disabled (seq-map
(lambda (e) (alist-get 'path e))
(seq-filter (lambda (e) (not (alist-get 'enabled e)))
mega-info))))
(append
(cl-loop for path in (seq-difference mega-paths-to-enable mega-paths-enabled)
if (seq-contains-p mega-paths-disabled path)
collect (list (format "mega-sync -e \"%s\"" path) "Mega enable sync" 5)
else append (list
(list (format "mega-mkdir -p \"%s\""
(my/index--mega-local-path path))
"Mega mkdirs" 4)
(list (format "mega-sync \"%s\" \"%s\""
path (my/index--mega-local-path path))
"Mega add sync" 5)))
(cl-loop for path in (seq-difference
(seq-intersection mega-paths-enabled paths-all)
mega-paths-to-enable)
collect (list
(format "mega-sync -d \"%s\""
(substring path 0 (1- (length path))))
"Mega remove sync" 4)))))
#+end_src
#+RESULTS:
: my/index--mega-commands
*** Git repos
To sync git, we just need to clone the required git repos. Removing the repos is handled by the folder sync commands.
#+begin_src emacs-lisp
(defun my/index--git-commands (tree)
"Get commands to clone the yet uncloned git repos in TREE.
TREE is a form a defined by `my/index--tree-get'. This is supposed to
be the tree narrowed to the current machine (`my/index--tree-narrow').
The return value is a list of commands as defined by
`my/index--commands-display'."
(cl-loop for elem in tree
for path = (alist-get :path elem)
when (and (eq (alist-get :kind elem) 'git)
(or (not (file-directory-p path))
(directory-empty-p path)))
collect (list (format "git clone \"%s\" \"%s\""
(alist-get :remote elem)
path)
"Init git repos" 2)
append (my/index--git-commands (alist-get :children elem))))
#+end_src
*** Wakatime
So, that's it for synchronization. A few other things are needed here.
I use [[https://wakatime.com/][WakaTime]] to track my coding activity, and I don't like the alphanumeric prefixes in my coding stats. Fortunately, =wakatime-cli= provides an option called [[https://github.com/wakatime/wakatime-cli/blob/develop/USAGE.md#project-map-section][projectmap]] to rename projects, so we just have to generate its contents.
#+begin_src emacs-lisp
(defun my/index--bare-project-name (name)
"Remove the alphanumeric prefix from NAME.
E.g. 10.03.R.01 Project Name -> Project Name."
(replace-regexp-in-string
(rx bos (+ (| num alpha "." "-")) space) "" name))
(defun my/index--wakatime-escape (string)
"Escape STRING for use in a WakaTime config file."
(thread-last
string
(replace-regexp-in-string (rx "'") "\\\\'")
(replace-regexp-in-string (rx "(") "\\\\(")
(replace-regexp-in-string (rx ")") "\\\\)")))
(defun my/index--wakatime-get-map-tree (tree)
"Get a list of (folder-name . bare-project-name) pairs from TREE.
TREE is a form as defined by `my/index--tree-get'.
\"bare-project-name\" is project name without the alphanumeric
prefix."
(cl-loop for elem in tree
for name = (alist-get :name elem)
if (eq (alist-get :kind elem) 'git)
collect (cons (my/index--wakatime-escape name)
(my/index--wakatime-escape
(my/index--bare-project-name name)))
if (and (eq (alist-get :kind elem) 'git)
(alist-get :symlink elem))
collect (cons (my/index--wakatime-escape
;; lmao
;; /a/b/c/ -> c
;; /a/b/c -> b
(file-name-nondirectory
(directory-file-name
(file-name-directory (alist-get :symlink elem)))))
(my/index--wakatime-escape
(my/index--bare-project-name name)))
append (my/index--wakatime-get-map-tree (alist-get :children elem))))
#+end_src
And insert that in =wakatime.cfg= if necessary.
#+begin_src emacs-lisp
(defun my/index--wakatime-commands (tree)
"Get commands to update WakaTime config from TREE.
TREE is a form a defined by `my/index--tree-get'. The return value is
a list of commands as defined by `my/index--commands-display'."
(let* ((map-tree (my/index--wakatime-get-map-tree tree))
(map-tree-encoding (ini-encode `(("projectmap" . ,map-tree))))
(map-tree-saved (with-temp-buffer
(insert-file-contents (expand-file-name "~/.wakatime.cfg"))
(string-match-p (regexp-quote map-tree-encoding)
(buffer-string)))))
(unless map-tree-saved
(let ((insert-command (list (format "echo \"\n\n%s\" >> ~/.wakatime.cfg"
map-tree-encoding)
"Update WakaTime config" 9)))
(list (list (format "sed -i -z 's/\\[projectmap\\]\\n[^[]*//g' ~/.wakatime.cfg")
"Update WakaTime config" 9)
insert-command)))))
#+end_src
#+RESULTS:
: my/index--wakatime-commands
*** Symlinks
The last part here is creating symbolic links.
#+begin_src emacs-lisp
(defun my/index-get-symlink-commands (tree)
"Get commands to create symlinks from TREE.
TREE is a form a defined by `my/index--tree-get'. The return value is
a list of commands as defined by `my/index--commands-display'."
(cl-loop for elem in tree
for path = (alist-get :path elem)
for symlink = (alist-get :symlink elem)
when (and symlink (not (string-match-p (rx "/" eos) symlink)))
do (user-error "Wrong symlink: %s (should be a directory)" symlink)
when (and path symlink
(or (file-exists-p symlink)
(file-exists-p (substring symlink 0 -1)))
(not (file-symlink-p (substring symlink 0 -1))))
collect (list (format "rm -rf %s" (substring symlink 0 -1))
"Remove files to make symlinks" 6)
when (and path symlink
(not (file-symlink-p (substring symlink 0 -1))))
collect (list (format "ln -s '%s' '%s'" path
(substring symlink 0 -1))
"Make symlinks" 7)
append (my/index-get-symlink-commands (alist-get :children elem))))
#+end_src
#+RESULTS:
: my/index-get-symlink-commands
*** Run all commands
And put that all together.
First, as I want to check what's going to be executed, let's make a function to display commands in a separate buffer. Making it =sh-mode= is enough for now.
#+begin_src emacs-lisp
(defvar-local my/index-commands nil
"Commands to be executed by `my/index-commands-exec'")
(defun my/index--commands-display (commands)
"Display COMMANDS in a buffer.
COMMANDS is a list of commands as defined by `my/index--commands-display'."
(unless commands
(user-error "No commands to display"))
(let ((buffer (get-buffer-create "*index commands*"))
(groups (seq-sort-by
(lambda (g) (nth 2 (nth 1 g)))
#'<
(seq-group-by (lambda (c) (nth 1 c))
commands))))
(with-current-buffer buffer
(sh-mode)
(let ((inhibit-read-only t)
commands-sequence)
(erase-buffer)
(setq-local my/index-commands nil)
(cl-loop for g in groups
for group-name = (car g)
for elems = (cdr g)
do (insert "# " group-name "\n")
do (cl-loop for elem in elems
do (push (nth 0 elem) my/index-commands)
do (insert (nth 0 elem) "\n")))
(setq-local buffer-read-only t)))
(switch-to-buffer buffer)))
#+end_src
In order to execute these commands, [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Compilation.html][compile]] with =bash -x= on a temporary file is quite sufficient.
#+begin_src emacs-lisp
(defun my/index-commands-exec ()
(interactive)
(unless (eq major-mode 'sh-mode)
(user-error "Not shell mode"))
(let ((filename (make-temp-file "index-commands-")))
(write-region (point-min) (point-max) filename)
(compile (concat "bash -x " filename))))
#+end_src
I'll also try to save some time by caching the resulting index tree. =file-has-changed-p= is pretty helpful in that.
#+begin_src emacs-lisp
(defvar my/index--tree nil
"The last version of the index tree.")
(defun my/index--tree-retrive ()
"Retrive the last version of the index tree.
This function returns the last saved version of the index tree if it
is still valid. Otherwise, it re-parses the index file."
(setq
my/index--tree
(cond ((string-equal (buffer-file-name) my/index-file)
(my/index--tree-get))
((or (null my/index--tree)
(file-has-changed-p my/index-file 'index))
(with-temp-buffer
(insert-file-contents my/index-file)
(let ((buffer-file-name my/index-file))
(my/index--tree-get))))
(t my/index--tree))))
#+end_src
With that, we can make the main entrypoint.
#+begin_src emacs-lisp
(defun my/index-commands-sync ()
"Sync the filesystem with the index."
(interactive)
(let* ((full-tree (my/index--tree-retrive)))
(my/index--tree-verify full-tree)
(let* ((tree (my/index--tree-narrow full-tree))
(mega-commands (my/index--mega-commands full-tree tree))
(mapping (my/index--filesystem-tree-mapping full-tree tree))
(folder-commands (my/index--filesystem-commands mapping))
(git-commands (my/index--git-commands tree))
(waka-commands (my/index--wakatime-commands tree))
(symlink-commands (my/index-get-symlink-commands tree)))
(my/index--commands-display (append mega-commands folder-commands git-commands
waka-commands symlink-commands)))))
#+end_src
** Navigation
The last piece is the navigation interface.
Of course, plain dired does the job fine, thanks to the relatively low-depth filesystem structure. But I still want a navigation interface like =M-x projectile-switch-project=.
*** Navigation data
There are two slight problems with that.
First, the index tree does not always have the full info. For instance, I have the =10.03.A Artifacts= folder, which I sync with MEGA and which has child folders like =10.03.A.01 smth= and so on. Names of the latter are not stored anywhere because I don't see the point, which means we have to extract that from the filesystem.
Second, as it turns out, there have to be two levels for navigation, which are delimited by the =project= property. I'm not sure if that the optimal way to implement Jonny.Decimal, but it works for me.
So, a function to tackle the first problem:
#+begin_src emacs-lisp
(defun my/index--nav-extend (name path)
"Find all index-related files in PATH.
NAME is the name of the root index entry, e.g. \"10.01
Something\". If PATH containts folders like \"10.01.01
Something\", \"10.01.02 ...\", they will be returned.
The return value is a form as defined by `my/index--nav-get'."
(when (file-directory-p path)
(let* ((number (my/index--extact-number name))
(files (mapcar
(lambda (f) (cons f (concat path f)))
(seq-filter (lambda (f) (not (string-prefix-p "." f)))
(directory-files path))))
(matching-files
(seq-filter
(lambda (f) (and (file-directory-p (cdr f))
(string-prefix-p number (car f))))
files)))
(when (and (length> matching-files 0)
(length< matching-files (length files)))
(user-error "Extraneuous files in %s" path))
(cl-loop for (name-1 . path-1) in matching-files
append (if-let ((child-files (my/index--nav-extend name-1 (concat path-1 "/"))))
(mapcar
(lambda (child-datum)
(push name-1 (alist-get :names child-datum))
child-datum)
child-files)
`(((:names . (,name-1))
(:path . ,(concat path-1 "/")))))))))
#+end_src
And one to get the navigation data structure.
#+begin_src emacs-lisp
(defun my/index--nav-get (tree &optional names)
"Get the navigation structure from TREE.
TREE is a form as defined by `my/index--tree-get'. NAMES is a
list of names of the parent entries, e.g. (\"10.01 Something\"), used
for recursive calls.
The result is a list of alists with the following keys:
- `:names` - list of names, e.g.
(\"10.01 Something\" \"10.01.01 Something\")
- `:path` - path to the folder, e.g.
\"/path/10 stuff/10.01 Something/10.01.01 Something/\"
- `:child-navs` - list of child navigation structures (optional)"
(seq-sort-by
(lambda (item) (alist-get :path item))
#'string-lessp
(cl-reduce
(lambda (acc elem)
(let* ((name (alist-get :name elem))
(path (alist-get :path elem)))
(cond ((alist-get :project elem)
(let ((current-nav `((:names . (,@names ,name))
(:path . ,path))))
(when-let (child-navs
(and (alist-get :children elem)
(my/index--nav-get (alist-get :children elem))))
(setf (alist-get :child-navs current-nav) child-navs))
(push current-nav acc)))
((alist-get :children elem)
(when-let (child-navs (my/index--nav-get
(alist-get :children elem)
`(,@names ,name)))
(cl-loop for child-nav in child-navs
do (push child-nav acc))))
(t (if-let ((extended-nav (my/index--nav-extend name path)))
(cl-loop for child-nav in extended-nav
do (setf (alist-get :names child-nav)
(append names (list name)
(alist-get :names child-nav)))
do (push child-nav acc))
(push `((:names . (,@names ,name))
(:path . ,path))
acc))))
acc))
tree
:initial-value nil)))
#+end_src
It also makes sense to cache results of the above.
#+begin_src emacs-lisp
(defvar my/index--nav nil
"Navigation stucture for the index.")
(defun my/index--nav-retrive ()
"Retrive the navigation structure from the index file.
The return value is a form as defined by `my/index--nav-get'."
(if (or (null my/index--nav)
(file-has-changed-p my/index-file 'nav))
(let ((tree (my/index--tree-retrive)))
(setq my/index--nav (my/index--nav-get
(my/index--tree-narrow tree))))
my/index--nav))
#+end_src
*** Emacs interface
As for Emacs interface, =completing-read= is sufficient, except that I don't want [[https://github.com/radian-software/prescient.el][prescient.el]] to interfere with the default ordering of elements.
#+begin_src emacs-lisp
(defun my/index--nav-prompt (nav)
"Prompt the user for the navigation item to select.
NAV is a structure as defined by `my/index--nav-get'."
(let* ((collection
(mapcar (lambda (item)
(cons (car (last (alist-get :names item)))
(alist-get :path item)))
nav))
(ivy-prescient-sort-commands nil))
(cdr
(assoc
(completing-read "Index: " collection nil t)
collection))))
(defun my/index--nav-find-path (nav path)
"Find the navigation item in NAV with the given PATH.
NAV is a structure as defined by `my/index--nav-get'."
(seq-find
(lambda (item)
(string-prefix-p (alist-get :path item) path))
nav))
(defun my/index-nav (arg &optional func)
"Navigate the filesystem index.
ARG is the prefix argument. It modifies the behavior of the
command as follows:
- If not in an indexed directory, or in an indexed directory with no
indexed children:
- nil: Select an indexed directory.
- '(4): Select an indexed directory, and select a child indexed
directory if available.
- If in an indexed directory with indexed children (a project):
- nil: Select another indexed directory from the project.
- '(4): Select a top-level indexed directory (the same as nil for
the previous case).
- '(16): The same as '(4) for the previous case.
FUNC is the function to call with the selected path. It defaults
to `dired' if used interactively."
(interactive (list current-prefix-arg #'dired))
(let* ((nav (my/index--nav-retrive))
(current-nav (my/index--nav-find-path
nav (expand-file-name default-directory)))
(current-child-navs (alist-get :child-navs current-nav)))
(cond
((or (and (null arg) (null current-child-navs))
(and (equal arg '(4)) current-child-navs))
(funcall
func
(my/index--nav-prompt nav)))
((or (and (equal arg '(4)) (null current-child-navs))
(and (equal arg '(16)) current-child-navs))
(let ((selected (my/index--nav-find-path
nav
(my/index--nav-prompt nav))))
(if-let (child-navs (alist-get :child-navs selected))
(funcall func (my/index--nav-prompt child-navs))
(funcall func (alist-get :path selected)))))
((and (null arg) current-child-navs)
(funcall func (my/index--nav-prompt current-child-navs))))))
#+end_src
Finally, something that I can bind to a key.
#+begin_src emacs-lisp
(my-leader-def
"i" #'my/index-nav)
#+end_src
* Footnotes
[fn:1] Thanks @maddo at the former [[https://systemcrafters.net/community/][SystemCrafters]] discord for pointing that out.
[fn:2] To my surprise, I found several places where I can't use (or find how to use) paths with spaces, [[https://guix.gnu.org/manual/en/html_node/Channels.html][Guix channels]] being one. Hence, symlinks.

BIN
org/static/images/index/index.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 245 KiB

BIN
static/images/index/index.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 245 KiB