bug#21025: tabulated-list.el: It should preserve header line set by derived modes. (Encl. a suggested PATCH)

[Vaidheeswaran C <vaidheeswaran.chinnaraju@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 949 bytes --]


tabulated-list.el: It should preserve header line set by derived
modes.  Also some fontification improvements.

1. Load the attached font-family.el.

2. M-x list-font-families.

3. Note that there is no header line when I explicitly request that I
   need a header line @ lines 25, 26 in font-family.el

      (setq tabulated-list-use-header-line nil)
      (setq header-line-format "Font families")

----------------------------------------------------------------

4. Apply the attached patch.

5. See that the header line is preserved (and stays put even when the
   columns are sorted and the buffer is refreshed).

6. Admire the revamped look of header columns.  (See the attached
   screenshot)

----------------------------------------------------------------

edictc.el -- my all new DICT client for Emacs -- uses header lines
when in tabulated list mode.  (See the attached screenshot.)  Btw, the
red strip is coming from whitespace mode.

[-- Attachment #2: font-family.el --]
[-- Type: text/x-emacs-lisp, Size: 2570 bytes --]

(require 'tabulated-list)

(defvar-local font-family-menu-test-string nil
  "Test string to display in the menu.")

(defvar font-family-menu-mode-map
  (let ((map (make-sparse-keymap))
        (menu-map (make-sparse-keymap "Font Family")))
    (set-keymap-parent map tabulated-list-mode-map)
    (define-key map "\C-m" 'font-family-menu-set-frame-font)
    (define-key map "x" 'font-family-menu-set-test-string)
    map)
  "Local keymap for `font-family-menu-mode' buffers.")

(define-derived-mode font-family-menu-mode tabulated-list-mode "Font Family Menu"
  "Inspect font families and pick a frame font.
Display the name of the font family in that family.  Use
`font-family-set-test-string' to set a test string.

 \\<font-family-menu-mode-map> \\{font-family-menu-mode-map}"
  (setq tabulated-list-format
        `[("Font Family" 30 t)
          ("Text" 30 nil)])
  (setq tabulated-list-padding 2)
  (setq tabulated-list-sort-key (cons "Font Family" nil))
  (setq tabulated-list-use-header-line nil)
  (setq header-line-format "Font families")
  (add-hook 'tabulated-list-revert-hook 'font-family-menu--refresh nil t)
  (font-family-menu--refresh)
  (tabulated-list-init-header)
  (tabulated-list-print))

(defun list-font-families ()
  "Display the name of the font family using it's own face.
Use `font-family-menu-set-test-string' to display a test string
instead."
  (interactive)
  (let ((buf (get-buffer-create "*Font Families*")))
    (with-current-buffer buf
      (font-family-menu-mode))
    (switch-to-buffer buf)))

(defun font-family-menu--refresh ()
  "Re-populate `tabulated-list-entries'."
  (let ((f (delete-dups (font-family-list))))
    (setq tabulated-list-entries
	  (mapcar
	   (lambda (f)
	     (let ((s (or font-family-menu-test-string f)))
	       (list f (vector
			(cons f `(font-family ,f action font-family-menu-set-frame-font))
			(propertize s 'face (list :family f))))))
	   f))))

(defun font-family-menu-set-frame-font ()
  "Set the frame font to current one."
  (interactive)
  (when (derived-mode-p 'font-family-menu-mode)
      (let ((f (tabulated-list-get-id)))
	(when (and f (yes-or-no-p (concat "Set frame font to " f)))
	  (set-frame-font f nil t)))))

(defun font-family-menu-set-test-string (s)
  "Set the test string."
  (interactive "sDisplay string: ")
  (when (derived-mode-p 'font-family-menu-mode)
    (if (and (stringp s) (not (string= s "")))
	(setq font-family-menu-test-string s)
      (setq font-family-menu-test-string nil))
        (font-family-menu--refresh)
	(tabulated-list-print)))

(provide 'font-family)

[-- Attachment #3: tabulated-list.el.diff --]
[-- Type: text/x-patch, Size: 1085 bytes --]

diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 9119c3a..34b46dc 100644
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -241,7 +241,6 @@ Populated by `tabulated-list-init-header'.")
     (setq cols (apply 'concat (nreverse cols)))
     (if tabulated-list-use-header-line
 	(setq header-line-format cols)
-      (setq header-line-format nil)
       (setq-local tabulated-list--header-string cols))))
 
 (defun tabulated-list-print-fake-header ()
@@ -255,7 +254,8 @@ Do nothing if `tabulated-list--header-string' is nil."
           (move-overlay tabulated-list--header-overlay (point-min) (point))
         (setq-local tabulated-list--header-overlay
                     (make-overlay (point-min) (point))))
-      (overlay-put tabulated-list--header-overlay 'face 'underline))))
+      (overlay-put tabulated-list--header-overlay
+                   'face '(:overline t :underline t :weight bold)))))
 
 (defun tabulated-list-revert (&rest ignored)
   "The `revert-buffer-function' for `tabulated-list-mode'.

[-- Attachment #4: tabulated-list-with-header-line-(after the fix).png --]
[-- Type: image/png, Size: 94089 bytes --]

[-- Attachment #5: a-preview-of-edictc.el-with-header-xref-buttons-and-header-line-in-tabulated-list-mode.png --]
[-- Type: image/png, Size: 127861 bytes --]