summaryrefslogtreecommitdiff
path: root/ibuffer.el
blob: 2fdd3dc7352267aa6d56128d342bdf91bd7776e1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
;;; -*- 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)