;;; -*- lexical-binding: t -*-
;;
;; --------------------------------------------------------------------------

(require 'cl-lib)
(cl-pushnew "." load-path :test #'string=)
(require 'luki-lisp)

;; --------------------------------------------------------------------------

(-> 'dired)
(-> 'll-close)
(-> 'll-scroll)
(-> 'll-switch-to-buffer-regexp)

;; --------------------------------------------------------------------------

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

;; --------------------------------------------------------------------------

(let ((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-constant-face))
         ("^....\\([-[:alnum:]]*\\.el\\) "      (1  font-lock-keyword-face))
         ("^....\\([-[:alnum:]]*\\.html\\)"     (1  font-lock-string-face))
         ("^....\\([-[:alnum:]]*\\.md\\)"       (1  font-lock-type-face))
         ("^....\\([-[:alnum:]]*\\.rc\\)"       (1  font-lock-variable-name-face))
         ("^....\\([-[:alnum:]]*\\.tex\\)"      (1  font-lock-function-name-face))
         ("^....\\([-[:upper:]]+\\) "           (1  font-lock-comment-face))
         ("^....\\(\\*.*\\*\\)"                 (1  font-lock-builtin-face)))))
  (defun buffer-menu-custom-font-lock () (i)
    (let ((font-lock-unfontify-region-function
           (L (a o) (remove-text-properties a o '(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))))

(declare-function buffer-menu-custom-font-lock nil)

;; --------------------------------------------------------------------------

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

;; -----------------------------------------------------------------------------

(defun switch-buffer () (i)
  (switch-to-buffer nil)) ; NOTE: OK

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

;; -----------------------------------------------------------------------------

(defun buffer-menu-kill-and-open () (i)
  (let* ((menu-buf  (current-buffer))
         (next-buf  (Buffer-menu-buffer nil)) ; NOTE: OK
         (next-mode (when (bufferp next-buf)
                      (with-current-buffer next-buf
                        major-mode)))
         (is-dired  (s= next-mode "dired-mode")))
    (when next-buf
      (switch-to-buffer next-buf)
      (when (& is-dired (dired-directory-changed-p dired-directory))
        (revert-buffer))
      (kill-buffer menu-buf))))

;; -----------------------------------------------------------------------------

(defun buffer-menu-next (&optional n)
  (interactive "p")
  (setf n (or n 1))
  (goto-char (+ 4 (pos-bol (1+ n)))))

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

(defun Buffer-menu-end () (i)
  (goto-end)
  (forward-line -1))

;; -----------------------------------------------------------------------------

(let ((kmap Buffer-menu-mode-map))
  (set-vertical-keys kmap nil t t (list #'buffer-menu-prev #'buffer-menu-next))
  (set-close-key kmap)

  (keymap-set kmap "RET" #'buffer-menu-kill-and-open)
  (keymap-set kmap "g"   #'buffer-menu-files-only)

  ;; switch to buffers
  (keymap-set kmap "c"   #'switch-to-compilation-buffer)
  (keymap-set kmap "m"   #'switch-to-messages-buffer)

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

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

;; -----------------------------------------------------------------------------

(<- 'll-buffer-menu)

;; -----------------------------------------------------------------------------