;;; org-src.el --- Source code examples in Org
;;
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Bastien Guerry <bzg AT altern DOT org>
;; Dan Davison <davison at stats dot ox dot ac dot uk>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.35i
+;; Version: 7.4
;;
;; This file is part of GNU Emacs.
;;
(require 'org-macs)
(require 'org-compat)
+(require 'ob-keys)
+(require 'ob-comint)
(eval-when-compile
(require 'cl))
"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
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
- ("asymptote" . asy) ("dot" . fundamental))
+ ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
+ ("calc" . fundamental))
"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
;;; Editing source examples
-(defvar org-src-mode-map (make-sparse-keymap))
-(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
+(defvar org-src-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map "\C-c'" 'org-edit-src-exit)
+ map))
+
(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 quietp)
"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))
+ (babel-info (org-babel-get-src-block-info 'light))
(org-mode-p (eq major-mode 'org-mode))
(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)
(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)
block-nindent (nth 5 info)
lang-f (intern (concat lang "-mode"))
begline (save-excursion (goto-char beg) (org-current-line)))
+ (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)
(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")
(org-src-switch-to-buffer buffer 'edit)
(if (eq single 'macro-definition)
(setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
(unless preserve-indentation
(setq total-nindent (or (org-do-remove-indentation) 0)))
(let ((org-inhibit-startup t))
- (funcall lang-f))
+ (condition-case e
+ (funcall lang-f)
+ (error
+ (error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(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-edit-src-allow-write-back-p) allow-write-back-p)
(set (make-local-variable 'org-src-preserve-indentation) preserve-indentation)
+ (when babel-info
+ (set (make-local-variable 'org-src-babel-info) babel-info))
(when lfmt
(set (make-local-variable 'org-coderef-label-format) lfmt))
(when org-mode-p
(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 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))))
(set-buffer-modified-p nil)
(and org-edit-src-persistent-message
(org-set-local 'header-line-format msg)))
- (message "%s" msg)
+ (unless quietp (message "%s" msg))
t)))
(defun org-edit-src-continue (e)
(defun org-src-switch-to-buffer (buffer context)
(case org-src-window-setup
- ('current-window
+ (current-window
(switch-to-buffer buffer))
- ('other-window
+ (other-window
(switch-to-buffer-other-window buffer))
- ('other-frame
+ (other-frame
(case context
- ('exit
+ (exit
(let ((frame (selected-frame)))
(switch-to-buffer-other-frame buffer)
(delete-frame frame)))
- ('save
+ (save
(kill-buffer (current-buffer))
(switch-to-buffer buffer))
(t
(switch-to-buffer-other-frame buffer))))
- ('reorganize-frame
+ (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))))
(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)
(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")
+ (overlay-put ovl :read-only "Leave me alone")
(switch-to-buffer buffer)
(insert code)
(remove-text-properties (point-min) (point-max)
((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)
(pos (point))
re1 re2 single beg end lang lfmt match-re1 ind entry)
(catch 'exit
- (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)))
(while (setq entry (pop re-list))
(setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
single (nth 3 entry))
(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)
(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)
- (unless preserve-indentation (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 (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))
(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))
+ (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 (org-overlay-get overlay 'invisible)
+ (eq (overlay-get overlay 'invisible)
'org-hide-block))
- (org-overlays-at (point))))
+ (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
(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))))
+
+(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))
+ (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 string)
+ (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))
+ t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified
+
+(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
HCoop / bpt / emacs.git / blobdiff