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