summaryrefslogtreecommitdiff
path: root/lisp/org/org-src.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/org/org-src.el')
-rw-r--r--lisp/org/org-src.el89
1 files changed, 64 insertions, 25 deletions
diff --git a/lisp/org/org-src.el b/lisp/org/org-src.el
index cabedecb689..91a3d415dfa 100644
--- a/lisp/org/org-src.el
+++ b/lisp/org/org-src.el
@@ -2,7 +2,7 @@
;;
;; Copyright (C) 2004-2021 Free Software Foundation, Inc.
;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; 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
@@ -299,6 +299,9 @@ is 0.")
"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 " ]*"))
@@ -327,8 +330,7 @@ a cons cell (LINE . COLUMN) or symbol `end'. See also
(cons (count-lines beg (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.
- (- (current-column)
- (progn (end-of-line) (current-column)))))))
+ (- (point) (min end (line-end-position)))))))
(defun org-src--goto-coordinates (coord beg end)
"Move to coordinates COORD relatively to BEG and END.
@@ -341,9 +343,9 @@ which see. BEG and END are buffer positions."
(org-with-wide-buffer
(goto-char beg)
(forward-line (car coord))
- (end-of-line)
- (org-move-to-column (max (+ (current-column) (cdr coord)) 0))
- (point)))))
+ (max (point)
+ (+ (min end (line-end-position))
+ (cdr coord)))))))
(defun org-src--contents-area (datum)
"Return contents boundaries of DATUM.
@@ -433,8 +435,8 @@ spaces after it as being outside."
(line-end-position)
(point))))))
-(defun org-src--contents-for-write-back ()
- "Return buffer contents in a format appropriate for write back.
+(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
@@ -444,27 +446,36 @@ Assume point is in the corresponding edit buffer."
0))))
(use-tabs? (and (> org-src--tab-width 0) t))
(source-tab-width org-src--tab-width)
- (contents (org-with-wide-buffer (buffer-string)))
- (write-back org-src--allow-write-back))
- (with-temp-buffer
+ (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 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 non-empty line in buffer,
+ ;; Add INDENTATION-OFFSET to every line in buffer,
;; unless indentation is meant to be preserved.
(when (> indentation-offset 0)
(while (not (eobp))
(skip-chars-forward " \t")
- (unless (eolp) ;ignore blank lines
+ (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)))
- (buffer-string))))
+ (set-marker marker nil))))
(defun org-src--edit-element
(datum name &optional initialize write-back contents remote)
@@ -509,6 +520,11 @@ Leave point in edit buffer."
(block-ind (org-with-point-at (org-element-property :begin datum)
(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)
@@ -557,6 +573,7 @@ Leave point in edit buffer."
(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
@@ -587,7 +604,7 @@ Leave point in edit buffer."
(defun org-src-font-lock-fontify-block (lang start end)
"Fontify code block.
-This function is called by emacs automatic fontification, as long
+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)
@@ -1190,20 +1207,27 @@ Throw an error if there is no such buffer."
(interactive)
(unless (org-src-edit-buffer-p) (user-error "Not in a sub-editing buffer"))
(set-buffer-modified-p nil)
- (let ((edited-code (org-src--contents-for-write-back))
+ (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)
- (delete-region beg end)
(let ((expecting-bol (bolp)))
- (insert edited-code)
+ (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
@@ -1213,30 +1237,45 @@ Throw an error if there is no such buffer."
(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"))
+ (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))))
- (code (and write-back (org-src--contents-for-write-back))))
+ (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 (error "Source buffer disappeared. Aborting"))
+ (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) code)))
+ (when (and write-back
+ (not (equal (buffer-substring beg end)
+ (with-current-buffer write-back-buf
+ (buffer-string)))))
(undo-boundary)
(goto-char beg)
- (delete-region beg end)
(let ((expecting-bol (bolp)))
- (insert code)
+ (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.