org-traverse.el

org-traverse.el

;; org-traverse - set of hacks to enable linking between headlines using org links -

;; Variable list
;;; org-traverse-hashtable : the hashtable in memory that stores information about headlines and their position
;;; org-traverse-cache-directory : the directory in the filesystem to cache
;;; org-traverse-cache-directory-exclude : directory names within the cache-dir to exclude

;; Functions
;; Intended for user
;;; org-traverse-goto : navigate to a headline within the cache
;;; org-traverse-insert : insert an org link to a headline
;;; org-traverse-extract : populate the hashtable with entries, redundant if mode is active

;; Minor Mode
;; org-traverse-mode : hooks onto after-save-hook and runs `org-traverse-mode--backend' to refresh entries upon save
;; on two conditions: a. it is an org file indeed, and b. the file is part of the inclusions and exclusions defined by user
;; based on `org-traverse-cache-directory' and `org-traverse-cache-directory-exclude'.


;; variables
(defvar org-traverse-hashtable (make-hash-table :test 'equal)
  "Hash table containing headlines (keys),
 their corresponding positions within the file, and the file names.

A Hash table is a list-like structure containing pairs: Keys and Value.
The Key is the Headline name itself.
The Value in this case is a list containing two pairs, Pos. and Filename.")

(defvar org-traverse-cache-directory org-roam-directory
  "Directory to cache Org files for headline extraction.")

(defvar org-traverse-cache-directory-exclude '()
  "Name of directories to exclude from headline extraction.
Subdirectories will be excluded too.")


;; user functions
(defun org-traverse-goto ()
  "Navigate to the position of a headline selected from the org-traverse-hashtable."
  (interactive)
  (let ((headline (completing-read "Choose headline: " (hash-table-keys org-traverse-hashtable) nil t)))
    (when headline
      (let ((position (gethash headline org-traverse-hashtable)))
	(if position
	    (progn
	      (find-file-other-window (cadr position))
	      (goto-char (car position))
	      (message "Navigated to %s in %s" headline (cadr position)))
	  (message "Headline '%s' not found in hash table" headline))))))

(defun org-traverse-insert ()
  "Create an Org link to a headline selected from the org-traverse-hashtable and insert it into the current buffer."
  (interactive)
  (let ((current-buffer (current-buffer))
	(headline (completing-read "Choose headline: " (hash-table-keys org-traverse-hashtable) nil t)))
    (when headline
      (let ((position (gethash headline org-traverse-hashtable)))
	(if position
	    (save-excursion
	      (let* ((org-file (cadr position))
		     (org-buffer (find-file-noselect org-file)))
		(with-current-buffer org-buffer
		  (goto-char (car position))
		  (let* ((headline-text (org-get-heading t t t t))
			 (id (org-id-get-create)))
		    (save-buffer)
		    (switch-to-buffer current-buffer)
		    (insert (format "[[id:%s][%s]]" id headline-text))
		    (message "Inserted Org link to headline '%s' with ID '%s' in current buffer" headline-text id)))))
	  (message "Headline '%s' not found in hash table" headline))))))

(defun org-traverse-extract (&optional clear-cache debug)
  "Recursively extract headlines from all Org files in the cache directory, excluding directories specified in `org-traverse-cache-directory-exclude`."
  (interactive "P\nP")
  (when clear-cache
    (org-traverse-cache-empty))
  (let ((files-to-process (org-traverse-filter)))  ; refer to abyss below
    (dolist (file files-to-process)
      (when debug
	(message "Processing file: %s" file))
      (org-traverse-extract--backend file))))


;; Minor Mode
;; Define a function to update the hash table upon saving a buffer
(defun org-traverse-mode--backend ()
  "Update the hash table upon saving the current buffer."
  (when (and (eq major-mode 'org-mode)
	     buffer-file-name)
    (let ((org-file (buffer-file-name)))
      (when org-file
	(when (org-traverse-filterp org-file)
	  (org-traverse-remove org-file)
	  (org-traverse-extract--backend org-file))))))

;; Define a global minor mode
;;;###autoload
(define-minor-mode org-traverse-mode
  "Global minor mode to automatically update the hash table upon saving Org files."
  :global t
  :init-value nil
  :lighter " 0/rHT"
  (if org-traverse-mode
      (progn
	;; Set up after-save hook to update the hash table
	(add-hook 'after-save-hook #'org-traverse-mode--backend)
	;; Refresh the hash table
	(org-traverse-extract t nil))
    ;; Remove hook if mode is deactivated
    (remove-hook 'after-save-hook #'org-traverse-mode--backend)))


;; underlying functions
(defun org-traverse-extract--backend (org-file &optional clear-cache debug)
  "Extract and store all headlines from ORG-FILE in org-traverse-hashtable.
If CLEAR-CACHE is non-nil, clear the existing cache before extraction.
If DEBUG is non-nil, display a message after populating the hash table."
  (interactive "fEnter Org file: \nP")
  (when clear-cache
    (org-traverse-cache-empty)) ; reset the cache when requested
  (with-temp-buffer
    (insert-file-contents org-file)
    (goto-char (point-min))
    (while (re-search-forward "^\\*+\\s-+\\(.*?\\)$" nil t)
      (let ((headline (match-string 1)))
	(puthash headline (list (line-beginning-position) org-file) org-traverse-hashtable))))
  (when debug
    (message "Populated hashtable with contents from %s" org-file)))

(defun org-traverse-remove (org-file &optional debug)
  "Delete all keys associated with the specified Org file from the org-traverse-hashtable."
  (interactive "fEnter Org file: ")
  (let ((keys-to-delete '()))
    (maphash (lambda (key value)
	       (let ((file-path (cadr value)))
		 (when (file-equal-p (expand-file-name file-path) (expand-file-name org-file))
		   (push key keys-to-delete))))
	     org-traverse-hashtable)
    (dolist (key keys-to-delete)
      (remhash key org-traverse-hashtable)))
  (when debug
    (message "Deleted keys associated with %s from the hash table." org-file)))

;; helper functions
(defun org-traverse-filter (&optional debug)
  "Return a list of files in the cache directory excluding directories listed in `org-traverse-cache-directory-exclude` and their subdirectories.
When DEBUG is non-nil print verbose output."
  (let ((exclude-dirs org-traverse-cache-directory-exclude)
	(cache-directory org-traverse-cache-directory)
	(filtered-files '()))
    (let ((excluded-dirs (mapcar (lambda (dir)
				   (file-name-as-directory (expand-file-name dir cache-directory)))
				 exclude-dirs)))
      (dolist (file (directory-files-recursively cache-directory "\\.org$"))
	(let ((file-directory (file-name-directory file)))
	  (if (or (string-prefix-p "." (file-name-nondirectory file))
		  (cl-some (lambda (excluded-dir)
			     (string-prefix-p excluded-dir file-directory))
			   excluded-dirs))
	      (when debug
		(message "Filtered out file: %s (Excluded directory)" file))
	    (progn
	      (when debug
		(message "Keeping file: %s" file))
	      (push file filtered-files)))))
      (nreverse filtered-files))))

(defun org-traverse-filterp (org-file &optional debug)
  "Check if ORG-FILE is a member of the filtered org files in the cache directory."
  (let* ((filtered-files (org-traverse-filter))
	 (org-file-abs (expand-file-name org-file))) ; Get the absolute path
    (when debug
      (message "Filtered files: %s" filtered-files))
    (if (member org-file-abs filtered-files)
	t
      nil)))

(defun org-traverse-cache-empty ()
  (interactive)
  (setq org-traverse-hashtable (make-hash-table :test 'equal))
  )


;; debug
(defun org-traverse-list-entries ()
  "Read and display all key-value pairs in the org-traverse-hashtable."
  (message "Contents of org-headlines-hash-table:")
  (maphash (lambda (key value)
	     (message "[%s] (%s %s)" key (car value) (cadr value)))
	   org-traverse-hashtable))

Revisions

• Fixed minor typographic errors in documentation.