;;; org-src.el --- Source code examples in Org
;;
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2004-2012 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT altern DOT org>
+;; Bastien Guerry <bzg AT gnu DOT org>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.33x
;;
;; This file is part of GNU Emacs.
;;
(require 'org-macs)
(require 'org-compat)
+(require 'ob-keys)
+(require 'ob-comint)
(eval-when-compile
(require 'cl))
(declare-function org-do-remove-indentation "org" (&optional n))
+(declare-function org-at-table.el-p "org" ())
(declare-function org-get-indentation "org" (&optional line))
(declare-function org-switch-to-buffer-other-window "org" (&rest args))
+(declare-function org-pop-to-buffer-same-window
+ "org-compat" (&optional buffer-or-name norecord label))
(defcustom org-edit-src-region-extra nil
"Additional regexps to identify regions for editing with `org-edit-src-code'.
"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 -f option, like
+an individual literal example with the -l option, like
#+BEGIN_SRC pascal +n -r -l \"((%s))\"
...
(function :tag "Other (specify)")))
(defcustom org-src-preserve-indentation nil
- "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. If this variable
-is nil then, after editing with \\[org-edit-src-code], the
+ "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. If this variable is nil
+then, 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'."
"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
+editing it with \\[org-edit-src-code]. Has no effect if
`org-src-preserve-indentation' is non-nil."
:group 'org-edit-structure
:type 'integer)
+(defvar org-src-strip-leading-and-trailing-blank-lines nil
+ "If non-nil, blank lines are removed when exiting the code edit
+buffer.")
+
(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.
-When nil, the message will only be shown intermittently in the echo area."
+first line of the window showing the editing buffer."
:group 'org-edit-structure
:type 'boolean)
-
(defcustom org-src-window-setup 'reorganize-frame
"How the source code edit buffer should be displayed.
Possible values for this option are:
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
- ("asymptote" . asy) ("dot" . fundamental))
+ ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
be inserted as the name of the major mode. For many languages this is
(defvar org-src-mode-map (make-sparse-keymap))
(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
+
(defvar org-edit-src-force-single-line nil)
(defvar org-edit-src-from-org-mode nil)
+(defvar org-edit-src-allow-write-back-p t)
(defvar org-edit-src-picture nil)
(defvar org-edit-src-beg-marker nil)
(defvar org-edit-src-end-marker nil)
immediately; otherwise it will ask whether you want to return
to the existing edit buffer.")
+(defvar org-src-babel-info nil)
+
(define-minor-mode org-src-mode
"Minor mode for language major mode buffers generated by org.
This minor mode is turned on in two situations:
There is a mode hook, and keybindings for `org-edit-src-exit' and
`org-edit-src-save'")
-(defun org-edit-src-code (&optional context)
+(defun org-edit-src-code (&optional context code edit-buffer-name)
"Edit the source code example at point.
-The example is copied to a separate buffer, and that buffer is switched
-to the correct language mode. 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. Optional argument CONTEXT is used by
-\\[org-edit-src-save] when calling this function."
+The example is copied to a separate buffer, and that buffer is
+switched to the correct language mode. 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. Optional
+argument CONTEXT is used by \\[org-edit-src-save] when calling
+this function. See \\[org-src-window-setup] to configure the
+display of windows containing the Org buffer and the code
+buffer."
(interactive)
(unless (eq context 'save)
(setq org-edit-src-saved-temp-window-config (current-window-configuration)))
- (let ((line (org-current-line))
- (col (current-column))
+ (let ((mark (and (org-region-active-p) (mark)))
(case-fold-search t)
- (msg (substitute-command-keys
- "Edit, then exit with C-c ' (C-c and single quote)"))
(info (org-edit-src-find-region-and-lang))
- (org-mode-p (eq major-mode 'org-mode))
+ (full-info (org-babel-get-src-block-info))
+ (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
(beg (make-marker))
(end (make-marker))
- (preserve-indentation org-src-preserve-indentation)
- block-nindent total-nindent ovl lang lang-f single lfmt code begline buffer)
+ (allow-write-back-p (null code))
+ block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
+ begline markline markcol line col transmitted-variables)
(if (not info)
nil
(setq beg (move-marker beg (nth 0 info))
end (move-marker end (nth 1 info))
- code (buffer-substring-no-properties beg end)
+ msg (if allow-write-back-p
+ (substitute-command-keys
+ "Edit, then exit with C-c ' (C-c and single quote)")
+ "Exit with C-c ' (C-c and single quote)")
+ code (or code (buffer-substring-no-properties beg end))
lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
(nth 2 info))
lang (if (symbolp lang) (symbol-name lang) lang)
single (nth 3 info)
- lfmt (nth 4 info)
block-nindent (nth 5 info)
lang-f (intern (concat lang "-mode"))
- begline (save-excursion (goto-char beg) (org-current-line)))
+ begline (save-excursion (goto-char beg) (org-current-line))
+ transmitted-variables
+ `((org-edit-src-content-indentation
+ ,org-edit-src-content-indentation)
+ (org-edit-src-force-single-line ,single)
+ (org-edit-src-from-org-mode ,org-mode-p)
+ (org-edit-src-allow-write-back-p ,allow-write-back-p)
+ (org-src-preserve-indentation ,org-src-preserve-indentation)
+ (org-src-babel-info ,(org-babel-get-src-block-info 'light))
+ (org-coderef-label-format
+ ,(or (nth 4 info) org-coderef-label-format))
+ (org-edit-src-beg-marker ,beg)
+ (org-edit-src-end-marker ,end)
+ (org-edit-src-block-indentation ,block-nindent)))
+ (if (and mark (>= mark beg) (<= mark (1+ end)))
+ (save-excursion (goto-char (min mark end))
+ (setq markline (org-current-line)
+ markcol (current-column))))
+ (if (equal lang-f 'table.el-mode)
+ (setq lang-f (lambda ()
+ (text-mode)
+ (if (org-bound-and-true-p flyspell-mode)
+ (flyspell-mode -1))
+ (table-recognize)
+ (org-set-local 'org-edit-src-content-indentation 0))))
(unless (functionp lang-f)
(error "No such language mode: %s" lang-f))
- (org-goto-line line)
+ (save-excursion
+ (if (> (point) end) (goto-char end))
+ (setq line (org-current-line)
+ col (current-column)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
(if org-src-ask-before-returning-to-edit-buffer
(y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t))
(when buffer
(with-current-buffer buffer
(if (boundp 'org-edit-src-overlay)
- (org-delete-overlay org-edit-src-overlay)))
+ (delete-overlay org-edit-src-overlay)))
(kill-buffer buffer))
(setq buffer (generate-new-buffer
- (org-src-construct-edit-buffer-name (buffer-name) lang)))
- (setq ovl (org-make-overlay beg end))
- (org-overlay-put ovl 'edit-buffer buffer)
- (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
- (org-overlay-put ovl 'face 'secondary-selection)
- (org-overlay-put ovl
- 'keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [mouse-1] 'org-edit-src-continue)
- map))
- (org-overlay-put ovl :read-only "Leave me alone")
+ (or edit-buffer-name
+ (org-src-construct-edit-buffer-name (buffer-name) lang))))
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'edit-buffer buffer)
+ (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
+ (overlay-put ovl 'face 'secondary-selection)
+ (overlay-put ovl
+ 'keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-edit-src-continue)
+ map))
+ (overlay-put ovl :read-only "Leave me alone")
+ (setq transmitted-variables
+ (append transmitted-variables `((org-edit-src-overlay ,ovl))))
(org-src-switch-to-buffer buffer 'edit)
(if (eq single 'macro-definition)
(setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
(insert code)
(remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil))
- (unless preserve-indentation
+ (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables))
(setq total-nindent (or (org-do-remove-indentation) 0)))
(let ((org-inhibit-startup t))
- (funcall lang-f))
- (set (make-local-variable 'org-edit-src-force-single-line) single)
- (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
- (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation)
- (when lfmt
- (set (make-local-variable 'org-coderef-label-format) lfmt))
- (when org-mode-p
+ (condition-case e
+ (funcall lang-f)
+ (error
+ (error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
+ (dolist (pair transmitted-variables)
+ (org-set-local (car pair) (cadr pair)))
+ (when (eq major-mode 'org-mode)
(goto-char (point-min))
(while (re-search-forward "^," nil t)
(if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
(replace-match "")))
+ (when markline
+ (org-goto-line (1+ (- markline begline)))
+ (org-move-to-column
+ (if org-src-preserve-indentation markcol
+ (max 0 (- markcol total-nindent))))
+ (push-mark (point) 'no-message t)
+ (setq deactivate-mark nil))
(org-goto-line (1+ (- line begline)))
(org-move-to-column
- (if preserve-indentation col (max 0 (- col total-nindent))))
- (org-set-local 'org-edit-src-beg-marker beg)
- (org-set-local 'org-edit-src-end-marker end)
- (org-set-local 'org-edit-src-overlay ovl)
- (org-set-local 'org-edit-src-block-indentation block-nindent)
+ (if org-src-preserve-indentation col (max 0 (- col total-nindent))))
(org-src-mode)
(set-buffer-modified-p nil)
(and org-edit-src-persistent-message
- (org-set-local 'header-line-format msg)))
- (message "%s" msg)
+ (org-set-local 'header-line-format msg))
+ (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
+ (when (fboundp edit-prep-func)
+ (funcall edit-prep-func full-info))))
t)))
(defun org-edit-src-continue (e)
(defun org-src-switch-to-buffer (buffer context)
(case org-src-window-setup
('current-window
- (switch-to-buffer buffer))
+ (org-pop-to-buffer-same-window buffer))
('other-window
(switch-to-buffer-other-window buffer))
('other-frame
(delete-frame frame)))
('save
(kill-buffer (current-buffer))
- (switch-to-buffer buffer))
+ (org-pop-to-buffer-same-window buffer))
(t
(switch-to-buffer-other-frame buffer))))
('reorganize-frame
(if (eq context 'edit) (delete-other-windows))
(org-switch-to-buffer-other-window buffer)
(if (eq context 'exit) (delete-other-windows)))
+ ('switch-invisibly
+ (set-buffer buffer))
(t
(message "Invalid value %s for org-src-window-setup"
(symbol-name org-src-window-setup))
- (switch-to-buffer buffer))))
+ (org-pop-to-buffer-same-window buffer))))
(defun org-src-construct-edit-buffer-name (org-buffer-name lang)
- "Construct the buffer name for a source editing buffer"
+ "Construct the buffer name for a source editing buffer."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
(defun org-edit-src-find-buffer (beg end)
begline (save-excursion (goto-char beg) (org-current-line)))
(if (and (setq buffer (org-edit-src-find-buffer beg end))
(y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
- (switch-to-buffer buffer)
+ (org-pop-to-buffer-same-window buffer)
(when buffer
(with-current-buffer buffer
(if (boundp 'org-edit-src-overlay)
- (org-delete-overlay org-edit-src-overlay)))
+ (delete-overlay org-edit-src-overlay)))
(kill-buffer buffer))
(setq buffer (generate-new-buffer
(org-src-construct-edit-buffer-name
(buffer-name) "Fixed Width")))
- (setq ovl (org-make-overlay beg end))
- (org-overlay-put ovl 'face 'secondary-selection)
- (org-overlay-put ovl 'edit-buffer buffer)
- (org-overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
- (org-overlay-put ovl 'face 'secondary-selection)
- (org-overlay-put ovl
+ (setq ovl (make-overlay beg end))
+ (overlay-put ovl 'face 'secondary-selection)
+ (overlay-put ovl 'edit-buffer buffer)
+ (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
+ (overlay-put ovl 'face 'secondary-selection)
+ (overlay-put ovl
'keymap
(let ((map (make-sparse-keymap)))
(define-key map [mouse-1] 'org-edit-src-continue)
map))
- (org-overlay-put ovl :read-only "Leave me alone")
- (switch-to-buffer buffer)
+ (overlay-put ovl :read-only "Leave me alone")
+ (org-pop-to-buffer-same-window buffer)
(insert code)
(remove-text-properties (point-min) (point-max)
'(display nil invisible nil intangible nil))
((eq org-edit-fixed-width-region-mode 'artist-mode)
(fundamental-mode)
(artist-mode 1))
- (t (funcall org-edit-fixed-width-region-mode)))
+ (t (funcall org-edit-fixed-width-region-mode)))
(set (make-local-variable 'org-edit-src-force-single-line) nil)
(set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
(set (make-local-variable 'org-edit-src-picture) t)
(throw 'exit
(list (match-end 0) end
(org-edit-src-get-lang lang)
- single lfmt ind))))))))))))
+ single lfmt ind)))))))))
+ (when (org-at-table.el-p)
+ (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
+ (setq beg (1+ (point-at-eol)))
+ (goto-char beg)
+ (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
+ (progn (goto-char (point-max)) (newline)))
+ (setq end (point-at-bol))
+ (setq ind (org-edit-src-get-indentation beg))
+ (throw 'exit (list beg end 'table.el nil nil ind))))))
(defun org-edit-src-get-lang (lang)
"Extract the src language."
(match-string 1 s))))
(defun org-edit-src-get-indentation (pos)
- "Count leading whitespace characters on line"
+ "Count leading whitespace characters on line."
(save-match-data
(goto-char pos)
(org-get-indentation)))
(defun org-edit-src-exit (&optional context)
"Exit special edit and protect problematic lines."
(interactive)
- (unless org-edit-src-from-org-mode
- (error "This is not a sub-editing buffer, something is wrong..."))
+ (unless (org-bound-and-true-p org-edit-src-from-org-mode)
+ (error "This is not a sub-editing buffer, something is wrong"))
+ (widen)
(let* ((beg org-edit-src-beg-marker)
(end org-edit-src-end-marker)
(ovl org-edit-src-overlay)
(total-nindent (+ (or org-edit-src-block-indentation 0)
org-edit-src-content-indentation))
(preserve-indentation org-src-preserve-indentation)
+ (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p))
(delta 0) code line col indent)
- (untabify (point-min) (point-max))
- (save-excursion
- (goto-char (point-min))
- (if (looking-at "[ \t\n]*\n") (replace-match ""))
- (unless macro
- (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))
+ (when allow-write-back-p
+ (unless preserve-indentation (untabify (point-min) (point-max)))
+ (if org-src-strip-leading-and-trailing-blank-lines
+ (save-excursion
+ (goto-char (point-min))
+ (if (looking-at "[ \t\n]*\n") (replace-match ""))
+ (unless macro
+ (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
(setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
1
(org-current-line))
col (current-column))
- (when single
- (goto-char (point-min))
- (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
- (goto-char (point-min))
- (let ((cnt 0))
- (while (re-search-forward "\n" nil t)
- (setq cnt (1+ cnt))
- (replace-match (if macro "\\n" " ") t t))
- (when (and macro (> cnt 0))
- (goto-char (point-max)) (insert "\\n")))
- (goto-char (point-min))
- (if (looking-at "\\s-*") (replace-match " ")))
- (when (org-bound-and-true-p org-edit-src-from-org-mode)
- (goto-char (point-min))
- (while (re-search-forward
- (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
- (if (eq (org-current-line) line) (setq delta (1+ delta)))
- (replace-match ",\\1")))
- (when (org-bound-and-true-p org-edit-src-picture)
- (setq preserve-indentation nil)
- (untabify (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "^" nil t)
- (replace-match ": ")))
- (unless (or single preserve-indentation (= total-nindent 0))
- (setq indent (make-string total-nindent ?\ ))
- (goto-char (point-min))
- (while (re-search-forward "^" nil t)
- (replace-match indent)))
- (if (org-bound-and-true-p org-edit-src-picture)
- (setq total-nindent (+ total-nindent 2)))
- (setq code (buffer-string))
- (set-buffer-modified-p nil)
+ (when allow-write-back-p
+ (when single
+ (goto-char (point-min))
+ (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
+ (goto-char (point-min))
+ (let ((cnt 0))
+ (while (re-search-forward "\n" nil t)
+ (setq cnt (1+ cnt))
+ (replace-match (if macro "\\n" " ") t t))
+ (when (and macro (> cnt 0))
+ (goto-char (point-max)) (insert "\\n")))
+ (goto-char (point-min))
+ (if (looking-at "\\s-*") (replace-match " ")))
+ (when (org-bound-and-true-p org-edit-src-from-org-mode)
+ (goto-char (point-min))
+ (while (re-search-forward
+ (if (eq major-mode 'org-mode) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
+ (if (eq (org-current-line) line) (setq delta (1+ delta)))
+ (replace-match ",\\1")))
+ (when (org-bound-and-true-p org-edit-src-picture)
+ (setq preserve-indentation nil)
+ (untabify (point-min) (point-max))
+ (goto-char (point-min))
+ (while (re-search-forward "^" nil t)
+ (replace-match ": ")))
+ (unless (or single preserve-indentation (= total-nindent 0))
+ (setq indent (make-string total-nindent ?\ ))
+ (goto-char (point-min))
+ (while (re-search-forward "^" nil t)
+ (replace-match indent)))
+ (if (org-bound-and-true-p org-edit-src-picture)
+ (setq total-nindent (+ total-nindent 2)))
+ (setq code (buffer-string))
+ (set-buffer-modified-p nil))
(org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
(kill-buffer buffer)
(goto-char beg)
- (delete-region beg end)
- (insert code)
- (goto-char beg)
- (if single (just-one-space))
- (org-goto-line (1- (+ (org-current-line) line)))
- (org-move-to-column (if preserve-indentation col (+ col total-nindent delta)))
+ (when allow-write-back-p
+ (delete-region beg end)
+ (insert code)
+ (goto-char beg)
+ (if single (just-one-space)))
+ (if (memq t (mapcar (lambda (overlay)
+ (eq (overlay-get overlay 'invisible)
+ 'org-hide-block))
+ (overlays-at (point))))
+ ;; Block is hidden; put point at start of block
+ (beginning-of-line 0)
+ ;; Block is visible, put point where it was in the code buffer
+ (org-goto-line (1- (+ (org-current-line) line)))
+ (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))
(move-marker beg nil)
(move-marker end nil))
(unless (eq context 'save)
(message (or msg ""))))
(defun org-src-mode-configure-edit-buffer ()
- (when org-edit-src-from-org-mode
- (setq buffer-offer-save t)
- (setq buffer-file-name
- (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker))
- "[" (buffer-name) "]"))
- (set (if (featurep 'xemacs) 'write-contents-hooks 'write-contents-functions)
- '(org-edit-src-save))
+ (when (org-bound-and-true-p org-edit-src-from-org-mode)
(org-add-hook 'kill-buffer-hook
- '(lambda () (org-delete-overlay org-edit-src-overlay)) nil 'local)))
+ #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
+ (if (org-bound-and-true-p org-edit-src-allow-write-back-p)
+ (progn
+ (setq buffer-offer-save t)
+ (setq buffer-file-name
+ (concat (buffer-file-name (marker-buffer org-edit-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))))
+ (setq buffer-read-only t))))
(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)
+
+(defun org-src-associate-babel-session (info)
+ "Associate edit buffer with comint session."
+ (interactive)
+ (let ((session (cdr (assoc :session (nth 2 info)))))
+ (and session (not (string= session "none"))
+ (org-babel-comint-buffer-livep session)
+ ((lambda (f) (and (fboundp f) (funcall f session)))
+ (intern (format "org-babel-%s-associate-session" (nth 0 info)))))))
+
+(defun org-src-babel-configure-edit-buffer ()
+ (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)
+(defmacro org-src-do-at-code-block (&rest body)
+ "Execute a command from an edit buffer in the Org-mode buffer."
+ `(let ((beg-marker org-edit-src-beg-marker))
+ (if beg-marker
+ (with-current-buffer (marker-buffer beg-marker)
+ (goto-char (marker-position 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.
+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)))))
+
+(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."
+ :type 'boolean
+ :group 'org-babel)
+
+(defun org-src-native-tab-command-maybe ()
+ "Perform language-specific TAB action.
+Alter code block according to effect of TAB in the language major
+mode."
+ (and org-src-tab-acts-natively
+ (let ((org-src-strip-leading-and-trailing-blank-lines nil))
+ (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
+
+(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)
+
+(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. For manual
+fontification of code blocks see `org-src-fontify-block' and
+`org-src-fontify-buffer'"
+ (let ((lang-mode (org-src-get-lang-mode lang)))
+ (if (fboundp lang-mode)
+ (let ((string (buffer-substring-no-properties start end))
+ (modified (buffer-modified-p))
+ (org-buffer (current-buffer)) pos next)
+ (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 (concat string " ")) ;; so there's a final property change
+ (unless (eq major-mode lang-mode) (funcall lang-mode))
+ (font-lock-fontify-buffer)
+ (setq pos (point-min))
+ (while (setq next (next-single-property-change pos 'face))
+ (put-text-property
+ (+ start (1- pos)) (+ start next) 'face
+ (get-text-property pos 'face) org-buffer)
+ (setq pos next)))
+ (add-text-properties
+ start end
+ '(font-lock-fontified t fontified t font-lock-multiline t))
+ (set-buffer-modified-p modified)))))
+
+(defun org-src-fontify-block ()
+ "Fontify code block at point."
+ (interactive)
+ (save-excursion
+ (let ((org-src-fontify-natively t)
+ (info (org-edit-src-find-region-and-lang)))
+ (font-lock-fontify-region (nth 0 info) (nth 1 info)))))
+
+(defun org-src-fontify-buffer ()
+ "Fontify all code blocks in the current buffer"
+ (interactive)
+ (org-babel-map-src-blocks nil
+ (org-src-fontify-block)))
+
+(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
+ ((lambda (l) (if (symbolp l) (symbol-name l) l))
+ (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode")))
+
(provide 'org-src)
-;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8
;;; org-src.el ends here