-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathphpinspect-fs.el
177 lines (143 loc) · 7.32 KB
/
phpinspect-fs.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
;;; phpinspect-fs.el --- PHP parsing and completion package -*- lexical-binding: t; -*-
;; Copyright (C) 2021-2023 Free Software Foundation, Inc
;; Author: Hugo Thunnissen <[email protected]>
;; Keywords: php, languages, tools, convenience
;; Version: 2.1.0
;; 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:
;;; Code:
(defconst phpinspect--cat-executable (executable-find "cat")
"The executable used to read files asynchronously from the filesystem.")
(cl-defstruct (phpinspect-fs (:constructor phpinspect-make-fs)))
(cl-defstruct (phpinspect-virtual-fs (:constructor phpinspect-make-virtual-fs))
"A rough in-memory filesystem. Useful for testing."
(files (make-hash-table :test 'equal)
:type hash-table
:documentation
"The files in the virtual filesystem"))
(defsubst phpinspect-make-virtual-file (contents)
(list contents (current-time)))
(defalias 'phpinspect-virtual-file-modification-time #'cadr)
(defalias 'phpinspect-virtual-file-contents #'car)
(defun phpinspect-virtual-fs-set-file (fs path contents)
(declare (indent defun))
(puthash path (phpinspect-make-virtual-file contents)
(phpinspect-virtual-fs-files fs)))
(cl-defgeneric phpinspect-fs-file-exists-p (fs file))
(cl-defgeneric phpinspect-fs-file-directory-p (fs file))
(cl-defgeneric phpinspect-fs-file-modification-time (fs file))
(cl-defgeneric phpinspect-fs-insert-file-contents (fs file &optional prefer-async)
"Insert file contents of FILE.
When PREFER-ASYNC is set and FS supports it, effort is made to
execute the insertion asynchronously in scenario's where this can
prevent the main thread (or other running threads) from stalling
while the current thread executes. When running in the main
thread, PREFER-ASYNC has no effect.")
(cl-defgeneric phpinspect-fs-directory-files (fs directory match))
(cl-defgeneric phpinspect-fs-directory-files-recursively (fs directory match))
(cl-defmethod phpinspect-fs-file-exists-p ((_fs phpinspect-fs) file)
(file-exists-p file))
(cl-defmethod phpinspect-fs-file-exists-p ((fs phpinspect-virtual-fs) file)
(and (gethash file (phpinspect-virtual-fs-files fs)) t))
(cl-defmethod phpinspect-fs-file-directory-p ((_fs phpinspect-fs) file)
(file-directory-p file))
(cl-defmethod phpinspect-fs-file-directory-p ((fs phpinspect-virtual-fs) file)
(setq file (concat (string-remove-suffix "/" file) "/"))
(let ((is-directory? nil))
(maphash
(lambda (existing-file _ignored)
(when (string-prefix-p (file-name-directory existing-file)
file)
(setq is-directory? t)))
(phpinspect-virtual-fs-files fs))
is-directory?))
(cl-defmethod phpinspect-fs-file-modification-time ((fs phpinspect-virtual-fs) file)
(let ((file (gethash file (phpinspect-virtual-fs-files fs))))
(when file
(phpinspect-virtual-file-modification-time file))))
(cl-defmethod phpinspect-fs-file-modification-time ((_fs phpinspect-fs) file)
(let ((attributes (file-attributes file)))
(when attributes
(file-attribute-modification-time attributes))))
(defsubst phpinspect--insert-file-contents-asynchronously (file)
"Inserts FILE contents into the current buffer asynchronously,
while blocking the current thread.
Errors when executed in main thread, as it should be used to make
background operations less invasive. Usage in the main thread can
only be the result of a logic error."
(let* ((thread (current-thread))
(mx (make-mutex))
(condition (make-condition-variable mx))
(err)
(sentinel
(lambda (process event)
(with-mutex mx
(if (string-match-p "^\\(deleted\\|exited\\|failed\\|connection\\)" event)
(progn
(setq err (format "cat process %s failed with event: %s" process event))
(condition-notify condition))
(when (string-match-p "^finished" event)
(condition-notify condition)))))))
(when (not phpinspect--cat-executable)
(error
"ERROR: phpinspect--insert-file-contents-asynchronously called when cat-executable is not set"))
(when (eq thread main-thread)
(error "ERROR: phpinspect--insert-file-contents-asynchronously called from main-thread"))
(with-mutex mx
(make-process :name "phpinspect--insert-file-contents-asynchronously"
:command `(,phpinspect--cat-executable ,file)
:buffer (current-buffer)
:sentinel sentinel)
(condition-wait condition)
(when err (error err)))))
(cl-defmethod phpinspect-fs-insert-file-contents ((_fs phpinspect-fs) file &optional prefer-async)
"Insert file contents from FILE. "
(if (and prefer-async (not (eq (current-thread) main-thread))
phpinspect--cat-executable)
(phpinspect--insert-file-contents-asynchronously file)
(insert-file-contents-literally file)))
(cl-defmethod phpinspect-fs-insert-file-contents ((fs phpinspect-virtual-fs) file &optional _ignored)
(let ((file-obj (gethash file (phpinspect-virtual-fs-files fs))))
(when file (insert (or (phpinspect-virtual-file-contents file-obj) "")))))
(cl-defmethod phpinspect-fs-directory-files ((_fs phpinspect-fs) directory &optional match)
(directory-files directory t match t))
(cl-defmethod phpinspect-fs-directory-files ((fs phpinspect-virtual-fs) directory &optional match)
(setq directory (replace-regexp-in-string "[/]+" "/" (concat directory "/")))
(let ((files))
(maphash
(lambda (file _ignored)
(let ((basename (replace-regexp-in-string "/.*$" "" (string-remove-prefix directory file))))
(when (and (string-prefix-p directory file)
(string-match-p "^[^/]*$" basename)
(if match (string-match-p match basename) t))
(cl-pushnew (concat directory basename) files :test #'string=))))
(phpinspect-virtual-fs-files fs))
files))
(cl-defmethod phpinspect-fs-directory-files-recursively ((_fs phpinspect-fs) directory &optional match)
(when (file-directory-p directory)
(directory-files-recursively directory
match
t ;; Ignore directories that cannot be read
t ;; follow symlinks
)))
(cl-defmethod phpinspect-fs-directory-files-recursively ((fs phpinspect-virtual-fs) directory &optional match)
(setq directory (replace-regexp-in-string "[/]+" "/" (concat directory "/")))
(let ((files))
(maphash
(lambda (file _ignored)
(when (and (string-prefix-p directory file)
(if match (string-match-p match file) t))
(push file files)))
(phpinspect-virtual-fs-files fs))
files))
(provide 'phpinspect-fs)
;;; phpinspect-fs.el ends here