jops/jops.org
Howard Abrams a6255c1127 Proof of concept that works for me
Copied the original code from the Emacs configuration to make it
available to others. Need to get a better packaging setup.
2024-11-16 10:51:33 -08:00

15 KiB
Raw Blame History

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 String library:

  (require 's)

This project also needs the following functions available in Emacs, version 28 or greater.

  (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")

This project also depends on an external dependency of ripgrep (version 0.8 or later). Seems that we could abstract this to use other fast external search tools, like git-grep or the 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):

  (defvar jops-ripgrep "rg"
    "Executable (or full path) to ripgrep.")

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:

  (defvar jops-flush-headers nil
    "Regular expression matching headers to purge.")

As an example, I use the rx macro, like:

  (setq jops-flush-headers
    (rx "*" (one-or-more space)
        (or "Introduction"
            "Install"
            "Overview"
            "Summary"
            "Technical Artifacts")))

Or one could set variable set in the .dir-locals.el for a particular project, as in:

  ((org-mode . ((jops-flush-headers .
                 "\\*[[:space:]]+\\(?:Background\\|Summary\\)"))))

Interactive Interface

The interface for this package is the jops function, and supporting functions begin with jops-.

Note: Using enhancements to completing-read (like 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.

  (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))))

This function collects all possible headers by issuing a call to ripgrep, which returns something like:

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
...

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):

  (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.")

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):

  (defvar jops--ripgrep
    (concat jops-ripgrep
            " --no-heading"
            " --line-number"
            " -e '^\\*+ '"
            " *.org")
    "A ripgrep shell call to search my headers.")

The jops—entries function calls the executable and threads the output through function calls to get a list of output lines:

  (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)))

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:

  (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)))

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:

  '(("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)
    ;; ...
    )

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:

  (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))

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,1 which returns each all matched groups.

  (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))))

The following test can verify (and explain) what we expect to return:

  (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))))

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:

  (defvar jops-prev-head-list '("" "")
    "The current parents of headlines as a list.")

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.

  (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)))

The following test should pass some mustard and explain how this function works:

  (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")))

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:

  (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.")

So the following tests should pass:

  (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")))

Whew. Let's provide a name so we can require this file:

Footnotes


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.