Tramp for Lem

extensions/tramp/lem-tramp.asd

@@ -0,0 +1,4 @@
+(defsystem "lem-tramp"
+  :depends-on ("lem/core" "flexi-streams" "str")
+  :serial t
+  :components ((:file "tramp")))

lem.asd

@@ -305,7 +305,8 @@
                "lem-tree-sitter"
                "lem-git-gutter"
                "lem-skk-mode"
-               "lem-display-time-mode"))
+               "lem-display-time-mode"
+               "lem-tramp"))
 
 (defsystem "lem"
   :version "2.3.0"

src/buffer/file-utils.lisp

@@ -7,7 +7,15 @@
            :file-size
            :copy-file-or-directory
            :virtual-probe-file
-           :with-open-virtual-file))
+           :with-open-virtual-file
+           ;; Virtual filesystem hooks
+           :*virtual-file-open*
+           :*virtual-probe-file-functions*
+           :*virtual-expand-file-name-functions*
+           :*virtual-directory-files-functions*
+           :*virtual-file-metadata-functions*
+           :*virtual-directory-exists-p-functions*
+           :virtual-directory-exists-p))
 (in-package :lem/buffer/file-utils)
 
 (defun guess-host-name (filename)
@@ -49,8 +57,11 @@
 
 (defun expand-file-name (filename &optional (directory (uiop:getcwd)))
   (when (pathnamep filename) (setf filename (namestring filename)))
-  (let ((pathname (parse-filename filename (pathname-directory directory))))
-    (namestring (merge-pathnames pathname directory))))
+  (or (loop :for f :in *virtual-expand-file-name-functions*
+            :for result := (funcall f filename directory)
+            :when result :do (return result))
+      (let ((pathname (parse-filename filename (pathname-directory directory))))
+        (namestring (merge-pathnames pathname directory)))))
 
 (defun tail-of-pathname (pathname)
   (let ((pathname (uiop:ensure-absolute-pathname pathname #p"/")))
@@ -71,9 +82,12 @@
             x2)))))
 
 (defun virtual-probe-file (pathspec &optional (base-dir pathspec))
-  (cond
-    ((ppcre:scan "^~/.*" (namestring base-dir)) (probe-file% pathspec))
-    (t (probe-file pathspec))))
+  (or (loop :for f :in *virtual-probe-file-functions*
+            :for result := (funcall f pathspec base-dir)
+            :when result :do (return result))
+      (cond
+        ((ppcre:scan "^~/.*" (namestring base-dir)) (probe-file% pathspec))
+        (t (probe-file pathspec)))))
 
 (defun sort-files (pathnames &key (key #'namestring) (test #'string<))
   "Sort a list of pathnames."
@@ -91,11 +105,14 @@
      (sort-files files))))
 
 (defun directory-files (pathspec)
-  (if (uiop:directory-pathname-p pathspec)
-      (list (pathname pathspec))
-      (or (mapcar (lambda (x) (virtual-probe-file x pathspec))
-                  (directory pathspec))
-          (list pathspec))))
+  (or (loop :for f :in *virtual-directory-files-functions*
+            :for result := (funcall f pathspec)
+            :when result :do (return result))
+      (if (uiop:directory-pathname-p pathspec)
+          (list (pathname pathspec))
+          (or (mapcar (lambda (x) (virtual-probe-file x pathspec))
+                      (directory pathspec))
+              (list pathspec)))))
 
 (defun list-directory (directory &key directory-only (sort-method :pathname))
   (delete nil
@@ -108,21 +125,27 @@
                                                     :sort-method sort-method))))))
 
 (defun file-size (pathname)
-  #+sbcl
-  (sb-posix:stat-size (sb-posix:stat pathname))
-  #+lispworks
-  (system:file-size pathname)
-  #+(and (not lispworks) win32)
-  (return-from file-size nil)
-  #-win32
-  (ignore-errors (with-open-file (in pathname) (file-length in))))
+  (or (loop :for f :in *virtual-file-metadata-functions*
+            :for result := (funcall f pathname :size)
+            :when result :do (return result))
+      #+sbcl
+      (sb-posix:stat-size (sb-posix:stat pathname))
+      #+lispworks
+      (system:file-size pathname)
+      #+(and (not lispworks) win32)
+      (return-from file-size nil)
+      #-win32
+      (ignore-errors (with-open-file (in pathname) (file-length in)))))
 
 (defun file-mtime (pathname)
   "Return the file's last data modification time."
-  #+sbcl
-  (sb-posix:stat-mtime (sb-posix:stat pathname))
-  #-sbcl
-  (error "file-utils: file-mtime is not implemented for your implementation."))
+  (or (loop :for f :in *virtual-file-metadata-functions*
+            :for result := (funcall f pathname :mtime)
+            :when result :do (return result))
+      #+sbcl
+      (sb-posix:stat-mtime (sb-posix:stat pathname))
+      #-sbcl
+      (error "file-utils: file-mtime is not implemented for your implementation.")))
 
 (defun copy-file-or-directory (from to)
   (let ((base-dir from))
@@ -142,6 +165,38 @@
 
 (defparameter *virtual-file-open* nil)
 
+(defparameter *virtual-probe-file-functions* nil
+  "A list of functions for virtual probe-file.
+Each function receives (pathspec &optional base-dir) and should return
+a pathname if the file exists, or nil to pass to the next handler.")
+
+(defparameter *virtual-expand-file-name-functions* nil
+  "A list of functions for virtual expand-file-name.
+Each function receives (filename &optional directory) and should return
+an expanded filename string, or nil to pass to the next handler.")
+
+(defparameter *virtual-directory-files-functions* nil
+  "A list of functions for virtual directory-files.
+Each function receives (pathspec) and should return a list of pathnames,
+or nil to pass to the next handler.")
+
+(defparameter *virtual-file-metadata-functions* nil
+  "A list of functions for virtual file metadata (size, mtime).
+Each function receives (pathname op) where op is :size, :mtime, or :write-date,
+and should return the value, or nil to pass to the next handler.")
+
+(defparameter *virtual-directory-exists-p-functions* nil
+  "A list of functions for virtual directory-exists-p.
+Each function receives (directory) and should return the directory if it exists,
+or nil to pass to the next handler.")
+
+(defun virtual-directory-exists-p (directory)
+  "Check if a directory exists, using virtual filesystem hooks if applicable."
+  (or (loop :for f :in *virtual-directory-exists-p-functions*
+            :for result := (funcall f directory)
+            :when result :do (return result))
+      (uiop:directory-exists-p directory)))
+
 (defun open-virtual-file (filename &key external-format direction element-type)
   (apply #'values
          (or (loop :for f :in *virtual-file-open*

src/buffer/file.lisp

@@ -72,9 +72,9 @@
   (when (pathnamep filename)
     (setf filename (namestring filename)))
   (setf filename (expand-file-name filename))
-  (unless (uiop:directory-exists-p (directory-namestring filename))
+  (unless (virtual-directory-exists-p (directory-namestring filename))
     (error 'directory-does-not-exist :directory (directory-namestring filename)))
-  (alexandria:when-let (it (probe-file filename)) (setf filename (namestring it)))
+  (alexandria:when-let (it (virtual-probe-file filename)) (setf filename (namestring it)))
   (cond ((uiop:directory-pathname-p filename)
          (if *find-directory-function*
              (funcall *find-directory-function* filename)
@@ -91,7 +91,7 @@
                                      :enable-undo-p nil
                                      :temporary temporary)))
            (setf (buffer-filename buffer) filename)
-           (when (probe-file filename)
+           (when (virtual-probe-file filename)
              (let ((*inhibit-modification-hooks* t))
                (let ((encoding
                        (handler-bind ((encoding-read-error
@@ -186,15 +186,18 @@
                       (%%write-region-to-file encoding out))))))
 
 (defun file-write-date* (buffer)
-  (if (probe-file (buffer-filename buffer))
-      (file-write-date (buffer-filename buffer))))
+  (if (virtual-probe-file (buffer-filename buffer))
+      (or (loop :for f :in *virtual-file-metadata-functions*
+                :for result := (funcall f (buffer-filename buffer) :write-date)
+                :when result :do (return result))
+          (file-write-date (buffer-filename buffer)))))
 
 (defun update-changed-disk-date (buffer)
   (setf (buffer-last-write-date buffer)
         (file-write-date* buffer)))
 
 (defun changed-disk-p (buffer)
   (and (buffer-filename buffer)
-       (probe-file (buffer-filename buffer))
+       (virtual-probe-file (buffer-filename buffer))
        (not (eql (buffer-last-write-date buffer)
                  (file-write-date* buffer)))))

src/buffer/internal/buffer.lisp

@@ -224,7 +224,7 @@ Options that can be specified by arguments are ignored if `temporary` is NIL and
       (namestring (uiop:getcwd))))
 
 (defun (setf buffer-directory) (directory &optional (buffer (current-buffer)))
-  (let ((result (uiop:directory-exists-p directory)))
+  (let ((result (virtual-directory-exists-p directory)))
     (unless result
       (error 'directory-does-not-exist :directory directory))
     (setf (buffer-%directory buffer)

src/commands/file.lisp

@@ -66,7 +66,7 @@
 
 (defun directory-for-file-or-lose (filename)
   (let ((directory (directory-namestring filename)))
-    (unless (or (uiop:directory-exists-p directory)
+    (unless (or (virtual-directory-exists-p directory)
                 (maybe-create-directory directory))
       (error 'editor-abort))
     directory))