From af6fc2a535d6c52bb39d7a0131995b5a68de8fa4 Mon Sep 17 00:00:00 2001
From: Roshan Shariff <roshan.shariff@gmail.com>
Date: Sun, 7 Nov 2021 20:58:23 -0700
Subject: [PATCH] Customizable faces for header line, and improved display
 logic

* Add two new customizable faces, topsy and topsy-highlight.

The topsy face is used for the header-line face when topsy-mode is enabled.  It
inherits from the default face, so that the text in the header line matches the
contents of the buffer. The topsy-highlight face is applied (with low priority)
when topsy is showing the first line of a defun (see below).

To go back to the previous appearance (using header-line face), customize the
topsy face to nil or remove its ":inherit default" attribute.

* Properly handle narrowed buffers

The first line of the defun is shown even if it is only partly within a
narrowed buffer.

* Improve logic for finding the first line of a defun

The first line of a defun is shown only if it is partially visible. If the
defun is entirely outside the window, its first line is not shown.

Fixes #1

* Show previous line when a defun starts at the top of a window

Finally, when there is no partially visible defun, show the line that is above
the top of the window. This gives a smooth scrolling effect, where the header
line looks and acts just like a normally scrolling part of the buffer. When you
scroll up, the top line of text will appear in the header line, which then
becomes sticky when you scroll past a defun.

Buffer text shown in this way doesn't have the topsy-highlight face.
---
 topsy.el | 59 +++++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 50 insertions(+), 9 deletions(-)

diff --git a/topsy.el b/topsy.el
index 065f4f0..c3f8b1e 100644
--- a/topsy.el
+++ b/topsy.el
@@ -39,6 +39,7 @@
 ;;;; Requirements
 
 (require 'subr-x)
+(require 'face-remap)
 
 ;;;; Variables
 
@@ -54,6 +55,9 @@
 (defvar-local topsy-fn nil
   "Function that returns the header in a buffer.")
 
+(defvar-local topsy--face-remap nil
+  "Cookie returned by `face-remap-add-relative'.")
+
 ;;;; Customization
 
 (defgroup topsy nil
@@ -87,6 +91,21 @@ nil key defines the default function."
   :type '(alist :key-type symbol
                 :value-type function))
 
+(defface topsy '((t :inherit default))
+  "Face with which to display sticky header.
+To match the appearance of the text in the buffer, the `default`
+face should be included in the :inherit specification.
+Otherwise, unspecified face attributes will be inherited from the
+`header-line` face.
+
+To use the header-line, remove the :inherit attribute.")
+
+(defface topsy-highlight '((t :weight bold :underline t))
+  "Face for sticky header when it is showing the first line of a defun.
+This face will be used only when a defun is partially visible and
+the sticky header is showing its first line.  The faces of the
+buffer text being shown have higher priority than this face.")
+
 ;;;; Commands
 
 ;;;###autoload
@@ -104,7 +123,9 @@ Return non-nil if the minor mode is enabled."
         ;; Enable the mode
         (setf topsy-fn (or (alist-get major-mode topsy-mode-functions)
                            (alist-get nil topsy-mode-functions))
-              header-line-format 'topsy-header-line-format))
+              header-line-format 'topsy-header-line-format)
+        (setq topsy--face-remap
+              (face-remap-add-relative 'header-line 'topsy)))
     ;; Disable mode
     (when (eq header-line-format 'topsy-header-line-format)
       ;; Restore previous buffer local value of header line format if
@@ -112,18 +133,38 @@ Return non-nil if the minor mode is enabled."
       (kill-local-variable 'header-line-format)
       (when topsy-old-hlf
         (setf header-line-format topsy-old-hlf
-              topsy-old-hlf nil)))))
+              topsy-old-hlf nil)))
+    (face-remap-remove-relative topsy--face-remap)))
 
 ;;;; Functions
 
 (defun topsy--beginning-of-defun ()
-  "Return the line moved to by `beginning-of-defun'."
-  (when (> (window-start) 1)
-    (save-excursion
-      (goto-char (window-start))
-      (beginning-of-defun)
-      (font-lock-ensure (point) (point-at-eol))
-      (buffer-substring (point) (point-at-eol)))))
+  "Return the first line of a partially visible defun.
+The beginning and end of the defun are identified by
+`beginning-of-defun' and `end-of-defun', respectively.
+
+If no defun is partially visible, return the first line above the
+top of the window.  Buffer narrowing is ignored when looking for
+the defun but not when showing the previous line."
+  (save-excursion
+    (or (save-restriction
+          (widen)
+          (goto-char (window-start))
+          (let ((bod (ignore-errors (beginning-of-defun) (point)))
+                (eol (point-at-eol))
+                (eod (ignore-errors (end-of-defun) (point))))
+            (when (and bod (< bod (window-start))
+                       (or (not eod) (>= eod (window-start))))
+              (font-lock-ensure bod eol)
+              (let ((line (buffer-substring bod eol)))
+                (add-face-text-property 0 (length line) 'topsy-highlight t line)
+                line))))
+        (progn (goto-char (window-start))
+               (let ((bol (point-at-bol 0))
+                     (eol (point-at-eol 0)))
+                 (when (< eol (window-start))
+                   (font-lock-ensure bol eol)
+                   (buffer-substring bol eol)))))))
 
 ;;;; Footer