You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

173 lines
6.0 KiB

;;; mono-complete-backend-filesystem.el --- DABBREV back-end -*- lexical-binding: t -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;; Copyright (C) 2023 Campbell Barton
;; URL:
;; Version: 0.1
;;; Commentary:
;; Whole line back-end.
;;; Code:
;; ---------------------------------------------------------------------------
;; Internal Utilities
;; Native path separator.
(defconst mono-complete-backend-filesystem--sep-char
((memq system-type '(windows-nt ms-dos))
(defun mono-complete-backend-filesystem--split-path (filepath)
"Split FILEPATH \"/a/b/c\" into (\"/a/b/\" . \"c\")."
(let ((filename (file-name-nondirectory filepath))
(filepath-len (length filepath)))
((length= filename filepath-len)
(cons filepath nil))
(cons (substring filepath 0 (- filepath-len (length filename))) filename)))))
(defun mono-complete-backend-filesystem--expand-path (filepath)
"Expand FILEPATH based on local or home directory (as needed)."
((string-empty-p filepath)
(let ((ch (aref filepath 0)))
((eq ch ?.)
(or (and buffer-file-name (file-name-directory buffer-file-name))
(substring filepath 1 nil)))
((eq ch ?~)
(concat (expand-file-name "~") (substring filepath 1 nil)))
;; ---------------------------------------------------------------------------
;; Callback Implementations
(defun mono-complete-backend-filesystem-prefix ()
"Return the prefix at point."
(let ((prefix nil)
(sep-chr mono-complete-backend-filesystem--sep-char))
;; Skip when the previous character is a:
;; - Slash: this is a complete path, don't attempt completion.
;; - White-space: while technically these could be used,
;; will attempt completion in many cases where it doesn't make much sense,
;; ignore as the user can simply type in the non-space character to trigger completion.
(unless (memq (preceding-char) (list sep-chr 0 ?\s ?\t ?\n))
(let* ((pos-init (point))
(skip-chars-forward "[:blank:]" pos-init)
(pos-beg nil)
(search t))
(unless (eq pos-init pos-bol)
(let ((sep-skip (concat "^" (char-to-string sep-chr))))
(while search
(let ((ch (following-char)))
(when (eq ch sep-chr)
(setq pos-beg (point))
(let ((ch-prev (preceding-char)))
((eq ch-prev ?.)
(setq pos-beg (1- pos-beg)))
((eq ch-prev ?~)
(setq pos-beg (1- pos-beg)))))
(let ((prefix-test (buffer-substring-no-properties pos-beg pos-init)))
(pcase-let ((`(,directory . ,filename)
(mono-complete-backend-filesystem--split-path prefix-test)))
(when (file-directory-p
(mono-complete-backend-filesystem--expand-path directory))
;; Break out of the loop, even if `prefix' is not set.
;; Since the directory exists, searching further makes no sense.
(setq search nil)
(setq prefix prefix-test))
;; This is a complete path,
;; stop searching but don't prevent further completion.
(setq prefix ""))))))))
(when (zerop (skip-chars-forward sep-skip pos-init))
(setq search nil))))))
(unless (and prefix (stringp prefix))
(setq prefix nil))))
(defun mono-complete-backend-filesystem-complete (_config prefix cache)
"Complete at point based on PREFIX & CACHE."
;; Note that cache is the:
;; (path . sorted-files)
;; Return a list of strings or nil.
(let ((result nil))
(pcase-let ((`(,directory . ,filename) (mono-complete-backend-filesystem--split-path prefix)))
;; Initialize cache.
(unless cache
;; Always overwrite next.
(setq cache (cons "" nil)))
(unless (string-equal directory (car cache))
(setcar cache directory)
"" (mono-complete-backend-filesystem--expand-path directory))
(let ((files (cdr cache)))
(while files
(let ((filename-complete (pop files)))
((string-prefix-p filename filename-complete)
(setq result (list (substring filename-complete (length filename) nil)))
;; On an exact match, keep searching as there may be longer names.
(unless (string-empty-p (car result))
;; Break.
(setq files nil)))
(t ; As this is a sorted list, early exit when the prefix no longer matches.
(when result
;; Break.
(setq files nil))))))))
;; No filename, empty completion.
(setq result (list "")))))
(cons result cache)))
;; ---------------------------------------------------------------------------
;; Public Callback
(defun mono-complete-backend-filesystem ()
"DEBBREV completer."
:prefix #'mono-complete-backend-filesystem-prefix
:complete #'mono-complete-backend-filesystem-complete))
(provide 'mono-complete-backend-filesystem)
;; Local Variables:
;; fill-column: 99
;; indent-tabs-mode: nil
;; End:
;;; mono-complete-backend-filesystem.el ends here