;;; org-src-context.el --- LSP support for org-src buffers -*- lexical-binding: t; -*- ;; Copyright (C) 2022 Free Software Foundation, Inc. ;; Author: Karthik Chikmagalur ;; Keywords: tools, languages, extensions ;; 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 . ;;; Commentary: ;; This file contains the code dealing with Language Server Protocol support via ;; other packages in Org Source buffers. ;;; Code: (require 'org) (require 'ob) (require 'ob-tangle) (require 'org-src) (require 'cl-lib) (declare-function eglot--maybe-activate-editing-mode "eglot") (declare-function eglot-current-server "eglot") (declare-function lsp-deferred "lsp-mode") (defgroup org-src-context nil "Provides LSP support in org-src buffers." :group 'org) (defcustom org-src-context-narrow-p t "Whether org-src buffers should be narrowed to the code block with Eglot enabled." :type 'boolean :group 'org-src-context) (defface org-src-context-read-only '((((class color) (min-colors 257) (background light)) :background "#ffeeee" :extend t) (((class color) (min-colors 88) (background light)) :background "#ffdddd" :extend t) (((class color) (min-colors 88) (background dark)) :background "#553333" :extend t)) "Face for read-only sections of org-src buffer" :group 'org-src-context) (defvar-local org-src-context--before-block-marker nil) (defvar-local org-src-context--after-block-marker nil) (defun org-src-context--edit-src-ad (orig-fn &rest args) "Set up `org-src-mode' buffers for use with Eglot, Emacs' LSP client. This does the following: - Include all the code blocks associated with the current tangle file in the org-src buffer. - Associate the buffer with a temporary file. - Connect to a running LSP server with Eglot." (if-let* ((info (org-babel-get-src-block-info 'light)) (lang (car info)) (this-block-data (save-excursion (goto-char (org-element-property :begin (org-element-at-point))) (car (org-babel-tangle-single-block 1 t)))) (tangle-file (car this-block-data)) (this-block (cadr this-block-data)) (all-blocks (cdar (org-babel-tangle-collect-blocks lang (alist-get :tangle (caddr info))))) (extra-blocks (list nil))) (prog1 (apply orig-fn args) (setq extra-blocks (cl-loop for block in all-blocks until (equal (nth 1 block) (nth 1 this-block)) collect block into before-blocks finally return (cons before-blocks (nthcdr (1+ (length before-blocks)) all-blocks)))) (when (or (car extra-blocks) (cdr extra-blocks)) (save-excursion ;; TODO: Handle :padlines, :shebang ;; Code blocks before the current one (cl-loop initially do (progn (goto-char (point-min)) (when (car extra-blocks) (insert "\n") (backward-char 1))) for block in (car extra-blocks) for code = (propertize (concat "\n" (nth 6 block) (propertize "\n" 'rear-nonsticky t)) 'read-only t 'font-lock-face 'org-src-context-read-only) do (insert code)) (setq-local org-src-context--before-block-marker (point-marker)) (set-marker-insertion-type org-src-context--before-block-marker nil) (setq-local org-src-context--after-block-marker (point-max-marker)) (set-marker-insertion-type org-src-context--after-block-marker nil) ;; Code blocks after the current one (cl-loop initially do (goto-char (point-max)) for block in (cdr extra-blocks) for code = (propertize (concat "\n" (nth 6 block) (propertize "\n" 'rear-nonsticky t)) 'read-only t 'font-lock-face 'org-src-context-read-only) do (insert code)) (when org-src-context-narrow-p (narrow-to-region (marker-position org-src-context--before-block-marker) (marker-position org-src-context--after-block-marker))))) (org-src-context--connect-maybe info tangle-file)) ;; No tangle file, don't do anything (apply orig-fn args))) (defun org-src-context--exit-src-ad () "Format `org-src-mode' buffers before updating the associated Org buffer." (when-let ((markerp org-src-context--before-block-marker) (markerp org-src-context--after-block-marker) (beg (marker-position org-src-context--before-block-marker)) (end (marker-position org-src-context--after-block-marker)) (inhibit-read-only t)) (when org-src-context-narrow-p (widen)) (delete-region end (point-max)) (delete-region (point-min) beg))) (defun org-src-context--lsp-connect () "Connect to an LSP server managing the current buffer's file." (when-let (((fboundp 'eglot-current-server)) (current-server (eglot-current-server))) (eglot--maybe-activate-editing-mode))) (defun org-src-context--connect-maybe (info tangle-file) "Prepare org source block buffer for an LSP connection" (when tangle-file ;; Handle directory paths in tangle-file (let* ((fnd (file-name-directory tangle-file)) (mkdirp (thread-last info caddr (alist-get :mkdirp))) ;;`file-name-concat' is emacs 28.1+ only (fnd-absolute (concat (temporary-file-directory) (or fnd "")))) (cond ((not fnd) t) ((file-directory-p fnd-absolute) t) ((and fnd (and (stringp mkdirp) (string= (downcase mkdirp) "yes"))) (make-directory fnd-absolute 'parents)) (t (user-error (format "Cannot create directory \"%s\", please use the :mkdirp header arg." fnd)))) (setq buffer-file-name (concat (temporary-file-directory) tangle-file)) (org-src-context--lsp-connect)))) (define-minor-mode org-src-context-mode "Toggle Org-Src-Context mode. When turned on, you can start persistent LSP connections using Eglot in org-src buffers. To inform the Language Server about files corresponding to code blocks to track, use `:tangle' headers with code blocks. LSP support is limited to the current file being edited." :global t :lighter nil :group 'org-src-context (if org-src-context-mode (progn (advice-add 'org-edit-src-code :around #'org-src-context--edit-src-ad) (advice-add 'org-edit-src-exit :before #'org-src-context--exit-src-ad)) (advice-remove 'org-edit-src-code #'org-src-context--edit-src-ad) (advice-remove 'org-edit-src-exit #'org-src-context--exit-src-ad))) (provide 'org-src-context) ;;; org-src-context.el ends here