org-src.el (57159B)
1 ;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2004-2023 Free Software Foundation, Inc. 4 ;; 5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com> 6 ;; Bastien Guerry <bzg@gnu.org> 7 ;; Dan Davison <davison at stats dot ox dot ac dot uk> 8 ;; Keywords: outlines, hypermedia, calendar, wp 9 ;; URL: https://orgmode.org 10 ;; 11 ;; This file is part of GNU Emacs. 12 ;; 13 ;; GNU Emacs is free software: you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; GNU Emacs is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 26 ;; 27 ;;; Commentary: 28 29 ;; This file contains the code dealing with source code examples in 30 ;; Org mode. 31 32 ;;; Code: 33 34 (require 'org-macs) 35 (org-assert-version) 36 37 (require 'cl-lib) 38 (require 'ob-comint) 39 (require 'org-macs) 40 (require 'org-compat) 41 (require 'org-keys) 42 43 (declare-function org--get-expected-indentation "org" (element contentsp)) 44 (declare-function org-mode "org" ()) 45 (declare-function org--get-expected-indentation "org" (element contentsp)) 46 (declare-function org-fold-region "org-fold" (from to flag &optional spec-or-alias)) 47 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 48 (declare-function org-element-class "org-element" (datum &optional parent)) 49 (declare-function org-element-context "org-element" (&optional element)) 50 (declare-function org-element-lineage "org-element" 51 (blob &optional types with-self)) 52 (declare-function org-element--parse-paired-brackets "org-element" (char)) 53 (declare-function org-element-property "org-element" (property element)) 54 (declare-function org-element-type "org-element" (element)) 55 (declare-function org-footnote-goto-definition "org-footnote" 56 (label &optional location)) 57 58 (defvar org-inhibit-startup) 59 60 (defcustom org-edit-src-turn-on-auto-save nil 61 "Non-nil means turn `auto-save-mode' on when editing a source block. 62 This will save the content of the source code editing buffer into 63 a newly created file, not the base buffer for this source block. 64 65 If you want to regularly save the base buffer instead of the source 66 code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." 67 :group 'org-edit-structure 68 :version "24.4" 69 :package-version '(Org . "8.0") 70 :type 'boolean) 71 72 (defcustom org-edit-src-auto-save-idle-delay 0 73 "Delay before saving a source code buffer back into its base buffer. 74 When a positive integer N, save after N seconds of idle time. 75 When 0 (the default), don't auto-save. 76 77 If you want to save the source code buffer itself, don't use this. 78 Check `org-edit-src-turn-on-auto-save' instead." 79 :group 'org-edit-structure 80 :version "24.4" 81 :package-version '(Org . "8.0") 82 :type 'integer) 83 84 (defcustom org-coderef-label-format "(ref:%s)" 85 "The default coderef format. 86 This format string will be used to search for coderef labels in literal 87 examples (EXAMPLE and SRC blocks). The format can be overwritten in 88 an individual literal example with the -l option, like 89 90 #+BEGIN_SRC pascal +n -r -l \"((%s))\" 91 ... 92 #+END_SRC 93 94 If you want to use this for HTML export, make sure that the format does 95 not introduce special font-locking, and avoid the HTML special 96 characters `<', `>', and `&'. The reason for this restriction is that 97 the labels are searched for only after htmlize has done its job." 98 :group 'org-edit-structure ; FIXME this is not in the right group 99 :type 'string) 100 101 (defcustom org-edit-fixed-width-region-mode 'artist-mode 102 "The mode that should be used to edit fixed-width regions. 103 These are the regions where each line starts with a colon." 104 :group 'org-edit-structure 105 :type '(choice 106 (const artist-mode) 107 (const picture-mode) 108 (const fundamental-mode) 109 (function :tag "Other (specify)"))) 110 111 (defcustom org-src-preserve-indentation nil 112 "If non-nil preserve leading whitespace characters on export. 113 \\<org-mode-map> 114 If non-nil leading whitespace characters in source code blocks 115 are preserved on export, and when switching between the org 116 buffer and the language mode edit buffer. 117 118 When this variable is nil, after editing with `\\[org-edit-src-code]', 119 the minimum (across-lines) number of leading whitespace characters 120 are removed from all lines, and the code block is uniformly indented 121 according to the value of `org-edit-src-content-indentation'." 122 :group 'org-edit-structure 123 :type 'boolean) 124 125 (defcustom org-edit-src-content-indentation 2 126 "Indentation for the content of a source code block. 127 128 This should be the number of spaces added to the indentation of the #+begin 129 line in order to compute the indentation of the block content after 130 editing it with `\\[org-edit-src-code]'. 131 132 It has no effect if `org-src-preserve-indentation' is non-nil." 133 :group 'org-edit-structure 134 :type 'integer 135 :safe #'wholenump) 136 137 (defcustom org-edit-src-persistent-message t 138 "Non-nil means show persistent exit help message while editing src examples. 139 The message is shown in the header-line, which will be created in the 140 first line of the window showing the editing buffer." 141 :group 'org-edit-structure 142 :type 'boolean) 143 144 (defcustom org-src-ask-before-returning-to-edit-buffer t 145 "Non-nil means ask before switching to an existing edit buffer. 146 If nil, when `org-edit-src-code' is used on a block that already 147 has an active edit buffer, it will switch to that edit buffer 148 immediately; otherwise it will ask whether you want to return to 149 the existing edit buffer." 150 :group 'org-edit-structure 151 :version "24.4" 152 :package-version '(Org . "8.0") 153 :type 'boolean) 154 155 (defcustom org-src-window-setup 'reorganize-frame 156 "How the source code edit buffer should be displayed. 157 Possible values for this option are: 158 159 plain Show edit buffer using `display-buffer'. Users can 160 further control the display behavior by modifying 161 `display-buffer-alist' and its relatives. 162 current-window Show edit buffer in the current window, keeping all other 163 windows. 164 split-window-below Show edit buffer below the current window, keeping all 165 other windows. 166 split-window-right Show edit buffer to the right of the current window, 167 keeping all other windows. 168 other-window Use `switch-to-buffer-other-window' to display edit buffer. 169 reorganize-frame Show only two windows on the current frame, the current 170 window and the edit buffer. 171 other-frame Use `switch-to-buffer-other-frame' to display edit buffer. 172 Also, when exiting the edit buffer, kill that frame. 173 174 Values that modify the window layout (reorganize-frame, split-window-below, 175 split-window-right) will restore the layout after exiting the edit buffer." 176 :group 'org-edit-structure 177 :type '(choice 178 (const plain) 179 (const current-window) 180 (const split-window-below) 181 (const split-window-right) 182 (const other-frame) 183 (const other-window) 184 (const reorganize-frame))) 185 186 (defvar org-src-mode-hook nil 187 "Hook run after Org switched a source code snippet to its Emacs mode. 188 \\<org-mode-map> 189 This hook will run: 190 - when editing a source code snippet with `\\[org-edit-special]' 191 - when formatting a source code snippet for export with htmlize. 192 193 You may want to use this hook for example to turn off `outline-minor-mode' 194 or similar things which you want to have when editing a source code file, 195 but which mess up the display of a snippet in Org exported files.") 196 197 (defcustom org-src-lang-modes 198 '(("C" . c) 199 ("C++" . c++) 200 ("asymptote" . asy) 201 ("bash" . sh) 202 ("beamer" . latex) 203 ("calc" . fundamental) 204 ("cpp" . c++) 205 ("ditaa" . artist) 206 ("desktop" . conf-desktop) 207 ("dot" . fundamental) 208 ("elisp" . emacs-lisp) 209 ("ocaml" . tuareg) 210 ("screen" . shell-script) 211 ("shell" . sh) 212 ("sqlite" . sql) 213 ("toml" . conf-toml)) 214 "Alist mapping languages to their major mode. 215 216 The key is the language name. The value is the mode name, as 217 a string or a symbol, without the \"-mode\" suffix. 218 219 For many languages this is simple, but for language where this is 220 not the case, this variable provides a way to simplify things on 221 the user side. For example, there is no `ocaml-mode' in Emacs, 222 but the mode to use is `tuareg-mode'." 223 :group 'org-edit-structure 224 :package-version '(Org . "9.6") 225 :type '(repeat 226 (cons 227 (string "Language name") 228 (symbol "Major mode")))) 229 230 (defcustom org-src-block-faces nil 231 "Alist of faces to be used for source-block. 232 Each element is a cell of the format 233 234 (\"language\" FACE) 235 236 Where FACE is either a defined face or an anonymous face. 237 238 For instance, the following would color the background of 239 emacs-lisp source blocks and python source blocks in purple and 240 green, respectability. 241 242 (setq org-src-block-faces 243 \\='((\"emacs-lisp\" (:background \"#EEE2FF\")) 244 (\"python\" (:background \"#e5ffb8\"))))" 245 :group 'org-edit-structure 246 :type '(repeat (list (string :tag "language") 247 (choice 248 (face :tag "Face") 249 (sexp :tag "Anonymous face")))) 250 :version "26.1" 251 :package-version '(Org . "9.0")) 252 253 (defcustom org-src-tab-acts-natively t 254 "If non-nil, TAB uses the language's major-mode binding in code blocks." 255 :type 'boolean 256 :package-version '(Org . "9.4") 257 :group 'org-babel) 258 259 260 261 ;;; Internal functions and variables 262 263 (defvar org-src--auto-save-timer nil 264 "Idle Timer auto-saving remote editing buffers.") 265 266 (defvar-local org-src--allow-write-back t) 267 (put 'org-src--allow-write-back 'permanent-local t) 268 269 (defvar-local org-src--babel-info nil) 270 (put 'org-src--babel-info 'permanent-local t) 271 272 (defvar-local org-src--beg-marker nil) 273 (put 'org-src--beg-marker 'permanent-local t) 274 275 (defvar-local org-src--block-indentation nil) 276 (put 'org-src--block-indentation 'permanent-local t) 277 278 (defvar-local org-src--content-indentation nil) 279 (put 'org-src--content-indentation 'permanent-local t) 280 281 (defvar-local org-src--end-marker nil) 282 (put 'org-src--end-marker 'permanent-local t) 283 284 (defvar-local org-src--from-org-mode nil) 285 (put 'org-src--from-org-mode 'permanent-local t) 286 287 (defvar-local org-src--overlay nil) 288 (put 'org-src--overlay 'permanent-local t) 289 290 (defvar-local org-src--preserve-indentation nil) 291 (put 'org-src--preserve-indentation 'permanent-local t) 292 293 (defvar-local org-src--remote nil) 294 (put 'org-src--remote 'permanent-local t) 295 296 (defvar-local org-src--saved-temp-window-config nil) 297 (put 'org-src--saved-temp-window-config 'permanent-local t) 298 299 (defvar-local org-src--source-type nil 300 "Type of element being edited, as a symbol.") 301 (put 'org-src--source-type 'permanent-local t) 302 303 (defvar-local org-src--tab-width nil 304 "Contains `tab-width' value from Org source buffer. 305 However, if `indent-tabs-mode' is nil in that buffer, its value 306 is 0.") 307 (put 'org-src--tab-width 'permanent-local t) 308 309 (defvar-local org-src-source-file-name nil 310 "File name associated to Org source buffer, or nil.") 311 (put 'org-src-source-file-name 'permanent-local t) 312 313 (defvar-local org-src--preserve-blank-line nil) 314 (put 'org-src--preserve-blank-line 'permanent-local t) 315 316 (defun org-src--construct-edit-buffer-name (org-buffer-name lang) 317 "Construct the buffer name for a source editing buffer. 318 Format is \"*Org Src ORG-BUFFER-NAME [ LANG ]*\"." 319 (concat "*Org Src " org-buffer-name "[ " lang " ]*")) 320 321 (defun org-src--edit-buffer (beg end) 322 "Return buffer editing area between BEG and END. 323 Return nil if there is no such buffer." 324 (catch 'exit 325 (dolist (b (buffer-list)) 326 (with-current-buffer b 327 (and (org-src-edit-buffer-p) 328 (= beg org-src--beg-marker) 329 (eq (marker-buffer beg) (marker-buffer org-src--beg-marker)) 330 (= end org-src--end-marker) 331 (eq (marker-buffer end) (marker-buffer org-src--end-marker)) 332 (throw 'exit b)))))) 333 334 (defun org-src--coordinates (pos beg end) 335 "Return coordinates of POS relatively to BEG and END. 336 POS, BEG and END are buffer positions. Return value is either 337 a cons cell (LINE . COLUMN) or symbol `end'. See also 338 `org-src--goto-coordinates'." 339 (if (>= pos end) 'end 340 (org-with-wide-buffer 341 (goto-char (max beg pos)) 342 (cons (count-lines (save-excursion (goto-char beg) (line-beginning-position)) 343 (line-beginning-position)) 344 ;; Column is relative to the end of line to avoid problems of 345 ;; comma escaping or colons appended in front of the line. 346 (- (point) (min end (line-end-position))))))) 347 348 (defun org-src--goto-coordinates (coord beg end) 349 "Move to coordinates COORD relatively to BEG and END. 350 COORD are coordinates, as returned by `org-src--coordinates', 351 which see. BEG and END are buffer positions." 352 (goto-char 353 (if (eq coord 'end) (max (1- end) beg) 354 ;; If BEG happens to be located outside of the narrowed part of 355 ;; the buffer, widen it first. 356 (org-with-wide-buffer 357 (goto-char beg) 358 (forward-line (car coord)) 359 (max (point) 360 (+ (min end (line-end-position)) 361 (cdr coord))))))) 362 363 (defun org-src--contents-area (datum) 364 "Return contents boundaries of DATUM. 365 DATUM is an element or object. Return a list (BEG END CONTENTS) 366 where BEG and END are buffer positions and CONTENTS is a string." 367 (let ((type (org-element-type datum))) 368 (org-with-wide-buffer 369 (cond 370 ((eq type 'footnote-definition) 371 (let* ((beg (progn 372 (goto-char (org-element-property :post-affiliated datum)) 373 (search-forward "]"))) 374 (end (or (org-element-property :contents-end datum) beg))) 375 (list beg end (buffer-substring-no-properties beg end)))) 376 ((eq type 'inline-src-block) 377 (let ((beg (progn (goto-char (org-element-property :begin datum)) 378 (search-forward "{" (line-end-position) t))) 379 (end (progn (goto-char (org-element-property :end datum)) 380 (search-backward "}" (line-beginning-position) t)))) 381 (list beg end (buffer-substring-no-properties beg end)))) 382 ((eq type 'latex-fragment) 383 (let ((beg (org-element-property :begin datum)) 384 (end (org-with-point-at (org-element-property :end datum) 385 (skip-chars-backward " \t") 386 (point)))) 387 (list beg end (buffer-substring-no-properties beg end)))) 388 ((org-element-property :contents-begin datum) 389 (let ((beg (org-element-property :contents-begin datum)) 390 (end (org-element-property :contents-end datum))) 391 (list beg end (buffer-substring-no-properties beg end)))) 392 ((memq type '(example-block export-block src-block comment-block)) 393 (list (progn (goto-char (org-element-property :post-affiliated datum)) 394 (line-beginning-position 2)) 395 (progn (goto-char (org-element-property :end datum)) 396 (skip-chars-backward " \r\t\n") 397 (line-beginning-position 1)) 398 (org-element-property :value datum))) 399 ((memq type '(fixed-width latex-environment table)) 400 (let ((beg (org-element-property :post-affiliated datum)) 401 (end (progn (goto-char (org-element-property :end datum)) 402 (skip-chars-backward " \r\t\n") 403 (line-beginning-position 2)))) 404 (list beg 405 end 406 (if (eq type 'fixed-width) (org-element-property :value datum) 407 (buffer-substring-no-properties beg end))))) 408 (t (error "Unsupported element or object: %s" type)))))) 409 410 (defun org-src--make-source-overlay (beg end edit-buffer) 411 "Create overlay between BEG and END positions and return it. 412 EDIT-BUFFER is the buffer currently editing area between BEG and 413 END." 414 (let ((overlay (make-overlay beg end))) 415 (overlay-put overlay 'face 'secondary-selection) 416 (overlay-put overlay 'edit-buffer edit-buffer) 417 (overlay-put overlay 'help-echo 418 "Click with mouse-1 to switch to buffer editing this segment") 419 (overlay-put overlay 'face 'secondary-selection) 420 (overlay-put overlay 'keymap 421 (let ((map (make-sparse-keymap))) 422 (define-key map [mouse-1] 'org-edit-src-continue) 423 map)) 424 (let ((read-only 425 (list 426 (lambda (&rest _) 427 (user-error 428 "Cannot modify an area being edited in a dedicated buffer"))))) 429 (overlay-put overlay 'modification-hooks read-only) 430 (overlay-put overlay 'insert-in-front-hooks read-only) 431 (overlay-put overlay 'insert-behind-hooks read-only)) 432 overlay)) 433 434 (defun org-src--remove-overlay () 435 "Remove overlay from current source buffer." 436 (when (overlayp org-src--overlay) (delete-overlay org-src--overlay))) 437 438 (defun org-src--on-datum-p (datum) 439 "Non-nil when point is on DATUM. 440 DATUM is an element or an object. Consider blank lines or white 441 spaces after it as being outside." 442 (and (>= (point) (org-element-property :begin datum)) 443 (<= (point) 444 (org-with-wide-buffer 445 (goto-char (org-element-property :end datum)) 446 (skip-chars-backward " \r\t\n") 447 (if (eq (org-element-class datum) 'element) 448 (line-end-position) 449 (point)))))) 450 451 (defun org-src--contents-for-write-back (write-back-buf) 452 "Populate WRITE-BACK-BUF with contents in the appropriate format. 453 Assume point is in the corresponding edit buffer." 454 (let ((indentation-offset 455 (if org-src--preserve-indentation 0 456 (+ (or org-src--block-indentation 0) 457 (if (memq org-src--source-type '(example-block src-block)) 458 org-src--content-indentation 459 0)))) 460 (use-tabs? (and (> org-src--tab-width 0) t)) 461 (preserve-fl (eq org-src--source-type 'latex-fragment)) 462 (source-tab-width org-src--tab-width) 463 (contents (org-with-wide-buffer 464 (let ((eol (line-end-position))) 465 (list (buffer-substring (point-min) eol) 466 (buffer-substring eol (point-max)))))) 467 (write-back org-src--allow-write-back) 468 (preserve-blank-line org-src--preserve-blank-line) 469 marker) 470 (with-current-buffer write-back-buf 471 ;; Reproduce indentation parameters from source buffer. 472 (setq indent-tabs-mode use-tabs?) 473 (when (> source-tab-width 0) (setq tab-width source-tab-width)) 474 ;; Apply WRITE-BACK function on edit buffer contents. 475 (insert (org-no-properties (car contents))) 476 (setq marker (point-marker)) 477 (insert (org-no-properties (car (cdr contents)))) 478 (goto-char (point-min)) 479 (when (functionp write-back) (save-excursion (funcall write-back))) 480 ;; Add INDENTATION-OFFSET to every line in buffer, 481 ;; unless indentation is meant to be preserved. 482 (when (> indentation-offset 0) 483 (when preserve-fl (forward-line)) 484 (while (not (eobp)) 485 (skip-chars-forward " \t") 486 (when (or (not (eolp)) ; not a blank line 487 (and (eq (point) (marker-position marker)) ; current line 488 preserve-blank-line)) 489 (let ((i (current-column))) 490 (delete-region (line-beginning-position) (point)) 491 (indent-to (+ i indentation-offset)))) 492 (forward-line))) 493 (set-marker marker nil)))) 494 495 (defun org-src--edit-element 496 (datum name &optional initialize write-back contents remote) 497 "Edit DATUM contents in a dedicated buffer NAME. 498 499 INITIALIZE is a function to call upon creating the buffer. 500 501 When WRITE-BACK is non-nil, assume contents will replace original 502 region. Moreover, if it is a function, apply it in the edit 503 buffer, from point min, before returning the contents. 504 505 When CONTENTS is non-nil, display them in the edit buffer. 506 Otherwise, show DATUM contents as specified by 507 `org-src--contents-area'. 508 509 When REMOTE is non-nil, do not try to preserve point or mark when 510 moving from the edit area to the source. 511 512 Leave point in edit buffer." 513 (when (memq org-src-window-setup '(reorganize-frame 514 split-window-below 515 split-window-right)) 516 (setq org-src--saved-temp-window-config (current-window-configuration))) 517 (let* ((area (org-src--contents-area datum)) 518 (beg (copy-marker (nth 0 area))) 519 (end (copy-marker (nth 1 area) t)) 520 (old-edit-buffer (org-src--edit-buffer beg end)) 521 (contents (or contents (nth 2 area)))) 522 (if (and old-edit-buffer 523 (or (not org-src-ask-before-returning-to-edit-buffer) 524 (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))) 525 ;; Move to existing buffer. 526 (org-src-switch-to-buffer old-edit-buffer 'return) 527 ;; Discard old edit buffer. 528 (when old-edit-buffer 529 (with-current-buffer old-edit-buffer (org-src--remove-overlay)) 530 (kill-buffer old-edit-buffer)) 531 (let* ((org-mode-p (derived-mode-p 'org-mode)) 532 (source-file-name (buffer-file-name (buffer-base-buffer))) 533 (source-tab-width (if indent-tabs-mode tab-width 0)) 534 (type (org-element-type datum)) 535 (block-ind (org-with-point-at (org-element-property :begin datum) 536 (cond 537 ((save-excursion (skip-chars-backward " \t") (bolp)) 538 (org-current-text-indentation)) 539 ((org-element-property :parent datum) 540 (org--get-expected-indentation 541 (org-element-property :parent datum) nil)) 542 (t (org-current-text-indentation))))) 543 (content-ind org-edit-src-content-indentation) 544 (blank-line (save-excursion (beginning-of-line) 545 (looking-at-p "^[[:space:]]*$"))) 546 (empty-line (and blank-line (looking-at-p "^$"))) 547 (preserve-blank-line (or (and blank-line (not empty-line)) 548 (and empty-line (= (+ block-ind content-ind) 0)))) 549 (preserve-ind 550 (and (memq type '(example-block src-block)) 551 (or (org-element-property :preserve-indent datum) 552 org-src-preserve-indentation))) 553 ;; Store relative positions of mark (if any) and point 554 ;; within the edited area. 555 (point-coordinates (and (not remote) 556 (org-src--coordinates (point) beg end))) 557 (mark-coordinates (and (not remote) 558 (org-region-active-p) 559 (let ((m (mark))) 560 (and (>= m beg) (>= end m) 561 (org-src--coordinates m beg end))))) 562 ;; Generate a new edit buffer. 563 (buffer (generate-new-buffer name)) 564 ;; Add an overlay on top of source. 565 (overlay (org-src--make-source-overlay beg end buffer))) 566 ;; Switch to edit buffer. 567 (org-src-switch-to-buffer buffer 'edit) 568 ;; Insert contents. 569 (insert contents) 570 (remove-text-properties (point-min) (point-max) 571 '(display nil invisible nil intangible nil)) 572 (let ((lf (eq type 'latex-fragment))) 573 (unless preserve-ind (org-do-remove-indentation (and lf block-ind) lf))) 574 (set-buffer-modified-p nil) 575 (setq buffer-file-name nil) 576 ;; Initialize buffer. 577 (when (functionp initialize) 578 (let ((org-inhibit-startup t)) 579 (condition-case e 580 (funcall initialize) 581 (error (message "Initialization fails with: %S" 582 (error-message-string e)))))) 583 ;; Transmit buffer-local variables for exit function. It must 584 ;; be done after initializing major mode, as this operation 585 ;; may reset them otherwise. 586 (setq org-src--tab-width source-tab-width) 587 (setq org-src--from-org-mode org-mode-p) 588 (setq org-src--beg-marker beg) 589 (setq org-src--end-marker end) 590 (setq org-src--remote remote) 591 (setq org-src--source-type type) 592 (setq org-src--block-indentation block-ind) 593 (setq org-src--content-indentation content-ind) 594 (setq org-src--preserve-indentation preserve-ind) 595 (setq org-src--overlay overlay) 596 (setq org-src--allow-write-back write-back) 597 (setq org-src-source-file-name source-file-name) 598 (setq org-src--preserve-blank-line preserve-blank-line) 599 ;; Start minor mode. 600 (org-src-mode) 601 ;; Clear undo information so we cannot undo back to the 602 ;; initial empty buffer. 603 (buffer-disable-undo (current-buffer)) 604 (buffer-enable-undo) 605 ;; Move mark and point in edit buffer to the corresponding 606 ;; location. 607 (if remote 608 (progn 609 ;; Put point at first non read-only character after 610 ;; leading blank. 611 (goto-char 612 (or (text-property-any (point-min) (point-max) 'read-only nil) 613 (point-max))) 614 (skip-chars-forward " \r\t\n")) 615 ;; Set mark and point. 616 (when mark-coordinates 617 (org-src--goto-coordinates mark-coordinates (point-min) (point-max)) 618 (push-mark (point) 'no-message t) 619 (setq deactivate-mark nil)) 620 (org-src--goto-coordinates 621 point-coordinates (point-min) (point-max))))))) 622 623 624 625 ;;; Fontification of source blocks 626 627 (defvar org-src-fontify-natively) ; Defined in org.el 628 (defun org-src-font-lock-fontify-block (lang start end) 629 "Fontify code block between START and END using LANG's syntax. 630 This function is called by Emacs' automatic fontification, as long 631 as `org-src-fontify-natively' is non-nil." 632 (let ((modified (buffer-modified-p))) 633 (remove-text-properties start end '(face nil)) 634 (let ((lang-mode (org-src-get-lang-mode lang))) 635 (when (fboundp lang-mode) 636 (let ((string (buffer-substring-no-properties start end)) 637 (org-buffer (current-buffer))) 638 (with-current-buffer 639 (get-buffer-create 640 (format " *org-src-fontification:%s*" lang-mode)) 641 (let ((inhibit-modification-hooks nil)) 642 (erase-buffer) 643 ;; Add string and a final space to ensure property change. 644 (insert string " ")) 645 (unless (eq major-mode lang-mode) (funcall lang-mode)) 646 (font-lock-ensure) 647 (let ((pos (point-min)) next) 648 (while (setq next (next-property-change pos)) 649 ;; Handle additional properties from font-lock, so as to 650 ;; preserve, e.g., composition. 651 ;; FIXME: We copy 'font-lock-face property explicitly because 652 ;; `font-lock-mode' is not enabled in the buffers starting from 653 ;; space and the remapping between 'font-lock-face and 'face 654 ;; text properties may thus not be set. See commit 655 ;; 453d634bc. 656 (dolist (prop (append '(font-lock-face face) font-lock-extra-managed-props)) 657 (let ((new-prop (get-text-property pos prop))) 658 (when new-prop 659 (if (not (eq prop 'invisible)) 660 (put-text-property 661 (+ start (1- pos)) (1- (+ start next)) prop new-prop 662 org-buffer) 663 ;; Special case. `invisible' text property may 664 ;; clash with Org folding. Do not assign 665 ;; `invisible' text property directly. Use 666 ;; property alias instead. 667 (let ((invisibility-spec 668 (or 669 ;; ATOM spec. 670 (and (memq new-prop buffer-invisibility-spec) 671 new-prop) 672 ;; (ATOM . ELLIPSIS) spec. 673 (assq new-prop buffer-invisibility-spec)))) 674 (with-current-buffer org-buffer 675 ;; Add new property alias. 676 (unless (memq 'org-src-invisible 677 (cdr (assq 'invisible char-property-alias-alist))) 678 (setq-local 679 char-property-alias-alist 680 (cons (cons 'invisible 681 (nconc (cdr (assq 'invisible char-property-alias-alist)) 682 '(org-src-invisible))) 683 (remove (assq 'invisible char-property-alias-alist) 684 char-property-alias-alist)))) 685 ;; Carry over the invisibility spec, unless 686 ;; already present. Note that there might 687 ;; be conflicting invisibility specs from 688 ;; different major modes. We cannot do much 689 ;; about this then. 690 (when invisibility-spec 691 (add-to-invisibility-spec invisibility-spec)) 692 (put-text-property 693 (+ start (1- pos)) (1- (+ start next)) 694 'org-src-invisible new-prop 695 org-buffer))))))) 696 (setq pos next))) 697 (set-buffer-modified-p nil))))) 698 ;; Add Org faces. 699 (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t)))) 700 (when (or (facep src-face) (listp src-face)) 701 (font-lock-append-text-property start end 'face src-face)) 702 (font-lock-append-text-property start end 'face 'org-block)) 703 ;; Clear abbreviated link folding. 704 (org-fold-region start end nil 'org-link) 705 (add-text-properties 706 start end 707 '(font-lock-fontified t fontified t font-lock-multiline t)) 708 (set-buffer-modified-p modified))) 709 710 (defun org-fontify-inline-src-blocks (limit) 711 "Try to apply `org-fontify-inline-src-blocks-1'." 712 (condition-case nil 713 (org-fontify-inline-src-blocks-1 limit) 714 (error (message "Org mode fontification error in %S at %d" 715 (current-buffer) 716 (line-number-at-pos))))) 717 718 (defun org-fontify-inline-src-blocks-1 (limit) 719 "Fontify inline src_LANG blocks, from `point' up to LIMIT." 720 (let ((case-fold-search t)) 721 ;; The regexp below is copied from `org-element-inline-src-block-parser'. 722 (while (re-search-forward "\\_<src_\\([^ \t\n[{]+\\)[{[]?" limit t) 723 (let ((beg (match-beginning 0)) 724 (lang-beg (match-beginning 1)) 725 (lang-end (match-end 1)) 726 pt) 727 (font-lock-append-text-property 728 lang-beg lang-end 'face 'org-meta-line) 729 (font-lock-append-text-property 730 beg lang-beg 'face 'shadow) 731 (font-lock-append-text-property 732 beg lang-end 'face 'org-inline-src-block) 733 (setq pt (goto-char lang-end)) 734 ;; `org-element--parse-paired-brackets' doesn't take a limit, so to 735 ;; prevent it searching the entire rest of the buffer we temporarily 736 ;; narrow the active region. 737 (save-restriction 738 (narrow-to-region beg 739 (min limit (or (save-excursion 740 (and (search-forward"\n" limit t 2) 741 (point))) 742 (point-max)))) 743 (when (ignore-errors (org-element--parse-paired-brackets ?\[)) 744 (font-lock-append-text-property 745 pt (point) 'face 'org-inline-src-block) 746 (setq pt (point))) 747 (when (ignore-errors (org-element--parse-paired-brackets ?\{)) 748 (remove-text-properties pt (point) '(face nil)) 749 (font-lock-append-text-property 750 pt (1+ pt) 'face '(org-inline-src-block shadow)) 751 (unless (= (1+ pt) (1- (point))) 752 (if org-src-fontify-natively 753 (org-src-font-lock-fontify-block 754 (buffer-substring-no-properties lang-beg lang-end) 755 (1+ pt) (1- (point))) 756 (font-lock-append-text-property 757 (1+ pt) (1- (point)) 'face 'org-inline-src-block))) 758 (font-lock-append-text-property 759 (1- (point)) (point) 'face '(org-inline-src-block shadow)) 760 (setq pt (point))))) 761 t))) 762 763 764 ;;; Escape contents 765 766 (defun org-escape-code-in-region (beg end) 767 "Escape lines between BEG and END. 768 Escaping happens when a line starts with \"*\", \"#+\", \",*\" or 769 \",#+\" by appending a comma to it." 770 (interactive "r") 771 (save-excursion 772 (goto-char end) 773 (while (re-search-backward "^[ \t]*\\(,*\\(?:\\*\\|#\\+\\)\\)" beg t) 774 (save-excursion (replace-match ",\\1" nil nil nil 1))))) 775 776 (defun org-escape-code-in-string (s) 777 "Escape lines in string S. 778 Escaping happens when a line starts with \"*\", \"#+\", \",*\" or 779 \",#+\" by appending a comma to it." 780 (replace-regexp-in-string "^[ \t]*\\(,*\\(?:\\*\\|#\\+\\)\\)" ",\\1" 781 s nil nil 1)) 782 783 (defun org-unescape-code-in-region (beg end) 784 "Un-escape lines between BEG and END. 785 Un-escaping happens by removing the first comma on lines starting 786 with \",*\", \",#+\", \",,*\" and \",,#+\"." 787 (interactive "r") 788 (save-excursion 789 (goto-char end) 790 (while (re-search-backward "^[ \t]*,*\\(,\\)\\(?:\\*\\|#\\+\\)" beg t) 791 (save-excursion (replace-match "" nil nil nil 1))))) 792 793 (defun org-unescape-code-in-string (s) 794 "Un-escape lines in string S. 795 Un-escaping happens by removing the first comma on lines starting 796 with \",*\", \",#+\", \",,*\" and \",,#+\"." 797 (replace-regexp-in-string 798 "^[ \t]*,*\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1)) 799 800 801 802 ;;; Org src minor mode 803 804 (defvar org-src-mode-map 805 (let ((map (make-sparse-keymap))) 806 (define-key map "\C-c'" 'org-edit-src-exit) 807 (define-key map "\C-c\C-k" 'org-edit-src-abort) 808 (define-key map "\C-x\C-s" 'org-edit-src-save) 809 map)) 810 811 (define-minor-mode org-src-mode 812 "Minor mode for language major mode buffers generated by Org. 813 \\<org-mode-map> 814 This minor mode is turned on in two situations: 815 - when editing a source code snippet with `\\[org-edit-special]' 816 - when formatting a source code snippet for export with htmlize. 817 818 \\{org-src-mode-map} 819 820 See also `org-src-mode-hook'." 821 :lighter " OrgSrc" 822 (when org-edit-src-persistent-message 823 (setq header-line-format 824 (substitute-command-keys 825 (if org-src--allow-write-back 826 "Edit, then exit with `\\[org-edit-src-exit]' or abort with \ 827 `\\[org-edit-src-abort]'" 828 "Exit with `\\[org-edit-src-exit]' or abort with \ 829 `\\[org-edit-src-abort]'")))) 830 ;; Possibly activate various auto-save features (for the edit buffer 831 ;; or the source buffer). 832 (when org-edit-src-turn-on-auto-save 833 (setq buffer-auto-save-file-name 834 (concat (make-temp-name "org-src-") 835 (format-time-string "-%Y-%d-%m") 836 ".txt"))) 837 (unless (or org-src--auto-save-timer 838 (= 0 org-edit-src-auto-save-idle-delay)) 839 (setq org-src--auto-save-timer 840 (run-with-idle-timer 841 org-edit-src-auto-save-idle-delay t 842 (lambda () 843 (save-excursion 844 (let (edit-flag) 845 (dolist (b (buffer-list)) 846 (with-current-buffer b 847 (when (org-src-edit-buffer-p) 848 (unless edit-flag (setq edit-flag t)) 849 (when (buffer-modified-p) (org-edit-src-save))))) 850 (unless edit-flag 851 (cancel-timer org-src--auto-save-timer) 852 (setq org-src--auto-save-timer nil))))))))) 853 854 (defun org-src-mode-configure-edit-buffer () 855 "Configure the src edit buffer." 856 (when (bound-and-true-p org-src--from-org-mode) 857 (add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local) 858 (if (bound-and-true-p org-src--allow-write-back) 859 (progn 860 (setq buffer-offer-save t) 861 (setq write-contents-functions '(org-edit-src-save))) 862 (setq buffer-read-only t)))) 863 864 (add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer) 865 866 867 868 ;;; Babel related functions 869 870 (defun org-src-associate-babel-session (info) 871 "Associate edit buffer with comint session. 872 INFO should be a list similar in format to the return value of 873 `org-babel-get-src-block-info'." 874 (interactive) 875 (let ((session (cdr (assq :session (nth 2 info))))) 876 (and session (not (string= session "none")) 877 (org-babel-comint-buffer-livep session) 878 (let ((f (intern (format "org-babel-%s-associate-session" 879 (nth 0 info))))) 880 (and (fboundp f) (funcall f session)))))) 881 882 (defun org-src-babel-configure-edit-buffer () 883 "Configure src editing buffer." 884 (when org-src--babel-info 885 (org-src-associate-babel-session org-src--babel-info))) 886 887 (add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer) 888 889 890 ;;; Public API 891 892 (defmacro org-src-do-at-code-block (&rest body) 893 "Execute BODY from an edit buffer in the Org mode buffer." 894 (declare (debug (body))) 895 `(let ((beg-marker org-src--beg-marker)) 896 (when beg-marker 897 (with-current-buffer (marker-buffer beg-marker) 898 (goto-char beg-marker) 899 ,@body)))) 900 901 (defun org-src-do-key-sequence-at-code-block (&optional key) 902 "Execute key sequence at code block in the source Org buffer. 903 The command bound to KEY in the Org-babel key map is executed 904 remotely with point temporarily at the start of the code block in 905 the Org buffer. 906 907 This command is not bound to a key by default, to avoid conflicts 908 with language major mode bindings. To bind it to C-c @ in all 909 language major modes, you could use 910 911 (add-hook \\='org-src-mode-hook 912 (lambda () (define-key org-src-mode-map \"\\C-c@\" 913 \\='org-src-do-key-sequence-at-code-block))) 914 915 In that case, for example, C-c @ t issued in code edit buffers 916 would tangle the current Org code block, C-c @ e would execute 917 the block and C-c @ h would display the other available 918 Org-babel commands." 919 (interactive "kOrg-babel key: ") 920 (if (equal key (kbd "C-g")) (keyboard-quit) 921 (org-edit-src-save) 922 (org-src-do-at-code-block 923 (call-interactively (lookup-key org-babel-map key))))) 924 925 (defun org-src-get-lang-mode (lang) 926 "Return major mode that should be used for LANG. 927 LANG is a string, and the returned major mode is a symbol." 928 (intern 929 (concat 930 (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) 931 (if (symbolp l) (symbol-name l) l)) 932 "-mode"))) 933 934 (defun org-src-edit-buffer-p (&optional buffer) 935 "Non-nil when current buffer is a source editing buffer. 936 If BUFFER is non-nil, test it instead." 937 (let ((buffer (org-base-buffer (or buffer (current-buffer))))) 938 (and (buffer-live-p buffer) 939 (local-variable-p 'org-src--beg-marker buffer) 940 (local-variable-p 'org-src--end-marker buffer)))) 941 942 (defun org-src-source-buffer () 943 "Return source buffer edited in current buffer. 944 Raise an error when current buffer is not a source editing buffer." 945 (unless (org-src-edit-buffer-p) (error "Not in a source buffer")) 946 (or (marker-buffer org-src--beg-marker) 947 (error "No source buffer available for current editing session"))) 948 949 (defun org-src-source-type () 950 "Return type of element edited in current buffer. 951 Raise an error when current buffer is not a source editing buffer." 952 (unless (org-src-edit-buffer-p) (error "Not in a source buffer")) 953 org-src--source-type) 954 955 (defun org-src-switch-to-buffer (buffer context) 956 "Switch to BUFFER considering CONTEXT and `org-src-window-setup'." 957 (pcase org-src-window-setup 958 (`plain 959 (when (eq context 'exit) (quit-restore-window)) 960 (pop-to-buffer buffer)) 961 (`current-window (pop-to-buffer-same-window buffer)) 962 (`other-window 963 (let ((cur-win (selected-window))) 964 (org-switch-to-buffer-other-window buffer) 965 (when (eq context 'exit) (quit-restore-window cur-win)))) 966 (`split-window-below 967 (if (eq context 'exit) 968 (delete-window) 969 (select-window (split-window-vertically))) 970 (pop-to-buffer-same-window buffer)) 971 (`split-window-right 972 (if (eq context 'exit) 973 (delete-window) 974 (select-window (split-window-horizontally))) 975 (pop-to-buffer-same-window buffer)) 976 (`other-frame 977 (pcase context 978 (`exit 979 (let ((frame (selected-frame))) 980 (switch-to-buffer-other-frame buffer) 981 (delete-frame frame))) 982 (`save 983 (kill-buffer (current-buffer)) 984 (pop-to-buffer-same-window buffer)) 985 (_ (switch-to-buffer-other-frame buffer)))) 986 (`reorganize-frame 987 (when (eq context 'edit) (delete-other-windows)) 988 (org-switch-to-buffer-other-window buffer) 989 (when (eq context 'exit) (delete-other-windows))) 990 (`switch-invisibly (set-buffer buffer)) 991 (_ 992 (message "Invalid value %s for `org-src-window-setup'" 993 org-src-window-setup) 994 (pop-to-buffer-same-window buffer)))) 995 996 (defun org-src-coderef-format (&optional element) 997 "Return format string for block at point. 998 999 When optional argument ELEMENT is provided, use that block. 1000 Otherwise, assume point is either at a source block, at an 1001 example block. 1002 1003 If point is in an edit buffer, retrieve format string associated 1004 to the remote source block." 1005 (cond 1006 ((and element (org-element-property :label-fmt element))) 1007 ((org-src-edit-buffer-p) (org-src-do-at-code-block (org-src-coderef-format))) 1008 ((org-element-property :label-fmt (org-element-at-point))) 1009 (t org-coderef-label-format))) 1010 1011 (defun org-src-coderef-regexp (fmt &optional label) 1012 "Return regexp matching a coderef format string FMT. 1013 1014 When optional argument LABEL is non-nil, match coderef for that 1015 label only. 1016 1017 Match group 1 contains the full coderef string with surrounding 1018 white spaces. Match group 2 contains the same string without any 1019 surrounding space. Match group 3 contains the label. 1020 1021 A coderef format regexp can only match at the end of a line." 1022 (format "\\([ \t]*\\(%s\\)[ \t]*\\)$" 1023 (replace-regexp-in-string 1024 "%s" 1025 (if label (regexp-quote label) "\\([-a-zA-Z0-9_][-a-zA-Z0-9_ ]*\\)") 1026 (regexp-quote fmt) 1027 nil t))) 1028 1029 (defun org-edit-footnote-reference () 1030 "Edit definition of footnote reference at point." 1031 (interactive) 1032 (let* ((context (org-element-context)) 1033 (label (org-element-property :label context))) 1034 (unless (and (eq (org-element-type context) 'footnote-reference) 1035 (org-src--on-datum-p context)) 1036 (user-error "Not on a footnote reference")) 1037 (unless label (user-error "Cannot edit remotely anonymous footnotes")) 1038 (let* ((definition (org-with-wide-buffer 1039 (org-footnote-goto-definition label) 1040 (backward-char) 1041 (org-element-context))) 1042 (inline? (eq 'footnote-reference (org-element-type definition))) 1043 (contents 1044 (org-with-wide-buffer 1045 (buffer-substring-no-properties 1046 (or (org-element-property :post-affiliated definition) 1047 (org-element-property :begin definition)) 1048 (cond 1049 (inline? (1+ (org-element-property :contents-end definition))) 1050 ((org-element-property :contents-end definition)) 1051 (t (goto-char (org-element-property :post-affiliated definition)) 1052 (line-end-position))))))) 1053 (add-text-properties 1054 0 1055 (progn (string-match (if inline? "\\`\\[fn:.*?:" "\\`.*?\\]") contents) 1056 (match-end 0)) 1057 '(read-only "Cannot edit footnote label" front-sticky t rear-nonsticky t) 1058 contents) 1059 (when inline? 1060 (let ((l (length contents))) 1061 (add-text-properties 1062 (1- l) l 1063 '(read-only "Cannot edit past footnote reference" 1064 front-sticky nil rear-nonsticky nil) 1065 contents))) 1066 (org-src--edit-element 1067 definition 1068 (format "*Edit footnote [%s]*" label) 1069 (let ((source (current-buffer))) 1070 (lambda () 1071 (org-mode) 1072 (org-clone-local-variables source))) 1073 (lambda () 1074 (if (not inline?) (delete-region (point) (search-forward "]")) 1075 (delete-region (point) (search-forward ":" nil t 2)) 1076 (delete-region (1- (point-max)) (point-max)) 1077 (when (re-search-forward "\n[ \t]*\n" nil t) 1078 (user-error "Inline definitions cannot contain blank lines")) 1079 ;; If footnote reference belongs to a table, make sure to 1080 ;; remove any newline characters in order to preserve 1081 ;; table's structure. 1082 (when (org-element-lineage definition '(table-cell)) 1083 (while (search-forward "\n" nil t) (replace-match " "))))) 1084 contents 1085 'remote)) 1086 ;; Report success. 1087 t)) 1088 1089 (defun org-edit-table.el () 1090 "Edit \"table.el\" table at point. 1091 \\<org-src-mode-map> 1092 A new buffer is created and the table is copied into it. Then 1093 the table is recognized with `table-recognize'. When done 1094 editing, exit with `\\[org-edit-src-exit]'. The edited text will \ 1095 then replace 1096 the area in the Org mode buffer. 1097 1098 Throw an error when not at such a table." 1099 (interactive) 1100 (let ((element (org-element-at-point))) 1101 (unless (and (eq (org-element-type element) 'table) 1102 (eq (org-element-property :type element) 'table.el) 1103 (org-src--on-datum-p element)) 1104 (user-error "Not in a table.el table")) 1105 (org-src--edit-element 1106 element 1107 (org-src--construct-edit-buffer-name (buffer-name) "Table") 1108 #'text-mode t) 1109 (when (bound-and-true-p flyspell-mode) (flyspell-mode -1)) 1110 (table-recognize) 1111 t)) 1112 1113 (defun org-edit-latex-fragment () 1114 "Edit LaTeX fragment at point." 1115 (interactive) 1116 (let ((context (org-element-context))) 1117 (unless (and (eq 'latex-fragment (org-element-type context)) 1118 (org-src--on-datum-p context)) 1119 (user-error "Not on a LaTeX fragment")) 1120 (let* ((contents 1121 (buffer-substring-no-properties 1122 (org-element-property :begin context) 1123 (- (org-element-property :end context) 1124 (org-element-property :post-blank context)))) 1125 (delim-length (if (string-match "\\`\\$[^$]" contents) 1 2))) 1126 ;; Make the LaTeX deliminators read-only. 1127 (add-text-properties 0 delim-length 1128 (list 'read-only "Cannot edit LaTeX deliminator" 1129 'front-sticky t 1130 'rear-nonsticky t) 1131 contents) 1132 (let ((l (length contents))) 1133 (add-text-properties (- l delim-length) l 1134 (list 'read-only "Cannot edit LaTeX deliminator" 1135 'front-sticky nil 1136 'rear-nonsticky nil) 1137 contents)) 1138 (org-src--edit-element 1139 context 1140 (org-src--construct-edit-buffer-name (buffer-name) "LaTeX fragment") 1141 (org-src-get-lang-mode "latex") 1142 (lambda () 1143 ;; Blank lines break things, replace with a single newline. 1144 (while (re-search-forward "\n[ \t]*\n" nil t) (replace-match "\n")) 1145 ;; If within a table a newline would disrupt the structure, 1146 ;; so remove newlines. 1147 (goto-char (point-min)) 1148 (when (org-element-lineage context '(table-cell)) 1149 (while (search-forward "\n" nil t) (replace-match " ")))) 1150 contents)) 1151 t)) 1152 1153 (defun org-edit-latex-environment () 1154 "Edit LaTeX environment at point. 1155 \\<org-src-mode-map> 1156 The LaTeX environment is copied into a new buffer. Major mode is 1157 set to the one associated to \"latex\" in `org-src-lang-modes', 1158 or to `latex-mode' if there is none. 1159 1160 When done, exit with `\\[org-edit-src-exit]'. The edited text \ 1161 will then replace 1162 the LaTeX environment in the Org mode buffer." 1163 (interactive) 1164 (let ((element (org-element-at-point))) 1165 (unless (and (eq (org-element-type element) 'latex-environment) 1166 (org-src--on-datum-p element)) 1167 (user-error "Not in a LaTeX environment")) 1168 (org-src--edit-element 1169 element 1170 (org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment") 1171 (org-src-get-lang-mode "latex") 1172 t) 1173 t)) 1174 1175 (defun org-edit-export-block () 1176 "Edit export block at point. 1177 \\<org-src-mode-map> 1178 A new buffer is created and the block is copied into it, and the 1179 buffer is switched into an appropriate major mode. See also 1180 `org-src-lang-modes'. 1181 1182 When done, exit with `\\[org-edit-src-exit]'. The edited text \ 1183 will then replace 1184 the area in the Org mode buffer. 1185 1186 Throw an error when not at an export block." 1187 (interactive) 1188 (let ((element (org-element-at-point))) 1189 (unless (and (eq (org-element-type element) 'export-block) 1190 (org-src--on-datum-p element)) 1191 (user-error "Not in an export block")) 1192 (let* ((type (downcase (or (org-element-property :type element) 1193 ;; Missing export-block type. Fallback 1194 ;; to default mode. 1195 "fundamental"))) 1196 (mode (org-src-get-lang-mode type))) 1197 (unless (functionp mode) (error "No such language mode: %s" mode)) 1198 (org-src--edit-element 1199 element 1200 (org-src--construct-edit-buffer-name (buffer-name) type) 1201 mode 1202 (lambda () (org-escape-code-in-region (point-min) (point-max))))) 1203 t)) 1204 1205 (defun org-edit-comment-block () 1206 "Edit comment block at point. 1207 \\<org-src-mode-map> 1208 A new buffer is created and the block is copied into it, and the 1209 buffer is switched into Org mode. 1210 1211 When done, exit with `\\[org-edit-src-exit]'. The edited text will 1212 then replace the area in the Org mode buffer. 1213 1214 Throw an error when not at a comment block." 1215 (interactive) 1216 (let ((element (org-element-at-point))) 1217 (unless (and (eq (org-element-type element) 'comment-block) 1218 (org-src--on-datum-p element)) 1219 (user-error "Not in a comment block")) 1220 (org-src--edit-element 1221 element 1222 (org-src--construct-edit-buffer-name (buffer-name) "org") 1223 'org-mode 1224 (lambda () (org-escape-code-in-region (point-min) (point-max))) 1225 (org-unescape-code-in-string (org-element-property :value element))) 1226 t)) 1227 1228 (defun org-edit-src-code (&optional code edit-buffer-name) 1229 "Edit the source or example block at point. 1230 \\<org-src-mode-map> 1231 The code is copied to a separate buffer and the appropriate mode 1232 is turned on. When done, exit with `\\[org-edit-src-exit]'. This \ 1233 will remove the 1234 original code in the Org buffer, and replace it with the edited 1235 version. See `org-src-window-setup' to configure the display of 1236 windows containing the Org buffer and the code buffer. 1237 1238 When optional argument CODE is a string, edit it in a dedicated 1239 buffer instead. 1240 1241 When optional argument EDIT-BUFFER-NAME is non-nil, use it as the 1242 name of the sub-editing buffer." 1243 (interactive) 1244 (let* ((element (org-element-at-point)) 1245 (type (org-element-type element))) 1246 (unless (and (memq type '(example-block src-block)) 1247 (org-src--on-datum-p element)) 1248 (user-error "Not in a source or example block")) 1249 (let* ((lang 1250 (if (eq type 'src-block) (org-element-property :language element) 1251 "example")) 1252 (lang-f (and (eq type 'src-block) (org-src-get-lang-mode lang))) 1253 (babel-info (and (eq type 'src-block) 1254 (org-babel-get-src-block-info 'no-eval))) 1255 deactivate-mark) 1256 (when (and (eq type 'src-block) (not (functionp lang-f))) 1257 (error "No such language mode: %s" lang-f)) 1258 (org-src--edit-element 1259 element 1260 (or edit-buffer-name 1261 (org-src--construct-edit-buffer-name (buffer-name) lang)) 1262 lang-f 1263 (and (null code) 1264 (lambda () (org-escape-code-in-region (point-min) (point-max)))) 1265 (and code (org-unescape-code-in-string code))) 1266 ;; Finalize buffer. 1267 (setq-local org-coderef-label-format 1268 (or (org-element-property :label-fmt element) 1269 org-coderef-label-format)) 1270 (when (eq type 'src-block) 1271 (setq org-src--babel-info babel-info) 1272 (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) 1273 (when (fboundp edit-prep-func) 1274 (funcall edit-prep-func babel-info)))) 1275 t))) 1276 1277 (defun org-edit-inline-src-code () 1278 "Edit inline source code at point." 1279 (interactive) 1280 (let ((context (org-element-context))) 1281 (unless (and (eq (org-element-type context) 'inline-src-block) 1282 (org-src--on-datum-p context)) 1283 (user-error "Not on inline source code")) 1284 (let* ((lang (org-element-property :language context)) 1285 (lang-f (org-src-get-lang-mode lang)) 1286 (babel-info (org-babel-get-src-block-info 'no-eval)) 1287 deactivate-mark) 1288 (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) 1289 (org-src--edit-element 1290 context 1291 (org-src--construct-edit-buffer-name (buffer-name) lang) 1292 lang-f 1293 (lambda () 1294 ;; Inline source blocks are limited to one line. 1295 (while (re-search-forward "\n[ \t]*" nil t) (replace-match " ")) 1296 ;; Trim contents. 1297 (goto-char (point-min)) 1298 (skip-chars-forward " \t") 1299 (delete-region (point-min) (point)) 1300 (goto-char (point-max)) 1301 (skip-chars-backward " \t") 1302 (delete-region (point) (point-max)))) 1303 ;; Finalize buffer. 1304 (setq org-src--babel-info babel-info) 1305 (setq org-src--preserve-indentation t) 1306 (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) 1307 (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info))) 1308 ;; Return success. 1309 t))) 1310 1311 (defun org-edit-fixed-width-region () 1312 "Edit the fixed-width ASCII drawing at point. 1313 \\<org-src-mode-map> 1314 This must be a region where each line starts with a colon 1315 followed by a space or a newline character. 1316 1317 A new buffer is created and the fixed-width region is copied into 1318 it, and the buffer is switched into the major mode defined in 1319 `org-edit-fixed-width-region-mode', which see. 1320 1321 When done, exit with `\\[org-edit-src-exit]'. The edited text \ 1322 will then replace 1323 the area in the Org mode buffer." 1324 (interactive) 1325 (let ((element (org-element-at-point))) 1326 (unless (and (eq (org-element-type element) 'fixed-width) 1327 (org-src--on-datum-p element)) 1328 (user-error "Not in a fixed-width area")) 1329 (org-src--edit-element 1330 element 1331 (org-src--construct-edit-buffer-name (buffer-name) "Fixed Width") 1332 org-edit-fixed-width-region-mode 1333 (lambda () (while (not (eobp)) (insert ": ") (forward-line)))) 1334 ;; Return success. 1335 t)) 1336 1337 (defun org-edit-src-abort () 1338 "Abort editing of the src code and return to the Org buffer." 1339 (interactive) 1340 (let (org-src--allow-write-back) (org-edit-src-exit))) 1341 1342 (defun org-edit-src-continue (event) 1343 "Unconditionally return to buffer editing area under point. 1344 Throw an error if there is no such buffer. 1345 EVENT is passed to `mouse-set-point'." 1346 (interactive "e") 1347 (mouse-set-point event) 1348 (let ((buf (get-char-property (point) 'edit-buffer))) 1349 (if buf (org-src-switch-to-buffer buf 'continue) 1350 (user-error "No sub-editing buffer for area at point")))) 1351 1352 (defun org-edit-src-save () 1353 "Save parent buffer with current state source-code buffer." 1354 (interactive) 1355 (unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer")) 1356 (set-buffer-modified-p nil) 1357 (let ((write-back-buf (generate-new-buffer "*org-src-write-back*")) 1358 (beg org-src--beg-marker) 1359 (end org-src--end-marker) 1360 (overlay org-src--overlay)) 1361 (org-src--contents-for-write-back write-back-buf) 1362 (with-current-buffer (org-src-source-buffer) 1363 (undo-boundary) 1364 (goto-char beg) 1365 ;; Temporarily disable read-only features of OVERLAY in order to 1366 ;; insert new contents. 1367 (delete-overlay overlay) 1368 (let ((expecting-bol (bolp))) 1369 (if (version< emacs-version "27.1") 1370 (progn (delete-region beg end) 1371 (insert (with-current-buffer write-back-buf (buffer-string)))) 1372 (save-restriction 1373 (narrow-to-region beg end) 1374 (org-replace-buffer-contents write-back-buf 0.1 nil) 1375 (goto-char (point-max)))) 1376 (when (and expecting-bol (not (bolp))) (insert "\n"))) 1377 (kill-buffer write-back-buf) 1378 (save-buffer) 1379 (move-overlay overlay beg (point)))) 1380 ;; `write-contents-functions' requires the function to return 1381 ;; a non-nil value so that other functions are not called. 1382 t) 1383 1384 (defun org-edit-src-exit () 1385 "Kill current sub-editing buffer and return to source buffer." 1386 (interactive) 1387 (unless (org-src-edit-buffer-p) 1388 (error "Not in a sub-editing buffer")) 1389 (let* ((beg org-src--beg-marker) 1390 (end org-src--end-marker) 1391 (write-back org-src--allow-write-back) 1392 (remote org-src--remote) 1393 (coordinates (and (not remote) 1394 (org-src--coordinates (point) 1 (point-max)))) 1395 (write-back-buf 1396 (and write-back (generate-new-buffer "*org-src-write-back*")))) 1397 (when write-back (org-src--contents-for-write-back write-back-buf)) 1398 (set-buffer-modified-p nil) 1399 ;; Switch to source buffer. Kill sub-editing buffer. 1400 (let ((edit-buffer (current-buffer)) 1401 (source-buffer (marker-buffer beg))) 1402 (unless source-buffer 1403 (when write-back-buf (kill-buffer write-back-buf)) 1404 (error "Source buffer disappeared. Aborting")) 1405 (org-src-switch-to-buffer source-buffer 'exit) 1406 (kill-buffer edit-buffer)) 1407 ;; Insert modified code. Ensure it ends with a newline character. 1408 (org-with-wide-buffer 1409 (when (and write-back 1410 (not (equal (buffer-substring beg end) 1411 (with-current-buffer write-back-buf 1412 (buffer-string))))) 1413 (undo-boundary) 1414 (goto-char beg) 1415 (let ((expecting-bol (bolp))) 1416 (if (version< emacs-version "27.1") 1417 (progn (delete-region beg end) 1418 (insert (with-current-buffer write-back-buf 1419 (buffer-string)))) 1420 (save-restriction 1421 (narrow-to-region beg end) 1422 (org-replace-buffer-contents write-back-buf 0.1 nil) 1423 (goto-char (point-max)))) 1424 (when (and expecting-bol (not (bolp))) (insert "\n"))))) 1425 (when write-back-buf (kill-buffer write-back-buf)) 1426 ;; If we are to return to source buffer, put point at an 1427 ;; appropriate location. In particular, if block is hidden, move 1428 ;; to the beginning of the block opening line. 1429 (unless remote 1430 (goto-char beg) 1431 (cond 1432 ;; Block is hidden; move at start of block. 1433 ((if (eq org-fold-core-style 'text-properties) 1434 (org-fold-folded-p nil 'block) 1435 (cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) 1436 (overlays-at (point)))) 1437 (beginning-of-line 0)) 1438 (write-back (org-src--goto-coordinates coordinates beg end)))) 1439 ;; Clean up left-over markers and restore window configuration. 1440 (set-marker beg nil) 1441 (set-marker end nil) 1442 (when org-src--saved-temp-window-config 1443 (unwind-protect 1444 (set-window-configuration org-src--saved-temp-window-config) 1445 (setq org-src--saved-temp-window-config nil))))) 1446 1447 (provide 'org-src) 1448 1449 ;;; org-src.el ends here