jops/jops.org

408 lines
15 KiB
Org Mode
Raw Permalink Normal View History

#+begin_src emacs-lisp :exports none
;;; org-project-headlines --- jump to Org headlines in projects -*- lexical-binding: t; -*-
;;
;; © 2024 Howard Abrams
;; Licensed under a Creative Commons Attribution 4.0 International License.
;; See http://creativecommons.org/licenses/by/4.0/
;;
;; Author: Howard Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard Abrams
;; Created: Nov 11, 2024
;;
;; While obvious, GNU Emacs does not include this file or project.
;;
;;; Commentary:
;;
;; The Jump to Org Project Section (or JOPS) is an interactive Emacs
;; function that allows you (in one step) to load an Org file from a
;; project and jump to a particular trees heading.
;;
;;; Code:
#+END_SRC
A literate programming file for jumping to Org Headlines in a project.
* Overview
This project attempts to limit dependencies, but along with Org, this
depends on Magnars [[https://github.com/magnars/s.el][String library]]:
#+BEGIN_SRC emacs-lisp
(require 's)
#+END_SRC
This project also needs the following functions available in Emacs,
version 28 or greater.
#+BEGIN_SRC emacs-lisp
(declare-function project-root "project.el")
(declare-function thread-first "subx.el")
(declare-function thread-last "subx.el")
(declare-function seq-remove "seq.el")
(declare-function seq-map "seq.el")
#+END_SRC
This project also depends on an external dependency of [[https://github.com/BurntSushi/ripgrep][ripgrep]]
(version 0.8 or later). Seems that we could abstract this to use other
fast external search tools, like [[https://git-scm.com/docs/git-grep][git-grep]] or the [[https://github.com/ggreer/the_silver_searcher][Silver Searcher]]… a
goal for another day.
Installing =ripgrep= on your operating system is an exercise left to the
reader.
* Customization
Set this variable to the full path of =ripgrep= if you cant adjust the =PATH= environment variable for Emacs (or change [[help:exec-path]]):
#+BEGIN_SRC emacs-lisp
(defvar jops-ripgrep "rg"
"Executable (or full path) to ripgrep.")
#+END_SRC
Not every header should be a destination, as org files often have
duplicate headlines. For instance, in my world, I almost always have a
section titled like *Introduction* and *Summary*,neither of which are
unique enough to jump to directly. Set the following variable to a
regular expression to remove or flush entries:
#+BEGIN_SRC emacs-lisp
(defvar jops-flush-headers nil
"Regular expression matching headers to purge.")
#+END_SRC
As an example, I use the =rx= macro, like:
#+BEGIN_SRC emacs-lisp :tangle no
(setq jops-flush-headers
(rx "*" (one-or-more space)
(or "Introduction"
"Install"
"Overview"
"Summary"
"Technical Artifacts")))
#+END_SRC
Or one could set variable set in the =.dir-locals.el= for a particular
project, as in:
#+BEGIN_SRC emacs-lisp :tangle no
((org-mode . ((jops-flush-headers .
"\\*[[:space:]]+\\(?:Background\\|Summary\\)"))))
#+END_SRC
* Interactive Interface
The interface for this package is the =jops= function, and supporting
functions begin with =jops-=.
*Note:* Using enhancements to =completing-read= (like [[https://github.com/oantolin/orderless][Orderless]]), offers
fuzzy matching features to choose a headline in any of my Org files in
a project, and then load that file and jump to that headline.
#+BEGIN_SRC emacs-lisp
(defun jops (&optional project-root-dir)
"Edit a file based on a particular heading.
After presenting a list of headings from all Org files in
PROJECT-ROOT-DIR (or results from `project-current'), it loads the
file, and jumps to the line number of the location of the heading."
(interactive)
(let* ((default-directory (or project-root-dir (project-root (project-current))))
(file-headings (jops--file-heading-list))
(file-choice (completing-read "Edit Heading: " file-headings))
(file-tuple (alist-get file-choice file-headings
nil nil 'string-equal)))
(find-file (car file-tuple))
(goto-char (point-min))
(forward-line (caar file-tuple))))
#+END_SRC
This function collects all possible headers by issuing a call to
=ripgrep=, which returns something like:
#+begin_example
ha-applications.org:29:* Git and Magit
ha-applications.org:85:** Git Gutter
ha-applications.org:110:** Git Delta
ha-applications.org:136:** Git with Difftastic
...
"ha-applications.org:385:* Web Browsing
ha-applications.org:386:** EWW
...
#+end_example
The following regular expression parses the three /parts/ of the output
of the =ripgrep= executable (as well as figure out the /depth/ of the
headline):
#+BEGIN_SRC emacs-lisp
(defvar jops-rx-ripgrep
(rx (group (one-or-more (not ":"))) ":" ; filename
(group (one-or-more digit)) ":" ; line number
(group (one-or-more "*")) ; header asterisks
(one-or-more space)
(group (one-or-more (not ":")))) ; headline without tags
"Regular expression of ripgrep default output with groups.")
#+END_SRC
* Working with ripgrep
Well use this shell command to call =ripgrep= to search a collection of
org files (from a particular directory we define later):
#+BEGIN_SRC emacs-lisp
(defvar jops--ripgrep
(concat jops-ripgrep
" --no-heading"
" --line-number"
" -e '^\\*+ '"
" *.org")
"A ripgrep shell call to search my headers.")
#+END_SRC
The =jops—entries= function calls the executable and /threads/ the output
through function calls to get a list of output lines:
#+BEGIN_SRC emacs-lisp
(defun jops--entries ()
"Call `ripgrep' and return a list of entries."
(thread-first jops--ripgrep
(shell-command-to-string)
(split-string "\\(\r\n\\|[\n\r]\\)" t)))
#+END_SRC
We use =jops—file-heading-list= as a simpler interface to both call
=ripgrep= and filter out non-useful headers with the function,
=ha-hamcs-edit—filter-heading=, and convert the headlines with
=ha-hamcs-edit—process-entry= to be more presentable:
#+BEGIN_SRC emacs-lisp
(defun jops--file-heading-list ()
"Return list of lists of headlines and file locations.
Call `ripgrep' executable in the `default-directory' (set
beforehand). Using the output from the shell command,
`jops-ripgrep-headers', it parses and returns
something like:
'((\"Applications∷ Git and Magit\" \"ha-applications.org\" 29)
(\"Applications∷ Git and Magit ﹥ Git Gutter\" \"ha-applications.org\" 85)
(\"Applications∷ Git and Magit ﹥ Git Delta\" \"ha-applications.org\" 110)
(\"Applications∷ Git and Magit ﹥ Time Machine\" \"ha-applications.org\" 265)
...)"
(thread-last (jops--entries)
;; Let's remove non-helpful, duplicate headings,
;; like Introduction:
(seq-remove 'jops--filter-heading)
;; Convert the results into both a displayable
;; string as well as the file and line structure:
(seq-map 'jops--process-entry)))
#+END_SRC
As the above functions documentation string claims, it creates a list
containing the data structure necessary for =completing-read= as well as
the information I need to load/jump to a position in the file. This is
a three-element list of the /headline/, /filename/ and /line number/ for
each entry:
#+BEGIN_SRC emacs-lisp :tangle no
'(("Applications∷ Git and Magit" "ha-applications.org" 29)
("Applications∷ Git and Magit ﹥ Git Gutter" "ha-applications.org" 85)
("Applications∷ Git and Magit ﹥ Time Machine" "ha-applications.org" 265)
("Applications∷ Git and Magit ﹥ Gist" "ha-applications.org" 272)
("Applications∷ Git and Magit ﹥ Pushing is Bad" "ha-applications.org" 334)
("Applications∷ Git and Magit ﹥ Github Search?" "ha-applications.org" 347)
("Applications∷ ediff" "ha-applications.org" 360)
("Applications∷ Web Browsing" "ha-applications.org" 385)
("Applications∷ Web Browsing ﹥ EWW" "ha-applications.org" 386)
;; ...
)
#+END_SRC
This function, callable by filter functions, uses the regular
expression, =jops-flush-headers=, and returns true (well, non-nil) if
the line entry, =rg-input=, matches:
#+BEGIN_SRC emacs-lisp
(defun jops--filter-heading (rg-input)
"Return non-nil if we should remove RG-INPUT.
These are headings with typical, non-unique entries,
like Introduction and Summary."
(if jops-flush-headers
(string-match jops-flush-headers rg-input)
rg-input))
#+END_SRC
The =seq-map= needs to take each line from the =ripgrep= call and convert
it to a list that I can use for the =completing-read= prompt. I love the
combination of =seq-let= and =s-match=,[fn:1] which returns each all
/matched groups/.
#+BEGIN_SRC emacs-lisp
(defun jops--process-entry (rg-input)
"Return list of heading, file and line number.
Parses the line entry, RG-INPUT, from a call to `rg',
using the regular expression, `jops-rx-ripgrep'.
Returns something like:
(\"Some Heading\" \"some-file.org\" 42)"
(seq-let (_ file line level head)
(s-match jops-rx-ripgrep rg-input)
(list (jops--new-heading file head (length level))
file
(string-to-number line))))
#+END_SRC
The following test can verify (and explain) what we expect to return:
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest jops--process-entry-test ()
(setq jops-prev-head-list '())
(should (equal
(jops--process-entry
"ha-somefile.org:42:* A Nice Headline :ignored:")
'("Somefile∷ A Nice Headline " "ha-somefile.org" 42)))
;; For second-level headlines, we need to keep track of its parent,
;; and for this, we use a global variable, which we can set for the
;; purposes of this test:
(setq jops-prev-head-list '("Parent"))
(should (equal
(jops--process-entry
"ha-somefile.org:73:** Another Headline")
'("Somefile∷ Parent﹥ Another Headline"
"ha-somefile.org" 73)))
(setq jops-prev-head-list '("Parent" "Subparent"))
(should (equal
(jops--process-entry
"ha-somefile.org:73:*** Deep Heading")
'("Somefile∷ Parent﹥ Subparent﹥ Deep Heading"
"ha-somefile.org" 73)))
(setq jops-prev-head-list '("Parent" "Subparent"
"Subby" "Deepsubby"))
(should (equal
(jops--process-entry
"ha-somefile.org:73:***** Deepest Heading")
'("Somefile∷ ... Deepest Heading"
"ha-somefile.org" 73))))
#+END_SRC
* Readable Headlines
Since the parents of any particular headline occurs /earlier/ in the
list, we store the current list of parents, in the following (/gasp/)
/global variable/:
#+BEGIN_SRC emacs-lisp
(defvar jops-prev-head-list '("" "")
"The current parents of headlines as a list.")
#+END_SRC
The =jops—new-heading= function will combine the name of the file and a
headlines parent headlines (if any) to the headline to be more useful
in both understanding the relative context of the headline, as well as
better to search using fuzzy matching.
I found the use of =setf= to be helpful in manipulating the list of
parents. Remember a =list= in a Lisp, is a /linked list/, and we can
replace one or more parts, by pointing to a new list.
Essentially, if we get to a top-level headline, we set the list of
parents to a list containing that new headline. If we get a
second-level headine, =B=, and our parent list is =A=, we create a list
=(A B)= by setting the =cdr= of =(A)= to the list =(B)=. The advantage of
this approach is that if the parent list is =(A C D)=, the =setf= works
the same, and the dangled /sublist/, =(C D)= gets garbage collected.
#+BEGIN_SRC emacs-lisp
(defun jops--new-heading (file head level)
"Return readable entry from FILE and org headline, HEAD.
The HEAD headline is, when LEVEL is greater than 1,
to include parent headlines. This is done by storing
the list of parents in `jops-prev-head-list'."
;; Reset the parent list to include the new HEAD:
(pcase level
(1 (setq jops-prev-head-list (list head)))
(2 (setf (cdr jops-prev-head-list) (list head)))
(3 (setf (cddr jops-prev-head-list) (list head)))
(4 (setf (cdddr jops-prev-head-list) (list head)))
(5 (setf (cddddr jops-prev-head-list) (list head))))
;; Let's never go any deeper than this...
(format "%s∷ %s"
(jops--file-title file)
(s-join "﹥ " jops-prev-head-list)))
#+END_SRC
The following test should pass some mustard and explain how this
function works:
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest jops--new-heading-test ()
(should (equal
(jops--new-heading "ha-foobar.org" "Apples" 1)
"Foobar∷ Apples"))
(setq jops-prev-head-list '("Apples"))
(should (equal
(jops--new-heading "ha-foobar.org" "Oranges" 2)
"Foobar∷ Apples﹥ Oranges"))
(setq jops-prev-head-list '("Apples" "Oranges"))
(should (equal
(jops--new-heading "ha-foobar.org" "Bananas" 3)
"Foobar∷ Apples﹥ Oranges﹥ Bananas"))
(setq jops-prev-head-list '("Apples" "Oranges" "Bananas"))
(should (equal
(jops--new-heading "ha-foobar.org" "Cantaloupe" 4)
"Foobar∷ Apples﹥ Oranges﹥ Bananas﹥ Cantaloupe")))
#+END_SRC
* Fix Filenames
I would like to make the /filename/ more readable, I use the =s-match=
again, to get the groups of a regular expression, remove all the
dashes, and use =s-titleize= to capitalize each word:
#+BEGIN_SRC emacs-lisp
(defun jops--file-title (file)
"Return a more readable string from FILE."
(s-with file
(s-match jops-file-to-title)
(second)
(s-replace "-" " ")
(s-titleize)))
(defvar jops-file-to-title
(rx (optional (or "README-" "ha-"))
(group (one-or-more any)) ".org")
"Extract the part of a file to use as a title.")
#+END_SRC
So the following tests should pass:
#+BEGIN_SRC emacs-lisp :tangle no
(ert-deftest jops-file-title-test ()
(should (equal (jops-file-title "ha-apples.org") "Apples"))
(should (equal (jops-file-title "apples.org") "Apples"))
(should (equal (jops-file-title "README-apples.org") "Apples"))
(should (equal (jops-file-title "README.org") "Readme")))
#+END_SRC
Whew. Let's =provide= a name so we can =require= this file:
#+BEGIN_SRC emacs-lisp :exports none
(provide 'jops)
;;; jops.el ends here
#+END_SRC
* Footnotes
[fn:1] The need for =s-match= is why this project depends on the
external =s= library. The built-in function, =string-match= returns the
index in the string where the match occurs (useful for positioning a
prompt). This requires subsequent calls to =match-string= to get each
grouped expression, while =s-match= returns all groups as a list.
#+PROPERTY: header-args :tangle yes :comments org :results none :eval no-export
# Local Variables:
# eval: (add-hook 'after-save-hook #'org-babel-tangle t t)
# End: