Initial commit

2 files changed, 289 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..016d3b1
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+*.elc
\ No newline at end of file
diff --git a/breadcrumb.el b/breadcrumb.el
new file mode 100644
index 0000000..eb42c34
--- /dev/null
+++ b/breadcrumb.el
@@ -0,0 +1,288 @@
+;;; breadcrumb.el --- imenu-based breadcrumb paths   -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023  João Távora
+
+;; Author: João Távora <joaotavora@gmail.com>
+;; Version: 0.0.2alpha
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;;; Usage:
+;;;
+;;; Breadcrumbs are sequences of short strings indicating where you
+;;; are in some big tree-like maze.
+;;;
+;;; To craft these strings, this library uses the maps provided by
+;;; project.el and Imenu, respectively.  Project breadcrumbs shows you
+;;; the current buffer's path in a large project.  Imenu breadcrumbs
+;;; show the current position of point in the buffer's nested
+;;; structure of programming constructs (for example, a specific
+;;; functions within multiple C++ nested namespaces).
+;;;
+;;; To use this library:
+;;;
+;;; * M-x breadcrumb-headerline-mode.  A buffer-local minor-mode which
+;;;   puts Project and Imenu-derived breadcrumbs derived in the header
+;;;   line automatically.
+;;;
+;;; * Manually put the mode-line constructs
+;;;
+;;;     (:eval (breadcrumb-imenu-crumbs))
+;;;
+;;;   and
+;;;
+;;;     (:eval (breadcrumb-project-crumbs))
+;;;
+;;;  in your seettings of the `mode-line-format' or
+;;;  `header-line-format' variables.
+;;;
+;;; The shape and size of each breadcrumb groups may be tweaked via
+;;; `breadcrumb-imenu-max-length', `breadcrumb-project-max-length',
+;;; `breadcrumb-imenu-crumb-separator', and
+;;; `breadcrumb-project-crumb-separator'.
+;;;
+;;; The structure each the breadcrumbs varies depending on whether
+;;; either project.el and imenu.el (or both) can do useful things for
+;;; your buffer.
+;;;
+;;; For Project breadcrumbs, this depends on whether project.el's
+;;; `project-current' can guess what project the current buffer
+;;; belongs to.
+;;;
+;;; For Imenu breadcrumbs, this varies.  Depending on the major-mode
+;;; author's taste, the Imenu tree (in variable `imenu--index-alist')
+;;; may have different structure.  Sometimes, minor mode also tweak
+;;; the Imenu tree in useful ways.  For example, with recent Eglot (I
+;;; think Eglot 1.14+), managed buffers get extra region info added to
+;;; it, which makes Breadcrumb show "richer" paths.
+;;;
+;;;; Implementation notes:
+;;;
+;;; This _should_ be faster than which-func.el due some caching
+;;; strategies.  One of these strategies occurs in `bc--ipath-alist',
+;;; which takes care not to over-call `imenu-make-index-alist', which
+;;; could be slow (in fact very slow if an external process needs to
+;;; be contacted).  The variable `breadcrumb-idle-delay' controls
+;;; that.  Another cache occurs in `bc--ipath-plain-cache' second is
+;;; just a simple "space-for-speed" cache.
+;;;
+;;; Breadcrumb uses the double-dashed Imenu symbols
+;;; `imenu--index-alist' and `imenu--make-index-alist'.  There's
+;;; really no official API here.  It's arguable that, despite the
+;;; name, these aren't really internal symbols (the much older
+;;; which-func.el library makes liberal use of them, for example).
+;;;
+
+;;; Code:
+(require 'cl-lib)
+(require 'imenu)
+(require 'project)
+
+(cl-defun bc-bisect (a x &key (from 0) (to (length a)) key from-end)
+  "Compute index to insert X in sequence A, keeping it sorted.
+If X already in A, the resulting index is the leftmost such
+index, unless FROM-END is t.  KEY is as usual in other CL land."
+  (cl-macrolet ((search (from-end key)
+                  `(cl-loop while (< from to)
+                            for mid = (/ (+ from to) 2)
+                            for p1 = (elt a mid)
+                            for p2 = ,(if key `(funcall key p1) `p1)
+                            if (,(if from-end '< '<=) x p2)
+                            do (setq to mid) else do (setq from (1+ mid))
+                            finally return from)))
+    (if from-end (if key (search t key) (search t nil))
+      (if key (search nil key) (search nil nil)))))
+
+(defun bc--ipath-rich (index-alist pos)
+  "Compute ipath for rich `imenu--index-alist' structures.
+These structures have a `breadcrumb-region' property on every
+node."
+  (cl-labels
+      ((search (nodes &optional ipath)
+         (cl-loop
+          for n in nodes
+          for reg = (get-text-property 0 'breadcrumb-region (car n))
+          when (<= (car reg) pos (cdr reg))
+          return (search (cdr n) (cons (car n) ipath))
+          finally (cl-return ipath))))
+    (nreverse (search index-alist))))
+
+(defvar-local bc--ipath-plain-cache nil
+  "A cache for `bc--ipath-plain'")
+
+(defun bc--ipath-plain (index-alist pos)
+  "Compute ipath for plain `imenu--index-alist' structures.
+These structures don't have a `breadcrumb-region' property on."
+  (cl-labels ((dfs (n &optional ipath)
+                (setq ipath (cons (car n) ipath))
+                (if (consp (cdr n))
+                    (mapc (lambda (n) (dfs n ipath)) (cdr n))
+                  (setq bc--ipath-plain-cache
+                        (vconcat bc--ipath-plain-cache
+                                 `[,(cons (cdr n) ipath)])))))
+    (unless bc--ipath-plain-cache
+      (mapc #'dfs index-alist)
+      (setq bc--ipath-plain-cache (cl-sort bc--ipath-plain-cache #'< :key #'car)))
+    (unless (< pos (car (aref bc--ipath-plain-cache 0)))
+      (let ((res (bc-bisect bc--ipath-plain-cache pos :key #'car :from-end t)))
+        (unless (zerop res) (reverse (cdr (elt bc--ipath-plain-cache (1- res)))))))))
+
+(defun bc-ipath (index-alist pos)
+  "Get breadcrumb for position POS given INDEX-ALIST."
+  (if (get-text-property 0 'breadcrumb-region (caar index-alist))
+      (bc--ipath-rich index-alist pos)
+    (bc--ipath-plain index-alist pos)))
+
+(defvar bc--header-line-key [header-line mouse-1])
+
+(defun bc--format-node (p)
+  (let ((reg (get-text-property 0 'breadcrumb-region p)))
+    (if reg
+        (propertize p
+                    'mouse-face 'header-line-highlight
+                    'help-echo "Go here"
+                    'keymap (let ((m (make-sparse-keymap)))
+                              (define-key m bc--header-line-key
+                                          (lambda (&rest _e)
+                                            (interactive)
+                                            (push-mark)
+                                            (goto-char (car reg))))
+                              m))
+      p)))
+
+(defvar bc-idle-time 1
+  "Control idle time before requesting new breadcrumbs.")
+
+(defvar-local bc--idle-timer nil
+  "Timer used by `bc--ipath-alist'.")
+
+(defvar-local bc--last-update-tick 0
+  "Last time `bc--ipath-alist' asked for an update.")
+
+(defun bc--ipath-alist ()
+  "Return `imenu--index-alist', maybe arrange for its update."
+  (let ((nochangep (= (buffer-chars-modified-tick) bc--last-update-tick))
+        (buf (current-buffer)))
+    (unless nochangep
+      (setq bc--last-update-tick (buffer-chars-modified-tick))
+      (when bc--idle-timer (cancel-timer bc--idle-timer))
+      (setq bc--idle-timer
+            (run-with-idle-timer
+             bc-idle-time nil
+             (lambda ()
+               (when (buffer-live-p buf)
+                 (with-current-buffer buf
+                   (setq bc--last-update-tick (buffer-chars-modified-tick))
+                   (let ((non-essential t)
+                         (imenu-auto-rescan t))
+                     (imenu--make-index-alist t)
+                     (setq bc--ipath-plain-cache nil)
+                     (force-mode-line-update t))))))))
+    imenu--index-alist))
+
+(defgroup breadcrumb nil
+  "One-liner indication of where you are in the maze."
+  :prefix "breadcrumb-"
+  :group 'convenience)
+
+(defcustom bc-project-max-length 40
+  "Soft cutoff for `breadcrumb-project-crumbs'." :type 'fixnum)
+
+(defcustom bc-project-crumb-separator "/"
+  "Separator for `breadcrumb-project-crumbs'." :type 'string)
+
+(defcustom bc-imenu-max-length 40
+  "Soft cutoff for `breadcrumb-imenu-crumbs'." :type 'fixnum)
+
+(defcustom bc-imenu-crumb-separator " > "
+  "Separator for `breadcrumb-project-crumbs'." :type 'string)
+
+(defun bc-imenu-crumbs ()
+  (bc--summarize
+   (cl-loop with alist = (bc--ipath-alist)
+            for p in (bc-ipath alist (point))
+            collect (bc--format-node p))
+   bc-imenu-max-length
+   bc-imenu-crumb-separator))
+
+(defun bc--summarize (crumbs cutoff separator)
+  (let ((rcrumbs
+         (cl-loop
+             for available = (- cutoff used)
+             for (c . more) on (reverse crumbs)
+             for seplen = (if more (length separator) 0)
+             for shorten-p = (unless (get-text-property 0 'bc-dont-shorten c)
+                               (> (+ (length c) seplen) available))
+             for toadd = (if shorten-p (substring c 0 1) c)
+             sum (+ (length toadd) seplen) into used
+             collect toadd)))
+    (string-join (reverse rcrumbs) separator)))
+
+(cl-defun bc-project-crumbs ()
+  (let ((p (project-current)))
+    (unless p (cl-return-from bc-project-crumbs (buffer-name)))
+    (bc--summarize
+     (cons (propertize (project-name p) 'bc-dont-shorten t)
+           (split-string
+            (file-relative-name (buffer-file-name) (project-root p))
+            "/"))
+     bc-project-max-length
+     bc-project-crumb-separator)))
+
+(defun bc--header-line ()
+  "Helper for bc-headerline-mode"
+  (let ((x (cl-remove-if
+            #'seq-empty-p (mapcar #'funcall
+                                  '(bc-project-crumbs bc-imenu-crumbs)))))
+    (mapconcat #'identity x " : ")))
+
+(define-minor-mode bc-headerline-mode
+  "Header lines with breadcrumbs."
+  :init-value nil
+  (if bc-headerline-mode (add-to-list 'header-line-format '(:eval (bc--header-line)))
+    (setq header-line-format (delete '(:eval (bc--header-line)) header-line-format))))
+
+(defun bc-jump ()
+  "Like M-x `imenu', but breadcrumb-powered."
+  (interactive)
+  (let (cands choice)
+    (cl-labels
+        ((fmt (strs)
+           (mapconcat #'identity strs " > "))
+         (dfs (nodes &optional ipath)
+           (cl-loop
+            for n in nodes
+            for newpath = (cons (car n) ipath)
+            for pos = (or (car (get-text-property 0 'breadcrumb-region (car n)))
+                          (and (number-or-marker-p (cdr n)) (cdr n)))
+            when pos do (push (cons (fmt (reverse newpath)) pos)
+                              cands)
+            do (dfs (cdr n) newpath))))
+      (imenu--make-index-alist)
+      (dfs imenu--index-alist)
+      (unless cands (user-error "Sorry, no breadcrumb items to jump to."))
+      (setq choice (cdr (assoc (completing-read "Index item? " cands nil t)
+                               cands #'string=)))
+      (push-mark)
+      (goto-char choice))))
+
+(provide 'breadcrumb)
+;;; breadcrumb.el ends here
+
+;; Local Variables:
+;; read-symbol-shorthands: (("bc-" . "breadcrumb-"))
+;; End: