;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/buffer-menu.el

(require 'close)
(require 'dired)
(require 'scroll)
(require 'super)
(require 'switch-to-buffer)

(setq Buffer-menu-use-header-line nil)

(defvar buffer-menu-buffer-font-lock-keywords)
(setq   buffer-menu-buffer-font-lock-keywords
  '((" \\([[:digit:]]+\\) "                (1  font-lock-negation-char-face))
    ("<.*>"                                 .  font-lock-comment-face)
    ("\\[.*\\]"                             .  font-lock-comment-face)
    ("^....\\([-[:alnum:]]*\\.bib\\)"      (1 'font-lock-regexp-grouping-backslash))
    ("^....\\([-[:alnum:]]*\\.confi?g?\\)" (1  font-lock-function-name-face))
    ("^....\\([-[:alnum:]]*\\.el\\) "      (1  font-lock-keyword-face))
    ("^....\\([-[:alnum:]]*\\.html\\)"     (1  font-lock-string-face))
    ("^....\\([-[:alnum:]]*\\.md\\)"       (1  font-lock-constant-face))
    ("^....\\([-[:alnum:]]*\\.rc\\)"       (1  font-lock-preprocessor-face))
    ("^....\\([-[:alnum:]]*\\.tex\\)"      (1  font-lock-variable-name-face))
    ("^....\\([-[:alnum:]]*\\.txt\\)"      (1  font-lock-type-face))
    ("^....\\([-[:upper:]]+\\) "           (1  font-lock-comment-face))
    ("^....\\(\\*.*\\*\\)"                 (1  font-lock-builtin-face)) ))

;; unused: font-lock-regexp-grouping-construct

(defun buffer-menu-custom-font-lock ()
  (interactive)
  (let ((font-lock-unfontify-region-function
          (lambda (beg end)
            (remove-text-properties beg end '(font-lock-face nil)))))
    (font-lock-unfontify-buffer)
    (set (make-local-variable 'font-lock-defaults)
         '(buffer-menu-buffer-font-lock-keywords t))
    (font-lock-ensure) ))

(defun buffer-menu-files-only ()
  (interactive)
  (switch-to-buffer
    (list-buffers-noselect (not Buffer-menu-files-only)) )
    (buffer-menu-custom-font-lock) )

(defun switch-buffer ()
  (interactive)
  (switch-to-buffer nil) )

(defun buffer-menu-kill-and-open ()
  (interactive)
  (let*((menu-buf  (current-buffer))
        (next-buf  (Buffer-menu-buffer nil))
        (next-mode (when (bufferp next-buf)
                     (with-current-buffer next-buf
                       major-mode) ))
        (is-dired  (string= next-mode "dired-mode")) )
    (when next-buf
      (switch-to-buffer next-buf)
      (when (and is-dired (dired-directory-changed-p dired-directory))
        (revert-buffer) )
      (kill-buffer menu-buf) )))

(defun switch-to-messages-buffer ()
  (interactive)
  (switch-to-buffer (messages-buffer)) )

(defun buffer-menu-next (&optional n)
  (interactive "p")
  (or n (setq n 1))
  (forward-line n)
  (beginning-of-line)
  (forward-char 4) )

(defun buffer-menu-prev (&optional n)
  (interactive "p")
  (or n (setq n 1))
  (buffer-menu-next (* -1 n)) )

(let ((kmap Buffer-menu-mode-map))
  (disable-super-global-keys kmap)
  (set-vertical-keys kmap nil t t `(,#'buffer-menu-prev ,#'buffer-menu-next))
  (set-close-key kmap)

  (define-key kmap "\r" #'buffer-menu-kill-and-open)
  (define-key kmap "g"  #'buffer-menu-files-only)

  ;; switch to buffers
  (define-key kmap "c" #'switch-to-compilation-buffer)
  (define-key kmap "l" #'switch-to-slime-buffer)
  (define-key kmap "m" #'switch-to-messages-buffer)

  ;; help buffers
  (define-key kmap "h" #'switch-to-help-buffer)
  (define-key kmap "I" #'switch-to-info-buffer)
  (define-key kmap "M" #'switch-to-manpage-buffer)

  ;; Gnus buffers
  (define-key kmap "a" #'switch-to-article-buffer)
  (define-key kmap "s" #'switch-to-summary-buffer)
  (define-key kmap "u" #'switch-to-unsent-buffer) )

(provide 'buffer-menu)