org-table.el: Implement org table header mode using an overlay

* lisp/org-table.el (org-table-row-get-visible-string): Update
docstring.
(org-table-header-set-header): Use an overlay instead of the
header line.

1 files changed, 25 insertions, 46 deletions

diff --git a/lisp/org-table.el b/lisp/org-table.el
index 94619bf..2000cff 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -450,13 +450,10 @@ prevents it from hanging Emacs."
   :package-version '(Org . "8.3"))
 
 
-;;; Org table electric header minor mode
-(defvar-local org-table-temp-header-line nil)
-(defvar-local org-table-temp-header-remapping nil)
-
+;;; Org table header minor mode
 (defun org-table-row-get-visible-string (&optional pos)
-  "Get the visible string of a row.
-This is useful when columns have been shrunk."
+  "Get the visible string of a table row.
+This may be useful when columns have been shrunk."
   (save-excursion
     (when pos (goto-char pos))
     (goto-char (line-beginning-position))
@@ -469,61 +466,43 @@ This is useful when columns have been shrunk."
 	    (goto-char (1- (overlay-end ov))))))
       (format "|%s" (mapconcat #'identity (reverse str) "")))))
 
+(defvar-local org-table-header-overlay nil)
 (defun org-table-header-set-header ()
-  "Set the header of table at point as the `header-line-format'.
-Assume `org-table-temp-header-line' already stores the previously
-existing value of `header-line-format' we might want to restore."
-  (face-remap-remove-relative org-table-temp-header-remapping)
-  (setq-local org-table-temp-header-remapping
-	      (face-remap-add-relative 'header-line '(:inherit default)))
-  (if (not (org-at-table-p))
-      (setq header-line-format org-table-temp-header-line)
+  "Display the header of the table at point."
+  (when (overlayp org-table-header-overlay)
+    (delete-overlay org-table-header-overlay))
+  (when (org-at-table-p)
     (run-with-timer
-     0.1 nil
+     0.01 nil
      (lambda ()
-       (let* ((beg (save-excursion
+       (let* ((ws (window-start))
+	      (beg (save-excursion
 		     (goto-char (org-table-begin))
 		     (while (or (org-at-table-hline-p)
 				(looking-at-p ".*|\\s-+<[rcl]?\\([0-9]+\\)?>"))
 		       (move-beginning-of-line 2))
-		     (point))))
-	 (if (pos-visible-in-window-p beg)
-	     (setq header-line-format org-table-temp-header-line)
-	   (setq header-line-format nil)
-	   (let (;; Are we using `display-line-numbers-mode'?
-		 (lin (and (boundp 'display-line-numbers-mode)
-			   display-line-numbers-mode
-			   (line-number-display-width)))
-		 ;; Are we using `org-indent-mode'?
-		 (pre (and (boundp 'org-indent-mode) org-indent-mode
-			   (length (get-text-property (point) 'line-prefix)))))
-	     (setq header-line-format
-		   (concat (when (eq scroll-bar-mode 'left)
-			     (propertize " " 'display '(space :width scroll-bar)))
-			   (propertize
-			    " " 'display '(space :width (+ left-fringe left-margin)))
-			   (when lin (propertize (make-string (+ lin 2) 32)
-						 'face 'line-number))
-			   (when pre (make-string pre 32))
-			   (substring
-			    (propertize (org-table-row-get-visible-string beg)
-					'face 'org-table-header)
-			    (window-hscroll)))))))))))
+		     (point)))
+	      (end (save-excursion (goto-char beg) (point-at-eol))))
+	 (when (not (pos-visible-in-window-p beg))
+	   (setq org-table-header-overlay
+		 (make-overlay ws (+ ws (- end beg))))
+	   (org-overlay-display
+	    org-table-header-overlay
+	    (org-table-row-get-visible-string beg)
+	    'org-table-header)))))))
 
 ;;;###autoload
 (defvar-local org-table-header-line-mode nil)
 (define-minor-mode org-table-header-line-mode
   "Display the first row of the table at point in the header line."
   nil " TblHeader" nil
-  (ignore-errors (require 'face-remap))
   (unless (eq major-mode 'org-mode)
-    (user-error "Cannot turn org table electric mode outside org-mode buffers"))
+    (user-error "Cannot turn org table header mode outside org-mode buffers"))
   (if org-table-header-line-mode
-      (progn (setq-local org-table-temp-header-line header-line-format)
-	     (add-hook 'post-command-hook 'org-table-header-set-header nil t))
-    (remove-hook 'post-command-hook 'org-table-header-set-header t)
-    (face-remap-remove-relative org-table-temp-header-remapping)
-    (setq-local header-line-format org-table-temp-header-line)))
+      (add-hook 'post-command-hook 'org-table-header-set-header nil t)
+    (when (overlayp org-table-header-overlay)
+      (delete-overlay org-table-header-overlay))
+    (remove-hook 'post-command-hook 'org-table-header-set-header t)))
 
 
 ;;; Regexps Constants