lisp/org/org-src.el

   1 ;;; org-src.el --- Source code examples in Org
   2 ;;
   3 ;; Copyright (C) 2004-2011  Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   6 ;;         Bastien Guerry <bzg AT altern DOT org>
   7 ;;         Dan Davison <davison at stats dot ox dot ac dot uk>
   8 ;; Keywords: outlines, hypermedia, calendar, wp
   9 ;; Homepage: http://orgmode.org
  10 ;; Version: 7.7
  11 ;;
  12 ;; This file is part of GNU Emacs.
  13 ;;
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;;; Commentary:
  29
  30 ;; This file contains the code dealing with source code examples in Org-mode.
  31
  32 ;;; Code:
  33
  34 (require 'org-macs)
  35 (require 'org-compat)
  36 (require 'ob-keys)
  37 (require 'ob-comint)
  38 (eval-when-compile
  39   (require 'cl))
  40
  41 (declare-function org-do-remove-indentation "org" (&optional n))
  42 (declare-function org-at-table.el-p "org" ())
  43 (declare-function org-get-indentation "org" (&optional line))
  44 (declare-function org-switch-to-buffer-other-window "org" (&rest args))
  45
  46 (defcustom org-edit-src-region-extra nil
  47   "Additional regexps to identify regions for editing with `org-edit-src-code'.
  48 For examples see the function `org-edit-src-find-region-and-lang'.
  49 The regular expression identifying the begin marker should end with a newline,
  50 and the regexp marking the end line should start with a newline, to make sure
  51 there are kept outside the narrowed region."
  52   :group 'org-edit-structure
  53   :type '(repeat
  54           (list
  55            (regexp :tag "begin regexp")
  56            (regexp :tag "end regexp")
  57            (choice :tag "language"
  58                    (string :tag "specify")
  59                    (integer :tag "from match group")
  60                    (const :tag "from `lang' element")
  61                    (const :tag "from `style' element")))))
  62
  63 (defcustom org-coderef-label-format "(ref:%s)"
  64   "The default coderef format.
  65 This format string will be used to search for coderef labels in literal
  66 examples (EXAMPLE and SRC blocks).  The format can be overwritten in
  67 an individual literal example with the -l option, like
  68
  69 #+BEGIN_SRC pascal +n -r -l \"((%s))\"
  70 ...
  71 #+END_SRC
  72
  73 If you want to use this for HTML export, make sure that the format does
  74 not introduce special font-locking, and avoid the HTML special
  75 characters `<', `>', and `&'.  The reason for this restriction is that
  76 the labels are searched for only after htmlize has done its job."
  77   :group 'org-edit-structure ; FIXME this is not in the right group
  78   :type 'string)
  79
  80 (defcustom org-edit-fixed-width-region-mode 'artist-mode
  81   "The mode that should be used to edit fixed-width regions.
  82 These are the regions where each line starts with a colon."
  83   :group 'org-edit-structure
  84   :type '(choice
  85           (const artist-mode)
  86           (const picture-mode)
  87           (const fundamental-mode)
  88           (function :tag "Other (specify)")))
  89
  90 (defcustom org-src-preserve-indentation nil
  91   "If non-nil preserve leading whitespace characters on export.
  92 If non-nil leading whitespace characters in source code blocks
  93 are preserved on export, and when switching between the org
  94 buffer and the language mode edit buffer.  If this variable is nil
  95 then, after editing with \\[org-edit-src-code], the
  96 minimum (across-lines) number of leading whitespace characters
  97 are removed from all lines, and the code block is uniformly
  98 indented according to the value of `org-edit-src-content-indentation'."
  99   :group 'org-edit-structure
 100   :type 'boolean)
 101
 102 (defcustom org-edit-src-content-indentation 2
 103   "Indentation for the content of a source code block.
 104 This should be the number of spaces added to the indentation of the #+begin
 105 line in order to compute the indentation of the block content after
 106 editing it with \\[org-edit-src-code].  Has no effect if
 107 `org-src-preserve-indentation' is non-nil."
 108   :group 'org-edit-structure
 109   :type 'integer)
 110
 111 (defvar org-src-strip-leading-and-trailing-blank-lines nil
 112   "If non-nil, blank lines are removed when exiting the code edit
 113 buffer.")
 114
 115 (defcustom org-edit-src-persistent-message t
 116   "Non-nil means show persistent exit help message while editing src examples.
 117 The message is shown in the header-line, which will be created in the
 118 first line of the window showing the editing buffer."
 119   :group 'org-edit-structure
 120   :type 'boolean)
 121
 122 (defcustom org-src-window-setup 'reorganize-frame
 123   "How the source code edit buffer should be displayed.
 124 Possible values for this option are:
 125
 126 current-window    Show edit buffer in the current window, keeping all other
 127                   windows.
 128 other-window      Use `switch-to-buffer-other-window' to display edit buffer.
 129 reorganize-frame  Show only two windows on the current frame, the current
 130                   window and the edit buffer. When exiting the edit buffer,
 131                   return to one window.
 132 other-frame       Use `switch-to-buffer-other-frame' to display edit buffer.
 133                   Also, when exiting the edit buffer, kill that frame."
 134   :group 'org-edit-structure
 135   :type '(choice
 136           (const current-window)
 137           (const other-frame)
 138           (const other-window)
 139           (const reorganize-frame)))
 140
 141 (defvar org-src-mode-hook nil
 142   "Hook  run after Org switched a source code snippet to its Emacs mode.
 143 This hook will run
 144
 145 - when editing a source code snippet with \"C-c '\".
 146 - When formatting a source code snippet for export with htmlize.
 147
 148 You may want to use this hook for example to turn off `outline-minor-mode'
 149 or similar things which you want to have when editing a source code file,
 150 but which mess up the display of a snippet in Org exported files.")
 151
 152 (defcustom org-src-lang-modes
 153   '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
 154     ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
 155     ("calc" . fundamental) ("C" . c))
 156   "Alist mapping languages to their major mode.
 157 The key is the language name, the value is the string that should
 158 be inserted as the name of the major mode.  For many languages this is
 159 simple, but for language where this is not the case, this variable
 160 provides a way to simplify things on the user side.
 161 For example, there is no ocaml-mode in Emacs, but the mode to use is
 162 `tuareg-mode'."
 163   :group 'org-edit-structure
 164   :type '(repeat
 165           (cons
 166            (string "Language name")
 167            (symbol "Major mode"))))
 168
 169 ;;; Editing source examples
 170
 171 (defvar org-src-mode-map (make-sparse-keymap))
 172 (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit)
 173
 174 (defvar org-edit-src-force-single-line nil)
 175 (defvar org-edit-src-from-org-mode nil)
 176 (defvar org-edit-src-allow-write-back-p t)
 177 (defvar org-edit-src-picture nil)
 178 (defvar org-edit-src-beg-marker nil)
 179 (defvar org-edit-src-end-marker nil)
 180 (defvar org-edit-src-overlay nil)
 181 (defvar org-edit-src-block-indentation nil)
 182 (defvar org-edit-src-saved-temp-window-config nil)
 183
 184 (defvar org-src-ask-before-returning-to-edit-buffer t
 185   "If nil, when org-edit-src code is used on a block that already
 186   has an active edit buffer, it will switch to that edit buffer
 187   immediately; otherwise it will ask whether you want to return
 188   to the existing edit buffer.")
 189
 190 (defvar org-src-babel-info nil)
 191
 192 (define-minor-mode org-src-mode
 193   "Minor mode for language major mode buffers generated by org.
 194 This minor mode is turned on in two situations:
 195 - when editing a source code snippet with \"C-c '\".
 196 - When formatting a source code snippet for export with htmlize.
 197 There is a mode hook, and keybindings for `org-edit-src-exit' and
 198 `org-edit-src-save'")
 199
 200 (defun org-edit-src-code (&optional context code edit-buffer-name)
 201   "Edit the source code example at point.
 202 The example is copied to a separate buffer, and that buffer is
 203 switched to the correct language mode.  When done, exit with
 204 \\[org-edit-src-exit].  This will remove the original code in the
 205 Org buffer, and replace it with the edited version. Optional
 206 argument CONTEXT is used by \\[org-edit-src-save] when calling
 207 this function. See \\[org-src-window-setup] to configure the
 208 display of windows containing the Org buffer and the code
 209 buffer."
 210   (interactive)
 211   (unless (eq context 'save)
 212     (setq org-edit-src-saved-temp-window-config (current-window-configuration)))
 213   (let ((mark (and (org-region-active-p) (mark)))
 214         (case-fold-search t)
 215         (info (org-edit-src-find-region-and-lang))
 216         (full-info (org-babel-get-src-block-info))
 217         (org-mode-p (or (org-mode-p) (derived-mode-p 'org-mode)))
 218         (beg (make-marker))
 219         (end (make-marker))
 220         (allow-write-back-p (null code))
 221         block-nindent total-nindent ovl lang lang-f single lfmt buffer msg
 222         begline markline markcol line col transmitted-variables)
 223     (if (not info)
 224         nil
 225       (setq beg (move-marker beg (nth 0 info))
 226             end (move-marker end (nth 1 info))
 227             msg (if allow-write-back-p
 228                     (substitute-command-keys
 229                      "Edit, then exit with C-c ' (C-c and single quote)")
 230                   "Exit with C-c ' (C-c and single quote)")
 231             code (or code (buffer-substring-no-properties beg end))
 232             lang (or (cdr (assoc (nth 2 info) org-src-lang-modes))
 233                      (nth 2 info))
 234             lang (if (symbolp lang) (symbol-name lang) lang)
 235             single (nth 3 info)
 236             block-nindent (nth 5 info)
 237             lang-f (intern (concat lang "-mode"))
 238             begline (save-excursion (goto-char beg) (org-current-line))
 239             transmitted-variables
 240             `((org-edit-src-content-indentation
 241                ,org-edit-src-content-indentation)
 242               (org-edit-src-force-single-line ,single)
 243               (org-edit-src-from-org-mode ,org-mode-p)
 244               (org-edit-src-allow-write-back-p ,allow-write-back-p)
 245               (org-src-preserve-indentation ,org-src-preserve-indentation)
 246               (org-src-babel-info ,(org-babel-get-src-block-info 'light))
 247               (org-coderef-label-format
 248                ,(or (nth 4 info) org-coderef-label-format))
 249               (org-edit-src-beg-marker ,beg)
 250               (org-edit-src-end-marker ,end)
 251               (org-edit-src-block-indentation ,block-nindent)))
 252       (if (and mark (>= mark beg) (<= mark (1+ end)))
 253           (save-excursion (goto-char (min mark end))
 254                           (setq markline (org-current-line)
 255                                 markcol (current-column))))
 256       (if (equal lang-f 'table.el-mode)
 257           (setq lang-f (lambda ()
 258                          (text-mode)
 259                          (if (org-bound-and-true-p flyspell-mode)
 260                              (flyspell-mode -1))
 261                          (table-recognize)
 262                          (org-set-local 'org-edit-src-content-indentation 0))))
 263       (unless (functionp lang-f)
 264         (error "No such language mode: %s" lang-f))
 265       (save-excursion
 266         (if (> (point) end) (goto-char end))
 267         (setq line (org-current-line)
 268               col (current-column)))
 269       (if (and (setq buffer (org-edit-src-find-buffer beg end))
 270                (if org-src-ask-before-returning-to-edit-buffer
 271                    (y-or-n-p "Return to existing edit buffer? [n] will revert changes: ") t))
 272           (org-src-switch-to-buffer buffer 'return)
 273         (when buffer
 274           (with-current-buffer buffer
 275             (if (boundp 'org-edit-src-overlay)
 276                 (delete-overlay org-edit-src-overlay)))
 277           (kill-buffer buffer))
 278         (setq buffer (generate-new-buffer
 279                       (or edit-buffer-name
 280                           (org-src-construct-edit-buffer-name (buffer-name) lang))))
 281         (setq ovl (make-overlay beg end))
 282         (overlay-put ovl 'edit-buffer buffer)
 283         (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
 284         (overlay-put ovl 'face 'secondary-selection)
 285         (overlay-put ovl
 286                      'keymap
 287                      (let ((map (make-sparse-keymap)))
 288                        (define-key map [mouse-1] 'org-edit-src-continue)
 289                        map))
 290         (overlay-put ovl :read-only "Leave me alone")
 291         (setq transmitted-variables
 292               (append transmitted-variables `((org-edit-src-overlay ,ovl))))
 293         (org-src-switch-to-buffer buffer 'edit)
 294         (if (eq single 'macro-definition)
 295             (setq code (replace-regexp-in-string "\\\\n" "\n" code t t)))
 296         (insert code)
 297         (remove-text-properties (point-min) (point-max)
 298                                 '(display nil invisible nil intangible nil))
 299         (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables))
 300           (setq total-nindent (or (org-do-remove-indentation) 0)))
 301         (let ((org-inhibit-startup t))
 302           (condition-case e
 303               (funcall lang-f)
 304             (error
 305              (error "Language mode `%s' fails with: %S" lang-f (nth 1 e)))))
 306         (dolist (pair transmitted-variables)
 307           (org-set-local (car pair) (cadr pair)))
 308         (when org-mode-p
 309           (goto-char (point-min))
 310           (while (re-search-forward "^," nil t)
 311             (if (eq (org-current-line) line) (setq total-nindent (1+ total-nindent)))
 312             (replace-match "")))
 313         (when markline
 314           (org-goto-line (1+ (- markline begline)))
 315           (org-move-to-column
 316            (if org-src-preserve-indentation markcol
 317              (max 0 (- markcol total-nindent))))
 318           (push-mark (point) 'no-message t)
 319           (setq deactivate-mark nil))
 320         (org-goto-line (1+ (- line begline)))
 321         (org-move-to-column
 322          (if org-src-preserve-indentation col (max 0 (- col total-nindent))))
 323         (org-src-mode)
 324         (set-buffer-modified-p nil)
 325         (and org-edit-src-persistent-message
 326              (org-set-local 'header-line-format msg))
 327         (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang))))
 328           (when (fboundp edit-prep-func)
 329             (funcall edit-prep-func full-info))))
 330       t)))
 331
 332 (defun org-edit-src-continue (e)
 333   (interactive "e")
 334   (mouse-set-point e)
 335   (let ((buf (get-char-property (point) 'edit-buffer)))
 336     (if buf (org-src-switch-to-buffer buf 'continue)
 337       (error "Something is wrong here"))))
 338
 339 (defun org-src-switch-to-buffer (buffer context)
 340   (case org-src-window-setup
 341     ('current-window
 342      (switch-to-buffer buffer))
 343     ('other-window
 344      (switch-to-buffer-other-window buffer))
 345     ('other-frame
 346      (case context
 347        ('exit
 348         (let ((frame (selected-frame)))
 349           (switch-to-buffer-other-frame buffer)
 350           (delete-frame frame)))
 351        ('save
 352         (kill-buffer (current-buffer))
 353         (switch-to-buffer buffer))
 354        (t
 355         (switch-to-buffer-other-frame buffer))))
 356     ('reorganize-frame
 357      (if (eq context 'edit) (delete-other-windows))
 358      (org-switch-to-buffer-other-window buffer)
 359      (if (eq context 'exit) (delete-other-windows)))
 360     ('switch-invisibly
 361      (set-buffer buffer))
 362     (t
 363      (message "Invalid value %s for org-src-window-setup"
 364               (symbol-name org-src-window-setup))
 365      (switch-to-buffer buffer))))
 366
 367 (defun org-src-construct-edit-buffer-name (org-buffer-name lang)
 368   "Construct the buffer name for a source editing buffer."
 369   (concat "*Org Src " org-buffer-name "[ " lang " ]*"))
 370
 371 (defun org-edit-src-find-buffer (beg end)
 372   "Find a source editing buffer that is already editing the region BEG to END."
 373   (catch 'exit
 374     (mapc
 375      (lambda (b)
 376        (with-current-buffer b
 377          (if (and (string-match "\\`*Org Src " (buffer-name))
 378                   (local-variable-p 'org-edit-src-beg-marker (current-buffer))
 379                   (local-variable-p 'org-edit-src-end-marker (current-buffer))
 380                   (equal beg org-edit-src-beg-marker)
 381                   (equal end org-edit-src-end-marker))
 382              (throw 'exit (current-buffer)))))
 383      (buffer-list))
 384     nil))
 385
 386 (defun org-edit-fixed-width-region ()
 387   "Edit the fixed-width ascii drawing at point.
 388 This must be a region where each line starts with a colon followed by
 389 a space character.
 390 An new buffer is created and the fixed-width region is copied into it,
 391 and the buffer is switched into `artist-mode' for editing.  When done,
 392 exit with \\[org-edit-src-exit].  The edited text will then replace
 393 the fragment in the Org-mode buffer."
 394   (interactive)
 395   (let ((line (org-current-line))
 396         (col (current-column))
 397         (case-fold-search t)
 398         (msg (substitute-command-keys
 399               "Edit, then exit with C-c ' (C-c and single quote)"))
 400         (org-mode-p (org-mode-p))
 401         (beg (make-marker))
 402         (end (make-marker))
 403         (preserve-indentation org-src-preserve-indentation)
 404         block-nindent ovl beg1 end1 code begline buffer)
 405     (beginning-of-line 1)
 406     (if (looking-at "[ \t]*[^:\n \t]")
 407         nil
 408       (if (looking-at "[ \t]*\\(\n\\|\\'\\)")
 409           (setq beg1 (point) end1 beg1)
 410         (save-excursion
 411           (if (re-search-backward "^[ \t]*[^: \t]" nil 'move)
 412               (setq beg1 (point-at-bol 2))
 413             (setq beg1 (point))))
 414         (save-excursion
 415           (if (re-search-forward "^[ \t]*[^: \t]" nil 'move)
 416               (setq end1 (1- (match-beginning 0)))
 417             (setq end1 (point))))
 418         (org-goto-line line))
 419       (setq beg (move-marker beg beg1)
 420             end (move-marker end end1)
 421             code (buffer-substring-no-properties beg end)
 422             begline (save-excursion (goto-char beg) (org-current-line)))
 423       (if (and (setq buffer (org-edit-src-find-buffer beg end))
 424                (y-or-n-p "Return to existing edit buffer? [n] will revert changes: "))
 425           (switch-to-buffer buffer)
 426         (when buffer
 427           (with-current-buffer buffer
 428             (if (boundp 'org-edit-src-overlay)
 429                 (delete-overlay org-edit-src-overlay)))
 430           (kill-buffer buffer))
 431         (setq buffer (generate-new-buffer
 432                       (org-src-construct-edit-buffer-name
 433                        (buffer-name) "Fixed Width")))
 434         (setq ovl (make-overlay beg end))
 435         (overlay-put ovl 'face 'secondary-selection)
 436         (overlay-put ovl 'edit-buffer buffer)
 437         (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment")
 438         (overlay-put ovl 'face 'secondary-selection)
 439         (overlay-put ovl
 440                          'keymap
 441                          (let ((map (make-sparse-keymap)))
 442                            (define-key map [mouse-1] 'org-edit-src-continue)
 443                            map))
 444         (overlay-put ovl :read-only "Leave me alone")
 445         (switch-to-buffer buffer)
 446         (insert code)
 447         (remove-text-properties (point-min) (point-max)
 448                                 '(display nil invisible nil intangible nil))
 449         (setq block-nindent (or (org-do-remove-indentation) 0))
 450         (cond
 451          ((eq org-edit-fixed-width-region-mode 'artist-mode)
 452           (fundamental-mode)
 453           (artist-mode 1))
 454          (t (funcall org-edit-fixed-width-region-mode)))
 455         (set (make-local-variable 'org-edit-src-force-single-line) nil)
 456         (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p)
 457         (set (make-local-variable 'org-edit-src-picture) t)
 458         (goto-char (point-min))
 459         (while (re-search-forward "^[ \t]*: ?" nil t)
 460           (replace-match ""))
 461         (org-goto-line (1+ (- line begline)))
 462         (org-move-to-column (max 0 (- col block-nindent 2)))
 463         (org-set-local 'org-edit-src-beg-marker beg)
 464         (org-set-local 'org-edit-src-end-marker end)
 465         (org-set-local 'org-edit-src-overlay ovl)
 466         (org-set-local 'org-edit-src-block-indentation block-nindent)
 467         (org-set-local 'org-edit-src-content-indentation 0)
 468         (org-set-local 'org-src-preserve-indentation nil)
 469         (org-src-mode)
 470         (set-buffer-modified-p nil)
 471         (and org-edit-src-persistent-message
 472              (org-set-local 'header-line-format msg)))
 473       (message "%s" msg)
 474       t)))
 475
 476 (defun org-edit-src-find-region-and-lang ()
 477   "Find the region and language for a local edit.
 478 Return a list with beginning and end of the region, a string representing
 479 the language, a switch telling if the content should be in a single line."
 480   (let ((re-list
 481          (append
 482           org-edit-src-region-extra
 483           '(
 484             ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang)
 485             ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style)
 486             ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental")
 487             ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp")
 488             ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl")
 489             ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python")
 490             ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby")
 491             ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2)
 492             ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental")
 493             ("^[ \t]*#\\+html:" "\n" "html" single-line)
 494             ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html")
 495             ("^[ \t]*#\\+latex:" "\n" "latex" single-line)
 496             ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex")
 497             ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line)
 498             ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental")
 499             ("^[ \t]*#\\+docbook:" "\n" "xml" single-line)
 500             ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)"
 501              "\n" "fundamental" macro-definition)
 502             ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml")
 503             )))
 504         (pos (point))
 505         re1 re2 single beg end lang lfmt match-re1 ind entry)
 506     (catch 'exit
 507       (while (setq entry (pop re-list))
 508         (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry)
 509               single (nth 3 entry))
 510         (save-excursion
 511           (if (or (looking-at re1)
 512                   (re-search-backward re1 nil t))
 513               (progn
 514                 (setq match-re1 (match-string 0))
 515                 (setq beg (match-end 0)
 516                       lang (org-edit-src-get-lang lang)
 517                       lfmt (org-edit-src-get-label-format match-re1)
 518                       ind (org-edit-src-get-indentation (match-beginning 0)))
 519                 (if (and (re-search-forward re2 nil t)
 520                          (>= (match-end 0) pos))
 521                     (throw 'exit (list beg (match-beginning 0)
 522                                        lang single lfmt ind))))
 523             (if (or (looking-at re2)
 524                     (re-search-forward re2 nil t))
 525                 (progn
 526                   (setq end (match-beginning 0))
 527                   (if (and (re-search-backward re1 nil t)
 528                            (<= (match-beginning 0) pos))
 529                       (progn
 530                         (setq lfmt (org-edit-src-get-label-format
 531                                     (match-string 0))
 532                               ind (org-edit-src-get-indentation
 533                                    (match-beginning 0)))
 534                         (throw 'exit
 535                                (list (match-end 0) end
 536                                      (org-edit-src-get-lang lang)
 537                                      single lfmt ind)))))))))
 538       (when (org-at-table.el-p)
 539         (re-search-backward "^[\t]*[^ \t|\\+]" nil t)
 540         (setq beg (1+ (point-at-eol)))
 541         (goto-char beg)
 542         (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t)
 543             (progn (goto-char (point-max)) (newline)))
 544         (setq end (point-at-bol))
 545         (setq ind (org-edit-src-get-indentation beg))
 546         (throw 'exit (list beg end 'table.el nil nil ind))))))
 547
 548 (defun org-edit-src-get-lang (lang)
 549   "Extract the src language."
 550   (let ((m (match-string 0)))
 551     (cond
 552      ((stringp lang) lang)
 553      ((integerp lang) (match-string lang))
 554      ((and (eq lang 'lang)
 555            (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m))
 556       (match-string 1 m))
 557      ((and (eq lang 'style)
 558            (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m))
 559       (match-string 1 m))
 560      (t "fundamental"))))
 561
 562 (defun org-edit-src-get-label-format (s)
 563   "Extract the label format."
 564   (save-match-data
 565     (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s)
 566         (match-string 1 s))))
 567
 568 (defun org-edit-src-get-indentation (pos)
 569   "Count leading whitespace characters on line."
 570   (save-match-data
 571     (goto-char pos)
 572     (org-get-indentation)))
 573
 574 (defun org-edit-src-exit (&optional context)
 575   "Exit special edit and protect problematic lines."
 576   (interactive)
 577   (unless (org-bound-and-true-p org-edit-src-from-org-mode)
 578     (error "This is not a sub-editing buffer, something is wrong"))
 579   (widen)
 580   (let* ((beg org-edit-src-beg-marker)
 581          (end org-edit-src-end-marker)
 582          (ovl org-edit-src-overlay)
 583          (buffer (current-buffer))
 584          (single (org-bound-and-true-p org-edit-src-force-single-line))
 585          (macro (eq single 'macro-definition))
 586          (total-nindent (+ (or org-edit-src-block-indentation 0)
 587                            org-edit-src-content-indentation))
 588          (preserve-indentation org-src-preserve-indentation)
 589          (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p))
 590          (delta 0) code line col indent)
 591     (when allow-write-back-p
 592       (unless preserve-indentation (untabify (point-min) (point-max)))
 593       (if org-src-strip-leading-and-trailing-blank-lines
 594           (save-excursion
 595             (goto-char (point-min))
 596             (if (looking-at "[ \t\n]*\n") (replace-match ""))
 597             (unless macro
 598               (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match ""))))))
 599     (setq line (if (org-bound-and-true-p org-edit-src-force-single-line)
 600                    1
 601                  (org-current-line))
 602           col (current-column))
 603     (when allow-write-back-p
 604       (when single
 605         (goto-char (point-min))
 606         (if (re-search-forward "\\s-+\\'" nil t) (replace-match ""))
 607         (goto-char (point-min))
 608         (let ((cnt 0))
 609           (while (re-search-forward "\n" nil t)
 610             (setq cnt (1+ cnt))
 611             (replace-match (if macro "\\n" " ") t t))
 612           (when (and macro (> cnt 0))
 613             (goto-char (point-max)) (insert "\\n")))
 614         (goto-char (point-min))
 615         (if (looking-at "\\s-*") (replace-match " ")))
 616       (when (org-bound-and-true-p org-edit-src-from-org-mode)
 617         (goto-char (point-min))
 618         (while (re-search-forward
 619                 (if (org-mode-p) "^\\(.\\)" "^\\([*]\\|[ \t]*#\\+\\)") nil t)
 620           (if (eq (org-current-line) line) (setq delta (1+ delta)))
 621           (replace-match ",\\1")))
 622       (when (org-bound-and-true-p org-edit-src-picture)
 623         (setq preserve-indentation nil)
 624         (untabify (point-min) (point-max))
 625         (goto-char (point-min))
 626         (while (re-search-forward "^" nil t)
 627           (replace-match ": ")))
 628       (unless (or single preserve-indentation (= total-nindent 0))
 629         (setq indent (make-string total-nindent ?\ ))
 630         (goto-char (point-min))
 631         (while (re-search-forward "^" nil t)
 632           (replace-match indent)))
 633       (if (org-bound-and-true-p org-edit-src-picture)
 634           (setq total-nindent (+ total-nindent 2)))
 635       (setq code (buffer-string))
 636       (set-buffer-modified-p nil))
 637     (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit))
 638     (kill-buffer buffer)
 639     (goto-char beg)
 640     (when allow-write-back-p
 641       (delete-region beg end)
 642       (insert code)
 643       (goto-char beg)
 644       (if single (just-one-space)))
 645     (if (memq t (mapcar (lambda (overlay)
 646                           (eq (overlay-get overlay 'invisible)
 647                               'org-hide-block))
 648                         (overlays-at (point))))
 649         ;; Block is hidden; put point at start of block
 650         (beginning-of-line 0)
 651       ;; Block is visible, put point where it was in the code buffer
 652       (org-goto-line (1- (+ (org-current-line) line)))
 653       (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))
 654     (move-marker beg nil)
 655     (move-marker end nil))
 656   (unless (eq context 'save)
 657     (when org-edit-src-saved-temp-window-config
 658       (set-window-configuration org-edit-src-saved-temp-window-config)
 659       (setq org-edit-src-saved-temp-window-config nil))))
 660
 661 (defun org-edit-src-save ()
 662   "Save parent buffer with current state source-code buffer."
 663   (interactive)
 664   (let ((p (point)) (m (mark)) msg)
 665     (save-window-excursion
 666       (org-edit-src-exit 'save)
 667       (save-buffer)
 668       (setq msg (current-message))
 669       (if (eq org-src-window-setup 'other-frame)
 670           (let ((org-src-window-setup 'current-window))
 671             (org-edit-src-code 'save))
 672         (org-edit-src-code 'save)))
 673     (push-mark m 'nomessage)
 674     (goto-char (min p (point-max)))
 675     (message (or msg ""))))
 676
 677 (defun org-src-mode-configure-edit-buffer ()
 678   (when (org-bound-and-true-p org-edit-src-from-org-mode)
 679     (org-add-hook 'kill-buffer-hook
 680                   #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local)
 681     (if (org-bound-and-true-p org-edit-src-allow-write-back-p)
 682         (progn
 683           (setq buffer-offer-save t)
 684           (setq buffer-file-name
 685                 (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker))
 686                         "[" (buffer-name) "]"))
 687           (if (featurep 'xemacs)
 688               (progn
 689                 (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4
 690                 (setq write-contents-hooks '(org-edit-src-save)))
 691             (setq write-contents-functions '(org-edit-src-save))))
 692       (setq buffer-read-only t))))
 693
 694 (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer)
 695
 696
 697 (defun org-src-associate-babel-session (info)
 698   "Associate edit buffer with comint session."
 699   (interactive)
 700   (let ((session (cdr (assoc :session (nth 2 info)))))
 701     (and session (not (string= session "none"))
 702          (org-babel-comint-buffer-livep session)
 703          ((lambda (f) (and (fboundp f) (funcall f session)))
 704           (intern (format "org-babel-%s-associate-session" (nth 0 info)))))))
 705
 706 (defun org-src-babel-configure-edit-buffer ()
 707   (when org-src-babel-info
 708     (org-src-associate-babel-session org-src-babel-info)))
 709
 710 (org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer)
 711 (defmacro org-src-do-at-code-block (&rest body)
 712   "Execute a command from an edit buffer in the Org-mode buffer."
 713   `(let ((beg-marker org-edit-src-beg-marker))
 714      (if beg-marker
 715          (with-current-buffer (marker-buffer beg-marker)
 716            (goto-char (marker-position beg-marker))
 717            ,@body))))
 718
 719 (defun org-src-do-key-sequence-at-code-block (&optional key)
 720   "Execute key sequence at code block in the source Org buffer.
 721 The command bound to KEY in the Org-babel key map is executed
 722 remotely with point temporarily at the start of the code block in
 723 the Org buffer.
 724
 725 This command is not bound to a key by default, to avoid conflicts
 726 with language major mode bindings. To bind it to C-c @ in all
 727 language major modes, you could use
 728
 729   (add-hook 'org-src-mode-hook
 730             (lambda () (define-key org-src-mode-map \"\\C-c@\"
 731                     'org-src-do-key-sequence-at-code-block)))
 732
 733 In that case, for example, C-c @ t issued in code edit buffers
 734 would tangle the current Org code block, C-c @ e would execute
 735 the block and C-c @ h would display the other available
 736 Org-babel commands."
 737   (interactive "kOrg-babel key: ")
 738   (if (equal key (kbd "C-g")) (keyboard-quit)
 739     (org-edit-src-save)
 740     (org-src-do-at-code-block
 741      (call-interactively
 742       (lookup-key org-babel-map key)))))
 743
 744 (defcustom org-src-tab-acts-natively nil
 745   "If non-nil, the effect of TAB in a code block is as if it were
 746 issued in the language major mode buffer."
 747   :type 'boolean
 748   :group 'org-babel)
 749
 750 (defun org-src-native-tab-command-maybe ()
 751   "Perform language-specific TAB action.
 752 Alter code block according to effect of TAB in the language major
 753 mode."
 754   (and org-src-tab-acts-natively
 755        (let ((org-src-strip-leading-and-trailing-blank-lines nil))
 756          (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))))
 757
 758 (add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe)
 759
 760 (defun org-src-font-lock-fontify-block (lang start end)
 761   "Fontify code block.
 762 This function is called by emacs automatic fontification, as long
 763 as `org-src-fontify-natively' is non-nil. For manual
 764 fontification of code blocks see `org-src-fontify-block' and
 765 `org-src-fontify-buffer'"
 766   (let ((lang-mode (org-src-get-lang-mode lang)))
 767     (if (fboundp lang-mode)
 768         (let ((string (buffer-substring-no-properties start end))
 769               (modified (buffer-modified-p))
 770               (org-buffer (current-buffer)) pos next)
 771           (remove-text-properties start end '(face nil))
 772           (with-current-buffer
 773               (get-buffer-create
 774                (concat " org-src-fontification:" (symbol-name lang-mode)))
 775             (delete-region (point-min) (point-max))
 776             (insert (concat string " ")) ;; so there's a final property change
 777             (unless (eq major-mode lang-mode) (funcall lang-mode))
 778             (font-lock-fontify-buffer)
 779             (setq pos (point-min))
 780             (while (setq next (next-single-property-change pos 'face))
 781               (put-text-property
 782                (+ start (1- pos)) (+ start next) 'face
 783                (get-text-property pos 'face) org-buffer)
 784               (setq pos next)))
 785           (add-text-properties
 786            start end
 787            '(font-lock-fontified t fontified t font-lock-multiline t))
 788           (set-buffer-modified-p modified)))))
 789
 790 (defun org-src-fontify-block ()
 791   "Fontify code block at point."
 792   (interactive)
 793   (save-excursion
 794     (let ((org-src-fontify-natively t)
 795           (info (org-edit-src-find-region-and-lang)))
 796       (font-lock-fontify-region (nth 0 info) (nth 1 info)))))
 797
 798 (defun org-src-fontify-buffer ()
 799   "Fontify all code blocks in the current buffer"
 800   (interactive)
 801   (org-babel-map-src-blocks nil
 802     (org-src-fontify-block)))
 803
 804 (defun org-src-get-lang-mode (lang)
 805   "Return major mode that should be used for LANG.
 806 LANG is a string, and the returned major mode is a symbol."
 807   (intern
 808    (concat
 809     ((lambda (l) (if (symbolp l) (symbol-name l) l))
 810      (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode")))
 811
 812 (provide 'org-src)
 813
 814
 815 ;;; org-src.el ends here