+
+(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")))
+