From f390593cfb2b880fa36bc06c0b42fb402a8f7af9 Mon Sep 17 00:00:00 2001 From: Jethro Kuan Date: Fri, 15 May 2020 16:10:11 +0800 Subject: [PATCH] (feat): Add a tagging system (#604) Tags are used as meta-data for files: they facilitate interactions with notes where titles are insufficient. For example, tags allow for categorization of notes: differentiating between bibliographical and structure notes during interactive commands. Co-authored-by: Leo Vivier Co-authored-by: N V <44036031+progfolio@users.noreply.github.com> --- doc/org-roam.org | 45 +++- doc/org-roam.texi | 124 ++++++++-- org-roam-capture.el | 7 +- org-roam-db.el | 53 ++++- org-roam.el | 217 ++++++++++-------- tests/roam-files/base.org | 1 + .../nested/deeply/deeply_nested_file.org | 1 + tests/roam-files/tags/no_tag.org | 3 + tests/roam-files/tags/tag.org | 4 + tests/test-org-roam.el | 80 ++++++- 10 files changed, 398 insertions(+), 137 deletions(-) create mode 100644 tests/roam-files/base.org create mode 100644 tests/roam-files/nested/deeply/deeply_nested_file.org create mode 100644 tests/roam-files/tags/no_tag.org create mode 100644 tests/roam-files/tags/tag.org diff --git a/doc/org-roam.org b/doc/org-roam.org index 4d96513..d6e46bb 100644 --- a/doc/org-roam.org +++ b/doc/org-roam.org @@ -19,10 +19,9 @@ This manual is for Org-roam version 1.1.1. #+BEGIN_QUOTE Copyright (C) 2020-2020 Jethro Kuan -You can redistribute this document and/or modify it under the terms -of the GNU General Public License as published by the Free Software -Foundation, either version 3 of the License, or (at your option) any -later version. +You can redistribute this document and/or modify it under the terms of the GNU +General Public License as published by the Free Software Foundation, either +version 3 of the License, or (at your option) any later version. This document is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -174,7 +173,7 @@ Org-mode. However, to support additional functionality, Org-roam adds several Org-roam-specific keywords. These functionality are not crucial to effective use of Org-roam. -** File Titles +** Titles To easily find a note, a title needs to be prescribed to a note. A note can have many titles: this allows a note to be referred to by different names, which is @@ -211,6 +210,41 @@ One can freely control which extraction methods to use by customizing information. If all methods of title extraction return no results, the file-name is used in place of the titles for completions. +If you wish to add your own title extraction method, you may push a symbol +='foo= into =org-roam-title-sources=, and define a +=org-roam--extract-titles-foo= which accepts no arguments. See +=org-roam--extract-titles-title= for an example. + +** Tags + +Tags are used as meta-data for files: they facilitate interactions with notes +where titles are insufficient. For example, tags allow for categorization of +notes: differentiating between bibliographical and structure notes during interactive commands. + +Org-roam calls =org-roam--extract-tags= to extract tags from files. It uses the +variable =org-roam-tag-sources=, to control how tags are extracted. The tag +extraction methods supported are: + +1. ='prop=: This extracts tags from the =#+ROAM_TAGS= property. Tags are space delimited, and can be multi-word using double quotes. +2. ='all-directories=: All sub-directories relative to =org-roam-directory= are + extracted as tags. That is, if a file is located at relative path + =foo/bar/file.org=, the file will have tags =foo= and =bar=. +3. ='last-directory=: Extracts the last directory relative to + =org-roam-directory= as the tag. That is, if a file is located at relative + path =foo/bar/file.org=, the file will have tag =bar=. + +By default, only the ='prop= extraction method is enabled. To enable the other +extraction methods, you may modify =org-roam-tag-sources=: + +#+BEGIN_SRC emacs-lisp +(setq org-roam-tag-sources '(prop last-directory)) +#+END_SRC + +If you wish to add your own tag extraction method, you may push a symbol ='foo= +into =org-roam-tag-sources=, and define a =org-roam--extract-tags-foo= which +accepts the absolute file path as its argument. See +=org-roam--extract-tags-prop= for an example. + ** File Refs Refs are unique identifiers for files. Each note can only have 1 ref. @@ -932,6 +966,7 @@ file within that directory, at least once. * _ :ignore: # Local Variables: +# eval: (refill-mode +1) # before-save-hook: org-make-toc # after-save-hook: (lambda nil (progn (require 'ox-texinfo nil t) (org-texinfo-export-to-info))) # indent-tabs-mode: nil diff --git a/doc/org-roam.texi b/doc/org-roam.texi index 38882da..7ef205a 100644 --- a/doc/org-roam.texi +++ b/doc/org-roam.texi @@ -51,10 +51,9 @@ This manual is for Org-roam version 1.1.1. @quotation Copyright (C) 2020-2020 Jethro Kuan -You can redistribute this document and/or modify it under the terms -of the GNU General Public License as published by the Free Software -Foundation, either version 3 of the License, or (at your option) any -later version. +You can redistribute this document and/or modify it under the terms of the GNU +General Public License as published by the Free Software Foundation, either +version 3 of the License, or (at your option) any later version. This document is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -79,19 +78,22 @@ General Public License for more details. * Diagnosing and Repairing Files:: * Appendix:: * FAQ:: +* _: _ (2). @detailmenu --- The Detailed Node Listing --- Installation +* _:: * Installing from MELPA:: * Installing from the Git Repository:: * Post-Installation Tasks:: Anatomy of an Org-roam File -* File Aliases:: +* Titles:: +* Tags:: * File Refs:: The Templating System @@ -117,6 +119,7 @@ Graphing Roam Protocol +* _: _ (1). * Installation: Installation (1). * The @samp{roam-file} protocol:: * The @samp{roam-ref} Protocol:: @@ -176,14 +179,18 @@ Emacs is also a fantastic interface for editing text, and we can inherit many of @node Installation @chapter Installation -Org-roam can be installed using Emacs' package manager or manually from its development repository. - @menu +* _:: * Installing from MELPA:: * Installing from the Git Repository:: * Post-Installation Tasks:: @end menu +@node _ +@section _ :ignore: + +Org-roam can be installed using Emacs' package manager or manually from its development repository. + @node Installing from MELPA @section Installing from MELPA @@ -310,22 +317,100 @@ several Org-roam-specific keywords. These functionality are not crucial to effective use of Org-roam. @menu -* File Aliases:: +* Titles:: +* Tags:: * File Refs:: @end menu -@node File Aliases -@section File Aliases +@node Titles +@section Titles -Suppose you want a note to be referred to by different names (e.g. -``World War 2'', ``WWII''). You may specify such aliases using the -@samp{#+ROAM_ALIAS} attribute: +To easily find a note, a title needs to be prescribed to a note. A note can have +many titles: this allows a note to be referred to by different names, which is +especially useful for topics or concepts with acronyms. For example, for a note +like ``World War 2'', it may be desirable to also refer to it using the acronym +``WWII''. + +Org-roam calls @samp{org-roam--extract-titles} to extract titles. It uses the +variable @samp{org-roam-title-sources}, to control how the titles are extracted. The +title extraction methods supported are: + +@enumerate +@item +@samp{'title}: This extracts the title using the file @samp{#+TITLE} property +@item +@samp{'headline}: This extracts the title from the first headline in the Org file +@item +@samp{'alias}: This extracts a list of titles using the @samp{#ROAM_ALIAS} property. +The aliases are space-delimited, and can be multi-worded using quotes +@end enumerate + +Take for example the following org file: @example #+TITLE: World War 2 #+ROAM_ALIAS: "WWII" "World War II" + +* Headline @end example +@multitable {aaaaaaaaaaa} {aaaaaaaaaaaaaaaaaaaaaaaa} +@headitem Method +@tab Titles +@item @samp{'title} +@tab '(``World War 2'') +@item @samp{'headline} +@tab '(``Headline'') +@item @samp{'alias} +@tab '(``WWII'' ``World War II'') +@end multitable + +One can freely control which extraction methods to use by customizing +@samp{org-roam-title-sources}: see the doc-string for the variable for more +information. If all methods of title extraction return no results, the file-name +is used in place of the titles for completions. + +If you wish to add your own title extraction method, you may push a symbol +@samp{'foo} into @samp{org-roam-title-sources}, and define a +@samp{org-roam--extract-titles-foo} which accepts no arguments. See +@samp{org-roam--extract-titles-title} for an example. + +@node Tags +@section Tags + +Tags are used as meta-data for files: they facilitate interactions with notes +where titles are insufficient. For example, tags allow for categorization of +notes: differentiating between bibliographical and structure notes during interactive commands. + +Org-roam calls @samp{org-roam--extract-tags} to extract tags from files. It uses the +variable @samp{org-roam-tag-sources}, to control how tags are extracted. The tag +extraction methods supported are: + +@enumerate +@item +@samp{'prop}: This extracts tags from the @samp{#+ROAM_TAGS} property. Tags are space delimited, and can be multi-word using double quotes. +@item +@samp{'all-directories}: All sub-directories relative to @samp{org-roam-directory} are +extracted as tags. That is, if a file is located at relative path +@samp{foo/bar/file.org}, the file will have tags @samp{foo} and @samp{bar}. +@item +@samp{'last-directory}: Extracts the last directory relative to +@samp{org-roam-directory} as the tag. That is, if a file is located at relative +path @samp{foo/bar/file.org}, the file will have tag @samp{bar}. +@end enumerate + +By default, only the @samp{'prop} extraction method is enabled. To enable the other +extraction methods, you may modify @samp{org-roam-tag-sources}: + +@lisp +(setq org-roam-tag-sources '(prop last-directory)) +@end lisp + +If you wish to add your own tag extraction method, you may push a symbol @samp{'foo} +into @samp{org-roam-tag-sources}, and define a @samp{org-roam--extract-tags-foo} which +accepts the absolute file path as its argument. See +@samp{org-roam--extract-tags-prop} for an example. + @node File Refs @section File Refs @@ -754,15 +839,19 @@ Other options include @samp{'ido}, and @samp{'ivy}. @node Roam Protocol @chapter Roam Protocol -Org-roam extending @samp{org-protocol} with 2 protocols: the @samp{roam-file} -and @samp{roam-ref} protocol. - @menu +* _: _ (1). * Installation: Installation (1). * The @samp{roam-file} protocol:: * The @samp{roam-ref} Protocol:: @end menu +@node _ (1) +@section _ :ignore: + +Org-roam extending @samp{org-protocol} with 2 protocols: the @samp{roam-file} +and @samp{roam-ref} protocol. + @node Installation (1) @section Installation @@ -1191,5 +1280,8 @@ All files within that directory will be treated as their own separate set of Org-roam files. Remember to run @samp{org-roam-db-build-cache} from a file within that directory, at least once. +@node _ (2) +@chapter _ :ignore: + Emacs 28.0.50 (Org mode 9.4) @bye diff --git a/org-roam-capture.el b/org-roam-capture.el index f7d2762..a8d98c6 100644 --- a/org-roam-capture.el +++ b/org-roam-capture.el @@ -331,8 +331,11 @@ This uses the templates defined at `org-roam-capture-templates'." (when (org-roam-capture--in-process-p) (user-error "Nested Org-roam capture processes not supported")) (let* ((completions (org-roam--get-title-path-completions)) - (title (org-roam-completion--completing-read "File: " completions)) - (file-path (cdr (assoc title completions)))) + (title-with-keys (org-roam-completion--completing-read "File: " + completions)) + (res (gethash title-with-keys completions)) + (title (plist-get res :title)) + (file-path (plist-get res :file-path))) (let ((org-roam-capture--info (list (cons 'title title) (cons 'slug (org-roam--title-to-slug title)) (cons 'file file-path))) diff --git a/org-roam-db.el b/org-roam-db.el index b34a48d..bf833a5 100644 --- a/org-roam-db.el +++ b/org-roam-db.el @@ -40,11 +40,12 @@ (defvar org-roam-verbose) (declare-function org-roam--org-roam-file-p "org-roam") -(declare-function org-roam--extract-and-format-titles "org-roam") +(declare-function org-roam--extract-titles "org-roam") (declare-function org-roam--extract-ref "org-roam") +(declare-function org-roam--extract-tags "org-roam") (declare-function org-roam--extract-links "org-roam") (declare-function org-roam--list-all-files "org-roam") -(declare-function org-roam-buffer--update-maybe "org-roam-buffer") +(declare-function org-roam-buffer--update-maybe "org-roam-buffer") ;;;; Options (defcustom org-roam-db-location nil @@ -56,7 +57,7 @@ when used with multiple Org-roam instances." :type 'string :group 'org-roam) -(defconst org-roam-db--version 3) +(defconst org-roam-db--version 4) (defconst org-roam-db--sqlite-available-p (with-demoted-errors "Org-roam initialization: %S" (emacsql-sqlite-ensure-binary) @@ -128,6 +129,10 @@ SQL can be either the emacsql vector representation, or a string." (type :not-null) (properties :not-null)]) + (tags + [(file :unique :primary-key) + (tags)]) + (titles [(file :not-null) titles]) @@ -215,6 +220,13 @@ This is equivalent to removing the node from the graph." :values $v1] (list (vector file titles)))) +(defun org-roam-db--insert-tags (file tags) + "Insert TAGS for a FILE into the Org-roam cache." + (org-roam-db-query + [:insert :into tags + :values $v1] + (list (vector file tags)))) + (defun org-roam-db--insert-ref (file ref) "Insert REF for FILE into the Org-roam cache." (let ((key (cdr ref)) @@ -297,12 +309,21 @@ connections, nil is returned." (defun org-roam-db--update-titles () "Update the title of the current buffer into the cache." (let* ((file (file-truename (buffer-file-name))) - (title (org-roam--extract-and-format-titles file))) + (title (org-roam--extract-titles))) (org-roam-db-query [:delete :from titles :where (= file $s1)] file) (org-roam-db--insert-titles file title))) +(defun org-roam-db--update-tags () + "Update the tags of the current buffer into the cache." + (let* ((file (file-truename (buffer-file-name))) + (tags (org-roam--extract-tags))) + (org-roam-db-query [:delete :from tags + :where (= file $s1)] + file) + (org-roam-db--insert-tags file tags))) + (defun org-roam-db--update-refs () "Update the ref of the current buffer into the cache." (let ((file (file-truename (buffer-file-name)))) @@ -329,6 +350,7 @@ connections, nil is returned." (current-buffer)))) (with-current-buffer buf (save-excursion + (org-roam-db--update-tags) (org-roam-db--update-titles) (org-roam-db--update-refs) (org-roam-db--update-cache-links) @@ -344,7 +366,7 @@ If FORCE, force a rebuild of the cache from scratch." (let* ((org-roam-files (org-roam--list-all-files)) (current-files (org-roam-db--get-current-files)) (time (current-time)) - all-files all-links all-titles all-refs) + all-files all-links all-titles all-refs all-tags) (dolist (file org-roam-files) (org-roam--with-temp-buffer (insert-file-contents file) @@ -352,12 +374,14 @@ If FORCE, force a rebuild of the cache from scratch." (unless (string= (gethash file current-files) contents-hash) (org-roam-db--clear-file file) - (setq all-files - (cons (vector file contents-hash time) all-files)) + (push (vector file contents-hash time) + all-files) (when-let (links (org-roam--extract-links file)) - (setq all-links (append links all-links))) - (let ((titles (org-roam--extract-and-format-titles file))) - (setq all-titles (cons (vector file titles) all-titles))) + (push links all-links)) + (when-let (tags (org-roam--extract-tags file)) + (push (vector file tags) all-tags)) + (let ((titles (org-roam--extract-titles))) + (push (vector file titles) all-titles)) (when-let* ((ref (org-roam--extract-ref)) (type (car ref)) (key (cdr ref))) @@ -381,6 +405,11 @@ If FORCE, force a rebuild of the cache from scratch." [:insert :into titles :values $v1] all-titles)) + (when all-tags + (org-roam-db-query + [:insert :into tags + :values $v1] + all-tags)) (when all-refs (org-roam-db-query [:insert :into refs @@ -388,12 +417,14 @@ If FORCE, force a rebuild of the cache from scratch." all-refs)) (let ((stats (list :files (length all-files) :links (length all-links) + :tags (length all-tags) :titles (length all-titles) :refs (length all-refs) :deleted (length (hash-table-keys current-files))))) - (org-roam-message "files: %s, links: %s, titles: %s, refs: %s, deleted: %s" + (org-roam-message "files: %s, links: %s, tags: %s, titles: %s, refs: %s, deleted: %s" (plist-get stats :files) (plist-get stats :links) + (plist-get stats :tags) (plist-get stats :titles) (plist-get stats :refs) (plist-get stats :deleted)) diff --git a/org-roam.el b/org-roam.el index 3927c93..33c85ed 100644 --- a/org-roam.el +++ b/org-roam.el @@ -113,7 +113,7 @@ Each element in the list is either: 1. a symbol -- this symbol corresponds to a title retrieval function, which returns the list of titles for the current buffer 2. a list of symbols -- symbols in the list are treated as -with (1). The return value of this list is the first symbol in +with (1). The return value of this list is the first symbol in the list returning a non-nil value. The return results of the root list are concatenated. @@ -134,6 +134,31 @@ space-delimited strings. (symbol))) :group 'org-roam) +(defcustom org-roam-tag-sources '(prop) + "Sources to obtain tags from. + +It should be a list of symbols representing any of the following +extraction methods: + + `prop' + Extract tags from the #+ROAM_TAGS property. + Tags are space delimited. + Tags may contain spaces if they are double-quoted. + e.g. #+ROAM_TAGS: tag \"tag with spaces\" + + `all-directories' + Extract sub-directories relative to `org-roam-directory'. + That is, if a file is located at relative path foo/bar/file.org, + the file will have tags \"foo\" and \"bar\". + + `last-directory' + Extract the last directory relative to `org-roam-directory'. + That is, if a file is located at relative path foo/bar/file.org, + the file will have tag \"bar\"." + :type '(set (const :tag "#+ROAM_TAGS" prop) + (const :tag "sub-directories" all-directories) + (const :tag "parent directory" last-directory))) + ;;;; Dynamic variables (defvar org-roam-last-window nil "Last window `org-roam' was called from.") @@ -149,8 +174,8 @@ space-delimited strings. (push (cons prop val) res))) res)) -(defun org-roam--aliases-str-to-list (str) - "Function to transform string STR into list of alias titles. +(defun org-roam--str-to-list (str) + "Function to transform string STR into list of titles. This snippet is obtained from ox-hugo: https://github.com/kaushalmodi/ox-hugo/blob/a80b250987bc770600c424a10b3bca6ff7282e3c/ox-hugo.el#L3131" @@ -314,69 +339,6 @@ it as FILE-PATH." names))))))) links)) -(defcustom org-roam-title-include-subdirs nil - "When non-nil, include subdirs in title completions. -The subdirs will be relative to `org-roam-directory'." - :type 'boolean - :group 'org-roam) - -(defcustom org-roam-title-subdir-format 'default - "Function to use to format the titles of entries with subdirs. -Only relevant when `org-roam-title-include-subdirs' is non-nil. -The value should be a function that takes two arguments: the -title of the note, and the subdirs as a list. If set to -'default, `org-roam--format-title-with-subdirs' is used." - :type '(choice - (const :tag "Default" 'default) - (function :tag "Custom function")) - :group 'org-roam) - -(defcustom org-roam-title-subdir-separator "/" - "String to use to separate subdirs. -Only relevant when `org-roam-title-include-subdirs' is non-nil." - :type 'string - :group 'org-roam) - -(defun org-roam--format-title-with-subdirs (title subdirs) - "Format TITLE with SUBDIRS as '\(SUBDIRS) TITLE'." - (let* ((separator org-roam-title-subdir-separator) - (subdirs (and subdirs - (format "(%s) " (string-join subdirs separator))))) - (concat subdirs title))) - -(defun org-roam--format-title (title &optional file-path) - "Format TITLE with relative subdirs from `org-roam-directory'. -When `org-roam-title-include-subdirs' is non-nil, FILE-PATH is -used to compute which subdirs should be included in the title. -If FILE-PATH is not provided, the file associated with the -current buffer is used." - (if org-roam-title-include-subdirs - (let* ((root (expand-file-name org-roam-directory)) - ;; If file-path is not provided, compute it - (path (or file-path - (-> (or (buffer-base-buffer) - (current-buffer)) - (buffer-file-name) - (file-truename)))) - (subdirs (--> path - (file-name-directory it) - (unless (equal root it) - (--> it - (file-relative-name it root) - ;; Transform path-string to list of subdirs - (split-string (substring it nil -1) "/")))))) - (pcase org-roam-title-subdir-format - ((pred functionp) - (funcall org-roam-title-subdir-format title subdirs)) - ((or 't 'default) - (org-roam--format-title-with-subdirs title subdirs)) - ('nil - (error "`org-roam-title-subdir-format' should not be nil")) - (wrong-type (signal 'wrong-type-argument - `((functionp symbolp) - ,wrong-type))))) - title)) - (defun org-roam--extract-titles-title () "Return title from \"#+TITLE\" of the current buffer." (let* ((prop (org-roam--extract-global-props '("TITLE"))) @@ -389,7 +351,7 @@ current buffer is used." Reads from the \"ROAM_ALIAS\" property." (let* ((prop (org-roam--extract-global-props '("ROAM_ALIAS"))) (aliases (cdr (assoc "ROAM_ALIAS" prop)))) - (org-roam--aliases-str-to-list aliases))) + (org-roam--str-to-list aliases))) (defun org-roam--extract-titles-headline () "Return the first headline of the current buffer." @@ -418,13 +380,60 @@ If NESTED, return the first successful result from SOURCES." (cl-return)))) coll)) -(defun org-roam--extract-and-format-titles (&optional file-path) - "Extract the titles from the current buffer and format them. -If FILE-PATH is not provided, the file associated with the -current buffer is used." - (mapcar (lambda (title) - (org-roam--format-title title file-path)) - (org-roam--extract-titles))) +(defun org-roam--extract-tags-all-directories (file) + "Extract tags from using the directory path FILE. +All sub-directories relative to `org-roam-directory' are used as tags." + (when-let ((dir-relative (file-name-directory + (file-relative-name file org-roam-directory)))) + (f-split dir-relative))) + +(defun org-roam--extract-tags-last-directory (file) + "Extract tags from using the directory path FILE. +The final directory component is used as a tag." + (when-let ((dir-relative (file-name-directory + (file-relative-name file org-roam-directory)))) + (last (f-split dir-relative)))) + +(defun org-roam--extract-tags-prop (_file) + "Extract tags from the current buffer's \"#ROAM_TAGS\" global property." + (let* ((prop (org-roam--extract-global-props '("ROAM_TAGS")))) + (org-roam--str-to-list (cdr (assoc "ROAM_TAGS" prop))))) + +(defcustom org-roam-tag-sort nil + "When non-nil, sort the tags in the completions. +When t, sort the tags alphabetically, regardless of case. +`org-roam-tag-sort' can also be a list of arguments to be applied +to `cl-sort'. For example, these are the arguments used when +`org-roam-tag-sort' is set to t: + \('string-lessp :key 'downcase) +Only relevant when `org-roam-tag-sources' is non-nil." + :type '(choice + (boolean) + (list :tag "Arguments to cl-loop")) + :group 'org-roam) + +(defun org-roam--extract-tags (&optional file) + "Extract tags from the current buffer. +If file-path FILE, use it to determine the directory tags. +Tags are obtained via: + +1. Directory tags: Relative to `org-roam-directory': each folder + path is considered a tag. +2. The key #+ROAM_TAGS." + (let* ((file (or file (buffer-file-name (buffer-base-buffer)))) + (tags (mapcan (lambda (source) + (funcall (intern (concat "org-roam--extract-tags-" + (symbol-name source))) + file)) + org-roam-tag-sources))) + (pcase org-roam-tag-sort + ('nil tags) + ((pred booleanp) (cl-sort tags 'string-lessp :key 'downcase)) + (`(,(pred symbolp) . ,_) + (apply #'cl-sort (push tags org-roam-tag-sort))) + (wrong-type (signal 'wrong-type-argument + `((booleanp (list symbolp …)) + ,wrong-type)))))) (defun org-roam--ref-type-p (type) "Return t if the ref from current buffer is TYPE." @@ -522,7 +531,7 @@ Examples: If LOWERCASE, downcase the title before insertion. FILTER-FN is the name of a function to apply on the candidates which takes as its argument an alist of path-completions. -If DESCRIPTION is provided, use this as the link label. See +If DESCRIPTION is provided, use this as the link label. See `org-roam--get-title-path-completions' for details." (interactive "P") (let* ((region (and (region-active-p) @@ -535,10 +544,12 @@ If DESCRIPTION is provided, use this as the link label. See (if filter-fn (funcall filter-fn it) it))) - (title (org-roam-completion--completing-read "File: " completions - :initial-input region-text)) + (title-with-tags (org-roam-completion--completing-read "File: " completions + :initial-input region-text)) + (res (gethash title-with-tags completions)) + (title (plist-get res :title)) + (target-file-path (plist-get res :path)) (description (or description region-text title)) - (target-file-path (cdr (assoc title completions))) (link-description (org-roam--format-link-title (if lowercase (downcase description) description)))) @@ -550,8 +561,8 @@ If DESCRIPTION is provided, use this as the link label. See (insert (org-roam--format-link target-file-path link-description))) (when (org-roam-capture--in-process-p) (user-error "Nested Org-roam capture processes not supported")) - (let ((org-roam-capture--info (list (cons 'title title) - (cons 'slug (org-roam--title-to-slug title)))) + (let ((org-roam-capture--info `((title . ,title-with-tags) + (slug . ,(org-roam--title-to-slug title-with-tags)))) (org-roam-capture--context 'title)) (add-hook 'org-capture-after-finalize-hook #'org-roam-capture--insert-link-h) (setq org-roam-capture-additional-template-props (list :region region @@ -560,19 +571,32 @@ If DESCRIPTION is provided, use this as the link label. See (org-roam--with-template-error 'org-roam-capture-templates (org-roam-capture--capture)))))) +(defcustom org-roam-tag-separator "," + "String to use to separate tags. +Only relevant when `org-roam-tag-sources' is non-nil." + :type 'string + :group 'org-roam) + (defun org-roam--get-title-path-completions () - "Return a list of cons pairs for titles to absolute path of Org-roam files." - (let* ((rows (org-roam-db-query [:select [file titles] :from titles])) - res) + "Return a hash table for completion. +The key is the displayed title for completion, and the value is a +plist containing the path to the file, and the original title." + (let* ((rows (org-roam-db-query [:select [titles:file titles:titles tags:tags] :from titles + :left :join tags + :on (= titles:file tags:file)])) + (ht (make-hash-table :test 'equal))) (dolist (row rows) - (let ((file-path (car row)) - (titles (cadr row))) - (if titles - (dolist (title titles) - (push (cons title file-path) res)) - (push (cons (org-roam--path-to-slug file-path) - file-path) res)))) - res)) + (pcase-let ((`(,file-path ,titles ,tags) row)) + (let ((titles (or titles (list (org-roam--path-to-slug file-path))))) + (dolist (title titles) + (let ((k (concat + (if tags + (concat "(" (s-join org-roam-tag-separator tags) ") ") + "") + title)) + (v (list :path file-path :title title))) + (puthash k v ht)))))) + ht)) (defun org-roam-find-file (&optional initial-prompt filter-fn) "Find and open an Org-roam file. @@ -585,15 +609,16 @@ which takes as its argument an alist of path-completions. See (if filter-fn (funcall filter-fn it) it))) - (title (org-roam-completion--completing-read "File: " completions - :initial-input initial-prompt)) - (file-path (cdr (assoc title completions)))) + (title-with-tags (org-roam-completion--completing-read "File: " completions + :initial-input initial-prompt)) + (res (gethash title-with-tags completions)) + (file-path (plist-get res :path))) (if file-path (find-file file-path) (if (org-roam-capture--in-process-p) (user-error "Org-roam capture in process") - (let ((org-roam-capture--info (list (cons 'title title) - (cons 'slug (org-roam--title-to-slug title)))) + (let ((org-roam-capture--info `((title . ,title-with-tags) + (slug . ,(org-roam--title-to-slug title-with-tags)))) (org-roam-capture--context 'title)) (add-hook 'org-capture-after-finalize-hook #'org-roam-capture--find-file-h) (org-roam--with-template-error 'org-roam-capture-templates diff --git a/tests/roam-files/base.org b/tests/roam-files/base.org new file mode 100644 index 0000000..1c9316b --- /dev/null +++ b/tests/roam-files/base.org @@ -0,0 +1 @@ +#+TITLE: Base diff --git a/tests/roam-files/nested/deeply/deeply_nested_file.org b/tests/roam-files/nested/deeply/deeply_nested_file.org new file mode 100644 index 0000000..3156db6 --- /dev/null +++ b/tests/roam-files/nested/deeply/deeply_nested_file.org @@ -0,0 +1 @@ +#+TITLE: Deeply Nested File diff --git a/tests/roam-files/tags/no_tag.org b/tests/roam-files/tags/no_tag.org new file mode 100644 index 0000000..3e78f2b --- /dev/null +++ b/tests/roam-files/tags/no_tag.org @@ -0,0 +1,3 @@ +#+TITLE: Tagless File + +This file has no tags, and should not yield any tags on extracting via =#+ROAM_TAGS=. diff --git a/tests/roam-files/tags/tag.org b/tests/roam-files/tags/tag.org new file mode 100644 index 0000000..68d8170 --- /dev/null +++ b/tests/roam-files/tags/tag.org @@ -0,0 +1,4 @@ +#+ROAM_TAGS: "t1" "t2 with space" t3 +#+TITLE: Tags + +This file is used to test functionality for =(org-roam--extract-tags)= diff --git a/tests/test-org-roam.el b/tests/test-org-roam.el index a5e9fe4..1702353 100644 --- a/tests/test-org-roam.el +++ b/tests/test-org-roam.el @@ -141,6 +141,72 @@ :to-equal '("Headline" "roam" "alias" "TITLE PROP")))))) +(describe "Tag extraction" + :var (org-roam-tag-sources) + (before-all + (test-org-roam--init)) + + (after-all + (test-org-roam--teardown)) + + (cl-flet + ((test (fn file) + (let* ((fname (test-org-roam--abs-path file)) + (buf (find-file-noselect fname))) + (with-current-buffer buf + (funcall fn fname))))) + (it "extracts from prop" + (expect (test #'org-roam--extract-tags-prop + "tags/tag.org") + :to-equal + '("t1" "t2 with space" "t3")) + (expect (test #'org-roam--extract-tags-prop + "tags/no_tag.org") + :to-equal + nil)) + + (it "extracts from all directories" + (expect (test #'org-roam--extract-tags-all-directories + "base.org") + :to-equal + nil) + (expect (test #'org-roam--extract-tags-all-directories + "tags/tag.org") + :to-equal + '("tags")) + (expect (test #'org-roam--extract-tags-all-directories + "nested/deeply/deeply_nested_file.org") + :to-equal + '("nested" "deeply"))) + + (it "extracts from last directory" + (expect (test #'org-roam--extract-tags-last-directory + "base.org") + :to-equal + nil) + (expect (test #'org-roam--extract-tags-last-directory + "tags/tag.org") + :to-equal + '("tags")) + (expect (test #'org-roam--extract-tags-last-directory + "nested/deeply/deeply_nested_file.org") + :to-equal + '("deeply"))) + + (describe "uses org-roam-tag-sources correctly" + (it "'(prop)" + (expect (let ((org-roam-tag-sources '(prop))) + (test #'org-roam--extract-tags + "tags/tag.org")) + :to-equal + '("t1" "t2 with space" "t3"))) + (it "'(prop all-directories)" + (expect (let ((org-roam-tag-sources '(prop all-directories))) + (test #'org-roam--extract-tags + "tags/tag.org")) + :to-equal + '("t1" "t2 with space" "t3" "tags")))))) + ;;; Tests (xdescribe "org-roam-db-build-cache" (before-each @@ -202,7 +268,7 @@ ;; Expect rebuilds to be really quick (nothing changed) (expect (org-roam-db-build-cache) :to-equal - (list :files 0 :links 0 :titles 0 :refs 0 :deleted 0)))) + (list :files 0 :links 0 :tags 0 :titles 0 :refs 0 :deleted 0)))) (xdescribe "org-roam-insert" (before-each @@ -216,15 +282,15 @@ (with-current-buffer buf (with-simulated-input "Foo RET" - (org-roam-insert nil)))) + (org-roam-insert)))) (expect (buffer-string) :to-match (regexp-quote "file:foo.org"))) (it "temp2 -> nested/foo" (let ((buf (test-org-roam--find-file "temp2.org"))) (with-current-buffer buf (with-simulated-input - "Nested SPC Foo RET" - (org-roam-insert nil)))) + "(nested) SPC Nested SPC Foo RET" + (org-roam-insert)))) (expect (buffer-string) :to-match (regexp-quote "file:nested/foo.org"))) (it "nested/temp3 -> foo" @@ -232,15 +298,15 @@ (with-current-buffer buf (with-simulated-input "Foo RET" - (org-roam-insert nil)))) + (org-roam-insert)))) (expect (buffer-string) :to-match (regexp-quote "file:../foo.org"))) (it "a/b/temp4 -> nested/foo" (let ((buf (test-org-roam--find-file "a/b/temp4.org"))) (with-current-buffer buf (with-simulated-input - "Nested SPC Foo RET" - (org-roam-insert nil)))) + "(nested) SPC Nested SPC Foo RET" + (org-roam-insert)))) (expect (buffer-string) :to-match (regexp-quote "file:../../nested/foo.org")))) (xdescribe "rename file updates cache"