path: root/ibuffer.el

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

(require 'ibuffer)
(require 'ibuf-ext)

(setq ibuffer-expert t)
(setq ibuffer-display-summary nil)

(setq ibuffer-show-empty-filter-groups nil)

;;; Bindings related to buffers

;;;; Quickly switch to the last buffer.

;;;###autoload
(defun durand-switch-to-last-buffer (&optional arg)
  "Switch to the last buffer.

The last buffer is given by `other-buffer'.

If ARG is non-nil, then display the last buffer in a new window."
  (interactive "P")
  (cond
   (arg (switch-to-buffer-other-window nil))
   ((switch-to-buffer nil))))

;;;###autoload
(defun durand-switch-to-last-buffer-other-window ()
  "Switch to the last buffer in a new window."
  (interactive)
  (switch-to-buffer-other-window nil))

;;;###autoload
(defun switch-to-buffer-same-mode (&optional arg)
  "Switch to a buffer with the same major mode as the current
   buffer.
If the optional ARG is non-nil, then produce an IBUFFER buffer
  listing all buffers of the same mode as the current buffer."
  (interactive "P")
  (cond
   ((null arg)
    (let* ((mode (buffer-local-value 'major-mode (current-buffer)))
           (def (buffer-name
                 (car
                  (delete nil
                          (mapcar
                           (lambda (buf)
                             (and
                              (provided-mode-derived-p
                               (buffer-local-value 'major-mode buf)
                               mode)
                              (not (= (aref (buffer-name buf) 0) 32))
                              (not (eq buf (current-buffer)))
                              buf))
                           (buffer-list)))))))
      (switch-to-buffer
       (read-buffer (format
                     "Switch to buffer with major mode %S:"
                     (buffer-local-value 'major-mode (current-buffer)))
                    def t
                    (lambda (name-or-cons)
                      (provided-mode-derived-p
                       (buffer-local-value
                        'major-mode
                        (cond ((consp name-or-cons)
                               (cdr name-or-cons))
                              ((get-buffer name-or-cons))))
                       mode))))))
   ((ibuffer
     nil
     (format "*Buffers for %S*"
             (buffer-local-value 'major-mode (current-buffer)))
     (list (cons 'used-mode
                 (buffer-local-value 'major-mode (current-buffer))))))))

;;;; clear buffers

;;;###autoload
(defvar durand-clear-passlist nil
  "The list of buffers that should not be deleted \
automatically.")

;;;###autoload
(defvar durand-default-clear-passlist
  (list dashboard-buffer-name
        "*Group*"
        ".newsrc-dribble")
  "The default value for `durand-clear-passlist'.")

;; from dashboard.el
(defvar dashboard-buffer-name)

(cond
 ((null dashboard-buffer-name)
  (setq dashboard-buffer-name "")))

(setq durand-clear-passlist durand-default-clear-passlist)

;;;###autoload
(defun durand-reset-clearlist (&optional arg)
  "Remove killed buffers from `durand-clear-passlist'.
If ARG is non-nil and not '(16), reset `durand-clear-passlist' to
`durand-default-clear-passlist'.

If ARG is '(16), show the current contents of
`durand-clear-passlist'."
  (interactive "P")
  (cond
   ((equal arg (cons 16 nil))
    (message "clear list: %s"
             (mapconcat
              (lambda (e)
                (cond
                 ((bufferp e) (buffer-name e))
                 (e)))
              durand-clear-passlist
              ", ")))
   
   ((setq
     durand-clear-passlist
     (cond
      ((null arg)
       (delq nil
             (mapcar
              (lambda (buf)
                (cond ((car (member buf durand-default-clear-passlist)))
                      ((and (stringp buf)
                            (get-buffer buf)
                            (buffer-live-p (get-buffer buf)))
                       buf)
                      ((and (bufferp buf) (buffer-live-p buf))
                       buf)))
              durand-clear-passlist)))
      (durand-default-clear-passlist)))
    (message "%s the clear list!"
             (cond
              ((null arg) "Removed killed buffers from")
              ("Reset"))))))

(autoload #'durand-member "common.el")

;;;###autoload
(defun durand-born-equal (x y)
  "Return t if two buffers or names X and Y are equal.
X and Y could be a buffer or a string that represents the name of
a buffer.

BORN is an abbreviation of \"Buffer OR Name\"."
  (let ((flag 0))
    (cond
     ((stringp x) (setq flag (logior flag 1)))
     ((bufferp x))
     ((error "X is not a string nor a buffer")))
    (cond
     ((stringp y) (setq flag (logior flag 2)))
     ((bufferp y))
     ((error "Y is not a string nor a buffer")))
    (cond
     ;; both are buffers
     ((= flag 0) (eq x y))
     ;; X = string, Y = buffer
     ((= flag 1) (string= x (buffer-name y)))
     ;; X = buffer, Y = string
     ((= flag 2) (string= (buffer-name x) y))
     ;; both are strings
     ((= flag 3) (string= x y))
     ((error "Invalid flag: %d" flag)))))

;; This is not defined via `define-ibuffer-op' as this is supposed to
;; clear ALL buffers by default, not only operating on marked buffers,
;; which is the default behaviour for functions defined by
;; `define-ibuffer-op'.

;;;###autoload
(defun durand-ibuffer-clear (&optional arg)
  "Kill every buffer except for those in `durand-clear-passlist'.
If the optional ARG is non-nil, then restrict the range to the
marked buffers."
  (interactive "P")
  (cond
   ((derived-mode-p 'ibuffer-mode))
   ((user-error "durand-ibuffer-clear should only be used in \
derived modes of `ibuffer-mode'.")))
  (cond
   ((null arg)
    (mapc (function
           (lambda (buffer)
             (cond
              ((durand-member (buffer-name buffer)
                              durand-clear-passlist
                              #'durand-born-equal))
              ((kill-buffer buffer)))))
          (cons
           (current-buffer)
           (mapcar #'car (ibuffer-current-state-list))))
    (let ((current (current-buffer)))
      (pop-to-buffer dashboard-buffer-name '((display-buffer-same-window)))
      (goto-char (point-min))
      (recenter 0)
      (pop-to-buffer current '((display-buffer-same-window)))))
   (t
    (mapc (function
           (lambda (buffer-and-mark)
             (cond
              ((or (/= (cdr buffer-and-mark)
                       ibuffer-marked-char)
                   (durand-member (buffer-name (car buffer-and-mark))
                                  durand-clear-passlist
                                  #'durand-born-equal)))
              ((kill-buffer (car buffer-and-mark))))))
          (cons
           (cons (current-buffer) 32)
           (ibuffer-current-state-list)))
    (ibuffer-update nil t))))

;;;; Protect buffers

;; NOTE: I know there is `emacs-lock-mode' which seems to do the same
;; thing.  But in my opinion my needs are different: indeed I do not
;; want to kill certain buffers, which functionality appears to be
;; covered by the afore-mentionned mode, but in fact, I am actually
;; not trying to protect those buffers from `kill-buffer'.  I might
;; actually delete those buffers at a later point, without first
;; unprotecting them.  The purpose of this protection is to ensure
;; that the specific operation that I define here for ibuffer does
;; kill those protected buffers.

;;;###autoload
(defvar durand-ibuffer-reset-marks nil
  "Whether to reset the marks in ibuffer.")

;;;###autoload
(defun durand-ibuffer-restore-mark-before-advice ()
  (ibuffer-assert-ibuffer-mode)
  (cond
   ((null (ibuffer-marked-buffer-names))
    (setq durand-ibuffer-reset-marks t))))

;;;###autoload
(define-ibuffer-op ibuffer-do-protect ()
  "Add the marked buffers to `durand-clear-passlist'."
  (:opstring "protected"
   :active-opstring "protect"
   :modifier-p nil
   :after (cond
           (durand-ibuffer-reset-marks
            (setq durand-ibuffer-reset-marks nil)
            (ibuffer-set-mark 32)))
   :complex t)
  (cond
   ((durand-member buf durand-clear-passlist #'durand-born-equal) nil)
   ((setq durand-clear-passlist (cons buf durand-clear-passlist)) t)))

(advice-add #'ibuffer-do-protect :before
            #'durand-ibuffer-restore-mark-before-advice)

(define-ibuffer-op ibuffer-do-unprotect ()
  "Remove the marked buffers from `durand-clear-passlist'."
  (:opstring "unprotected"
   :active-opstring "unprotect"
   :modifier-p nil
   :after (cond
           (durand-ibuffer-reset-marks
            (setq durand-ibuffer-reset-marks nil)
            (ibuffer-set-mark 32)))   
   :complex t)
  (cond
   ((durand-member buf durand-clear-passlist #'durand-born-equal)
    (setq durand-clear-passlist (delq buf durand-clear-passlist))
    t)))

(advice-add #'ibuffer-do-unprotect :before
            #'durand-ibuffer-restore-mark-before-advice)

;;;; A custom column

;;;###autoload
(define-ibuffer-column protect
  (:name "P" :inline t)
  (cond
   ((durand-member buffer durand-clear-passlist #'durand-born-equal)
    "P")
   (" ")))

(setq ibuffer-formats
      '((mark
         modified
         read-only
         locked
         protect
         " "
         (name 18 18 :left :elide)
         " "
         (size 9 -1 :right)
         " "
         (mode 16 16 :left :elide)
         " "
         filename-and-process)
        (mark " " (name 16 -1) " " filename)))

(ibuffer-recompile-formats)

;;; key-bindings

(define-key global-map (vector 24 2) #'durand-ibuffer)
(define-key global-map (vector ?\s-h) #'durand-ibuffer)
(define-key global-map (vector ?\M-\s-b) #'switch-to-buffer-same-mode)
(define-key global-map (vector ?\s-b) #'switch-to-buffer)
(define-key global-map (vector ?\s-B) #'switch-to-buffer-other-window)
(define-key global-map (vector ?\s-n) #'durand-switch-to-last-buffer)
(define-key global-map (vector ?\s-N) #'durand-switch-to-last-buffer-other-window)

(define-key ibuffer-mode-map (vector ?d) #'ibuffer-do-delete)
(define-key ibuffer-mode-map (vector ?D) #'ibuffer-mark-for-delete)
(define-key ibuffer-mode-map (vector ?c) #'durand-ibuffer-clear)
(define-key ibuffer-mode-map (vector ?C) #'durand-reset-clearlist)
;; open paren is bound to proect
(define-key ibuffer-mode-map (vector 40) #'ibuffer-do-protect)
;; close paren is bound to unprotect
(define-key ibuffer-mode-map (vector 41) #'ibuffer-do-unprotect)

;;; Make ibuffer silent

(defun durand-ibuffer
    (&optional other-window-p name qualifiers noselect shrink
               filter-groups formats)
  "\\<ibuffer-mode-map>Begin using Ibuffer to edit a list of buffers.
Type \\[describe-mode] after entering ibuffer for more information.

All arguments are optional.
OTHER-WINDOW-P says to use another window.
NAME specifies the name of the buffer (defaults to \"*Ibuffer*\").
QUALIFIERS is an initial set of filtering qualifiers to use;
  see `ibuffer-filtering-qualifiers'.
NOSELECT means don't select the Ibuffer buffer.
SHRINK means shrink the buffer to minimal size.  The special
  value `onewindow' means always use another window.
FILTER-GROUPS is an initial set of filtering groups to use;
  see `ibuffer-filter-groups'.
FORMATS is the value to use for `ibuffer-formats'.
  If specified, then the variable `ibuffer-formats' will have
  that value locally in this buffer.

Modified by Durand to make it silent.  -- 2022-10-01 12:31:37.532012"
  (interactive "P")
  (when ibuffer-use-other-window
    (setq other-window-p t))
  (let ((buf (get-buffer-create (or name "*Ibuffer*"))))
    (if other-window-p
	(or (and noselect (display-buffer buf t))
	    (pop-to-buffer buf t))
      (funcall (if noselect #'display-buffer #'switch-to-buffer) buf))
    (with-current-buffer buf
      (save-selected-window
	;; We switch to the buffer's window in order to be able
	;; to modify the value of point
	(select-window (get-buffer-window buf 0))
	(or (derived-mode-p 'ibuffer-mode)
	    (ibuffer-mode))
 	(when shrink
	  (setq ibuffer-shrink-to-minimum-size shrink))
	(when qualifiers
	  (require 'ibuf-ext)
	  (setq ibuffer-filtering-qualifiers qualifiers))
	(when filter-groups
	  (require 'ibuf-ext)
	  (setq ibuffer-filter-groups filter-groups))
	(when formats
	  (setq-local ibuffer-formats formats))
        ;; NOTE: `ibuffer-update' has an argument to be silent.  But
        ;; it sometimes talks about formats being changed and
        ;; recompiling formats.  So I just use this hack to stop it
        ;; from talking, at all.
        (advice-add #'message :override #'ignore)
	(ibuffer-update nil)
        (advice-remove #'message #'ignore)
	;; Skip the group name by default.
	(ibuffer-forward-line 0 t)
	(unwind-protect
	    (progn
	      (setq buffer-read-only nil)
	      (run-hooks 'ibuffer-hook))
	  (setq buffer-read-only t))
	(unless ibuffer-expert
	  (message "Commands: m, u, t, RET, g, k, S, D, Q; q to quit; h for help"))))))

;;; filter for bongo

;;;###autoload
(define-ibuffer-filter durand-bongo
    "Group bongo buffers together."
  (:description "Bongo buffers together"
                :reader (read-string "no effect: "))
  (cond
   ((not (boundp 'durand-bongo-music-dir))
    (load-config "durand-bongo.el")))
  (with-current-buffer buf
    (cond
     ((derived-mode-p 'dired-mode)
      (let ((bongo-dirs durand-bongo-music-dir)
            found)
        (while (and (not found)
                    (consp bongo-dirs))
          (cond
           ((file-in-directory-p default-directory (car bongo-dirs))
            (setq found t))
           (t (setq bongo-dirs (cdr bongo-dirs)))))
        found))
     ((derived-mode-p 'bongo-playlist-mode 'bongo-library-mode)))))

;;; For directory

;;;###autoload
(define-ibuffer-filter durand-directory
    "Limit current view to buffers with directory a subdirectory of \
QUALIFIER.

For a buffer not associated with a file, this matches against the
value of `default-directory' in that buffer."
  (:description "directory name"
                :reader (read-from-minibuffer
                         "Filter by directory name (regex): "))
  (ibuffer-aif (with-current-buffer buf (ibuffer-buffer-file-name))
      (let ((dirname (expand-file-name (file-name-directory it))))
        (cond (dirname (string-match-p qualifier dirname))))
    (when (buffer-local-value default-directory buf)
      (string-match-p
       qualifier
       (expand-file-name
        (buffer-local-value buf default-directory))))))

;;;###autoload
(defun durand-bongo-set-filter ()
  "Set my custom filters."
  (interactive)
  (setq ibuffer-filter-groups
        (list (cons "Bongo" '((durand-bongo)))
              (cons "RS" '((or
                            (mode . rustic-mode)
                            (mode . rust-mode))))
              (cons "TeX" '((derived-mode . tex-mode)))
              (cons "C" '((mode . c-mode)))
              (cons "ELisp" '((mode . emacs-lisp-mode)))
              (cons "EWW" '((mode . eww-mode)))
              (cons "PDF" '((mode . pdf-view-mode)))
              (cons "Eshell" '((mode . eshell-mode)))
              (cons "Org" '((mode . org-mode)))
              (cons "Roman" '((mode . novel-read-mode)))))
  (let ((ibuf (get-buffer "*Ibuffer*")))
    (when ibuf
      (with-current-buffer ibuf
        ;; (pop-to-buffer ibuf)
        (ibuffer-update nil t)))))

(add-hook 'ibuffer-hook 'durand-bongo-set-filter 10)
(add-hook 'ibuffer-hook 'hl-line-mode)

;;; Export an ibuffer listing from `read-buffer'

;;;; Define a custom function to export buffers

(defvar durand-export-buffers-name "*Durand Export Buffers*"
  "The name of the buffer used to display the exported buffers.")

(defun durand-export-buffers-select (&optional timer)
  "Select the exported buffer."
  (remove-hook 'post-command-hook #'durand-export-buffers-select)
  (cond ((timerp timer) (cancel-timer timer)))
  (display-buffer durand-export-buffers-name
                  (list (list #'display-buffer-same-window)))
  (with-current-buffer durand-export-buffers-name
    (advice-add #'message :override #'ignore)
    (ibuffer-update nil)
    (advice-remove #'message #'ignore)))

(defun durand-export-buffers ()
  "Export buffers into an IBuffer buffer."
  (interactive)
  (let ((buffers (remove-last-non-nil-cdr
                  (completion-all-completions
                   ""
                   minibuffer-completion-table
                   minibuffer-completion-predicate
                   0))))
    (ibuffer nil durand-export-buffers-name
             `((predicate . (member (buffer-name) ',buffers))))
    (let* (timer
           (timer (run-at-time 0 nil #'durand-export-buffers-select timer)))
      (add-hook 'post-command-hook #'durand-export-buffers-select))
    (cond
     ((fboundp 'minibuffer-quit-recursive-edit)
      (minibuffer-quit-recursive-edit))
     ((abort-recursive-edit)))))

;;;; Define a custom keymap

(defvar durand-read-buffer-map (make-sparse-keymap "buffer")
  "A keymap dedicated to reading buffers using completion.")

(define-key durand-read-buffer-map (vector ?\C-.) #'durand-export-buffers)

;;;; Define a custom function for `read-buffer-function'.

(defun durand-read-buffer-function
    (prompt &optional def require-match predicate)
  "A custom `read-buffer-function' that has a custom keymap.
See `read-buffer' for explanations on the behaviours.

Note that we do not respect `completing-read-function' here."
  (cond ((bufferp def) (setq def (buffer-name def))))
  ;; We must change the prompt to insert the default value in the
  ;; prompt, if the default value is non-nil, as the documentation
  ;; string in `read-buffer' says.
  (cond
   (def
    (cond
     ((stringp prompt)
      (let ((len (length prompt))
            (def (cond ((consp def) (car def)) (def))))
        (cond
         ((and (>= len 2)
               (= (aref prompt (- len 2)) ?:)
               (= (aref prompt (- len 1)) 32))
          (setq prompt (substring prompt 0 -2)))
         ((and (>= len 1)
               (or
                (= (aref prompt (- len 1)) ?:)
                (= (aref prompt (- len 1)) 32)))
          (setq prompt (substring prompt 0 -1))))
        (setq prompt (format-prompt prompt def)))))))
  (let* ((completion-ignore-case read-buffer-completion-ignore-case)
         (base-keymap (if require-match
                          minibuffer-local-must-match-map
                        minibuffer-local-completion-map))
         (keymap (make-composed-keymap
                  durand-read-buffer-map base-keymap))
         (buffer (current-buffer))
         (result
          (minibuffer-with-setup-hook
              (lambda ()
                (setq-local minibuffer-completion-table
                            #'internal-complete-buffer)
                (setq-local minibuffer-completion-predicate predicate)
                ;; FIXME: Remove/rename this var, see the next one.
                (setq-local
                 minibuffer-completion-confirm
                 (cond ((eq require-match t))
                       (require-match)))
                (setq-local minibuffer--require-match require-match)
                (setq-local minibuffer--original-buffer buffer))
            (read-from-minibuffer prompt "" keymap
                                  nil 'buffer-name-history def
                                  nil))))
    (when (and (equal result "") def)
      (setq result (if (consp def) (car def) def)))
    result))

;;;; Set the `read-buffer-function'

(setq read-buffer-function #'durand-read-buffer-function)