diff --git a/elisp/beep.el b/elisp/beep.el index d1a7fae..8999fc2 100644 --- a/elisp/beep.el +++ b/elisp/beep.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2020 Howard X. Abrams ;; ;; Author: Howard X. Abrams -;; Maintainer: Howard X. Abrams +;; Maintainer: Howard X. Abrams ;; Created: December 23, 2020 ;; ;; This file is not part of GNU Emacs. diff --git a/elisp/ha-focus.el b/elisp/ha-focus.el index f88252d..967d426 100644 --- a/elisp/ha-focus.el +++ b/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 "") 'ha-focus-begin) -(global-set-key (kbd "S-") 'ha-focus-break) +(global-set-key (kbd "") 'ha-focus-begin) +(global-set-key (kbd "S-") 'ha-focus-break) (provide 'ha-focus) ;;; ha-focus.el ends here diff --git a/elisp/org-find-file-tags.el b/elisp/org-find-file-tags.el new file mode 100644 index 0000000..d5b3bce --- /dev/null +++ b/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 +;; Maintainer: Howard X. Abrams +;; 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