Add org-find-file-by-tag function

For details on this, see an essay on my website:
  https://howardism.org/Technical/Emacs/org-find-file-tags.html

elisp/beep.el

@@ -3,7 +3,7 @@
 ;; Copyright (C) 2020 Howard X. Abrams
 ;;
 ;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
-;; Maintainer: Howard X. Abrams
+;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
 ;; Created: December 23, 2020
 ;;
 ;; This file is not part of GNU Emacs.

elisp/ha-focus.el

@@ -67,8 +67,8 @@ set volume output volume v"))
   "Asynchronously called when the `osascript' process finishes."
   (message "Finished calling osascript."))
 
-(global-set-key (kbd "<f5>") 'ha-focus-begin)
+(global-set-key (kbd "<f7>") 'ha-focus-begin)
-(global-set-key (kbd "S-<f5>") 'ha-focus-break)
+(global-set-key (kbd "S-<f7>") 'ha-focus-break)
 
 (provide 'ha-focus)
 ;;; ha-focus.el ends here

elisp/org-find-file-tags.el

@@ -0,0 +1,146 @@
+;;; org-find-file-tags.el --- select files based on org-mode tags. -*- lexical-binding: t; -*-
+;;
+;; Copyright (C) 2023 Howard X. Abrams
+;;
+;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
+;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
+;; Created: January 8, 2023
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; *NB:* Do not edit this file. Instead, edit the original literate file at:
+;;            ~/website/Technical/Emacs/org-find-file-tags.org
+;;       And tangle the file to recreate this one.
+;;
+;;; Code:
+
+(defvar org-find-files-tag-line-re
+  (rx line-start
+      (or
+       (seq (one-or-more "*") " " (+? any) ":"
+            (group (one-or-more (any alnum "@_#%:"))) ":")
+       (seq "#+tags:" (one-or-more space)
+            (group (one-or-more (any alnum "@_#%" space)))))
+      line-end)
+  "Regular expression that matches either headline or global file tags.")
+
+(require 'pcre2el)
+
+(defun org-grep-tags (project-dir)
+  "Show `grep-mode' buffer of org files with tagged headlines.
+
+If PROJECT-DIR is nil, searches in the current project."
+  (interactive (list (read-directory-name "Directory: " (if (project-current)
+                                         (project-root (project-current))
+                                       default-directory))))
+
+  (let ((command (format "rg --no-heading '%s' %s"
+                         (rxt-elisp-to-pcre org-find-files-tag-line-re)
+                         project-dir)))
+    (grep command)))
+
+(defun shell-command-to-list (command)
+  "Return call to COMMAND as a list of strings for each line."
+  (thread-first command
+                shell-command-to-string
+                (string-lines t)))
+
+(defun org-tags-in-current (&optional dir)
+  "Returns a list of tags available in a directory tree."
+  (unless dir
+    (setq dir (if (project-current)
+                  (project-root (project-current))
+                default-directory)))
+  (let* ((command (format "rg --ignore-case --no-heading --no-line-number --no-filename '%s' %s"
+                          (rxt-elisp-to-pcre org-find-files-tag-line-re) dir))
+         (output  (shell-command-to-list command))
+         (tags    (thread-last output
+                               (seq-map 'org-tags-in-current--from-grep)
+                               (flatten-list))))
+    (seq-uniq tags 'string-equal)))
+
+(defun org-tags-in-current--from-grep (line)
+  "Return a list of tags from LINE that match `org-find-files-tag-line-re'."
+  (let ((case-fold-search t))
+    (when (string-match org-find-files-tag-line-re line)
+      (if-let ((s1 (match-string 1 line)))
+          (split-string s1 ":")
+        (if-let ((s2 (match-string 2 line)))
+          (split-string s2 (rx (1+ space))))))))
+
+(defun org-find-file-by-tags (file-tuple)
+  "Load file from FILE-TUPLE like `find-file'.
+
+If called interactively, first ask for a TAG and then limit the
+files displayed based on if they have a headline that contains
+that TAG."
+  (interactive (list
+                ;; The org-find-files-file-with-tag is a hash table where
+                ;; the key is a user-visible entry, and the value is a
+                ;; list of the filename and the (first) line number:
+                (let ((files (call-interactively 'org-find-files-file-with-tag)))
+                  (gethash (completing-read "File: " files) files))))
+
+  (seq-let (file line) file-tuple
+    (find-file file)
+    (when line
+      (goto-line line))))
+
+(defun org-find-files-file-with-tag (tag &optional dir)
+  "Return hashtable of files in project with headlines containing TAG."
+  (interactive (list (completing-read "Tag: " (org-tags-in-current) nil t)))
+  (unless dir
+    (setq dir (file-truename (if (project-current)
+                                 (project-root (project-current))
+                               default-directory))))
+
+  (let* ((tags-re (rx (or (seq "#+tags:" (0+ any) space (literal tag) word-boundary)
+                          (seq (1+ "*") space (1+ any) ":" (literal tag) ":"))))
+         (command (format "rg --ignore-case --no-heading --line-number '%s' %s"
+                          (rxt-elisp-to-pcre tags-re) dir))
+         (output  (shell-command-to-list command))
+         (reducer (org-find-files--add-file-with-tag dir))
+         (results (make-hash-table :test 'equal)))
+    (reduce reducer output :initial-value results)
+    results))
+
+(defun org-find-files--add-file-with-tag (dir)
+  "Return a reducer function with DIR available as lexical scope.
+The function return is a reducer, accepting a hashtable as an accumulator,
+and an entry from ripgrep. Assumes the entry looks like:
+
+/home/howard/website/Technical/Emacs/org-find-file-tags.org:58:** What Tags do we have? :tags:
+
+And crafts a key for display to the user, e.g.
+
+     Technical/Emacs/org-find-file-tags.org :: What Tags do we have?
+
+And the value is a list with the full filename as well as the
+linenumber. For instance:
+
+    (\"/home/howard/website/Technical/Emacs/org-find-file-tags.org\" 58)"
+  (lambda (acc-hash rg-file-entry)
+    (let ((line-re (rx (group (one-or-more (not ":"))) ":"
+                       (group (one-or-more digit))     ":"
+                       (or "#+tags:"
+                           (seq
+                            (one-or-more "*") (one-or-more space)
+                            (group (+? (not ":")))
+                            (one-or-more space) ":")))))
+      (when (string-match line-re rg-file-entry)
+        ;; Extract the grouped parts of the entry into variables:
+        (let* ((fullfile (match-string 1 rg-file-entry))
+               (linestr  (match-string 2 rg-file-entry))
+               (heading  (or (match-string 3 rg-file-entry) ""))
+               (linenum  (string-to-number linestr))
+               ;; Prepare to store the key/value in the hashtable:
+               (key      (format "%s %s"
+                                 (string-trim (string-remove-prefix dir fullfile))
+                                 (if (string-blank-p heading)  ""
+                                   (concat ":: " heading))))
+               (value    (list fullfile linenum)))
+          (puthash key value acc-hash)))
+      acc-hash)))
+
+(provide 'org-find-file-tags)
+;;; org-find-file-tags.el ends here