From 2798a292d293f1d0aeed34bd0014c6bb97079491 Mon Sep 17 00:00:00 2001 From: Karthik Chikmagalur Date: Fri, 7 Oct 2022 21:14:42 -0700 Subject: [PATCH] Add org-src-context.el --- etc/ORG-NEWS | 27 ++++++ lisp/org-src-context.el | 186 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 213 insertions(+) create mode 100644 lisp/org-src-context.el diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 34ec099..97f28c3 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -314,6 +314,15 @@ This provides a proper counterpart to ~org-babel-pre-tangle-hook~, as per-tangle-destination. ~org-babel-tangle-finished-hook~ is just run once after the post tangle hooks. +*** Support for Eglot in =org-src-mode= buffers via new minor-mode =org-src-context-mode= + +Turning on =org-src-context-mode= will allow connecting to LSP servers +using Eglot from =org-src= buffers. Enabling this requires setting +the =:tangle= header argument on the code block being edited with +=org-edit-special=, as well as other code blocks that are intended to +be part of the same file. The =:tangle= headers indicate which code +blocks are visible to the Language Server, no actual tangling is +carried out by =org-src-context-mode=. ** New options *** New custom settings =org-icalendar-scheduled-summary-prefix= and =org-icalendar-deadline-summary-prefix= @@ -350,6 +359,13 @@ The folding state can also be controlled on per-file basis using The new setting, when set to non-nil, makes Org create alarm at the event time when the alarm time is set to 0. The default value is nil -- do not create alarms at the event time. +*** New custom setting ~org-src-context-narrow-p~ + +This setting applies when =org-src-context-mode= is turned on. When +set to nil, Org will display all the code blocks corresponding to the +=:tangle= header argument of the code block currently being edited in +=org-src-mode=. Only the contents of the current code block are +editable, the rest of the buffer is marked read-only. ** New functions and changes in function arguments *** ~org-fold-show-entry~ does not fold drawers by default anymore @@ -418,6 +434,17 @@ Previously, executing PlantUML src blocks always exported to a file. Now, if :results is set to a value which does not include "file", no file will be exported and an ASCII graph will be inserted below the src block. +*** New function ~org-src-context--connect-maybe~ + +This function prepares =org-src-mode= buffers for LSP connections via +Eglot. + +*** New function ~org-src-context--lsp-connect~ + +This function connects to an LSP server managing the current +=org-src-mode= buffer using Eglot if one is found. This is intended +for use with =org-src-context-mode=. + ** Removed or renamed functions and variables *** =org-plantump-executable-args= is renamed and applies to jar as well diff --git a/lisp/org-src-context.el b/lisp/org-src-context.el new file mode 100644 index 0000000..1c5c358 --- /dev/null +++ b/lisp/org-src-context.el @@ -0,0 +1,186 @@ +;;; 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 + -- 2.37.2