diff options
| -rw-r--r-- | common.el | 12 | ||||
| -rw-r--r-- | ibuffer.el | 100 |
2 files changed, 112 insertions, 0 deletions
@@ -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. @@ -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) |