diff options
Diffstat (limited to 'elpa/org-9.5.2/org-src.el')
| -rw-r--r-- | elpa/org-9.5.2/org-src.el | 1311 |
1 files changed, 1311 insertions, 0 deletions
diff --git a/elpa/org-9.5.2/org-src.el b/elpa/org-9.5.2/org-src.el new file mode 100644 index 0000000..8d02cf4 --- /dev/null +++ b/elpa/org-9.5.2/org-src.el @@ -0,0 +1,1311 @@ +;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2004-2021 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten.dominik@gmail.com> +;; Bastien Guerry <bzg@gnu.org> +;; Dan Davison <davison at stats dot ox dot ac dot uk> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: https://orgmode.org +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the code dealing with source code examples in +;; Org mode. + +;;; Code: + +(require 'cl-lib) +(require 'ob-comint) +(require 'org-macs) +(require 'org-compat) +(require 'org-keys) + +(declare-function org-mode "org" ()) +(declare-function org--get-expected-indentation "org" (element contentsp)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-class "org-element" (datum &optional parent)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-lineage "org-element" + (blob &optional types with-self)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-footnote-goto-definition "org-footnote" + (label &optional location)) + +(defvar org-inhibit-startup) + +(defcustom org-edit-src-turn-on-auto-save nil + "Non-nil means turn `auto-save-mode' on when editing a source block. +This will save the content of the source code editing buffer into +a newly created file, not the base buffer for this source block. + +If you want to regularly save the base buffer instead of the source +code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-edit-src-auto-save-idle-delay 0 + "Delay before saving a source code buffer back into its base buffer. +When a positive integer N, save after N seconds of idle time. +When 0 (the default), don't auto-save. + +If you want to save the source code buffer itself, don't use this. +Check `org-edit-src-turn-on-auto-save' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-coderef-label-format "(ref:%s)" + "The default coderef format. +This format string will be used to search for coderef labels in literal +examples (EXAMPLE and SRC blocks). The format can be overwritten in +an individual literal example with the -l option, like + +#+BEGIN_SRC pascal +n -r -l \"((%s))\" +... +#+END_SRC + +If you want to use this for HTML export, make sure that the format does +not introduce special font-locking, and avoid the HTML special +characters `<', `>', and `&'. The reason for this restriction is that +the labels are searched for only after htmlize has done its job." + :group 'org-edit-structure ; FIXME this is not in the right group + :type 'string) + +(defcustom org-edit-fixed-width-region-mode 'artist-mode + "The mode that should be used to edit fixed-width regions. +These are the regions where each line starts with a colon." + :group 'org-edit-structure + :type '(choice + (const artist-mode) + (const picture-mode) + (const fundamental-mode) + (function :tag "Other (specify)"))) + +(defcustom org-src-preserve-indentation nil + "If non-nil preserve leading whitespace characters on export. +\\<org-mode-map> +If non-nil leading whitespace characters in source code blocks +are preserved on export, and when switching between the org +buffer and the language mode edit buffer. + +When this variable is nil, after editing with `\\[org-edit-src-code]', +the minimum (across-lines) number of leading whitespace characters +are removed from all lines, and the code block is uniformly indented +according to the value of `org-edit-src-content-indentation'." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-edit-src-content-indentation 2 + "Indentation for the content of a source code block. + +This should be the number of spaces added to the indentation of the #+begin +line in order to compute the indentation of the block content after +editing it with `\\[org-edit-src-code]'. + +It has no effect if `org-src-preserve-indentation' is non-nil." + :group 'org-edit-structure + :type 'integer + :safe #'wholenump) + +(defcustom org-edit-src-persistent-message t + "Non-nil means show persistent exit help message while editing src examples. +The message is shown in the header-line, which will be created in the +first line of the window showing the editing buffer." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-src-ask-before-returning-to-edit-buffer t + "Non-nil means ask before switching to an existing edit buffer. +If nil, when `org-edit-src-code' is used on a block that already +has an active edit buffer, it will switch to that edit buffer +immediately; otherwise it will ask whether you want to return to +the existing edit buffer." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-src-window-setup 'reorganize-frame + "How the source code edit buffer should be displayed. +Possible values for this option are: + +plain Show edit buffer using `display-buffer'. Users can + further control the display behavior by modifying + `display-buffer-alist' and its relatives. +current-window Show edit buffer in the current window, keeping all other + windows. +split-window-below Show edit buffer below the current window, keeping all + other windows. +split-window-right Show edit buffer to the right of the current window, + keeping all other windows. +other-window Use `switch-to-buffer-other-window' to display edit buffer. +reorganize-frame Show only two windows on the current frame, the current + window and the edit buffer. +other-frame Use `switch-to-buffer-other-frame' to display edit buffer. + Also, when exiting the edit buffer, kill that frame. + +Values that modify the window layout (reorganize-frame, split-window-below, +split-window-right) will restore the layout after exiting the edit buffer." + :group 'org-edit-structure + :type '(choice + (const current-window) + (const split-window-below) + (const split-window-right) + (const other-frame) + (const other-window) + (const reorganize-frame))) + +(defvar org-src-mode-hook nil + "Hook run after Org switched a source code snippet to its Emacs mode. +\\<org-mode-map> +This hook will run: +- when editing a source code snippet with `\\[org-edit-special]' +- when formatting a source code snippet for export with htmlize. + +You may want to use this hook for example to turn off `outline-minor-mode' +or similar things which you want to have when editing a source code file, +but which mess up the display of a snippet in Org exported files.") + +(defcustom org-src-lang-modes + '(("C" . c) + ("C++" . c++) + ("asymptote" . asy) + ("bash" . sh) + ("beamer" . latex) + ("calc" . fundamental) + ("cpp" . c++) + ("ditaa" . artist) + ("dot" . fundamental) + ("elisp" . emacs-lisp) + ("ocaml" . tuareg) + ("screen" . shell-script) + ("shell" . sh) + ("sqlite" . sql)) + "Alist mapping languages to their major mode. + +The key is the language name. The value is the mode name, as +a string or a symbol, without the \"-mode\" suffix. + +For many languages this is simple, but for language where this is +not the case, this variable provides a way to simplify things on +the user side. For example, there is no `ocaml-mode' in Emacs, +but the mode to use is `tuareg-mode'." + :group 'org-edit-structure + :type '(repeat + (cons + (string "Language name") + (symbol "Major mode")))) + +(defcustom org-src-block-faces nil + "Alist of faces to be used for source-block. +Each element is a cell of the format + + (\"language\" FACE) + +Where FACE is either a defined face or an anonymous face. + +For instance, the following value would color the background of +emacs-lisp source blocks and python source blocks in purple and +green, respectability. + + \\='((\"emacs-lisp\" (:background \"#EEE2FF\")) + (\"python\" (:background \"#e5ffb8\")))" + :group 'org-edit-structure + :type '(repeat (list (string :tag "language") + (choice + (face :tag "Face") + (sexp :tag "Anonymous face")))) + :version "26.1" + :package-version '(Org . "9.0")) + +(defcustom org-src-tab-acts-natively t + "If non-nil, the effect of TAB in a code block is as if it were +issued in the language major mode buffer." + :type 'boolean + :package-version '(Org . "9.4") + :group 'org-babel) + + + +;;; Internal functions and variables + +(defvar org-src--auto-save-timer nil + "Idle Timer auto-saving remote editing buffers.") + +(defvar-local org-src--allow-write-back t) +(put 'org-src--allow-write-back 'permanent-local t) + +(defvar-local org-src--babel-info nil) +(put 'org-src--babel-info 'permanent-local t) + +(defvar-local org-src--beg-marker nil) +(put 'org-src--beg-marker 'permanent-local t) + +(defvar-local org-src--block-indentation nil) +(put 'org-src--block-indentation 'permanent-local t) + +(defvar-local org-src--content-indentation nil) +(put 'org-src--content-indentation 'permanent-local t) + +(defvar-local org-src--end-marker nil) +(put 'org-src--end-marker 'permanent-local t) + +(defvar-local org-src--from-org-mode nil) +(put 'org-src--from-org-mode 'permanent-local t) + +(defvar-local org-src--overlay nil) +(put 'org-src--overlay 'permanent-local t) + +(defvar-local org-src--preserve-indentation nil) +(put 'org-src--preserve-indentation 'permanent-local t) + +(defvar-local org-src--remote nil) +(put 'org-src--remote 'permanent-local t) + +(defvar-local org-src--saved-temp-window-config nil) +(put 'org-src--saved-temp-window-config 'permanent-local t) + +(defvar-local org-src--source-type nil + "Type of element being edited, as a symbol.") +(put 'org-src--source-type 'permanent-local t) + +(defvar-local org-src--tab-width nil + "Contains `tab-width' value from Org source buffer. +However, if `indent-tabs-mode' is nil in that buffer, its value +is 0.") +(put 'org-src--tab-width 'permanent-local t) + +(defvar-local org-src-source-file-name nil + "File name associated to Org source buffer, or nil.") +(put 'org-src-source-file-name 'permanent-local t) + +(defvar-local org-src--preserve-blank-line nil) +(put 'org-src--preserve-blank-line 'permanent-local t) + +(defun org-src--construct-edit-buffer-name (org-buffer-name lang) + "Construct the buffer name for a source editing buffer." + (concat "*Org Src " org-buffer-name "[ " lang " ]*")) + +(defun org-src--edit-buffer (beg end) + "Return buffer editing area between BEG and END. +Return nil if there is no such buffer." + (catch 'exit + (dolist (b (buffer-list)) + (with-current-buffer b + (and (org-src-edit-buffer-p) + (= beg org-src--beg-marker) + (eq (marker-buffer beg) (marker-buffer org-src--beg-marker)) + (= end org-src--end-marker) + (eq (marker-buffer end) (marker-buffer org-src--end-marker)) + (throw 'exit b)))))) + +(defun org-src--coordinates (pos beg end) + "Return coordinates of POS relatively to BEG and END. +POS, BEG and END are buffer positions. Return value is either +a cons cell (LINE . COLUMN) or symbol `end'. See also +`org-src--goto-coordinates'." + (if (>= pos end) 'end + (org-with-wide-buffer + (goto-char (max beg pos)) + (cons (count-lines (save-excursion (goto-char beg) (line-beginning-position)) + (line-beginning-position)) + ;; Column is relative to the end of line to avoid problems of + ;; comma escaping or colons appended in front of the line. + (- (point) (min end (line-end-position))))))) + +(defun org-src--goto-coordinates (coord beg end) + "Move to coordinates COORD relatively to BEG and END. +COORD are coordinates, as returned by `org-src--coordinates', +which see. BEG and END are buffer positions." + (goto-char + (if (eq coord 'end) (max (1- end) beg) + ;; If BEG happens to be located outside of the narrowed part of + ;; the buffer, widen it first. + (org-with-wide-buffer + (goto-char beg) + (forward-line (car coord)) + (max (point) + (+ (min end (line-end-position)) + (cdr coord))))))) + +(defun org-src--contents-area (datum) + "Return contents boundaries of DATUM. +DATUM is an element or object. Return a list (BEG END CONTENTS) +where BEG and END are buffer positions and CONTENTS is a string." + (let ((type (org-element-type datum))) + (org-with-wide-buffer + (cond + ((eq type 'footnote-definition) + (let* ((beg (progn + (goto-char (org-element-property :post-affiliated datum)) + (search-forward "]"))) + (end (or (org-element-property :contents-end datum) beg))) + (list beg end (buffer-substring-no-properties beg end)))) + ((eq type 'inline-src-block) + (let ((beg (progn (goto-char (org-element-property :begin datum)) + (search-forward "{" (line-end-position) t))) + (end (progn (goto-char (org-element-property :end datum)) + (search-backward "}" (line-beginning-position) t)))) + (list beg end (buffer-substring-no-properties beg end)))) + ((eq type 'latex-fragment) + (let ((beg (org-element-property :begin datum)) + (end (org-with-point-at (org-element-property :end datum) + (skip-chars-backward " \t") + (point)))) + (list beg end (buffer-substring-no-properties beg end)))) + ((org-element-property :contents-begin datum) + (let ((beg (org-element-property :contents-begin datum)) + (end (org-element-property :contents-end datum))) + (list beg end (buffer-substring-no-properties beg end)))) + ((memq type '(example-block export-block src-block)) + (list (progn (goto-char (org-element-property :post-affiliated datum)) + (line-beginning-position 2)) + (progn (goto-char (org-element-property :end datum)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 1)) + (org-element-property :value datum))) + ((memq type '(fixed-width latex-environment table)) + (let ((beg (org-element-property :post-affiliated datum)) + (end (progn (goto-char (org-element-property :end datum)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (list beg + end + (if (eq type 'fixed-width) (org-element-property :value datum) + (buffer-substring-no-properties beg end))))) + (t (error "Unsupported element or object: %s" type)))))) + +(defun org-src--make-source-overlay (beg end edit-buffer) + "Create overlay between BEG and END positions and return it. +EDIT-BUFFER is the buffer currently editing area between BEG and +END." + (let ((overlay (make-overlay beg end))) + (overlay-put overlay 'face 'secondary-selection) + (overlay-put overlay 'edit-buffer edit-buffer) + (overlay-put overlay 'help-echo + "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put overlay 'face 'secondary-selection) + (overlay-put overlay 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (let ((read-only + (list + (lambda (&rest _) + (user-error + "Cannot modify an area being edited in a dedicated buffer"))))) + (overlay-put overlay 'modification-hooks read-only) + (overlay-put overlay 'insert-in-front-hooks read-only) + (overlay-put overlay 'insert-behind-hooks read-only)) + overlay)) + +(defun org-src--remove-overlay () + "Remove overlay from current source buffer." + (when (overlayp org-src--overlay) (delete-overlay org-src--overlay))) + +(defun org-src--on-datum-p (datum) + "Non-nil when point is on DATUM. +DATUM is an element or an object. Consider blank lines or white +spaces after it as being outside." + (and (>= (point) (org-element-property :begin datum)) + (<= (point) + (org-with-wide-buffer + (goto-char (org-element-property :end datum)) + (skip-chars-backward " \r\t\n") + (if (eq (org-element-class datum) 'element) + (line-end-position) + (point)))))) + +(defun org-src--contents-for-write-back (write-back-buf) + "Populate WRITE-BACK-BUF with contents in the appropriate format. +Assume point is in the corresponding edit buffer." + (let ((indentation-offset + (if org-src--preserve-indentation 0 + (+ (or org-src--block-indentation 0) + (if (memq org-src--source-type '(example-block src-block)) + org-src--content-indentation + 0)))) + (use-tabs? (and (> org-src--tab-width 0) t)) + (preserve-fl (eq org-src--source-type 'latex-fragment)) + (source-tab-width org-src--tab-width) + (contents (org-with-wide-buffer + (let ((eol (line-end-position))) + (list (buffer-substring (point-min) eol) + (buffer-substring eol (point-max)))))) + (write-back org-src--allow-write-back) + (preserve-blank-line org-src--preserve-blank-line) + marker) + (with-current-buffer write-back-buf + ;; Reproduce indentation parameters from source buffer. + (setq indent-tabs-mode use-tabs?) + (when (> source-tab-width 0) (setq tab-width source-tab-width)) + ;; Apply WRITE-BACK function on edit buffer contents. + (insert (org-no-properties (car contents))) + (setq marker (point-marker)) + (insert (org-no-properties (car (cdr contents)))) + (goto-char (point-min)) + (when (functionp write-back) (save-excursion (funcall write-back))) + ;; Add INDENTATION-OFFSET to every line in buffer, + ;; unless indentation is meant to be preserved. + (when (> indentation-offset 0) + (when preserve-fl (forward-line)) + (while (not (eobp)) + (skip-chars-forward " \t") + (when (or (not (eolp)) ; not a blank line + (and (eq (point) (marker-position marker)) ; current line + preserve-blank-line)) + (let ((i (current-column))) + (delete-region (line-beginning-position) (point)) + (indent-to (+ i indentation-offset)))) + (forward-line))) + (set-marker marker nil)))) + +(defun org-src--edit-element + (datum name &optional initialize write-back contents remote) + "Edit DATUM contents in a dedicated buffer NAME. + +INITIALIZE is a function to call upon creating the buffer. + +When WRITE-BACK is non-nil, assume contents will replace original +region. Moreover, if it is a function, apply it in the edit +buffer, from point min, before returning the contents. + +When CONTENTS is non-nil, display them in the edit buffer. +Otherwise, show DATUM contents as specified by +`org-src--contents-area'. + +When REMOTE is non-nil, do not try to preserve point or mark when +moving from the edit area to the source. + +Leave point in edit buffer." + (when (memq org-src-window-setup '(reorganize-frame + split-window-below + split-window-right)) + (setq org-src--saved-temp-window-config (current-window-configuration))) + (let* ((area (org-src--contents-area datum)) + (beg (copy-marker (nth 0 area))) + (end (copy-marker (nth 1 area) t)) + (old-edit-buffer (org-src--edit-buffer beg end)) + (contents (or contents (nth 2 area)))) + (if (and old-edit-buffer + (or (not org-src-ask-before-returning-to-edit-buffer) + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))) + ;; Move to existing buffer. + (org-src-switch-to-buffer old-edit-buffer 'return) + ;; Discard old edit buffer. + (when old-edit-buffer + (with-current-buffer old-edit-buffer (org-src--remove-overlay)) + (kill-buffer old-edit-buffer)) + (let* ((org-mode-p (derived-mode-p 'org-mode)) + (source-file-name (buffer-file-name (buffer-base-buffer))) + (source-tab-width (if indent-tabs-mode tab-width 0)) + (type (org-element-type datum)) + (block-ind (org-with-point-at (org-element-property :begin datum) + (cond + ((save-excursion (skip-chars-backward " \t") (bolp)) + (current-indentation)) + ((org-element-property :parent datum) + (org--get-expected-indentation + (org-element-property :parent datum) nil)) + (t (current-indentation))))) + (content-ind org-edit-src-content-indentation) + (blank-line (save-excursion (beginning-of-line) + (looking-at-p "^[[:space:]]*$"))) + (empty-line (and blank-line (looking-at-p "^$"))) + (preserve-blank-line (or (and blank-line (not empty-line)) + (and empty-line (= (+ block-ind content-ind) 0)))) + (preserve-ind + (and (memq type '(example-block src-block)) + (or (org-element-property :preserve-indent datum) + org-src-preserve-indentation))) + ;; Store relative positions of mark (if any) and point + ;; within the edited area. + (point-coordinates (and (not remote) + (org-src--coordinates (point) beg end))) + (mark-coordinates (and (not remote) + (org-region-active-p) + (let ((m (mark))) + (and (>= m beg) (>= end m) + (org-src--coordinates m beg end))))) + ;; Generate a new edit buffer. + (buffer (generate-new-buffer name)) + ;; Add an overlay on top of source. + (overlay (org-src--make-source-overlay beg end buffer))) + ;; Switch to edit buffer. + (org-src-switch-to-buffer buffer 'edit) + ;; Insert contents. + (insert contents) + (remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) + (let ((lf (eq type 'latex-fragment))) + (unless preserve-ind (org-do-remove-indentation (and lf block-ind) lf))) + (set-buffer-modified-p nil) + (setq buffer-file-name nil) + ;; Initialize buffer. + (when (functionp initialize) + (let ((org-inhibit-startup t)) + (condition-case e + (funcall initialize) + (error (message "Initialization fails with: %S" + (error-message-string e)))))) + ;; Transmit buffer-local variables for exit function. It must + ;; be done after initializing major mode, as this operation + ;; may reset them otherwise. + (setq org-src--tab-width source-tab-width) + (setq org-src--from-org-mode org-mode-p) + (setq org-src--beg-marker beg) + (setq org-src--end-marker end) + (setq org-src--remote remote) + (setq org-src--source-type type) + (setq org-src--block-indentation block-ind) + (setq org-src--content-indentation content-ind) + (setq org-src--preserve-indentation preserve-ind) + (setq org-src--overlay overlay) + (setq org-src--allow-write-back write-back) + (setq org-src-source-file-name source-file-name) + (setq org-src--preserve-blank-line preserve-blank-line) + ;; Start minor mode. + (org-src-mode) + ;; Clear undo information so we cannot undo back to the + ;; initial empty buffer. + (buffer-disable-undo (current-buffer)) + (buffer-enable-undo) + ;; Move mark and point in edit buffer to the corresponding + ;; location. + (if remote + (progn + ;; Put point at first non read-only character after + ;; leading blank. + (goto-char + (or (text-property-any (point-min) (point-max) 'read-only nil) + (point-max))) + (skip-chars-forward " \r\t\n")) + ;; Set mark and point. + (when mark-coordinates + (org-src--goto-coordinates mark-coordinates (point-min) (point-max)) + (push-mark (point) 'no-message t) + (setq deactivate-mark nil)) + (org-src--goto-coordinates + point-coordinates (point-min) (point-max))))))) + + + +;;; Fontification of source blocks + +(defun org-src-font-lock-fontify-block (lang start end) + "Fontify code block. +This function is called by Emacs' automatic fontification, as long +as `org-src-fontify-natively' is non-nil." + (let ((lang-mode (org-src-get-lang-mode lang))) + (when (fboundp lang-mode) + (let ((string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer))) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (format " *org-src-fontification:%s*" lang-mode)) + (let ((inhibit-modification-hooks nil)) + (erase-buffer) + ;; Add string and a final space to ensure property change. + (insert string " ")) + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (org-font-lock-ensure) + (let ((pos (point-min)) next) + (while (setq next (next-property-change pos)) + ;; Handle additional properties from font-lock, so as to + ;; preserve, e.g., composition. + (dolist (prop (cons 'face font-lock-extra-managed-props)) + (let ((new-prop (get-text-property pos prop))) + (put-text-property + (+ start (1- pos)) (1- (+ start next)) prop new-prop + org-buffer))) + (setq pos next)))) + ;; Add Org faces. + (let ((src-face (nth 1 (assoc-string lang org-src-block-faces t)))) + (when (or (facep src-face) (listp src-face)) + (font-lock-append-text-property start end 'face src-face)) + (font-lock-append-text-property start end 'face 'org-block)) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))))) + + +;;; Escape contents + +(defun org-escape-code-in-region (beg end) + "Escape lines between BEG and END. +Escaping happens when a line starts with \"*\", \"#+\", \",*\" or +\",#+\" by appending a comma to it." + (interactive "r") + (save-excursion + (goto-char end) + (while (re-search-backward "^[ \t]*\\(,*\\(?:\\*\\|#\\+\\)\\)" beg t) + (save-excursion (replace-match ",\\1" nil nil nil 1))))) + +(defun org-escape-code-in-string (s) + "Escape lines in string S. +Escaping happens when a line starts with \"*\", \"#+\", \",*\" or +\",#+\" by appending a comma to it." + (replace-regexp-in-string "^[ \t]*\\(,*\\(?:\\*\\|#\\+\\)\\)" ",\\1" + s nil nil 1)) + +(defun org-unescape-code-in-region (beg end) + "Un-escape lines between BEG and END. +Un-escaping happens by removing the first comma on lines starting +with \",*\", \",#+\", \",,*\" and \",,#+\"." + (interactive "r") + (save-excursion + (goto-char end) + (while (re-search-backward "^[ \t]*,*\\(,\\)\\(?:\\*\\|#\\+\\)" beg t) + (save-excursion (replace-match "" nil nil nil 1))))) + +(defun org-unescape-code-in-string (s) + "Un-escape lines in string S. +Un-escaping happens by removing the first comma on lines starting +with \",*\", \",#+\", \",,*\" and \",,#+\"." + (replace-regexp-in-string + "^[ \t]*,*\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1)) + + + +;;; Org src minor mode + +(defvar org-src-mode-map + (let ((map (make-sparse-keymap))) + (define-key map "\C-c'" 'org-edit-src-exit) + (define-key map "\C-c\C-k" 'org-edit-src-abort) + (define-key map "\C-x\C-s" 'org-edit-src-save) + map)) + +(define-minor-mode org-src-mode + "Minor mode for language major mode buffers generated by Org. +\\<org-mode-map> +This minor mode is turned on in two situations: + - when editing a source code snippet with `\\[org-edit-special]' + - when formatting a source code snippet for export with htmlize. + +\\{org-src-mode-map} + +See also `org-src-mode-hook'." + :lighter " OrgSrc" + (when org-edit-src-persistent-message + (setq header-line-format + (substitute-command-keys + (if org-src--allow-write-back + "Edit, then exit with `\\[org-edit-src-exit]' or abort with \ +`\\[org-edit-src-abort]'" + "Exit with `\\[org-edit-src-exit]' or abort with \ +`\\[org-edit-src-abort]'")))) + ;; Possibly activate various auto-save features (for the edit buffer + ;; or the source buffer). + (when org-edit-src-turn-on-auto-save + (setq buffer-auto-save-file-name + (concat (make-temp-name "org-src-") + (format-time-string "-%Y-%d-%m") + ".txt"))) + (unless (or org-src--auto-save-timer + (= 0 org-edit-src-auto-save-idle-delay)) + (setq org-src--auto-save-timer + (run-with-idle-timer + org-edit-src-auto-save-idle-delay t + (lambda () + (save-excursion + (let (edit-flag) + (dolist (b (buffer-list)) + (with-current-buffer b + (when (org-src-edit-buffer-p) + (unless edit-flag (setq edit-flag t)) + (when (buffer-modified-p) (org-edit-src-save))))) + (unless edit-flag + (cancel-timer org-src--auto-save-timer) + (setq org-src--auto-save-timer nil))))))))) + +(defun org-src-mode-configure-edit-buffer () + "Configure the src edit buffer." + (when (bound-and-true-p org-src--from-org-mode) + (add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local) + (if (bound-and-true-p org-src--allow-write-back) + (progn + (setq buffer-offer-save t) + (setq write-contents-functions '(org-edit-src-save))) + (setq buffer-read-only t)))) + +(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer) + + + +;;; Babel related functions + +(defun org-src-associate-babel-session (info) + "Associate edit buffer with comint session." + (interactive) + (let ((session (cdr (assq :session (nth 2 info))))) + (and session (not (string= session "none")) + (org-babel-comint-buffer-livep session) + (let ((f (intern (format "org-babel-%s-associate-session" + (nth 0 info))))) + (and (fboundp f) (funcall f session)))))) + +(defun org-src-babel-configure-edit-buffer () + (when org-src--babel-info + (org-src-associate-babel-session org-src--babel-info))) + +(add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer) + + +;;; Public API + +(defmacro org-src-do-at-code-block (&rest body) + "Execute BODY from an edit buffer in the Org mode buffer." + (declare (debug (body))) + `(let ((beg-marker org-src--beg-marker)) + (when beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char beg-marker) + ,@body)))) + +(defun org-src-do-key-sequence-at-code-block (&optional key) + "Execute key sequence at code block in the source Org buffer. +The command bound to KEY in the Org-babel key map is executed +remotely with point temporarily at the start of the code block in +the Org buffer. + +This command is not bound to a key by default, to avoid conflicts +with language major mode bindings. To bind it to C-c @ in all +language major modes, you could use + + (add-hook \\='org-src-mode-hook + (lambda () (define-key org-src-mode-map \"\\C-c@\" + \\='org-src-do-key-sequence-at-code-block))) + +In that case, for example, C-c @ t issued in code edit buffers +would tangle the current Org code block, C-c @ e would execute +the block and C-c @ h would display the other available +Org-babel commands." + (interactive "kOrg-babel key: ") + (if (equal key (kbd "C-g")) (keyboard-quit) + (org-edit-src-save) + (org-src-do-at-code-block + (call-interactively (lookup-key org-babel-map key))))) + +(defun org-src-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (intern + (concat + (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) + (if (symbolp l) (symbol-name l) l)) + "-mode"))) + +(defun org-src-edit-buffer-p (&optional buffer) + "Non-nil when current buffer is a source editing buffer. +If BUFFER is non-nil, test it instead." + (let ((buffer (org-base-buffer (or buffer (current-buffer))))) + (and (buffer-live-p buffer) + (local-variable-p 'org-src--beg-marker buffer) + (local-variable-p 'org-src--end-marker buffer)))) + +(defun org-src-source-buffer () + "Return source buffer edited in current buffer. +Raise an error when current buffer is not a source editing buffer." + (unless (org-src-edit-buffer-p) (error "Not in a source buffer")) + (or (marker-buffer org-src--beg-marker) + (error "No source buffer available for current editing session"))) + +(defun org-src-source-type () + "Return type of element edited in current buffer. +Raise an error when current buffer is not a source editing buffer." + (unless (org-src-edit-buffer-p) (error "Not in a source buffer")) + org-src--source-type) + +(defun org-src-switch-to-buffer (buffer context) + (pcase org-src-window-setup + (`plain + (when (eq context 'exit) (quit-restore-window)) + (pop-to-buffer buffer)) + (`current-window (pop-to-buffer-same-window buffer)) + (`other-window + (let ((cur-win (selected-window))) + (org-switch-to-buffer-other-window buffer) + (when (eq context 'exit) (quit-restore-window cur-win)))) + (`split-window-below + (if (eq context 'exit) + (delete-window) + (select-window (split-window-vertically))) + (pop-to-buffer-same-window buffer)) + (`split-window-right + (if (eq context 'exit) + (delete-window) + (select-window (split-window-horizontally))) + (pop-to-buffer-same-window buffer)) + (`other-frame + (pcase context + (`exit + (let ((frame (selected-frame))) + (switch-to-buffer-other-frame buffer) + (delete-frame frame))) + (`save + (kill-buffer (current-buffer)) + (pop-to-buffer-same-window buffer)) + (_ (switch-to-buffer-other-frame buffer)))) + (`reorganize-frame + (when (eq context 'edit) (delete-other-windows)) + (org-switch-to-buffer-other-window buffer) + (when (eq context 'exit) (delete-other-windows))) + (`switch-invisibly (set-buffer buffer)) + (_ + (message "Invalid value %s for `org-src-window-setup'" + org-src-window-setup) + (pop-to-buffer-same-window buffer)))) + +(defun org-src-coderef-format (&optional element) + "Return format string for block at point. + +When optional argument ELEMENT is provided, use that block. +Otherwise, assume point is either at a source block, at an +example block. + +If point is in an edit buffer, retrieve format string associated +to the remote source block." + (cond + ((and element (org-element-property :label-fmt element))) + ((org-src-edit-buffer-p) (org-src-do-at-code-block (org-src-coderef-format))) + ((org-element-property :label-fmt (org-element-at-point))) + (t org-coderef-label-format))) + +(defun org-src-coderef-regexp (fmt &optional label) + "Return regexp matching a coderef format string FMT. + +When optional argument LABEL is non-nil, match coderef for that +label only. + +Match group 1 contains the full coderef string with surrounding +white spaces. Match group 2 contains the same string without any +surrounding space. Match group 3 contains the label. + +A coderef format regexp can only match at the end of a line." + (format "\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" + (if label (regexp-quote label) "\\([-a-zA-Z0-9_][-a-zA-Z0-9_ ]*\\)") + (regexp-quote fmt) + nil t))) + +(defun org-edit-footnote-reference () + "Edit definition of footnote reference at point." + (interactive) + (let* ((context (org-element-context)) + (label (org-element-property :label context))) + (unless (and (eq (org-element-type context) 'footnote-reference) + (org-src--on-datum-p context)) + (user-error "Not on a footnote reference")) + (unless label (user-error "Cannot edit remotely anonymous footnotes")) + (let* ((definition (org-with-wide-buffer + (org-footnote-goto-definition label) + (backward-char) + (org-element-context))) + (inline? (eq 'footnote-reference (org-element-type definition))) + (contents + (org-with-wide-buffer + (buffer-substring-no-properties + (or (org-element-property :post-affiliated definition) + (org-element-property :begin definition)) + (cond + (inline? (1+ (org-element-property :contents-end definition))) + ((org-element-property :contents-end definition)) + (t (goto-char (org-element-property :post-affiliated definition)) + (line-end-position))))))) + (add-text-properties + 0 + (progn (string-match (if inline? "\\`\\[fn:.*?:" "\\`.*?\\]") contents) + (match-end 0)) + '(read-only "Cannot edit footnote label" front-sticky t rear-nonsticky t) + contents) + (when inline? + (let ((l (length contents))) + (add-text-properties + (1- l) l + '(read-only "Cannot edit past footnote reference" + front-sticky nil rear-nonsticky nil) + contents))) + (org-src--edit-element + definition + (format "*Edit footnote [%s]*" label) + (let ((source (current-buffer))) + (lambda () + (org-mode) + (org-clone-local-variables source))) + (lambda () + (if (not inline?) (delete-region (point) (search-forward "]")) + (delete-region (point) (search-forward ":" nil t 2)) + (delete-region (1- (point-max)) (point-max)) + (when (re-search-forward "\n[ \t]*\n" nil t) + (user-error "Inline definitions cannot contain blank lines")) + ;; If footnote reference belongs to a table, make sure to + ;; remove any newline characters in order to preserve + ;; table's structure. + (when (org-element-lineage definition '(table-cell)) + (while (search-forward "\n" nil t) (replace-match " "))))) + contents + 'remote)) + ;; Report success. + t)) + +(defun org-edit-table.el () + "Edit \"table.el\" table at point. +\\<org-src-mode-map> +A new buffer is created and the table is copied into it. Then +the table is recognized with `table-recognize'. When done +editing, exit with `\\[org-edit-src-exit]'. The edited text will \ +then replace +the area in the Org mode buffer. + +Throw an error when not at such a table." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'table) + (eq (org-element-property :type element) 'table.el) + (org-src--on-datum-p element)) + (user-error "Not in a table.el table")) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) "Table") + #'text-mode t) + (when (bound-and-true-p flyspell-mode) (flyspell-mode -1)) + (table-recognize) + t)) + +(defun org-edit-latex-fragment () + "Edit LaTeX fragment at point." + (interactive) + (let ((context (org-element-context))) + (unless (and (eq 'latex-fragment (org-element-type context)) + (org-src--on-datum-p context)) + (user-error "Not on a LaTeX fragment")) + (let* ((contents + (buffer-substring-no-properties + (org-element-property :begin context) + (- (org-element-property :end context) + (org-element-property :post-blank context)))) + (delim-length (if (string-match "\\`\\$[^$]" contents) 1 2))) + ;; Make the LaTeX deliminators read-only. + (add-text-properties 0 delim-length + (list 'read-only "Cannot edit LaTeX deliminator" + 'front-sticky t + 'rear-nonsticky t) + contents) + (let ((l (length contents))) + (add-text-properties (- l delim-length) l + (list 'read-only "Cannot edit LaTeX deliminator" + 'front-sticky nil + 'rear-nonsticky nil) + contents)) + (org-src--edit-element + context + (org-src--construct-edit-buffer-name (buffer-name) "LaTeX fragment") + (org-src-get-lang-mode "latex") + (lambda () + ;; Blank lines break things, replace with a single newline. + (while (re-search-forward "\n[ \t]*\n" nil t) (replace-match "\n")) + ;; If within a table a newline would disrupt the structure, + ;; so remove newlines. + (goto-char (point-min)) + (when (org-element-lineage context '(table-cell)) + (while (search-forward "\n" nil t) (replace-match " ")))) + contents)) + t)) + +(defun org-edit-latex-environment () + "Edit LaTeX environment at point. +\\<org-src-mode-map> +The LaTeX environment is copied into a new buffer. Major mode is +set to the one associated to \"latex\" in `org-src-lang-modes', +or to `latex-mode' if there is none. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the LaTeX environment in the Org mode buffer." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'latex-environment) + (org-src--on-datum-p element)) + (user-error "Not in a LaTeX environment")) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) "LaTeX environment") + (org-src-get-lang-mode "latex") + t) + t)) + +(defun org-edit-export-block () + "Edit export block at point. +\\<org-src-mode-map> +A new buffer is created and the block is copied into it, and the +buffer is switched into an appropriate major mode. See also +`org-src-lang-modes'. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the area in the Org mode buffer. + +Throw an error when not at an export block." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'export-block) + (org-src--on-datum-p element)) + (user-error "Not in an export block")) + (let* ((type (downcase (or (org-element-property :type element) + ;; Missing export-block type. Fallback + ;; to default mode. + "fundamental"))) + (mode (org-src-get-lang-mode type))) + (unless (functionp mode) (error "No such language mode: %s" mode)) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) type) + mode + (lambda () (org-escape-code-in-region (point-min) (point-max))))) + t)) + +(defun org-edit-src-code (&optional code edit-buffer-name) + "Edit the source or example block at point. +\\<org-src-mode-map> +The code is copied to a separate buffer and the appropriate mode +is turned on. When done, exit with `\\[org-edit-src-exit]'. This \ +will remove the +original code in the Org buffer, and replace it with the edited +version. See `org-src-window-setup' to configure the display of +windows containing the Org buffer and the code buffer. + +When optional argument CODE is a string, edit it in a dedicated +buffer instead. + +When optional argument EDIT-BUFFER-NAME is non-nil, use it as the +name of the sub-editing buffer." + (interactive) + (let* ((element (org-element-at-point)) + (type (org-element-type element))) + (unless (and (memq type '(example-block src-block)) + (org-src--on-datum-p element)) + (user-error "Not in a source or example block")) + (let* ((lang + (if (eq type 'src-block) (org-element-property :language element) + "example")) + (lang-f (and (eq type 'src-block) (org-src-get-lang-mode lang))) + (babel-info (and (eq type 'src-block) + (org-babel-get-src-block-info 'light))) + deactivate-mark) + (when (and (eq type 'src-block) (not (functionp lang-f))) + (error "No such language mode: %s" lang-f)) + (org-src--edit-element + element + (or edit-buffer-name + (org-src--construct-edit-buffer-name (buffer-name) lang)) + lang-f + (and (null code) + (lambda () (org-escape-code-in-region (point-min) (point-max)))) + (and code (org-unescape-code-in-string code))) + ;; Finalize buffer. + (setq-local org-coderef-label-format + (or (org-element-property :label-fmt element) + org-coderef-label-format)) + (when (eq type 'src-block) + (setq org-src--babel-info babel-info) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) + (funcall edit-prep-func babel-info)))) + t))) + +(defun org-edit-inline-src-code () + "Edit inline source code at point." + (interactive) + (let ((context (org-element-context))) + (unless (and (eq (org-element-type context) 'inline-src-block) + (org-src--on-datum-p context)) + (user-error "Not on inline source code")) + (let* ((lang (org-element-property :language context)) + (lang-f (org-src-get-lang-mode lang)) + (babel-info (org-babel-get-src-block-info 'light)) + deactivate-mark) + (unless (functionp lang-f) (error "No such language mode: %s" lang-f)) + (org-src--edit-element + context + (org-src--construct-edit-buffer-name (buffer-name) lang) + lang-f + (lambda () + ;; Inline source blocks are limited to one line. + (while (re-search-forward "\n[ \t]*" nil t) (replace-match " ")) + ;; Trim contents. + (goto-char (point-min)) + (skip-chars-forward " \t") + (delete-region (point-min) (point)) + (goto-char (point-max)) + (skip-chars-backward " \t") + (delete-region (point) (point-max)))) + ;; Finalize buffer. + (setq org-src--babel-info babel-info) + (setq org-src--preserve-indentation t) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) (funcall edit-prep-func babel-info))) + ;; Return success. + t))) + +(defun org-edit-fixed-width-region () + "Edit the fixed-width ASCII drawing at point. +\\<org-src-mode-map> +This must be a region where each line starts with a colon +followed by a space or a newline character. + +A new buffer is created and the fixed-width region is copied into +it, and the buffer is switched into the major mode defined in +`org-edit-fixed-width-region-mode', which see. + +When done, exit with `\\[org-edit-src-exit]'. The edited text \ +will then replace +the area in the Org mode buffer." + (interactive) + (let ((element (org-element-at-point))) + (unless (and (eq (org-element-type element) 'fixed-width) + (org-src--on-datum-p element)) + (user-error "Not in a fixed-width area")) + (org-src--edit-element + element + (org-src--construct-edit-buffer-name (buffer-name) "Fixed Width") + org-edit-fixed-width-region-mode + (lambda () (while (not (eobp)) (insert ": ") (forward-line)))) + ;; Return success. + t)) + +(defun org-edit-src-abort () + "Abort editing of the src code and return to the Org buffer." + (interactive) + (let (org-src--allow-write-back) (org-edit-src-exit))) + +(defun org-edit-src-continue (e) + "Unconditionally return to buffer editing area under point. +Throw an error if there is no such buffer." + (interactive "e") + (mouse-set-point e) + (let ((buf (get-char-property (point) 'edit-buffer))) + (if buf (org-src-switch-to-buffer buf 'continue) + (user-error "No sub-editing buffer for area at point")))) + +(defun org-edit-src-save () + "Save parent buffer with current state source-code buffer." + (interactive) + (unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer")) + (set-buffer-modified-p nil) + (let ((write-back-buf (generate-new-buffer "*org-src-write-back*")) + (beg org-src--beg-marker) + (end org-src--end-marker) + (overlay org-src--overlay)) + (org-src--contents-for-write-back write-back-buf) + (with-current-buffer (org-src-source-buffer) + (undo-boundary) + (goto-char beg) + ;; Temporarily disable read-only features of OVERLAY in order to + ;; insert new contents. + (delete-overlay overlay) + (let ((expecting-bol (bolp))) + (if (version< emacs-version "27.1") + (progn (delete-region beg end) + (insert (with-current-buffer write-back-buf (buffer-string)))) + (save-restriction + (narrow-to-region beg end) + (replace-buffer-contents write-back-buf 0.1 nil) + (goto-char (point-max)))) + (when (and expecting-bol (not (bolp))) (insert "\n"))) + (kill-buffer write-back-buf) + (save-buffer) + (move-overlay overlay beg (point)))) + ;; `write-contents-functions' requires the function to return + ;; a non-nil value so that other functions are not called. + t) + +(defun org-edit-src-exit () + "Kill current sub-editing buffer and return to source buffer." + (interactive) + (unless (org-src-edit-buffer-p) + (error "Not in a sub-editing buffer")) + (let* ((beg org-src--beg-marker) + (end org-src--end-marker) + (write-back org-src--allow-write-back) + (remote org-src--remote) + (coordinates (and (not remote) + (org-src--coordinates (point) 1 (point-max)))) + (write-back-buf + (and write-back (generate-new-buffer "*org-src-write-back*")))) + (when write-back (org-src--contents-for-write-back write-back-buf)) + (set-buffer-modified-p nil) + ;; Switch to source buffer. Kill sub-editing buffer. + (let ((edit-buffer (current-buffer)) + (source-buffer (marker-buffer beg))) + (unless source-buffer + (when write-back-buf (kill-buffer write-back-buf)) + (error "Source buffer disappeared. Aborting")) + (org-src-switch-to-buffer source-buffer 'exit) + (kill-buffer edit-buffer)) + ;; Insert modified code. Ensure it ends with a newline character. + (org-with-wide-buffer + (when (and write-back + (not (equal (buffer-substring beg end) + (with-current-buffer write-back-buf + (buffer-string))))) + (undo-boundary) + (goto-char beg) + (let ((expecting-bol (bolp))) + (if (version< emacs-version "27.1") + (progn (delete-region beg end) + (insert (with-current-buffer write-back-buf + (buffer-string)))) + (save-restriction + (narrow-to-region beg end) + (replace-buffer-contents write-back-buf 0.1 nil) + (goto-char (point-max)))) + (when (and expecting-bol (not (bolp))) (insert "\n"))))) + (when write-back-buf (kill-buffer write-back-buf)) + ;; If we are to return to source buffer, put point at an + ;; appropriate location. In particular, if block is hidden, move + ;; to the beginning of the block opening line. + (unless remote + (goto-char beg) + (cond + ;; Block is hidden; move at start of block. + ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) + (overlays-at (point))) + (beginning-of-line 0)) + (write-back (org-src--goto-coordinates coordinates beg end)))) + ;; Clean up left-over markers and restore window configuration. + (set-marker beg nil) + (set-marker end nil) + (when org-src--saved-temp-window-config + (unwind-protect + (set-window-configuration org-src--saved-temp-window-config) + (setq org-src--saved-temp-window-config nil))))) + +(provide 'org-src) + +;;; org-src.el ends here |