Merge pull request #1658 from lem-project/read-only-sources

open the source code of the sbcl as read-only

extensions/lisp-mode/connection.lisp

@@ -21,6 +21,7 @@
            :connection-command
            :connection-process
            :connection-process-directory
+           :connection-system-file-patterns
            :connection-plist
            :self-connection-p)
   (:export :new-connection

extensions/lisp-mode/lem-lisp-mode.asd

@@ -53,6 +53,9 @@
                (:file "ext/test-runner")
                (:file "ext/utopian")
                (:file "ext/highlight")
+
+               (:file "read-only-sources")
+
                (:file "package")))
 
 (defsystem "lem-lisp-mode/v2"

extensions/lisp-mode/read-only-sources.lisp

@@ -0,0 +1,14 @@
+(uiop:define-package :lem-lisp-mode/read-only-sources
+  (:use :cl)
+  (:import-from :lem/read-only-sources
+                :define-read-only-source))
+(in-package :lem-lisp-mode/read-only-sources)
+
+(define-read-only-source sbcl-source (directory)
+  (alexandria:when-let (connection (lem-lisp-mode/internal:current-connection))
+    (dolist (pattern (lem-lisp-mode/connection:connection-system-file-patterns connection))
+      (when (pathname-match-p directory pattern)
+        (return t)))))
+
+(define-read-only-source quicklisp-dists (directory)
+  (search "/dists/quicklisp/software/" directory))

lem.asd

@@ -204,7 +204,8 @@
                              (:file "filer")
                              (:file "deepl")
                              (:file "themes")
-                             (:file "detective")))
+                             (:file "detective")
+                             (:file "read-only-sources")))
 
                (:module "ui"
                 :serial t

src/ext/read-only-sources.lisp

@@ -0,0 +1,29 @@
+(uiop:define-package :lem/read-only-sources
+  (:use :cl :lem)
+  (:export :read-only-sources
+           :define-read-only-source))
+(in-package :lem/read-only-sources)
+
+(define-editor-variable read-only-sources t)
+
+(defvar *patterns* (make-hash-table :test 'equal))
+
+(defun register-pattern (name function)
+  (setf (gethash name *patterns*) function))
+
+(defmacro define-read-only-source (name (directory) &body body)
+  `(register-pattern ',name (lambda (,directory) ,@body)))
+
+(defun read-only-source-p (directory)
+  (maphash (lambda (name pattern)
+             (declare (ignore name))
+             (when (funcall pattern directory)
+               (return-from read-only-source-p t)))
+           *patterns*))
+
+(defun on-switch-to-buffer (buffer)
+  (when (and (variable-value 'read-only-sources :default buffer)
+             (read-only-source-p (buffer-directory buffer)))
+    (setf (buffer-read-only-p buffer) t)))
+
+(add-hook *switch-to-buffer-hook* 'on-switch-to-buffer)