;;; -*- lexical-binding: t -*-
;;;
;;; this file:
;;;   http://user.it.uu.se/~embe8573/emacs-init/buffer-menu.el
;;;   https://dataswamp.org/~incal/emacs-init/buffer-menu.el

(require 'cl-lib)
(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:]]*\\.py\\)"       (1 'font-lock-regexp-grouping-construct))
    ("^....\\([-[: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))
    ))

(defun buffer-menu-custom-font-lock ()
  (interactive)
  (let ((font-lock-unfontify-region-function
         (lambda (start end)
           (remove-text-properties start 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) ) ; BUFFER-OR-NAME

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

(defun switch-to-messages-buffer ()
  (interactive)
  (let ((buffer (messages-buffer)))
    (when buffer
      (set-buffer buffer)
      (goto-char (point-max))
      (switch-to-buffer buffer)
      (recenter -2) )))

(let ((the-map Buffer-menu-mode-map))
  (disable-super-global-keys the-map)
  (set-vertical-keys         the-map)
  (set-close-key             the-map)

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

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

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

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

(provide 'buffer-menu)