....org/ideasman42/emacs-mono-complete https://www.gnu.org/software/emacs/download.html#gnu-linux
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

168 lines
5.8 KiB

;;; mono-complete-backend-filesystem.el --- DABBREV back-end -*- lexical-binding: t -*-
;; URL: https://codeberg.org/ideasman42/emacs-mono-complete
;; Version: 0.1
;; Package-Requires: ((emacs "26.2"))
;;; 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\")."
(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)) default-directory)
(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."
(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))
(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)))
(`(,directory . ,filename)
(mono-complete-backend-filesystem--split-path prefix-test)))
(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 (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)
(setcdr cache
(mono-complete-backend-filesystem--expand-path directory))
(let ((files (cdr cache)))
(while files
(let ((filename-complete (pop files)))
(when (string-prefix-p filename filename-complete)
(setq result (list (substring filename-complete (length filename) nil)))
;; 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)
;;; mono-complete-backend-filesystem.el ends here