ibuffer: Try to re-invent the wheel of exporting buffers to ibuffer.

1 files changed, 100 insertions, 0 deletions

diff --git a/ibuffer.el b/ibuffer.el
index 40ef737..e2d7932 100644
--- a/ibuffer.el
+++ b/ibuffer.el
@@ -453,3 +453,103 @@ value of `default-directory' in that buffer."
 
 (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))))
+
+(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)