emacs/protesilaos.denote
1
0
Fork 0
mirror of https://github.com/protesilaos/denote.git synced 2026-09-10 07:16:20 -04:00
Code Issues Actions Packages Projects Releases Wiki Activity

Rewrite denote--get-common-root-directory and include a test for it

Browse source
This commit is contained in:
Protesilaos Stavrou 2026-01-14 09:19:34 +02:00
parent 0afdc6af14
commit d90f3633de
No known key found for this signature in database
GPG key ID: 99BD6459CD5CA3EA
2 changed files with 55 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
denote.el
View file

@ -983,18 +983,33 @@ to override what this function returns."
(not (cdr (denote-directories))))
(defun denote--get-common-root-directory (directories)
"Return common root directory among DIRECTORIES."
(if-let* ((parts (mapcar (lambda (directory) (split-string directory "/" :omit-nulls)) directories))
(common-parent (seq-reduce
(lambda (dir-parts comparison-parts)
(let ((common nil))
(dolist (part dir-parts)
(when (member part comparison-parts)
(push part common)))
(nreverse common)))
parts (car parts))))
(format "/%s/" (mapconcat #'identity common-parent "/"))
"/"))
"Return common root directory among DIRECTORIES.
DIRECTORIES are absolute file system paths."
(cond
;; FIXME 2026-01-14: The `file-name-absolute-p' actually returns
;; non-nil for ~/PATH. This will not work here. Does the prefix
;; check work on all operating systems? Linux is fine.
((unless (seq-every-p (lambda (d) (string-prefix-p "/" d)) directories)
(error "All directories must be absolute paths")))
((length= directories 1)
(car directories))
((when-let* ((parts (mapcar
(lambda (dir)
(split-string dir "/" :omit-nulls))
directories)))
(let ((common-prefix (car parts)))
(dolist (part (cdr parts))
(let ((new-common-prefix nil))
(while (and common-prefix
part
(string= (car common-prefix) (car part)))
(push (car common-prefix) new-common-prefix)
(setq common-prefix (cdr common-prefix))
(setq part (cdr part)))
(setq common-prefix (nreverse new-common-prefix))))
(if common-prefix
(format "/%s/" (mapconcat #'identity common-prefix "/"))
"/"))))))
(defun denote-directories-get-common-root ()
"Get the common root directory of `denote-directories'."

28
tests/denote-test.el
View file

@ -531,6 +531,34 @@ does not involve the time zone."
(should-error (denote--date-convert '(26454 45206 461174 657000) :not-valid-type))
(should-error (denote--date-convert nil :not-valid-type)))
(ert-deftest dt-denote--get-common-root-directory ()
"Test that `denote--get-common-root-directory' returns the right path."
(should (string=
(denote--get-common-root-directory
'("/home/prot/Documents/notes/"
"/home/prot/Documents/notes/attachments"))
"/home/prot/Documents/notes/"))
(should (string=
(denote--get-common-root-directory
'("/home/prot/Documents/"
"/home/prot/Documents/notes/attachments"))
"/home/prot/Documents/"))
(should (string=
(denote--get-common-root-directory
'("/home/prot/Books/"
"/home/prot/Documents/notes/"))
"/home/prot/"))
(should (string=
(denote--get-common-root-directory
'("/tmp/notes/"
"/home/prot/Documents/notes/"))
"/"))
(should (string=
(denote--get-common-root-directory
'("/home/prot/Documents/notes/"))
"/home/prot/Documents/notes/"))
(should-error (denote--get-common-root-directory '("~/Documents/notes/"))))
(provide 'denote-test)
;;; denote-test.el ends here