[elpa] externals/jarchive 059efdf37c 16/33: Make eglot-extend-to-xref work, breaking support for `zipfile:` uris

[ELPA Syncer]

branch: externals/jarchive
commit 059efdf37c287e41723418ca08038e51ab50b9d5
Author: dannyfreeman <danny@dfreeman.email>
Commit: dannyfreeman <danny@dfreeman.email>

    Make eglot-extend-to-xref work, breaking support for `zipfile:` uris
    
    This change removes support for the zipfile dependency-scheme in
    clojure-lsp, requiring the setting to be initialized always with "jar".
    
    It also requires some changes to eglot to NOT parse jar scheme URIs at
    all, leaving the `jar:file://` prefix. Jarchive now only triggers on
    file descriptors as this URI. This makes it easy for eglot to forward
    references from the jar uri back to clojure-lsp. This allows clojure-lsp
    to continue performing analysis when the extracted file is not in the
    project.
    
    The following code snippet allows this to work before eglot change are
    patched into emacs, (or hacked in with advice if we decide to leave it
    out of eglot).
    
    ```emacs-lisp
    (defun eglot--path-to-uri (path)
      "URIfy PATH."
      (if (equal "jar" (url-type (url-generic-parse-url path)))
          path
        (let ((truepath (file-truename path)))
          (concat "file://"
                  ;; Add a leading "/" for local MS Windows-style paths.
                  (if (and (eq system-type 'windows-nt)
                           (not (file-remote-p truepath)))
                      "/")
                  (url-hexify-string
                   ;; Again watch out for trampy paths.
                   (directory-file-name (file-local-name truepath))
                   eglot--uri-path-allowed-chars)))))
    
    (defun eglot--uri-to-path (uri)
      "Convert URI to file path, helped by `eglot--current-server'."
      (when (keywordp uri) (setq uri (substring (symbol-name uri) 1)))
      (let* ((server (eglot-current-server))
             (remote-prefix (and server (eglot--trampish-p server)))
             (url (url-generic-parse-url uri))
             (retval (if (string= "jar" (url-type url))
                         uri
                       (url-unhex-string (url-filename url))))
             ;; Remove the leading "/" for local MS Windows-style paths.
             (normalized (if (and (not remote-prefix)
                                  (eq system-type 'windows-nt)
                                  (cl-plusp (length retval)))
                             (substring retval 1)
                           retval)))
        (concat remote-prefix normalized)))
    ```
    
    This `eglot-server-programs` entry is also used
    ```
    ((clojure-mode clojurescript-mode clojurec-mode)
       . ("clojure-lsp" :initializationOptions (:dependency-scheme "jar")))
    ```
    
    This setting can also be set in
    `~/.config/clojure-lsp/config.edn` with `{:dependency-scheme "jar"}`
---
 jarchive.el | 180 +++++++++++++++++++++++++++---------------------------------
 1 file changed, 81 insertions(+), 99 deletions(-)

diff --git a/jarchive.el b/jarchive.el
index 2423b2d2f9..a3a3bd1f83 100644
--- a/jarchive.el
+++ b/jarchive.el
@@ -5,15 +5,17 @@
 
 ;;; Code:
 (require 'arc-mode)
-(require 'project)
+(require 'cl-macs)
+(require 'seq)
 
-(defvar jarchive--hybrid-path-regex
+(defconst jarchive--uri-regex
   (rx
+   line-start
+   "jar:file://"
    ;; match group 1, the jar file location
    (group "/" (* not-newline) ".jar")
    ;; Potential delimiters between the jar and the file inside the jar
-   (or "::" "!")
-   ;; match the leading directory delimiter /,
+   "!" ;; match the leading directory delimiter /,
    ;; archvie mode expects none so it's outside match group 2
    (zero-or-one "/")
    ;; match group 2, the file within the archive
@@ -22,112 +24,92 @@
   "A regex for matching paths to a jar file and a file path into the jar file.
 Delimited by `!' or `::'")
 
-(defun jarchive--match-jar (hybrid-filename)
-  (string-match jarchive--hybrid-path-regex hybrid-filename)
-  (substring hybrid-filename (match-beginning 1) (match-end 1)))
+(defun jarchive--match! (uri)
+  (string-match jarchive--uri-regex uri))
 
-(defun jarchive--match-file (hybrid-filename)
-  (string-match jarchive--hybrid-path-regex hybrid-filename)
-  (substring hybrid-filename (match-beginning 2) (match-end 2)))
+(defun jarchive--match-jar (uri)
+  (substring uri (match-beginning 1) (match-end 1)))
 
-(defmacro jarchive--inhibit (op &rest body)
-  "Run BODY with `jarchive--file-name-handler' inhibited for OP."
-  `(let ((inhibit-file-name-handlers (cons (quote jarchive--file-name-handler)
+(defun jarchive--match-file (uri)
+  (substring uri (match-beginning 2) (match-end 2)))
+
+(defmacro jarchive--inhibit (op handler &rest body)
+  "Run BODY with HANDLER inhibited for OP ."
+  `(let ((inhibit-file-name-handlers (cons ,handler
                                            (and (eq 
inhibit-file-name-operation ,op)
                                                 inhibit-file-name-handlers)))
          (inhibit-file-name-operation ,op))
      ,@body))
 
-(defvar-local jarchive--jar-path nil)
-
-(defvar-local jarchive--file-in-jar-path nil)
-
-(defvar-local jarchive--visitor-project nil)
-
-(defvar-local jarchive-visiting-project-source-dir "src/"
-  "The source directory of the project that is visiting an archived file.
-When invoking `jarchive-move-to-visiting-project',
-this value is used as the parent directory in the project to save the 
extracted file.")
-
-(defun jarchive--instruction-message ()
-  (message "File opened by jarchive. Type %s to move it into your project."
-           (or (car (mapcar 'key-description (where-is-internal 
'jarchive-move-to-visiting-project)))
-               "M-x jarchive-move-to-visiting-project")))
-
 (defun jarchive--file-name-handler (op &rest args)
-  "A `file-name-handler-alist' handler for opening files located in jars.
-OP is a `(elisp)Magic File Names' operation and ARGS are any extra argument
-provided when calling OP."
-  (cond
-   ((eq op 'get-file-buffer)
-    (let* ((file  (car args))
-           (jar (jarchive--match-jar file))
-           (file-in-jar  (jarchive--match-file file))
-           ;; Use a different filename that doesn't match 
`jarchive--hybrid-path-regex'
-           ;; so that this handler will not deal with existing open buffers.
-           (buffer-file (concat jar ":" file-in-jar))
-           (visitor-project (project-current)))
-      (or (find-buffer-visiting buffer-file)
-          (with-current-buffer (create-file-buffer buffer-file)
-            (archive-zip-extract jar file-in-jar)
-            (goto-char 0)
-            (setq-local buffer-file-name buffer-file)
-            (setq-local buffer-offer-save nil)
-            (setq-local buffer-read-only t)
-            (set-auto-mode)
-            (jarchive--managed-mode 1)
-            (when visitor-project ;; Allow the user to move to the visitor 
project later.
-              (setq-local jarchive--jar-path jar)
-              (setq-local jarchive--file-in-jar-path file-in-jar)
-              (setq-local jarchive--visitor-project visitor-project))
-            (set-buffer-modified-p nil)
-            (jarchive--instruction-message)
-            (current-buffer)))))
-   (t (jarchive--inhibit op (apply op args)))))
-
-(defvar jarchive-mode-map (make-sparse-keymap)
-  "A keymap that is active in buffers opened by jarchive.")
-
-;;;###autoload
-(define-minor-mode jarchive--managed-mode
-  "Mode for buffers opened by jarchive mode."
-  :init-value nil
-  :ligher nil
-  :interactive nil
-  :keymap jarchive-mode-map)
-
-(defun jarchive--visting-project-location ()
-  (concat (project-root jarchive--visitor-project)
-          jarchive-visiting-project-source-dir
-          jarchive--file-in-jar-path))
-
-(defun jarchive-move-to-visiting-project ()
-  "Move the currently archived file into the project that visited it.
-The file will be moved under the `jarchive-visiting-project-source-dir' and 
saved."
-  (interactive)
-  (cond ((not jarchive--managed-mode)
-         (message "This command is only available in jarchive--managed-mode"))
-        ((not jarchive--visitor-project)
-         (message "This buffer was not visited from a known project. Nothing 
to do."))
-        (t
-         (let* ((new-location (jarchive--visting-project-location)))
-           (write-file new-location t)
-           (revert-buffer t t)
-           (setq-local buffer-read-only nil)
-           (jarchive--managed-mode -1)
-           (message "Moved to %s" new-location)))))
+  "A `file-name-handler-alist' function for files matching 
`jarchive--url-regex'.
+OP is an I/O primitive and ARGS are the remaining arguments passed to that 
primitive.
+See `(elisp)Magic File Names'."
+  (if-let ((uri (car args)))  ;; Sometimes this is invoked with nil args
+      (let* ((_   (jarchive--match! uri))
+             (jar-path (jarchive--match-jar uri))
+             (file-path (jarchive--match-file uri)))
+        (jarchive--inhibit op 'jarchive--file-name-handler
+         (cond
+          ((eq op 'expand-file-name) uri)
+          ((eq op 'file-truename) uri)
+          ((eq op 'file-name-directory) (file-name-directory jar-path))
+          ((eq op 'file-name-nondirectory) (file-name-nondirectory file-path))
+          ((eq op 'directory-file-name) (directory-file-name 
(file-name-directory jar-path)))
+          ((eq op 'file-name-case-insensitive-p) (file-name-case-insensitive-p 
jar-path))
+          ((eq op 'file-attributes) (file-attributes jar-path (cadr args)))
+
+          ;; Predicates
+          ((eq op 'file-directory-p) nil)
+          ((eq op 'file-readable-p) (file-readable-p jar-path))
+          ((eq op 'file-writable-p) nil)
+          ((eq op 'file-exists-p) (file-exists-p jar-path))
+          ((eq op 'file-remote-p) (file-remote-p jar-path))
+          ((eq op 'file-symlink-p) (file-symlink-p jar-path))
+          ((eq op 'file-accessible-directory-p) nil)
+          ((eq op 'file-executable-p) nil)
+
+          ;; Custom implementations
+          ((eq op 'get-file-buffer)
+           (seq-find (lambda (buf)
+                       (string= uri (buffer-local-value 'buffer-file-name 
buf)))
+                     (buffer-list)))
+          ((eq op 'insert-file-contents) ;; This is executed in the context of 
a new buffer.
+           (cl-destructuring-bind (_filename visit beg end replace) args
+             (setq buffer-file-name uri)
+             (when replace
+               (erase-buffer))
+             (archive-zip-extract jar-path file-path)
+             (goto-char (point-min))
+             (unless visit
+               (set-buffer-modified-p nil)
+               (when (or beg end)
+                 (display-warning
+                  'jarchive
+                  "The beg and end options are not respected by the jarchive 
`insert-file-contents' handler."
+                  :warning)))
+             (setq buffer-offer-save nil)
+             (rename-buffer (format "%s(%s)"
+                                    (file-name-nondirectory file-path)
+                                    (file-name-nondirectory jar-path))
+                            t)
+             (list uri (string-width (buffer-string)))))
+          (t (apply op args)))))
+    (jarchive--inhibit op 'jarchive--file-name-handler
+                       (message "jarchive--inhibit %s for %s" op args)
+                       (apply op args))))
+
+(defun jarchive--find-file-not-found ()
+  "Return t if the file not found was a file extracted by jarchive.
+TODO: this might be unnecessary, try to remove"
+  (and (string-match-p jarchive--uri-regex buffer-file-name)
+       t))
 
 ;;;###autoload
 (defun jarchive-setup ()
   (interactive)
-  (add-to-list 'file-name-handler-alist (cons jarchive--hybrid-path-regex 
#'jarchive--file-name-handler)))
-
-;; Temporary, for testing
-(defmacro comment (&rest body) nil)
-(comment
- (jarchive-setup)
- (defvar test-file 
"/home/user/.m2/repository/hiccup/hiccup/1.0.5/hiccup-1.0.5.jar!/hiccup/page.clj")
- (find-file test-file)
- )
+  (add-to-list 'file-name-handler-alist (cons jarchive--uri-regex 
#'jarchive--file-name-handler))
+  (add-to-list 'find-file-not-found-functions #'jarchive--find-file-not-found))
 
 (provide 'jarchive)
+;;; jarchive.el ends here