;;; mock-fs.el --- Virtual filesystem for Emacs Lisp tests -*- lexical-binding: t; -*-

;; Copyright (C) 2025

;; Author: Aldric Giacomoni
;; Package-Version: 20260708.2247
;; Package-Revision: b15c34281d07
;; Package-Requires: ((emacs "27.1"))
;; Keywords: testing, files
;; URL: https://codeberg.org/Trevoke/mock-fs.el
;; SPDX-License-Identifier: GPL-3.0

;; This file is not part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A testing library that provides a virtual filesystem for Emacs Lisp tests.
;; Uses `file-name-handler-alist' to intercept file operations on `/mock:'
;; prefixed paths.
;;
;; Usage:
;;
;;   ;; Declarative
;;   (with-mock-fs '(("/path/file.txt" . "content")
;;                   ("/path/dir/" . nil))
;;     (file-exists-p "/mock:/path/file.txt"))  ; => t
;;
;;   ;; Builder
;;   (let ((fs (mock-fs-create)))
;;     (mock-fs-add-file fs "/file.txt" "content")
;;     (with-mock-fs fs
;;       (insert-file-contents "/mock:/file.txt")))

;;; Code:

(require 'cl-lib)

;;; Data structures

(cl-defstruct mock-fs-entry
  "Entry in a mock filesystem."
  content      ; string (file), 'directory, or (symlink . target-path)
  mtime        ; modification time (current-time format)
  permissions) ; integer (e.g., #o644)

(defvar mock-fs--current nil
  "The currently active mock filesystem (hash-table).")

;;; Path utilities

(defconst mock-fs--prefix "/mock:"
  "Prefix for mock filesystem paths.")

(defun mock-fs--strip-prefix (path)
  "Remove the /mock: prefix from PATH."
  (if (string-prefix-p mock-fs--prefix path)
      (substring path (length mock-fs--prefix))
    path))

(defun mock-fs--normalize-path (path)
  "Normalize PATH by stripping prefix and trailing slashes (except root)."
  (let ((stripped (mock-fs--strip-prefix path)))
    (if (string= stripped "/")
        stripped
      (string-trim-right stripped "/"))))

(defun mock-fs--get-entry (path)
  "Get the filesystem entry for PATH from the current mock filesystem."
  (when mock-fs--current
    (gethash (mock-fs--normalize-path path) mock-fs--current)))

(defun mock-fs--symlink-target (entry)
  "Return the symlink target if ENTRY is a symlink, nil otherwise."
  (let ((content (mock-fs-entry-content entry)))
    (and (consp content)
         (eq (car content) 'symlink)
         (cdr content))))

(defconst mock-fs--symlink-limit 40
  "Maximum number of symlinks to follow before signaling a loop error.")

(defun mock-fs--resolve-symlinks (path &optional count)
  "Resolve symlinks in PATH, returning the final target path.
COUNT tracks total symlink resolutions for loop detection.
Returns the resolved path (without /mock: prefix).
Signals `file-error' if too many symlinks are encountered.

This function walks the path component by component, resolving
any symlinks found in parent directories along the way."
  (let ((count (or count 0))
        (normalized (mock-fs--normalize-path path)))
    (when (>= count mock-fs--symlink-limit)
      (signal 'file-error (list "Too many levels of symbolic links" path)))
    ;; Split into components and walk the path
    (let ((components (split-string normalized "/" t))
          (resolved ""))
      (dolist (component components)
        (setq resolved (concat resolved "/" component))
        ;; Check if current accumulated path is a symlink
        (let ((entry (gethash resolved mock-fs--current)))
          (when (and entry (mock-fs--symlink-target entry))
            (let* ((target (mock-fs--symlink-target entry))
                   (resolved-target
                    (if (file-name-absolute-p target)
                        target
                      (expand-file-name target (file-name-directory resolved)))))
              ;; Recursively resolve the target (it might also be a symlink)
              (setq resolved (mock-fs--resolve-symlinks resolved-target (1+ count)))))))
      resolved)))

;;; File handler

(defun mock-fs-file-handler (operation &rest args)
  "Handle file OPERATION with ARGS for mock filesystem."
  (let ((handler (and mock-fs--current (get operation 'mock-fs-handler))))
    (if handler
        (apply handler args)
      ;; Fallback: inhibit our handler and call the real operation.
      ;; This also covers the case where no mock filesystem is active
      ;; (`mock-fs--current' is nil): a /mock: path then degrades to an
      ;; ordinary non-existent path for every operation, instead of some
      ;; handlers crashing on the nil hash-table.
      (let ((inhibit-file-name-handlers
             (cons 'mock-fs-file-handler inhibit-file-name-handlers))
            (inhibit-file-name-operation operation))
        (apply operation args)))))

;; Register the handler
(add-to-list 'file-name-handler-alist
             (cons (concat "\\`" (regexp-quote mock-fs--prefix)) 'mock-fs-file-handler))

;;; Operation handlers

(defun mock-fs--file-exists-p (filename)
  "Return t if FILENAME exists in the mock filesystem.
Follows symlinks - returns nil for broken symlinks."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ((null entry) nil)
     ;; If it's a symlink, check if target exists
     ((mock-fs--symlink-target entry)
      (condition-case nil
          (let ((resolved (mock-fs--resolve-symlinks filename)))
            (and (gethash resolved mock-fs--current) t))
        (file-error nil)))  ; Loop or broken = doesn't exist
     (t t))))

(put 'file-exists-p 'mock-fs-handler #'mock-fs--file-exists-p)

(defun mock-fs--file-directory-p (filename)
  "Return t if FILENAME is a directory in the mock filesystem.
Follows symlinks."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ((null entry) nil)
     ;; If it's a symlink, check target type
     ((mock-fs--symlink-target entry)
      (condition-case nil
          (let* ((resolved (mock-fs--resolve-symlinks filename))
                 (target-entry (gethash resolved mock-fs--current)))
            (and target-entry
                 (eq (mock-fs-entry-content target-entry) 'directory)))
        (file-error nil)))
     (t (eq (mock-fs-entry-content entry) 'directory)))))

(put 'file-directory-p 'mock-fs-handler #'mock-fs--file-directory-p)

(defun mock-fs--file-accessible-directory-p (filename)
  "Return t if FILENAME is an accessible directory in the mock filesystem.
A directory is accessible if it exists."
  (let ((entry (mock-fs--get-entry filename)))
    (and entry (eq (mock-fs-entry-content entry) 'directory))))

(put 'file-accessible-directory-p 'mock-fs-handler #'mock-fs--file-accessible-directory-p)

(defun mock-fs--file-regular-p (filename)
  "Return t if FILENAME is a regular file in the mock filesystem.
Follows symlinks."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ((null entry) nil)
     ;; If it's a symlink, check target type
     ((mock-fs--symlink-target entry)
      (condition-case nil
          (let* ((resolved (mock-fs--resolve-symlinks filename))
                 (target-entry (gethash resolved mock-fs--current)))
            (and target-entry
                 (stringp (mock-fs-entry-content target-entry))))
        (file-error nil)))
     (t (stringp (mock-fs-entry-content entry))))))

(put 'file-regular-p 'mock-fs-handler #'mock-fs--file-regular-p)

(defun mock-fs--file-symlink-p (filename)
  "Return symlink target if FILENAME is a symlink, nil otherwise."
  (let ((entry (mock-fs--get-entry filename)))
    (when entry
      (mock-fs--symlink-target entry))))

(put 'file-symlink-p 'mock-fs-handler #'mock-fs--file-symlink-p)

(defun mock-fs--insert-file-contents (filename &optional visit beg end replace)
  "Insert contents of FILENAME into current buffer.
VISIT, BEG, END, REPLACE are as in `insert-file-contents'.
Point is preserved at its original position (before inserted text).
Follows symlinks."
  (let* ((entry (mock-fs--get-entry filename))
         ;; Resolve symlinks if necessary
         (effective-entry
          (if (and entry (mock-fs--symlink-target entry))
              (condition-case nil
                  (let ((resolved (mock-fs--resolve-symlinks filename)))
                    (gethash resolved mock-fs--current))
                (file-error nil))
            entry)))
    (unless effective-entry
      (when visit
        (set-visited-file-name filename)
        (set-buffer-modified-p nil))
      (signal 'file-missing (list "Opening input file" "No such file or directory" filename)))
    (let* ((content (mock-fs-entry-content effective-entry))
           (len (length content))
           (pt (point)))
      (when (and beg end)
        (setq content (substring content beg end))
        (setq len (length content)))
      (when replace
        (erase-buffer)
        (setq pt (point-min)))
      (insert content)
      (goto-char pt)
      (when visit
        (set-visited-file-name filename)
        (set-buffer-modified-p nil))
      (list filename len))))

(put 'insert-file-contents 'mock-fs-handler #'mock-fs--insert-file-contents)

(defun mock-fs--write-region (start end filename &optional append visit _lockname _mustbenew)
  "Write region from START to END to FILENAME in mock filesystem.
APPEND, VISIT, LOCKNAME, MUSTBENEW are as in `write-region'.
START can also be a string, in which case it is written directly.
If START and END are nil, write the entire buffer.
VISIT semantics: t means visit file, string means visit with that name,
other non-nil values (like `silent') just suppress messages."
  (let ((content (cond
                  ((stringp start) start)
                  ((and (null start) (null end))
                   ;; nil nil means write entire buffer (e.g., save-buffer)
                   (buffer-substring-no-properties (point-min) (point-max)))
                  (t (buffer-substring-no-properties
                      (or start (point-min))
                      (or end (point-max)))))))
    (when append
      (let ((entry (mock-fs--get-entry filename)))
        (when entry
          (setq content (concat (mock-fs-entry-content entry) content)))))
    (puthash (mock-fs--normalize-path filename)
             (make-mock-fs-entry :content content
                                 :mtime (current-time)
                                 :permissions #o644)
             mock-fs--current)
    ;; VISIT: t means visit file, string means visit with that name
    ;; Other non-nil values (like 'silent) just suppress messages, don't visit
    (when (or (eq visit t) (stringp visit))
      (set-visited-file-name (if (stringp visit) visit filename)))
    nil))

(put 'write-region 'mock-fs-handler #'mock-fs--write-region)

(defun mock-fs--delete-file (filename &optional _trash)
  "Delete FILENAME from mock filesystem.
TRASH is ignored."
  (let ((path (mock-fs--normalize-path filename)))
    (unless (gethash path mock-fs--current)
      (signal 'file-missing (list "Deleting" "No such file or directory" filename)))
    (remhash path mock-fs--current)))

(put 'delete-file 'mock-fs-handler #'mock-fs--delete-file)

(defun mock-fs--directory-files (directory &optional full match nosort _count)
  "List files in DIRECTORY from mock filesystem.
FULL, MATCH, NOSORT, COUNT are as in `directory-files'."
  (let* ((dir-path (mock-fs--normalize-path directory))
         (dir-prefix (if (string-suffix-p "/" dir-path)
                         dir-path
                       (concat dir-path "/")))
         (results '()))
    ;; Collect files that are direct children of directory
    (maphash (lambda (path _entry)
               (when (and (string-prefix-p dir-prefix path)
                          (not (string= path dir-path)))
                 (let ((relative (substring path (length dir-prefix))))
                   ;; Only include direct children (no further slashes)
                   (unless (string-match-p "/" relative)
                     (when (or (not match) (string-match-p match relative))
                       (push (if full
                                 (concat mock-fs--prefix path)
                               relative)
                             results))))))
             mock-fs--current)
    ;; Add . and .. unless MATCH excludes them
    (unless (and match (not (string-match-p match ".")))
      (push (if full (concat mock-fs--prefix dir-path) ".") results))
    (unless (and match (not (string-match-p match "..")))
      (push (if full (concat mock-fs--prefix (file-name-directory (directory-file-name dir-path))) "..") results))
    (if nosort results (sort results #'string<))))

(put 'directory-files 'mock-fs-handler #'mock-fs--directory-files)

(defun mock-fs--insert-directory (file switches &optional _wildcard _full-directory-p)
  "Insert directory listing for FILE into current buffer.
SWITCHES are ls-style switches (partially supported).
WILDCARD and FULL-DIRECTORY-P are as in `insert-directory'."
  (let* ((dir-path (mock-fs--normalize-path file))
         (files (mock-fs--directory-files file nil nil t))
         (long-format (and switches (string-match-p "l" switches))))
    (dolist (f files)
      (if long-format
          (let* ((full-path (concat mock-fs--prefix dir-path "/" f))
                 (entry (mock-fs--get-entry full-path))
                 (is-dir (and entry (eq (mock-fs-entry-content entry) 'directory)))
                 (size (if (and entry (not is-dir))
                           (length (mock-fs-entry-content entry))
                         0))
                 (perms (if entry
                            (mock-fs--format-modes
                             (or (mock-fs-entry-permissions entry)
                                 (if is-dir #o755 #o644))
                             is-dir)
                          "-rw-r--r--")))
            (insert (format "%s  1 user user %7d Jan  1 00:00 %s\n"
                            perms size f)))
        (insert f "\n")))))

(put 'insert-directory 'mock-fs-handler #'mock-fs--insert-directory)

(defun mock-fs--make-directory (dir &optional parents)
  "Create directory DIR in mock filesystem.
If PARENTS is non-nil, create parent directories as needed."
  (let ((path (mock-fs--normalize-path dir)))
    (if parents
        ;; Create all parent directories
        (let ((parts (split-string path "/" t))
              (current ""))
          (dolist (part parts)
            (setq current (concat current "/" part))
            (unless (gethash current mock-fs--current)
              (puthash current
                       (make-mock-fs-entry :content 'directory
                                           :mtime (current-time)
                                           :permissions #o755)
                       mock-fs--current))))
      ;; Just create the single directory
      (puthash path
               (make-mock-fs-entry :content 'directory
                                   :mtime (current-time)
                                   :permissions #o755)
               mock-fs--current))))

(put 'make-directory 'mock-fs-handler #'mock-fs--make-directory)

(defun mock-fs--delete-directory (directory &optional _recursive _trash)
  "Delete DIRECTORY from mock filesystem.
RECURSIVE and TRASH are as in `delete-directory'."
  (let ((path (mock-fs--normalize-path directory)))
    (unless (gethash path mock-fs--current)
      (signal 'file-missing (list "Removing directory" "No such file or directory" directory)))
    (remhash path mock-fs--current)))

(put 'delete-directory 'mock-fs-handler #'mock-fs--delete-directory)

(defun mock-fs--copy-file (file newname &optional _ok-if-already-exists keep-time _preserve-uid-gid _preserve-extended-attributes)
  "Copy FILE to NEWNAME in mock filesystem.
If KEEP-TIME is non-nil, preserve the original modification time.
OK-IF-ALREADY-EXISTS is accepted for compatibility but ignored."
  (let ((entry (mock-fs--get-entry file)))
    (unless entry
      (signal 'file-missing (list "Copying" "No such file or directory" file)))
    (puthash (mock-fs--normalize-path newname)
             (make-mock-fs-entry :content (mock-fs-entry-content entry)
                                 :mtime (if keep-time
                                            (mock-fs-entry-mtime entry)
                                          (current-time))
                                 :permissions (mock-fs-entry-permissions entry))
             mock-fs--current)))

(put 'copy-file 'mock-fs-handler #'mock-fs--copy-file)

(defun mock-fs--rename-file (file newname &optional _ok-if-already-exists)
  "Rename FILE to NEWNAME in mock filesystem.
OK-IF-ALREADY-EXISTS is accepted for compatibility but ignored."
  (let ((entry (mock-fs--get-entry file)))
    (unless entry
      (signal 'file-missing (list "Renaming" "No such file or directory" file)))
    (puthash (mock-fs--normalize-path newname)
             entry
             mock-fs--current)
    (remhash (mock-fs--normalize-path file) mock-fs--current)))

(put 'rename-file 'mock-fs-handler #'mock-fs--rename-file)

(defun mock-fs--make-symbolic-link (target linkname &optional ok-if-already-exists)
  "Create a symbolic link LINKNAME pointing to TARGET.
If OK-IF-ALREADY-EXISTS is nil, signal error if LINKNAME exists."
  (let ((path (mock-fs--normalize-path linkname)))
    (when (and (gethash path mock-fs--current)
               (not ok-if-already-exists))
      (signal 'file-already-exists (list "File exists" linkname)))
    (puthash path
             (make-mock-fs-entry :content (cons 'symlink target)
                                 :mtime (current-time)
                                 :permissions #o777)
             mock-fs--current)
    nil))

(put 'make-symbolic-link 'mock-fs-handler #'mock-fs--make-symbolic-link)

(defun mock-fs--file-truename (filename &optional _counter _prev-dirs)
  "Return the true name of FILENAME in mock filesystem.
Resolves symlinks and normalizes the path.
COUNTER and PREV-DIRS are ignored (compatibility with real impl)."
  (let* ((stripped (mock-fs--strip-prefix filename))
         (expanded (expand-file-name stripped))
         (resolved (mock-fs--resolve-symlinks expanded)))
    (concat mock-fs--prefix resolved)))

(put 'file-truename 'mock-fs-handler #'mock-fs--file-truename)

(defun mock-fs--expand-file-name (name &optional dir)
  "Expand NAME in mock filesystem context.
DIR is used as the default directory if NAME is relative."
  (let* ((name-has-prefix (string-prefix-p mock-fs--prefix name))
         (default-has-prefix (and dir
                                  (string-prefix-p mock-fs--prefix dir)))
         (name-is-absolute (and (not name-has-prefix)
                                (file-name-absolute-p name)))
         (stripped-name (if name-has-prefix
                            (let ((s (mock-fs--strip-prefix name)))
                              ;; Handle /mock: -> "/" (root of mock fs)
                              (if (string-empty-p s) "/" s))
                          name))
         (stripped-default (if default-has-prefix
                               (mock-fs--strip-prefix dir)
                             dir)))
    ;; Use real expand-file-name with inhibited handler
    (let ((inhibit-file-name-handlers
           (cons 'mock-fs-file-handler inhibit-file-name-handlers))
          (inhibit-file-name-operation 'expand-file-name))
      (let ((expanded (expand-file-name stripped-name stripped-default)))
        ;; Only add /mock: prefix if the result should be in mock filesystem:
        ;; - NAME has /mock: prefix, OR
        ;; - NAME is relative and DEFAULT-DIRECTORY has /mock: prefix
        ;; If NAME is absolute without /mock: prefix, it's a real path.
        (if (or name-has-prefix
                (and (not name-is-absolute) default-has-prefix))
            (concat mock-fs--prefix expanded)
          expanded)))))

(put 'expand-file-name 'mock-fs-handler #'mock-fs--expand-file-name)

(defun mock-fs--file-readable-p (filename)
  "Return t if FILENAME is readable in the mock filesystem.
Follows symlinks - returns nil for broken symlinks."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ((null entry) nil)
     ((mock-fs--symlink-target entry)
      (condition-case nil
          (let ((resolved (mock-fs--resolve-symlinks filename)))
            (and (gethash resolved mock-fs--current) t))
        (file-error nil)))
     (t t))))

(put 'file-readable-p 'mock-fs-handler #'mock-fs--file-readable-p)

(defun mock-fs--file-writable-p (filename)
  "Return t if FILENAME is writable in the mock filesystem.
Follows symlinks. Returns nil for broken symlinks.
A file is writable if it exists, or if its parent directory exists."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ;; Symlink: check if target exists and is writable
     ((and entry (mock-fs--symlink-target entry))
      (condition-case nil
          (let ((resolved (mock-fs--resolve-symlinks filename)))
            (and (gethash resolved mock-fs--current) t))
        (file-error nil)))
     ;; Regular entry exists
     (entry t)
     ;; Check if parent directory exists (so we can create file)
     (t (let ((parent (file-name-directory (mock-fs--normalize-path filename))))
          (and parent
               (mock-fs--get-entry (concat mock-fs--prefix parent))
               t))))))

(put 'file-writable-p 'mock-fs-handler #'mock-fs--file-writable-p)

(defun mock-fs--file-modes (filename &optional flag)
  "Return the mode bits of FILENAME in mock filesystem.
If FLAG is `nofollow', return symlink's own modes.
Returns nil if file does not exist."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ((null entry) nil)
     ;; Symlink handling
     ((mock-fs--symlink-target entry)
      (if (eq flag 'nofollow)
          ;; Return symlink's own permissions
          (or (mock-fs-entry-permissions entry) #o777)
        ;; Follow symlink
        (condition-case nil
            (let* ((resolved (mock-fs--resolve-symlinks filename))
                   (target-entry (gethash resolved mock-fs--current)))
              (when target-entry
                (or (mock-fs-entry-permissions target-entry)
                    (if (eq (mock-fs-entry-content target-entry) 'directory)
                        #o755
                      #o644))))
          (file-error nil))))
     ;; Regular file/directory
     (t (or (mock-fs-entry-permissions entry)
            (if (eq (mock-fs-entry-content entry) 'directory)
                #o755
              #o644))))))

(put 'file-modes 'mock-fs-handler #'mock-fs--file-modes)

(defun mock-fs--set-file-modes (filename mode &optional flag)
  "Set the mode bits of FILENAME to MODE in mock filesystem.
If FLAG is `nofollow', modify symlink itself instead of target."
  (let ((entry (mock-fs--get-entry filename)))
    (cond
     ((null entry)
      (signal 'file-missing (list "Setting mode" "No such file or directory" filename)))
     ;; Symlink handling
     ((mock-fs--symlink-target entry)
      (if (eq flag 'nofollow)
          ;; Modify symlink itself
          (setf (mock-fs-entry-permissions entry) mode)
        ;; Follow symlink and modify target
        (let* ((resolved (mock-fs--resolve-symlinks filename))
               (target-entry (gethash resolved mock-fs--current)))
          (if target-entry
              (setf (mock-fs-entry-permissions target-entry) mode)
            (signal 'file-missing (list "Setting mode" "No such file or directory" filename))))))
     ;; Regular file/directory
     (t (setf (mock-fs-entry-permissions entry) mode)))))

(put 'set-file-modes 'mock-fs-handler #'mock-fs--set-file-modes)

(defun mock-fs--format-modes (perms is-dir)
  "Format PERMS integer as a mode string like \"-rwxr-xr-x\".
IS-DIR controls the first character."
  (concat
   (if is-dir "d" "-")
   (if (> (logand perms #o400) 0) "r" "-")
   (if (> (logand perms #o200) 0) "w" "-")
   (if (> (logand perms #o100) 0) "x" "-")
   (if (> (logand perms #o040) 0) "r" "-")
   (if (> (logand perms #o020) 0) "w" "-")
   (if (> (logand perms #o010) 0) "x" "-")
   (if (> (logand perms #o004) 0) "r" "-")
   (if (> (logand perms #o002) 0) "w" "-")
   (if (> (logand perms #o001) 0) "x" "-")))

(defun mock-fs--format-modes-full (perms is-dir is-symlink)
  "Format PERMS integer as a mode string like \"-rwxr-xr-x\".
IS-DIR and IS-SYMLINK control the first character."
  (concat
   (cond (is-symlink "l")
         (is-dir "d")
         (t "-"))
   (if (> (logand perms #o400) 0) "r" "-")
   (if (> (logand perms #o200) 0) "w" "-")
   (if (> (logand perms #o100) 0) "x" "-")
   (if (> (logand perms #o040) 0) "r" "-")
   (if (> (logand perms #o020) 0) "w" "-")
   (if (> (logand perms #o010) 0) "x" "-")
   (if (> (logand perms #o004) 0) "r" "-")
   (if (> (logand perms #o002) 0) "w" "-")
   (if (> (logand perms #o001) 0) "x" "-")))

(defun mock-fs--file-attributes (filename &optional id-format)
  "Return attributes of FILENAME in mock filesystem.
ID-FORMAT controls uid/gid format: `string' for names, otherwise integers.
Returns nil if file does not exist."
  (let ((entry (mock-fs--get-entry filename)))
    (when entry
      (let* ((content (mock-fs-entry-content entry))
             (symlink-target (mock-fs--symlink-target entry))
             (is-dir (eq content 'directory))
             (is-symlink (not (null symlink-target)))
             (size (cond
                    (is-dir 0)
                    (is-symlink (length symlink-target))
                    (t (length content))))
             (mtime (or (mock-fs-entry-mtime entry) (current-time)))
             (perms (or (mock-fs-entry-permissions entry)
                        (cond (is-symlink #o777)
                              (is-dir #o755)
                              (t #o644))))
             (uid (if (eq id-format 'string)
                      (user-login-name)
                    (user-uid)))
             (gid (if (eq id-format 'string)
                      (number-to-string (group-gid))
                    (group-gid))))
        (list
         (cond (is-symlink symlink-target)  ; 0: symlink target or...
               (is-dir t)                    ;    t for dir or...
               (t nil))                      ;    nil for file
         1                                    ; 1: link count
         uid                                  ; 2: uid
         gid                                  ; 3: gid
         mtime                                ; 4: access time
         mtime                                ; 5: modification time
         mtime                                ; 6: status change time
         size                                 ; 7: size in bytes
         (mock-fs--format-modes-full perms is-dir is-symlink) ; 8: mode string
         nil                                  ; 9: gid change flag
         (sxhash filename)                    ; 10: inode
         0)))))                               ; 11: device

(put 'file-attributes 'mock-fs-handler #'mock-fs--file-attributes)

(defun mock-fs--directory-file-name (dirname)
  "Return DIRNAME without trailing slash, except for mock root.
For `/mock:/' (root), returns `/mock:/' unchanged."
  (let ((stripped (mock-fs--strip-prefix dirname)))
    (if (string= stripped "/")
        ;; Root of mock filesystem - keep as is
        (concat mock-fs--prefix "/")
      ;; Non-root - strip trailing slash
      (concat mock-fs--prefix (directory-file-name stripped)))))

(put 'directory-file-name 'mock-fs-handler #'mock-fs--directory-file-name)

;;; Process handling
;; When default-directory is a mock path, shell commands would fail.
;; These handlers and advice redirect to a real directory.

(defun mock-fs--real-directory ()
  "Return a real directory to use for process execution."
  (or (getenv "HOME") temporary-file-directory "/tmp"))

(defun mock-fs--process-file (program &optional infile buffer display &rest args)
  "Run PROGRAM with a real `default-directory' instead of mock path.
INFILE, BUFFER, DISPLAY, and ARGS are as in `process-file'."
  (let ((default-directory (mock-fs--real-directory))
        (inhibit-file-name-handlers
         (cons 'mock-fs-file-handler inhibit-file-name-handlers))
        (inhibit-file-name-operation 'process-file))
    (apply #'process-file program infile buffer display args)))

(put 'process-file 'mock-fs-handler #'mock-fs--process-file)

(defun mock-fs--start-file-process (name buffer program &rest args)
  "Start PROGRAM with a real `default-directory' instead of mock path.
NAME, BUFFER, and ARGS are as in `start-file-process'."
  (let ((default-directory (mock-fs--real-directory))
        (inhibit-file-name-handlers
         (cons 'mock-fs-file-handler inhibit-file-name-handlers))
        (inhibit-file-name-operation 'start-file-process))
    (apply #'start-file-process name buffer program args)))

(put 'start-file-process 'mock-fs-handler #'mock-fs--start-file-process)

;; Advice for call-process functions (C primitives that don't use file handlers)

(defun mock-fs--call-process-advice (orig-fun &rest args)
  "Advice for ORIG-FUN to use real directory when in mock path.
ARGS are passed to ORIG-FUN.  When `default-directory' is a mock
path, redirects to a real directory."
  (if (and mock-fs--current
           (string-prefix-p mock-fs--prefix default-directory))
      (let ((default-directory (mock-fs--real-directory)))
        (apply orig-fun args))
    (apply orig-fun args)))

(defun mock-fs--install-advice ()
  "Install advice for `call-process' functions."
  (advice-add 'call-process :around #'mock-fs--call-process-advice)
  (advice-add 'call-process-region :around #'mock-fs--call-process-advice))

(defun mock-fs--remove-advice ()
  "Remove advice from `call-process' functions."
  (advice-remove 'call-process #'mock-fs--call-process-advice)
  (advice-remove 'call-process-region #'mock-fs--call-process-advice))

;;; Public API

(defun mock-fs-create ()
  "Create a new empty mock filesystem."
  (make-hash-table :test 'equal))

(defun mock-fs-add-file (fs path content)
  "Add a file to FS at PATH with CONTENT."
  (puthash (mock-fs--normalize-path path)
           (make-mock-fs-entry :content content
                               :mtime (current-time)
                               :permissions #o644)
           fs))

(defun mock-fs-add-directory (fs path)
  "Add a directory to FS at PATH."
  (puthash (mock-fs--normalize-path path)
           (make-mock-fs-entry :content 'directory
                               :mtime (current-time)
                               :permissions #o755)
           fs))

(defun mock-fs-add-symlink (fs path target)
  "Add a symbolic link to FS at PATH pointing to TARGET."
  (puthash (mock-fs--normalize-path path)
           (make-mock-fs-entry :content (cons 'symlink target)
                               :mtime (current-time)
                               :permissions #o777)
           fs))

(defun mock-fs-path (path)
  "Return PATH prefixed for the mock filesystem."
  (concat "/mock:" path))

(defmacro with-mock-fs (init &rest body)
  "Execute BODY with a mock filesystem initialized from INIT.
INIT can be either:
- An alist of (path . content) pairs where content is:
  - A string for file contents
  - nil for directories (or path ends with /)
  - (:symlink . target) for symbolic links
- A hash-table (from `mock-fs-create')"
  (declare (indent 1))
  `(let ((mock-fs--current
          (if (hash-table-p ,init)
              ,init
            (let ((fs (mock-fs-create)))
              (dolist (entry ,init)
                (let ((path (car entry))
                      (content (cdr entry)))
                  (cond
                   ;; Symlink: (:symlink . target)
                   ((and (consp content) (eq (car content) :symlink))
                    (mock-fs-add-symlink fs path (cdr content)))
                   ;; Directory: nil or trailing slash
                   ((or (null content) (string-suffix-p "/" path))
                    (mock-fs-add-directory fs path))
                   ;; Regular file
                   (t (mock-fs-add-file fs path content)))))
              fs))))
     (mock-fs--install-advice)
     (unwind-protect
         (progn ,@body)
       (mock-fs--remove-advice))))

(provide 'mock-fs)
;;; mock-fs.el ends here
