diff options
Diffstat (limited to '.emacs.d/org-7.4/lisp/org-src.el')
| -rw-r--r-- | .emacs.d/org-7.4/lisp/org-src.el | 811 |
1 files changed, 0 insertions, 811 deletions
diff --git a/.emacs.d/org-7.4/lisp/org-src.el b/.emacs.d/org-7.4/lisp/org-src.el deleted file mode 100644 index c932b4a..0000000 --- a/.emacs.d/org-7.4/lisp/org-src.el +++ /dev/null @@ -1,811 +0,0 @@ -;;; org-src.el --- Source code examples in Org -;; -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; 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: 7.4 -;; -;; This file is part of GNU Emacs. -;; -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the code dealing with source code examples in Org-mode. - -;;; Code: - -(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)) - -(defcustom org-edit-src-region-extra nil - "Additional regexps to identify regions for editing with `org-edit-src-code'. -For examples see the function `org-edit-src-find-region-and-lang'. -The regular expression identifying the begin marker should end with a newline, -and the regexp marking the end line should start with a newline, to make sure -there are kept outside the narrowed region." - :group 'org-edit-structure - :type '(repeat - (list - (regexp :tag "begin regexp") - (regexp :tag "end regexp") - (choice :tag "language" - (string :tag "specify") - (integer :tag "from match group") - (const :tag "from `lang' element") - (const :tag "from `style' element"))))) - -(defcustom org-coderef-label-format "(ref:%s)" - "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 -l option, like - -#+BEGIN_SRC pascal +n -r -l \"((%s))\" -... -#+END_SRC - -If you want to use this for HTML export, make sure that the format does -not introduce special font-locking, and avoid the HTML special -characters `<', `>', and `&'. The reason for this restriction is that -the labels are searched for only after htmlize has done its job." - :group 'org-edit-structure ; FIXME this is not in the right group - :type 'string) - -(defcustom org-edit-fixed-width-region-mode 'artist-mode - "The mode that should be used to edit fixed-width regions. -These are the regions where each line starts with a colon." - :group 'org-edit-structure - :type '(choice - (const artist-mode) - (const picture-mode) - (const fundamental-mode) - (function :tag "Other (specify)"))) - -(defcustom org-src-preserve-indentation nil - "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'." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-edit-src-content-indentation 2 - "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 -`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." - :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: - -current-window Show edit buffer in the current window, keeping all other - 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, - 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." - :group 'org-edit-structure - :type '(choice - (const current-window) - (const other-frame) - (const other-window) - (const reorganize-frame))) - -(defvar org-src-mode-hook nil - "Hook run after Org switched a source code snippet to its Emacs mode. -This hook will run - -- when editing a source code snippet with \"C-c '\". -- When formatting a source code snippet for export with htmlize. - -You may want to use this hook for example to turn off `outline-minor-mode' -or similar things which you want to have when editing a source code file, -but which mess up the display of a snippet in Org exported files.") - -(defcustom org-src-lang-modes - '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) - ("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 -simple, but for language where this is not the case, this variable -provides a way to simplify things on the user side. -For example, there is no ocaml-mode in Emacs, but the mode to use is -`tuareg-mode'." - :group 'org-edit-structure - :type '(repeat - (cons - (string "Language name") - (symbol "Major mode")))) - -;;; 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-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) -(defvar org-edit-src-overlay nil) -(defvar org-edit-src-block-indentation nil) -(defvar org-edit-src-saved-temp-window-config 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.") - -(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: -- when editing a source code snippet with \"C-c '\". -- When formatting a source code snippet for export with htmlize. -There is a mode hook, and keybindings for `org-edit-src-exit' and -`org-edit-src-save'") - -(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. 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)) - (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) - (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)) - 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))) - (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)) - (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)) - (org-src-switch-to-buffer buffer 'return) - (when buffer - (with-current-buffer buffer - (if (boundp 'org-edit-src-overlay) - (delete-overlay org-edit-src-overlay))) - (kill-buffer buffer)) - (setq buffer (generate-new-buffer - (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))) - (insert code) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) - (unless preserve-indentation - (setq total-nindent (or (org-do-remove-indentation) 0))) - (let ((org-inhibit-startup t)) - (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 - (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 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) - (org-src-mode) - (set-buffer-modified-p nil) - (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg))) - (unless quietp (message "%s" msg)) - t))) - -(defun org-edit-src-continue (e) - (interactive "e") - (mouse-set-point e) - (let ((buf (get-char-property (point) 'edit-buffer))) - (if buf (org-src-switch-to-buffer buf 'continue) - (error "Something is wrong here")))) - -(defun org-src-switch-to-buffer (buffer context) - (case org-src-window-setup - ('current-window - (switch-to-buffer buffer)) - ('other-window - (switch-to-buffer-other-window buffer)) - ('other-frame - (case context - ('exit - (let ((frame (selected-frame))) - (switch-to-buffer-other-frame buffer) - (delete-frame frame))) - ('save - (kill-buffer (current-buffer)) - (switch-to-buffer 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)))) - -(defun org-src-construct-edit-buffer-name (org-buffer-name lang) - "Construct the buffer name for a source editing buffer." - (concat "*Org Src " org-buffer-name "[ " lang " ]*")) - -(defun org-edit-src-find-buffer (beg end) - "Find a source editing buffer that is already editing the region BEG to END." - (catch 'exit - (mapc - (lambda (b) - (with-current-buffer b - (if (and (string-match "\\`*Org Src " (buffer-name)) - (local-variable-p 'org-edit-src-beg-marker (current-buffer)) - (local-variable-p 'org-edit-src-end-marker (current-buffer)) - (equal beg org-edit-src-beg-marker) - (equal end org-edit-src-end-marker)) - (throw 'exit (current-buffer))))) - (buffer-list)) - nil)) - -(defun org-edit-fixed-width-region () - "Edit the fixed-width ascii drawing at point. -This must be a region where each line starts with a colon followed by -a space character. -An new buffer is created and the fixed-width region is copied into it, -and the buffer is switched into `artist-mode' for editing. When done, -exit with \\[org-edit-src-exit]. The edited text will then replace -the fragment in the Org-mode buffer." - (interactive) - (let ((line (org-current-line)) - (col (current-column)) - (case-fold-search t) - (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote)")) - (org-mode-p (eq major-mode 'org-mode)) - (beg (make-marker)) - (end (make-marker)) - (preserve-indentation org-src-preserve-indentation) - block-nindent ovl beg1 end1 code begline buffer) - (beginning-of-line 1) - (if (looking-at "[ \t]*[^:\n \t]") - nil - (if (looking-at "[ \t]*\\(\n\\|\\'\\)") - (setq beg1 (point) end1 beg1) - (save-excursion - (if (re-search-backward "^[ \t]*[^: \t]" nil 'move) - (setq beg1 (point-at-bol 2)) - (setq beg1 (point)))) - (save-excursion - (if (re-search-forward "^[ \t]*[^: \t]" nil 'move) - (setq end1 (1- (match-beginning 0))) - (setq end1 (point)))) - (org-goto-line line)) - (setq beg (move-marker beg beg1) - end (move-marker end end1) - 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: ")) - (switch-to-buffer buffer) - (when buffer - (with-current-buffer buffer - (if (boundp '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 (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)) - (overlay-put ovl :read-only "Leave me alone") - (switch-to-buffer buffer) - (insert code) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) - (setq block-nindent (or (org-do-remove-indentation) 0)) - (cond - ((eq org-edit-fixed-width-region-mode 'artist-mode) - (fundamental-mode) - (artist-mode 1)) - (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) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*: ?" nil t) - (replace-match "")) - (org-goto-line (1+ (- line begline))) - (org-move-to-column (max 0 (- col block-nindent 2))) - (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) - (org-set-local 'org-edit-src-content-indentation 0) - (org-set-local 'org-src-preserve-indentation nil) - (org-src-mode) - (set-buffer-modified-p nil) - (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg))) - (message "%s" msg) - t))) - -(defun org-edit-src-find-region-and-lang () - "Find the region and language for a local edit. -Return a list with beginning and end of the region, a string representing -the language, a switch telling if the content should be in a single line." - (let ((re-list - (append - org-edit-src-region-extra - '( - ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang) - ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style) - ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental") - ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp") - ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl") - ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python") - ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby") - ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2) - ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental") - ("^[ \t]*#\\+html:" "\n" "html" single-line) - ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html") - ("^[ \t]*#\\+latex:" "\n" "latex" single-line) - ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") - ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) - ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") - ("^[ \t]*#\\+docbook:" "\n" "xml" single-line) - ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)" - "\n" "fundamental" macro-definition) - ("^[ \t]*#\\+begin_docbook.*\n" "\n[ \t]*#\\+end_docbook" "xml") - ))) - (pos (point)) - re1 re2 single beg end lang lfmt match-re1 ind entry) - (catch 'exit - (while (setq entry (pop re-list)) - (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) - single (nth 3 entry)) - (save-excursion - (if (or (looking-at re1) - (re-search-backward re1 nil t)) - (progn - (setq match-re1 (match-string 0)) - (setq beg (match-end 0) - lang (org-edit-src-get-lang lang) - lfmt (org-edit-src-get-label-format match-re1) - ind (org-edit-src-get-indentation (match-beginning 0))) - (if (and (re-search-forward re2 nil t) - (>= (match-end 0) pos)) - (throw 'exit (list beg (match-beginning 0) - lang single lfmt ind)))) - (if (or (looking-at re2) - (re-search-forward re2 nil t)) - (progn - (setq end (match-beginning 0)) - (if (and (re-search-backward re1 nil t) - (<= (match-beginning 0) pos)) - (progn - (setq lfmt (org-edit-src-get-label-format - (match-string 0)) - ind (org-edit-src-get-indentation - (match-beginning 0))) - (throw 'exit - (list (match-end 0) end - (org-edit-src-get-lang lang) - 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." - (let ((m (match-string 0))) - (cond - ((stringp lang) lang) - ((integerp lang) (match-string lang)) - ((and (eq lang 'lang) - (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m)) - (match-string 1 m)) - ((and (eq lang 'style) - (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m)) - (match-string 1 m)) - (t "fundamental")))) - -(defun org-edit-src-get-label-format (s) - "Extract the label format." - (save-match-data - (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s) - (match-string 1 s)))) - -(defun org-edit-src-get-indentation (pos) - "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-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) - (buffer (current-buffer)) - (single (org-bound-and-true-p org-edit-src-force-single-line)) - (macro (eq single 'macro-definition)) - (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) - (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 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) - (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) - (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)))) - -(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 "")))) - -(defun org-src-mode-configure-edit-buffer () - (when (org-bound-and-true-p org-edit-src-from-org-mode) - (org-add-hook 'kill-buffer-hook - '(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 |