summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--common.el12
-rw-r--r--ibuffer.el100
2 files changed, 112 insertions, 0 deletions
diff --git a/common.el b/common.el
index 94cbe3c..7da6129 100644
--- a/common.el
+++ b/common.el
@@ -474,6 +474,18 @@ If the length of LS is less than N, then return the whole LS."
((setq i n))))
(reverse result)))))
+;;; A helper function to remove the last non-cons-cell `cdr'.
+
+(defun remove-last-non-nil-cdr (arg)
+ "Remove the last `cdr' that is not a cons cell."
+ (let ((temp arg))
+ (while (consp temp)
+ (cond
+ ((consp (cdr temp)))
+ ((setcdr temp nil)))
+ (setq temp (cdr temp))))
+ arg)
+
(provide 'common)
;;; common.el ends here.
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)