From ec84430cf4e09ba25ec675debdf802bc28111e06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Mon, 7 Nov 2016 10:41:54 +0100 Subject: Imported Upstream version 9.0 --- lisp/org-src.el | 291 ++++++++++++++++++++++++++++++++++++++------------------ 1 file changed, 197 insertions(+), 94 deletions(-) (limited to 'lisp/org-src.el') 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. +\\ 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. \\ 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. \\ 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. - +\\ 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. - +\\ 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. \\ 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. - +\\ 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)))) -- cgit v1.2.3