summaryrefslogtreecommitdiff
path: root/lisp/org-src.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
committerS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
commitec84430cf4e09ba25ec675debdf802bc28111e06 (patch)
tree9c64bc8a0cd5e8cac82aa5fdf369d40529f140f8 /lisp/org-src.el
parent84539dca3aa301ecfe48858eceef1ced0505388b (diff)
Imported Upstream version 9.0
Diffstat (limited to 'lisp/org-src.el')
-rw-r--r--lisp/org-src.el291
1 files changed, 197 insertions, 94 deletions
diff --git a/lisp/org-src.el b/lisp/org-src.el
index b7bbf31..bcc93ac 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -1,4 +1,4 @@
-;;; org-src.el --- Source code examples in Org
+;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2004-2016 Free Software Foundation, Inc.
;;
@@ -26,19 +26,21 @@
;;
;;; Commentary:
-;; This file contains the code dealing with source code examples in Org-mode.
+;; This file contains the code dealing with source code examples in
+;; Org mode.
;;; Code:
+(require 'cl-lib)
(require 'org-macs)
(require 'org-compat)
(require 'ob-keys)
(require 'ob-comint)
-(eval-when-compile (require 'cl))
(declare-function org-base-buffer "org" (buffer))
(declare-function org-do-remove-indentation "org" (&optional n))
(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))
@@ -47,13 +49,9 @@
(declare-function org-footnote-goto-definition "org-footnote"
(label &optional location))
(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
-(declare-function org-some "org" (pred seq))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
-(declare-function org-trim "org" (s))
+(declare-function org-trim "org" (s &optional keep-lead))
-(defvar org-element-all-elements)
(defvar org-inhibit-startup)
(defcustom org-edit-src-turn-on-auto-save nil
@@ -109,11 +107,12 @@ These are the regions where each line starts with a colon."
(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],
+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'."
@@ -122,10 +121,12 @@ according to the value of `org-edit-src-content-indentation'."
(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]. Has no effect if
-`org-src-preserve-indentation' is non-nil."
+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)
@@ -170,7 +171,7 @@ other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
"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 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'
@@ -195,6 +196,28 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is
(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 "25.2"
+ :package-version '(Org . "9.0"))
+
(defcustom org-src-tab-acts-natively nil
"If non-nil, the effect of TAB in a code block is as if it were
issued in the language major mode buffer."
@@ -292,6 +315,12 @@ where BEG and END are buffer positions and CONTENTS is a string."
(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))))
((org-element-property :contents-begin datum)
(let ((beg (org-element-property :contents-begin datum))
(end (org-element-property :contents-end datum)))
@@ -351,7 +380,7 @@ spaces after it as being outside."
(org-with-wide-buffer
(goto-char (org-element-property :end datum))
(skip-chars-backward " \r\t\n")
- (if (memq (org-element-type datum) org-element-all-elements)
+ (if (eq (org-element-class datum) 'element)
(line-end-position)
(point))))))
@@ -370,7 +399,7 @@ Assume point is in the corresponding edit buffer."
(let ((ind (make-string indentation ?\s)))
(goto-char (point-min))
(while (not (eobp))
- (when (org-looking-at-p "[ \t]*\\S-") (insert ind))
+ (when (looking-at-p "[ \t]*\\S-") (insert ind))
(forward-line))))
(buffer-string))))
@@ -448,14 +477,14 @@ Leave point in edit buffer."
;; Transmit buffer-local variables for exit function. It must
;; be done after initializing major mode, as this operation
;; may reset them otherwise.
- (org-set-local 'org-src--from-org-mode org-mode-p)
- (org-set-local 'org-src--beg-marker beg)
- (org-set-local 'org-src--end-marker end)
- (org-set-local 'org-src--remote remote)
- (org-set-local 'org-src--block-indentation ind)
- (org-set-local 'org-src--preserve-indentation preserve-ind)
- (org-set-local 'org-src--overlay overlay)
- (org-set-local 'org-src--allow-write-back write-back)
+ (setq-local org-src--from-org-mode org-mode-p)
+ (setq-local org-src--beg-marker beg)
+ (setq-local org-src--end-marker end)
+ (setq-local org-src--remote remote)
+ (setq-local org-src--block-indentation ind)
+ (setq-local org-src--preserve-indentation preserve-ind)
+ (setq-local org-src--overlay overlay)
+ (setq-local org-src--allow-write-back write-back)
;; Start minor mode.
(org-src-mode)
;; Move mark and point in edit buffer to the corresponding
@@ -488,27 +517,36 @@ as `org-src-fontify-natively' is non-nil."
(when (fboundp lang-mode)
(let ((string (buffer-substring-no-properties start end))
(modified (buffer-modified-p))
- (org-buffer (current-buffer)) pos next)
+ (org-buffer (current-buffer)))
(remove-text-properties start end '(face nil))
(with-current-buffer
(get-buffer-create
- (concat " org-src-fontification:" (symbol-name lang-mode)))
- (delete-region (point-min) (point-max))
- (insert string " ") ;; so there's a final property change
+ (format " *org-src-fontification:%s*" lang-mode))
+ (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)
- (setq pos (point-min))
- (while (setq next (next-single-property-change pos 'face))
- (put-text-property
- (+ start (1- pos)) (1- (+ start next)) 'face
- (get-text-property pos 'face) org-buffer)
- (setq pos next)))
+ (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
@@ -560,7 +598,7 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
"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 editing a source code snippet with `\\[org-edit-special]'
- when formatting a source code snippet for export with htmlize.
\\{org-src-mode-map}
@@ -568,14 +606,14 @@ This minor mode is turned on in two situations:
See also `org-src-mode-hook'."
nil " OrgSrc" nil
(when org-edit-src-persistent-message
- (org-set-local
- 'header-line-format
+ (setq-local
+ 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]"))))
+ "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
@@ -600,22 +638,17 @@ See also `org-src-mode-hook'."
(setq org-src--auto-save-timer nil)))))))))
(defun org-src-mode-configure-edit-buffer ()
- (when (org-bound-and-true-p org-src--from-org-mode)
- (org-add-hook 'kill-buffer-hook #'org-src--remove-overlay nil 'local)
- (if (org-bound-and-true-p org-src--allow-write-back)
+ (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 buffer-file-name
(concat (buffer-file-name (marker-buffer org-src--beg-marker))
- "[" (buffer-name) "]"))
- (if (featurep 'xemacs)
- (progn
- (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4
- (setq write-contents-hooks '(org-edit-src-save)))
- (setq write-contents-functions '(org-edit-src-save))))
+ "[" (buffer-name) "]")))
(setq buffer-read-only t))))
-(org-add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
+(add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer)
@@ -624,7 +657,7 @@ See also `org-src-mode-hook'."
(defun org-src-associate-babel-session (info)
"Associate edit buffer with comint session."
(interactive)
- (let ((session (cdr (assoc :session (nth 2 info)))))
+ (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"
@@ -635,16 +668,19 @@ See also `org-src-mode-hook'."
(when org-src--babel-info
(org-src-associate-babel-session org-src--babel-info)))
-(org-add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer)
+(add-hook 'org-src-mode-hook #'org-src-babel-configure-edit-buffer)
+
+
+;;; Public API
(defmacro org-src-do-at-code-block (&rest body)
- "Execute a command from an edit buffer in the Org mode buffer."
+ "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))))
-(def-edebug-spec org-src-do-at-code-block (body))
(defun org-src-do-key-sequence-at-code-block (&optional key)
"Execute key sequence at code block in the source Org buffer.
@@ -670,10 +706,6 @@ Org-babel commands."
(org-src-do-at-code-block
(call-interactively (lookup-key org-babel-map key)))))
-
-
-;;; Public functions
-
(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."
@@ -683,29 +715,62 @@ If BUFFER is non-nil, test it instead."
(local-variable-p 'org-src--end-marker buffer))))
(defun org-src-switch-to-buffer (buffer context)
- (case org-src-window-setup
- (current-window (org-pop-to-buffer-same-window buffer))
- (other-window
+ (pcase org-src-window-setup
+ (`current-window (pop-to-buffer-same-window buffer))
+ (`other-window
(switch-to-buffer-other-window buffer))
- (other-frame
- (case context
- (exit
+ (`other-frame
+ (pcase context
+ (`exit
(let ((frame (selected-frame)))
(switch-to-buffer-other-frame buffer)
(delete-frame frame)))
- (save
+ (`save
(kill-buffer (current-buffer))
- (org-pop-to-buffer-same-window buffer))
- (t (switch-to-buffer-other-frame buffer))))
- (reorganize-frame
+ (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))
- (t
+ (`switch-invisibly (set-buffer buffer))
+ (_
(message "Invalid value %s for `org-src-window-setup'"
org-src-window-setup)
- (org-pop-to-buffer-same-window buffer))))
+ (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 "\\S-\\([ \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."
@@ -765,11 +830,12 @@ If BUFFER is non-nil, test it instead."
(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.
+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)
@@ -782,18 +848,20 @@ Throw an error when not at such a table."
element
(org-src--construct-edit-buffer-name (buffer-name) "Table")
#'text-mode t)
- (when (org-bound-and-true-p flyspell-mode) (flyspell-mode -1))
+ (when (bound-and-true-p flyspell-mode) (flyspell-mode -1))
(table-recognize)
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.
+`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)
@@ -815,7 +883,7 @@ Throw an error when not at an export block."
"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 \
+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
@@ -850,36 +918,71 @@ name of the sub-editing buffer."
`(lambda ()
(unless ,(or org-src-preserve-indentation
(org-element-property :preserve-indent element))
- (untabify (point-min) (point-max))
(when (> org-edit-src-content-indentation 0)
- (let ((ind (make-string org-edit-src-content-indentation
- ?\s)))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$") (insert ind))
- (forward-line)))))
+ (while (not (eobp))
+ (unless (looking-at "[ \t]*$")
+ (indent-line-to (+ (org-get-indentation)
+ org-edit-src-content-indentation)))
+ (forward-line))))
(org-escape-code-in-region (point-min) (point-max))))
(and code (org-unescape-code-in-string code)))
;; Finalize buffer.
- (org-set-local 'org-coderef-label-format
- (or (org-element-property :label-fmt element)
- org-coderef-label-format))
+ (setq-local org-coderef-label-format
+ (or (org-element-property :label-fmt element)
+ org-coderef-label-format))
(when (eq type 'src-block)
- (org-set-local 'org-src--babel-info babel-info)
+ (setq-local 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 src 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-local org-src--babel-info babel-info)
+ (setq-local 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
+`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)))
@@ -962,7 +1065,7 @@ Throw an error if there is no such buffer."
(goto-char beg)
(cond
;; Block is hidden; move at start of block.
- ((org-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-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))))