diff --git a/assets/sass/researcher.scss b/assets/sass/researcher.scss index 2d784c1..da80aa0 100644 --- a/assets/sass/researcher.scss +++ b/assets/sass/researcher.scss @@ -257,6 +257,17 @@ $toc-left-width: $toc-width + $max-width + 25px; 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 { a { diff --git a/content/posts/2023-11-11-index.md b/content/posts/2023-11-11-index.md new file mode 100644 index 0000000..986e071 --- /dev/null +++ b/content/posts/2023-11-11-index.md @@ -0,0 +1,1004 @@ ++++ +title = "Declarative filesystem management with Emacs & Org Mode" +author = ["Pavel Korytov"] +date = 2023-11-10 +tags = ["emacs", "orgmode"] +draft = true ++++ + +
+ +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. + +
+ + +## Intro {#intro} + +My filesystem is, shall we say, not the most orderly place. + +
+ +
+ +It's been kinda 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 on. + +And it's strange that I wasn't able to find any existing solution to that problem. I can't be the only one with that problem, can I? + +Anyway, I'm lucky to know my way in (make-yourself-a) Swiss Army Knife of computing called [Emacs](https://www.gnu.org/software/emacs/), so... below is my attempt to make something of it. And another entry to add 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 also probably the least portable, but I nevertheless hope you'll find it useful. + + +## Idea {#idea} + +{{< figure src="/images/index/index.png" >}} + +So, I've decided to try declarative filesystem management. + +At the core, there's my work-in-progress adaptation of [Johnny.Decimal](https://johnnydecimal.com/)[^fn:1]. Essentially, it proposes to prefix your folders with numbers like `12.34`, where: + +- the first digit is "[category](https://johnnydecimal.com/10-19-concepts/11-core/11.02-areas-and-categories/)" +- the second digit is "[area](https://johnnydecimal.com/10-19-concepts/11-core/11.02-areas-and-categories/)" +- the last two digits are the [ID](https://johnnydecimal.com/10-19-concepts/11-core/11.03-ids/). + +The point is to organize your folder structure and limit its depth, which should make finding things quicker and more straightforward. Check the website for a more thorough description. + +So, what I want is: + +- to define a Jonny.Decimal-esque file tree in a single [Org](https://orgmode.org/) file; +- have different nodes of that file tree active on different machines, e.g. I don't want [my Emacs stuff](https://github.com/SqrtMinusOne?tab=repositories&q=&type=&language=emacs+lisp&sort=) on my work machine; +- use different tools to sync different nodes (as of now [git](https://git-scm.com/), [MEGA](https://mega.nz/), and "nothing"). + + +### Folder structure {#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. + +```text +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 +``` + +The root of the tree is my `$HOME`. The entry at the third (or second) level can be either an entity it 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 some year, which I need for occasional reports. I also have semester references (`SEM10`) for my undergraduate studies. + +Project structure is also more or less standard. Johnny.Decimal [proposes](https://johnnydecimal.com/10-19-concepts/13-multiple-projects/13.01-introduction/) to use `PRO.AC.ID` to manage multiple projects, but this doesn't seem to fit quite as well to my case, so I came up with the following: + +```text +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 +``` + +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 {#tools-choice} + +As I've said, my current options to manage a particular node are: + +- [git](https://git-scm.com/); +- [MEGA](https://mega.nz/) - for files that don't fit into git, such as DOCX documents, photos, etc.; +- nothing - something that I don't need to sync across machines, e.g. database dumps. + +One other tool I considered was [restic](https://github.com/restic/restic). It's an interesting backup & sync solution, with built-in encryption, snapshots, etc. + +My problem 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. So for now I'm more interested in synchronizing the file tree in MEGA with [MEGAcmd](https://github.com/meganz/MEGAcmd) (and also clean up the mess there, two birds with one stone). + +Another interesting tool is [rclone](https://rclone.org/), which provides a single interface for multiple services like Google Drive, Dropbox, S3, WebDAV. It also supports MEGA, but requires turning off the two-factor authentication, which I don't want. + + +## Implementation {#implementation} + + +### Dependencies {#dependencies} + +We'll need lexical binding. + +```emacs-lisp +;;; -*- lexical-binding: t -*- +``` + +And a package called [ini.el](https://github.com/daniel-ness/ini.el) to parse INI files. + +```emacs-lisp +(use-package ini + :straight (:host github :repo "daniel-ness/ini.el")) +``` + +The rest is built-in into Emacs. + + +### Org tree {#org-tree} + + +#### Tree definitions {#tree-definitions} + +The root is my `$HOME` directory. + +```emacs-lisp +(defvar my/index-root (concat (getenv "HOME") "/")) +``` + +The org tree is located in my `org-mode` folder in a file called `index.org`: + +```emacs-lisp +(defvar my/index-file + (concat org-directory "/misc/index.org")) +``` + +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` - 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: + +```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: +``` + + +#### Parse tree {#parse-tree} + +So, let's parse the Org tree. This is done by recursively traversing the tree returned by `org-element-parse-buffer`. + +```emacs-lisp +(defun my/index--tree-get-recursive (heading &optional path) + "Recursively read index tree from HEADING. + +HEADING is an org-element of type `headline'. + +PATH 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 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)) +``` + + +#### Verify tree {#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: + +```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))) +``` + +Then, we can recursively verify the numbers: + +```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)) +``` + + +#### Narrow tree {#narrow-tree} + +Finally, we need to narrow the tree to only leave nodes that are active for the current machine. + +```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)))) +``` + + +### Commands {#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 loss of data if something unexpected happens. + +One command for the script will be a list like: + +- `( )` + + +#### Filesystem {#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: + +```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, i.e. as those paths that have to +exists on the current machine. + +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 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))))))) +``` + +And generate commands from the results of the above: + +```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)))) +``` + + +#### MEGA {#mega} + +As I said above, MEGA provides [MEGAcmd](https://github.com/meganz/MEGAcmd), which is a convenient way to access MEGA via CLI. + +To initialize the session, run + +```bash +mega-login +``` + +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. + +```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))))))) +``` + +Now we can invoke `mega-sync` to get the current sync status. `--path-display-size=10000` disables truncation of long paths. + +```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")))))) +``` + +And get the same data from the tree. + +```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))) +``` + +With that information, we can generate commands to synchronize the required and actual sync paths. + +```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))))) +``` + + +#### Git repos {#git-repos} + +To sync git, we just need to clone the required git repos. Removing the repos is handled by the folder sync commands. + +```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)))) +``` + + +#### Wakatime {#wakatime} + +So, that's it for synchronization. A few other things are needed here. + +I use [WakaTime](https://wakatime.com/) to track my coding activity, and I don't like the alphanumeric prefixes in my coding stats. Fortunately, `wakatime-cli` provides an option called [projectmap](https://github.com/wakatime/wakatime-cli/blob/develop/USAGE.md#project-map-section) to rename projects, so we just have to generate its contents. + +```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)))) +``` + +And insert that in `wakatime.cfg` if necessary. + +```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))))) +``` + + +#### Symlinks {#symlinks} + +The last part here is creating symbolic links. + +```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)))) +``` + + +#### Run all 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. + +```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))) +``` + +In order to execute these commands, [compile](https://www.gnu.org/software/emacs/manual/html_node/emacs/Compilation.html) with `bash -x` on a temporary file is quite sufficient. + +```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)))) +``` + +I'll also try to save some time by caching the resulting index tree. `file-has-changed-p` is pretty helpful in that. + +```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)))) +``` + +With that, we can make the main entrypoint. + +```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))))) +``` + + +### Navigation {#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 {#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: + +```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 "/"))))))))) +``` + +And one to get the navigation data structure. + +```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))) +``` + +It also makes sense to cache results of the above. + +```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)) +``` + + +#### Emacs interface {#emacs-interface} + +As for Emacs interface, a plain `completing-read` is sufficient, except that I don't want [prescient.el](https://github.com/radian-software/prescient.el) to interfere with the default ordering of elements. + +```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)))))) +``` + +Finally, something that I can bind to a key. + +```emacs-lisp +(my-leader-def + "i" #'my/index-nav) +``` + +[^fn:1]: Thanks @maddo at the former [SystemCrafters](https://systemcrafters.net/community/) 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, [Guix channels](https://guix.gnu.org/manual/en/html_node/Channels.html) being one. Hence, symlinks. \ No newline at end of file diff --git a/org/2023-11-11-index.org b/org/2023-11-11-index.org new file mode 100644 index 0000000..9a7d15b --- /dev/null +++ b/org/2023-11-11-index.org @@ -0,0 +1,943 @@ +#+HUGO_SECTION: posts +#+HUGO_BASE_DIR: ../ +#+TITLE: Declarative filesystem management with Emacs & Org Mode +#+DATE: 2023-11-10 +#+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 +
+ +
+#+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) + "Recursively read index tree from HEADING. + +HEADING is an org-element of type `headline'. + +PATH 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 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: +- =( )= + +*** 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, i.e. as those paths that have to +exists on the current machine. + +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 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 +#+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. diff --git a/org/static/images/index/index.png b/org/static/images/index/index.png new file mode 100644 index 0000000..fb71228 Binary files /dev/null and b/org/static/images/index/index.png differ diff --git a/static/images/index/index.png b/static/images/index/index.png new file mode 100644 index 0000000..fb71228 Binary files /dev/null and b/static/images/index/index.png differ