diff options
| -rw-r--r-- | completion-conf.el | 128 |
1 files changed, 125 insertions, 3 deletions
diff --git a/completion-conf.el b/completion-conf.el index 47d59ad..c40294e 100644 --- a/completion-conf.el +++ b/completion-conf.el @@ -23,14 +23,16 @@ ;;; Commentary: ;; Thsi file is my configurations of the built in completion framework -;; in Emacs. I intend to configure it to use my yet-to-come completion -;; style using suffix trees. +;; in Emacs. I intend to configure it to use my yet-to-come +;; completion style using suffix trees. ;;; Code: (require 'minibuffer) (require 'simple) +;;; Basic settings + (setq completion-styles '(initials substring partial-completion regex flex)) (setq completion-category-defaults nil) (setq completion-flex-nospace nil) @@ -55,6 +57,8 @@ (define-key completion-list-mode-map (vector ?\C-n) #'durand-completion-scroll-down-or-go-to-minibuffer) (define-key completion-list-mode-map (vector ?\C-p) #'durand-completion-scroll-up-or-go-to-minibuffer) +;;; Headlong stuff + ;;;###autoload (defvar durand-headlong-entered-minibuffer-p nil "Whether or not we have entered minibuffer. @@ -105,6 +109,8 @@ minibuffer as usual." (advice-add 'minibuffer-message :around 'durand-minibuffer-respect-inhibit-advice) +;;; Display completion candidates + ;;;###autoload (defun durand-completion-display-after-change (&rest args) "Call `minibuffer-completion-help' with no input. @@ -163,6 +169,123 @@ minibuffer as usual." ;; (remove-hook 'post-command-hook #'durand-completion-display-after-change t)) ;; ((add-hook 'post-command-hook #'durand-completion-display-after-change nil t)))) +;;; Live previews + +;; TODO: Add the functionality to "preview" the completions in some +;; sense. + +(defun durand-preview-in-completion-list () + "Preview the current candidate in the completion list buffer." + (cond + ((derived-mode-p 'completion-list-mode) + (let ((mes "Nothing to preview here") + prop) + (cond + ((setq prop (get-text-property + (point) 'durand-preview-property)) + (cond + ((eq (car prop) 'buffer) + (display-buffer-use-least-recent-window + (cadr prop) + '((".*" (display-buffer-use-some-window + display-buffer-use-least-recent-window)))) + (cond ((integerp (caddr prop)) (goto-line (caddr prop))))))) + ((active-minibuffer-window) (minibuffer-message mes)) + ((message mes))))))) + +(defun durand-propertize-buffer-for-completion-list (ls) + "Propertize the buffer candidates so as to preview buffers. +LS has two argument: STR and GROUP-FUN. + +STR is the string to insert, and GROUP-FUN is used to group +candidates." + (let ((str (car ls)) + (group-fun (cadr ls))) + (cond + ((not (consp str)) + ;; if it is a cons, it will be processed and called again. + (list + (propertize + str + 'durand-preview-property + (list 'buffer (get-buffer str))) + group-fun)) + ((list str grou-fun))))) + +(defun durand-open-completion-list-with-buffer-preview () + "Open the completion list buffer and propertize the candidates." + (interactive) + (advice-add #'completion--insert :filter-args + #'durand-propertize-buffer-for-completion-list) + (let ((minibuffer-allow-text-properties t)) + (minibuffer-completion-help)) + (advice-remove #'completion--insert + #'durand-propertize-buffer-for-completion-list) + (goto-char (point-max)) + (durand-embark-scroll-down-or-go-to-completions 1) + (cond + ((derived-mode-p 'completion-list-mode) + (add-hook 'post-command-hook + #'durand-preview-in-completion-list)) + ((user-error "Something is wrong!")))) + +;; (defun durand-quit-completion-list-with-buffer-preview () +;; "Restore the buffer and quit the completion list." +;; (interactive) +;; (quit-window) +;; (set-window-configuration durand-completion-list-window-conf)) + +(defvar durand-preview-keymap (make-sparse-keymap "Buffer:") + "A keymap used to read buffers with previews.") + +(define-key durand-preview-keymap (vector 'tab) + #'durand-open-completion-list-with-buffer-preview) + +(defun durand-read-buffer-with-preview-function + (prompt &optional def require-match predicate) + "Use a custom keymap when reading buffers. +The arguments PROMPT, DEF, REQUIRE-MATCH and PREDICATE have the +same meaning as in `read-buffer'." + (let* ((base-keymap + (cond (require-match minibuffer-local-must-match-map) + (minibuffer-local-completion-map))) + (keymap (make-composed-keymap + (list base-keymap durand-preview-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 + (unless (eq require-match t) require-match)) + (setq-local minibuffer--require-match require-match) + (setq-local minibuffer--original-buffer buffer)) + (read-from-minibuffer + prompt nil keymap nil 'buffer-name-history def)))) + (when (and (equal result "") def) + (setq result (if (consp def) (car def) def))) + result)) + +(defun durand-switch-to-buffer-preview () + "Preview switching buffers." + (interactive) + (let ((read-buffer-function + #'durand-read-buffer-with-preview-function)) + (switch-to-buffer + (let ((default (other-buffer))) + (read-buffer-to-switch + (format + "Switch to buffer%s" + (cond + ((and (bufferp default) + (buffer-live-p default)) + (format " (default %s): " (buffer-name default))) + (": ")))))))) + +;;; Regular expression completion style + ;;;###autoload (defun regex-try-completion (string table pred point &optional metadata) "The function that tries to complete STRING using completion table \ @@ -209,6 +332,5 @@ This considers the input as the regular expression itself." )) ((setq completion-styles-alist (cons (cons 'regex style-elements) completion-styles-alist))))) - (provide 'completion-conf) ;;; completion-conf.el ends here |