└── org-src-context.el /org-src-context.el: -------------------------------------------------------------------------------- 1 | ;;; org-src-context.el --- LSP support for org-src buffers -*- lexical-binding: t; -*- 2 | 3 | ;; Copyright (C) 2022 Free Software Foundation, Inc. 4 | 5 | ;; Author: Karthik Chikmagalur 6 | ;; Keywords: tools, languages, extensions 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file contains the code dealing with Language Server Protocol support via 24 | ;; other packages in Org Source buffers. 25 | 26 | ;;; Code: 27 | 28 | (require 'org) 29 | (require 'ob) 30 | (require 'ob-tangle) 31 | (require 'org-src) 32 | (require 'cl-lib) 33 | 34 | (declare-function eglot--maybe-activate-editing-mode "eglot") 35 | (declare-function lsp-deferred "lsp-mode") 36 | 37 | (defgroup org-src-context nil 38 | "Provides LSP support in org-src buffers." 39 | :group 'org) 40 | 41 | (defcustom org-src-context-narrow-p nil 42 | "Whether org-src buffers should be narrowed to the code block 43 | with Eglot enabled." 44 | :type 'boolean 45 | :group 'org-src-context) 46 | 47 | (defcustom org-src-context-lsp-command #'eglot--maybe-activate-editing-mode 48 | "LSP integration backend for org-src-context. 49 | 50 | Choose between Eglot and LSP-mode." 51 | :type '(choice 52 | (function-item :tag "Eglot" eglot--maybe-activate-editing-mode) 53 | (function-item :tag "Lsp-mode" lsp-deferred)) 54 | :group 'org-src-context) 55 | 56 | (defface org-src-context-read-only 57 | '((((class color) (min-colors 257) (background light)) 58 | :background "#ffeeee" :extend t) 59 | (((class color) (min-colors 88) (background light)) 60 | :background "#ffdddd" :extend t) 61 | (((class color) (min-colors 88) (background dark)) 62 | :background "#553333" :extend t)) 63 | "Face for read-only sections of org-src buffer" 64 | :group 'org-src-context) 65 | 66 | (defvar-local org-src-context--before-block-marker nil) 67 | (defvar-local org-src-context--after-block-marker nil) 68 | 69 | (defun org-src-context--edit-src-ad (orig-fn &rest args) 70 | (if-let* ((info (org-babel-get-src-block-info 'light)) 71 | (lang (car info)) 72 | (this-block-data 73 | (save-excursion 74 | (goto-char 75 | (org-element-property :post-affiliated (org-element-at-point))) 76 | (car (org-babel-tangle-single-block 1 t)))) 77 | (tangle-file (car this-block-data)) 78 | (this-block (cadr this-block-data)) 79 | (all-blocks (cdar (org-babel-tangle-collect-blocks 80 | lang (alist-get :tangle (caddr info))))) 81 | (extra-blocks (list nil))) 82 | 83 | (prog1 (apply orig-fn args) 84 | (setq extra-blocks 85 | (cl-loop for block in all-blocks 86 | until (equal (nth 1 block) (nth 1 this-block)) 87 | collect block into before-blocks 88 | finally return 89 | (cons before-blocks (nthcdr (1+ (length before-blocks)) 90 | all-blocks)))) 91 | 92 | (when (or (car extra-blocks) (cdr extra-blocks)) 93 | (setq-local org-src-context--before-block-marker (point-min-marker)) 94 | (set-marker-insertion-type org-src-context--before-block-marker t) 95 | (setq-local org-src-context--after-block-marker (point-max-marker)) 96 | (set-marker-insertion-type org-src-context--after-block-marker nil) 97 | ;; TODO: Handle :padlines, :shebang 98 | ;; Code blocks before the current one 99 | (cl-loop initially do 100 | (progn (goto-char (marker-position org-src-context--before-block-marker)) 101 | (when (car extra-blocks) (insert "\n") (backward-char 1))) 102 | for block in (car extra-blocks) 103 | for code = (propertize (concat "\n" (nth 6 block) 104 | (propertize "\n" 'rear-nonsticky t)) 105 | 'read-only t 106 | 'font-lock-face 'org-src-context-read-only) 107 | do (insert code)) 108 | 109 | (set-marker-insertion-type org-src-context--before-block-marker nil) 110 | 111 | ;; Code blocks after the current one 112 | (cl-loop initially do (goto-char (marker-position org-src-context--after-block-marker)) 113 | for block in (cdr extra-blocks) 114 | 115 | for code = (propertize (concat "\n" (nth 6 block) 116 | (propertize "\n" 'rear-nonsticky t)) 117 | 'read-only t 118 | 'font-lock-face 'org-src-context-read-only) 119 | do (insert code)) 120 | 121 | (when org-src-context-narrow-p 122 | (narrow-to-region (marker-position org-src-context--before-block-marker) 123 | (marker-position org-src-context--after-block-marker))) 124 | 125 | (goto-char (marker-position org-src-context--before-block-marker)) 126 | (set-window-start (selected-window) 127 | (marker-position org-src-context--before-block-marker))) 128 | 129 | (org-src-context--connect-maybe info tangle-file)) 130 | 131 | ;; No tangle file, don't do anything 132 | (apply orig-fn args))) 133 | 134 | (defun org-src-context--exit-src-ad () 135 | (when-let ((markerp org-src-context--before-block-marker) 136 | (markerp org-src-context--after-block-marker) 137 | (beg (marker-position org-src-context--before-block-marker)) 138 | (end (marker-position org-src-context--after-block-marker)) 139 | (inhibit-read-only t)) 140 | (when org-src-context-narrow-p 141 | (widen)) 142 | (delete-region end (point-max)) 143 | (delete-region (point-min) beg))) 144 | 145 | (defun org-src-context--connect-maybe (info tangle-file) 146 | "Prepare org source block buffer for an LSP connection" 147 | (when tangle-file 148 | ;; Handle directory paths in tangle-file 149 | (let* ((fnd (file-name-directory tangle-file)) 150 | (mkdirp (thread-last info caddr (alist-get :mkdirp))) 151 | ;;`file-name-concat' is emacs 28.1+ only 152 | (fnd-absolute (concat (temporary-file-directory) (or fnd "")))) 153 | (cond 154 | ((not fnd) t) 155 | ((file-directory-p fnd-absolute) t) 156 | ((and fnd (and (stringp mkdirp) (string= (downcase mkdirp) "yes"))) 157 | (make-directory fnd-absolute 'parents)) 158 | (t (user-error 159 | (format "Cannot create directory \"%s\", please use the :mkdirp header arg." fnd)))) 160 | 161 | (setq buffer-file-name (concat (temporary-file-directory) tangle-file)) 162 | (pcase org-src-context-lsp-command 163 | ('eglot--maybe-activate-editing-mode 164 | (require 'eglot) 165 | (when-let ((current-server (eglot-current-server))) 166 | (funcall org-src-context-lsp-command))) 167 | ('lsp-deferred (funcall org-src-context-lsp-command)))))) 168 | 169 | ;;;###autoload 170 | (define-minor-mode org-src-context-mode 171 | "Toggle Org-Src-Context mode. When turned on, you can start persistent 172 | LSP connections using Eglot in org-src buffers. 173 | 174 | To inform the Language Server about files corresponding to code 175 | blocks to track, use `:tangle' headers with code blocks. LSP 176 | support is limited to the current file being edited." 177 | :global t 178 | :lighter nil 179 | :group 'org-src-context 180 | (if org-src-context-mode 181 | (progn 182 | (advice-add 'org-edit-src-code :around #'org-src-context--edit-src-ad) 183 | (advice-add 'org-edit-src-exit :before #'org-src-context--exit-src-ad)) 184 | (advice-remove 'org-edit-src-code #'org-src-context--edit-src-ad) 185 | (advice-remove 'org-edit-src-exit #'org-src-context--exit-src-ad))) 186 | 187 | (provide 'org-src-context) 188 | ;;; org-src-context.el ends here 189 | 190 | --------------------------------------------------------------------------------