a6255c1127
Copied the original code from the Emacs configuration to make it available to others. Need to get a better packaging setup.
277 lines
9.2 KiB
EmacsLisp
277 lines
9.2 KiB
EmacsLisp
;;; 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 tree’s heading.
|
||
;;
|
||
;;; Code:
|
||
|
||
|
||
|
||
;; This project attempts to limit dependencies, but along with Org, this
|
||
;; depends on Magnar’s [[https://github.com/magnars/s.el][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")
|
||
|
||
|
||
|
||
;; Set this variable to the full path of =ripgrep= if you can’t 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.")
|
||
|
||
|
||
;; 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.
|
||
|
||
|
||
(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:
|
||
|
||
;; #+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):
|
||
|
||
|
||
(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.")
|
||
|
||
|
||
;; We’ll 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)))
|
||
|
||
|
||
|
||
;; 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=,[fn: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))))
|
||
|
||
|
||
|
||
;; 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
|
||
;; headline’s 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)))
|
||
|
||
|
||
;; 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.")
|
||
|
||
|
||
|
||
;; Whew. Let's =provide= a name so we can =require= this file:
|
||
|
||
|
||
(provide 'jops)
|
||
;;; jops.el ends here
|