;;; org-src.el --- Source code examples in Org
;;
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
+;; Copyright (C) 2004-2013 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: 7.7
;;
;; This file is part of GNU Emacs.
;;
(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
+(declare-function org-pop-to-buffer-same-window
"org-compat" (&optional buffer-or-name norecord label))
+(declare-function org-base-buffer "org" (buffer))
(defcustom org-edit-src-region-extra nil
"Additional regexps to identify regions for editing with `org-edit-src-code'.
: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.")
+ "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.
windows.
other-window Use `switch-to-buffer-other-window' to display edit buffer.
reorganize-frame Show only two windows on the current frame, the current
- window and the edit buffer. When exiting the edit buffer,
+ window and the edit buffer. When exiting the edit buffer,
return to one window.
other-frame Use `switch-to-buffer-other-frame' to display edit buffer.
Also, when exiting the edit buffer, kill that frame."
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
- ("calc" . fundamental) ("C" . c))
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++)
+ ("screen" . shell-script))
"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)
+(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save)
(defvar org-edit-src-force-single-line nil)
(defvar org-edit-src-from-org-mode nil)
(defvar org-src-ask-before-returning-to-edit-buffer t
"If nil, when org-edit-src code is used on a block that already
- has an active edit buffer, it will switch to that edit buffer
- immediately; otherwise it will ask whether you want to return
- to the existing edit buffer.")
+has an active edit buffer, it will switch to that edit buffer
+immediately; otherwise it will ask whether you want to return to
+the existing edit buffer.")
(defvar org-src-babel-info nil)
`org-edit-src-save'")
(defun org-edit-src-code (&optional context code edit-buffer-name)
- "Edit the source code example at point.
+ "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
+Org buffer, and replace it with the edited version. An optional
argument CONTEXT is used by \\[org-edit-src-save] when calling
-this function. See \\[org-src-window-setup] to configure the
+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 ((mark (and (org-region-active-p) (mark)))
- (case-fold-search t)
- (info (org-edit-src-find-region-and-lang))
- (full-info (org-babel-get-src-block-info))
- (org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode)))
- (beg (make-marker))
- (end (make-marker))
- (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)
+ (let* ((mark (and (org-region-active-p) (mark)))
+ (case-fold-search t)
+ (info
+ ;; If the src region consists in no lines, we insert a blank
+ ;; line.
+ (let* ((temp (org-edit-src-find-region-and-lang))
+ (beg (nth 0 temp))
+ (end (nth 1 temp)))
+ (if (>= end beg) temp
+ (goto-char beg)
+ (insert "\n")
+ (org-edit-src-find-region-and-lang))))
+ (full-info (org-babel-get-src-block-info 'light))
+ (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive
+ (beg (make-marker))
+ ;; Move marker with inserted text for case when src block is
+ ;; just one empty line, i.e. beg == end.
+ (end (copy-marker nil t))
+ (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))
(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))
+ (or (eq context 'save)
+ (if org-src-ask-before-returning-to-edit-buffer
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t)))
(org-src-switch-to-buffer buffer 'return)
(when buffer
(with-current-buffer buffer
(error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
(dolist (pair transmitted-variables)
(org-set-local (car pair) (cadr pair)))
- (when org-mode-p
- (goto-char (point-min))
- (while (re-search-forward "^," nil t)
- (if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
- (replace-match "")))
+ ;; Remove protecting commas from visible part of buffer.
+ (org-unescape-code-in-region (point-min) (point-max))
(when markline
(org-goto-line (1+ (- markline begline)))
(org-move-to-column
(if org-src-preserve-indentation col (max 0 (- col total-nindent))))
(org-src-mode)
(set-buffer-modified-p nil)
+ (setq buffer-file-name nil)
(and org-edit-src-persistent-message
(org-set-local 'header-line-format msg))
(let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
t)))
(defun org-edit-src-continue (e)
+ "Continue editing source blocks." ;; Fixme: be more accurate
(interactive "e")
(mouse-set-point e)
(let ((buf (get-char-property (point) 'edit-buffer)))
"Construct the buffer name for a source editing buffer."
(concat "*Org Src " org-buffer-name "[ " lang " ]*"))
+(defun org-src-edit-buffer-p (&optional buffer)
+ "Test whether BUFFER (or the current buffer if BUFFER is nil)
+is a source block editing buffer."
+ (let ((buffer (org-base-buffer (or buffer (current-buffer)))))
+ (and (buffer-name buffer)
+ (string-match "\\`*Org Src " (buffer-name buffer))
+ (local-variable-p 'org-edit-src-beg-marker buffer)
+ (local-variable-p 'org-edit-src-end-marker buffer))))
+
(defun org-edit-src-find-buffer (beg end)
"Find a source editing buffer that is already editing the region BEG to END."
(catch 'exit
(case-fold-search t)
(msg (substitute-command-keys
"Edit, then exit with C-c ' (C-c and single quote)"))
- (org-mode-p (org-mode-p))
+ (org-mode-p (derived-mode-p 'org-mode))
(beg (make-marker))
(end (make-marker))
(preserve-indentation org-src-preserve-indentation)
code (buffer-substring-no-properties 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: "))
+ (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? "))
(org-pop-to-buffer-same-window buffer)
(when buffer
(with-current-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))
+ '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-pop-to-buffer-same-window buffer)
(insert code)
(goto-char pos)
(org-get-indentation)))
+(defun org-escape-code-in-region (beg end)
+ "Escape lines between BEG and END.
+Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
+\",#+\" by appending a comma to it."
+ (interactive "r")
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*,?\\(\\*\\|#\\+\\)" end t)
+ (replace-match ",\\1" nil nil nil 1))))
+
+(defun org-escape-code-in-string (s)
+ "Escape lines in string S.
+Escaping happens when a line starts with \"*\", \"#+\", \",*\" or
+\",#+\" by appending a comma to it."
+ (replace-regexp-in-string "^[ \t]*,?\\(\\*\\|#\\+\\)" ",\\1" s nil nil 1))
+
+(defun org-unescape-code-in-region (beg end)
+ "Un-escape lines between BEG and END.
+Un-escaping happens by removing the first comma on lines starting
+with \",*\", \",#+\", \",,*\" and \",,#+\"."
+ (interactive "r")
+ (save-excursion
+ (goto-char beg)
+ (while (re-search-forward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" end t)
+ (replace-match "" nil nil nil 1))))
+
+(defun org-unescape-code-in-string (s)
+ "Un-escape lines in string S.
+Un-escaping happens by removing the first comma on lines starting
+with \",*\", \",#+\", \",,*\" and \",,#+\"."
+ (replace-regexp-in-string
+ "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1))
+
(defun org-edit-src-exit (&optional context)
"Exit special edit and protect problematic lines."
(interactive)
(let* ((beg org-edit-src-beg-marker)
(end org-edit-src-end-marker)
(ovl org-edit-src-overlay)
+ (bufstr (buffer-string))
(buffer (current-buffer))
(single (org-bound-and-true-p org-edit-src-force-single-line))
(macro (eq single 'macro-definition))
(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")))
+ (org-escape-code-in-region (point-min) (point-max))
+ (setq delta (+ delta
+ (save-excursion
+ (org-goto-line line)
+ (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1
+ 0)))))
(when (org-bound-and-true-p org-edit-src-picture)
(setq preserve-indentation nil)
(untabify (point-min) (point-max))
(if (org-bound-and-true-p org-edit-src-picture)
(setq total-nindent (+ total-nindent 2)))
(setq code (buffer-string))
+ (when (eq context 'save)
+ (erase-buffer)
+ (insert bufstr))
(set-buffer-modified-p nil))
(org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
- (kill-buffer buffer)
+ (if (eq context 'save) (save-buffer)
+ (kill-buffer buffer))
(goto-char beg)
(when allow-write-back-p
- (delete-region beg end)
- (insert code)
+ (delete-region beg (max beg end))
+ (unless (string-match "\\`[ \t]*\\'" code)
+ (insert code))
(goto-char beg)
(if single (just-one-space)))
(if (memq t (mapcar (lambda (overlay)
;; 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)
+ (move-marker beg nil)
+ (move-marker end nil)))
(unless (eq context 'save)
(when org-edit-src-saved-temp-window-config
(set-window-configuration org-edit-src-saved-temp-window-config)
(setq org-edit-src-saved-temp-window-config nil))))
+(defmacro org-src-in-org-buffer (&rest body)
+ `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg)
+ (save-window-excursion
+ (org-edit-src-exit 'save)
+ ,@body
+ (setq msg (current-message))
+ (if (eq org-src-window-setup 'other-frame)
+ (let ((org-src-window-setup 'current-window))
+ (org-edit-src-code 'save))
+ (org-edit-src-code 'save)))
+ (setq buffer-undo-list ul)
+ (push-mark m 'nomessage)
+ (goto-char (min p (point-max)))
+ (message (or msg ""))))
+(def-edebug-spec org-src-in-org-buffer (body))
+
(defun org-edit-src-save ()
"Save parent buffer with current state source-code buffer."
(interactive)
- (let ((p (point)) (m (mark)) msg)
- (save-window-excursion
- (org-edit-src-exit 'save)
- (save-buffer)
- (setq msg (current-message))
- (if (eq org-src-window-setup 'other-frame)
- (let ((org-src-window-setup 'current-window))
- (org-edit-src-code 'save))
- (org-edit-src-code 'save)))
- (push-mark m 'nomessage)
- (goto-char (min p (point-max)))
- (message (or msg ""))))
+ (org-src-in-org-buffer (save-buffer)))
+
+(declare-function org-babel-tangle "ob-tangle" (&optional only-this-block target-file lang))
+
+(defun org-src-tangle (arg)
+ "Tangle the parent buffer."
+ (interactive)
+ (org-src-in-org-buffer (org-babel-tangle arg)))
(defun org-src-mode-configure-edit-buffer ()
(when (org-bound-and-true-p org-edit-src-from-org-mode)
(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 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
+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
"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
+ :version "24.1"
:group 'org-babel)
(defun org-src-native-tab-command-maybe ()
Alter code block according to effect of TAB in the language major
mode."
(and org-src-tab-acts-natively
+ (not (equal this-command 'org-shifttab))
(let ((org-src-strip-leading-and-trailing-blank-lines nil))
(org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
(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
+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)))
(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
+ (insert 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
+ (+ start (1- pos)) (1- (+ start next)) 'face
(get-text-property pos 'face) org-buffer)
(setq pos next)))
(add-text-properties
(font-lock-fontify-region (nth 0 info) (nth 1 info)))))
(defun org-src-fontify-buffer ()
- "Fontify all code blocks in the current buffer"
+ "Fontify all code blocks in the current buffer."
(interactive)
(org-babel-map-src-blocks nil
(org-src-fontify-block)))
(provide 'org-src)
-
;;; org-src.el ends here