diff options
| author | Bastien Guerry <[email protected]> | 2013-11-12 14:13:04 +0100 |
|---|---|---|
| committer | Bastien Guerry <[email protected]> | 2013-11-12 14:13:04 +0100 |
| commit | 9b1ee27c6c88619f32fdbc4e5be7c745763c3b65 (patch) | |
| tree | a7d497c5244dc50eb09526a4d6cfcaec814b755c /lisp | |
| parent | 271672fad74cdbc9065d23d6e6cee1b8540f571b (diff) | |
Fix previous commit: remove files that are not part of Org 8.2.3a anymore
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/org/org-ascii.el | 730 | ||||
| -rw-r--r-- | lisp/org/org-beamer.el | 657 | ||||
| -rw-r--r-- | lisp/org/org-exp-blocks.el | 402 | ||||
| -rw-r--r-- | lisp/org/org-exp.el | 3354 | ||||
| -rw-r--r-- | lisp/org/org-freemind.el | 1227 | ||||
| -rw-r--r-- | lisp/org/org-html.el | 2761 | ||||
| -rw-r--r-- | lisp/org/org-icalendar.el | 692 | ||||
| -rw-r--r-- | lisp/org/org-jsinfo.el | 262 | ||||
| -rw-r--r-- | lisp/org/org-latex.el | 2901 | ||||
| -rw-r--r-- | lisp/org/org-lparse.el | 2303 | ||||
| -rw-r--r-- | lisp/org/org-mac-message.el | 216 | ||||
| -rw-r--r-- | lisp/org/org-mew.el | 136 | ||||
| -rw-r--r-- | lisp/org/org-mks.el | 134 | ||||
| -rw-r--r-- | lisp/org/org-odt.el | 2859 | ||||
| -rw-r--r-- | lisp/org/org-publish.el | 1198 | ||||
| -rw-r--r-- | lisp/org/org-remember.el | 1156 | ||||
| -rw-r--r-- | lisp/org/org-special-blocks.el | 104 | ||||
| -rw-r--r-- | lisp/org/org-vm.el | 180 | ||||
| -rw-r--r-- | lisp/org/org-wl.el | 316 | ||||
| -rw-r--r-- | lisp/org/org-xoxo.el | 129 |
20 files changed, 0 insertions, 21717 deletions
diff --git a/lisp/org/org-ascii.el b/lisp/org/org-ascii.el deleted file mode 100644 index c5a4b3775e..0000000000 --- a/lisp/org/org-ascii.el +++ /dev/null @@ -1,730 +0,0 @@ -;;; org-ascii.el --- ASCII export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;;; Code: - -(require 'org-exp) - -(eval-when-compile - (require 'cl)) - -(defgroup org-export-ascii nil - "Options specific for ASCII export of Org-mode files." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$) - "Characters for underlining headings in ASCII export. -In the given sequence, these characters will be used for level 1, 2, ..." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-bullets '(?* ?+ ?-) - "Bullet characters for headlines converted to lists in ASCII export. -The first character is used for the first lest level generated in this -way, and so on. If there are more levels than characters given here, -the list will be repeated. -Note that plain lists will keep the same bullets as the have in the -Org-mode file." - :group 'org-export-ascii - :type '(repeat character)) - -(defcustom org-export-ascii-links-to-notes t - "Non-nil means convert links to notes before the next headline. -When nil, the link will be exported in place. If the line becomes long -in this way, it will be wrapped." - :group 'org-export-ascii - :type 'boolean) - -(defcustom org-export-ascii-table-keep-all-vertical-lines nil - "Non-nil means keep all vertical lines in ASCII tables. -When nil, vertical lines will be removed except for those needed -for column grouping." - :group 'org-export-ascii - :type 'boolean) - -(defcustom org-export-ascii-table-widen-columns t - "Non-nil means widen narrowed columns for export. -When nil, narrowed columns will look in ASCII export just like in org-mode, -i.e. with \"=>\" as ellipsis." - :group 'org-export-ascii - :type 'boolean) - -(defvar org-export-ascii-entities 'ascii - "The ascii representation to be used during ascii export. -Possible values are: - -ascii Only use plain ASCII characters -latin1 Include Latin-1 character -utf8 Use all UTF-8 characters") - -;;; Hooks - -(defvar org-export-ascii-final-hook nil - "Hook run at the end of ASCII export, in the new buffer.") - -;;; ASCII export - -(defvar org-ascii-current-indentation nil) ; For communication - -;;;###autoload -(defun org-export-as-latin1 (&rest args) - "Like `org-export-as-ascii', use latin1 encoding for special symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii (org-called-interactively-p 'any) - 'latin1 args)) - -;;;###autoload -(defun org-export-as-latin1-to-buffer (&rest args) - "Like `org-export-as-ascii-to-buffer', use latin1 encoding for symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii-to-buffer - (org-called-interactively-p 'any) 'latin1 args)) - -;;;###autoload -(defun org-export-as-utf8 (&rest args) - "Like `org-export-as-ascii', use encoding for special symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii - (org-called-interactively-p 'any) - 'utf8 args)) - -;;;###autoload -(defun org-export-as-utf8-to-buffer (&rest args) - "Like `org-export-as-ascii-to-buffer', use utf8 encoding for symbols." - (interactive) - (org-export-as-encoding 'org-export-as-ascii-to-buffer - (org-called-interactively-p 'any) 'utf8 args)) - -(defun org-export-as-encoding (command interactivep encoding &rest args) - (let ((org-export-ascii-entities encoding)) - (if interactivep - (call-interactively command) - (apply command args)))) - - -;;;###autoload -(defun org-export-as-ascii-to-buffer (arg) - "Call `org-export-as-ascii` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-ascii'." - (interactive "P") - (org-export-as-ascii arg nil "*Org ASCII Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org ASCII Export*"))) - -;;;###autoload -(defun org-replace-region-by-ascii (beg end) - "Assume the current region has org-mode syntax, and convert it to plain ASCII. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in a Mail buffer and then use this -command to convert it." - (interactive "r") - (let (reg ascii buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq ascii (org-export-region-as-ascii - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq ascii (org-export-region-as-ascii - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert ascii))) - -;;;###autoload -(defun org-export-region-as-ascii (beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to plain ASCII. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted ASCII. If BUFFER is the symbol `string', return the -produced ASCII as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq ascii (org-export-region-as-ascii beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org ASCII Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-ascii nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -;;;###autoload -(defun org-export-as-ascii (arg &optional ext-plist to-buffer body-only pub-dir) - "Export the outline as a pretty ASCII file. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -underlined headlines, default is 3. Lower levels will become bulleted -lists. EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting ASCII as a string. When BODY-ONLY is set, don't produce -the file header and footer. When PUB-DIR is set, use this as the -publishing directory." - (interactive "P") - (run-hooks 'org-export-first-hook) - (setq-default org-todo-line-regexp org-todo-line-regexp) - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (custom-times org-display-custom-times) - (org-ascii-current-indentation '(0 . 0)) - (level 0) line txt - (umax nil) - (umax-toc nil) - (case-fold-search nil) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (if to-buffer - nil - (concat (file-name-as-directory - (or pub-dir - (org-export-directory :ascii opt-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".txt"))) - (filename (and filename - (if (equal (file-truename filename) - (file-truename bfname)) - (concat filename ".txt") - filename))) - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) - (get-buffer-create "*Org ASCII Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - (org-levels-open (make-vector org-level-max nil)) - (odd org-odd-levels-only) - (date (plist-get opt-plist :date)) - (author (plist-get opt-plist :author)) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and (buffer-file-name) - (file-name-sans-extension - (file-name-nondirectory bfname))) - "UNTITLED")) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (quote-re0 (concat "^\\(" org-quote-string "\\)\\( +\\|[ \t]*$\\)")) - (todo nil) - (lang-words nil) - (region - (buffer-substring - (if (org-region-active-p) (region-beginning) (point-min)) - (if (org-region-active-p) (region-end) (point-max)))) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (lines (org-split-string - (org-export-preprocess-string - region - :for-backend 'ascii - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :verbatim-multiline t - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :archived-trees - (plist-get opt-plist :archived-trees) - :add-text (plist-get opt-plist :text)) - "\n")) - thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc) - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - (set-buffer buffer) - (erase-buffer) - (fundamental-mode) - (org-install-letbind) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (org-set-local 'org-odd-levels-only odd) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - - ;; File header - (unless body-only - (when (and title (not (string= "" title))) - (org-insert-centered title ?=) - (insert "\n")) - - (if (and (or author email) - org-export-author-info) - (insert (concat (nth 1 lang-words) ": " (or author "") - (if (and org-export-email-info - email (string-match "\\S-" email)) - (concat " <" email ">") "") - "\n"))) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string "%Y-%m-%d %T %Z")))) - - (if (and date org-export-time-stamp-file) - (insert (concat (nth 2 lang-words) ": " date"\n"))) - - (unless (= (point) (point-min)) - (insert "\n\n"))) - - (if (and org-export-with-toc (not body-only)) - (progn - (push (concat (nth 3 lang-words) "\n") thetoc) - (push (concat (make-string (string-width (nth 3 lang-words)) ?=) - "\n") thetoc) - (mapc #'(lambda (line) - (if (string-match org-todo-line-regexp - line) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (match-string 3 line) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (setq txt (org-html-expand-for-ascii txt)) - - (while (string-match org-bracket-link-regexp txt) - (setq txt - (replace-match - (match-string (if (match-end 2) 3 1) txt) - t t txt))) - - (if (and (memq org-export-with-tags '(not-in-toc nil)) - (string-match - (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") - txt)) - (setq txt (replace-match "" t t txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt 1))) - - (if org-export-with-section-numbers - (setq txt (concat (org-section-number level) - " " txt))) - (if (<= level umax-toc) - (progn - (push - (concat - (make-string - (* (max 0 (- level org-min-level)) 4) ?\ ) - (format (if todo "%s (*)\n" "%s\n") txt)) - thetoc) - (setq org-last-level level)) - )))) - lines) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (org-init-section-numbers) - (while (setq line (pop lines)) - (when (and link-buffer (string-match org-outline-regexp-bol line)) - (org-export-ascii-push-links (nreverse link-buffer)) - (setq link-buffer nil)) - (setq wrap nil) - ;; Remove the quoted HTML tags. - (setq line (org-html-expand-for-ascii line)) - ;; Replace links with the description when possible - (while (string-match org-bracket-link-analytic-regexp++ line) - (setq path (match-string 3 line) - link (concat (match-string 1 line) path) - type (match-string 2 line) - desc0 (match-string 5 line) - desc0 (replace-regexp-in-string "\\\\_" "_" desc0) - desc (or desc0 link) - desc (replace-regexp-in-string "\\\\_" "_" desc)) - (if (and (> (length link) 8) - (equal (substring link 0 8) "coderef:")) - (setq line (replace-match - (format (org-export-get-coderef-format (substring link 8) desc) - (cdr (assoc - (substring link 8) - org-export-code-refs))) - t t line)) - (setq rpl (concat "[" desc "]")) - (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - (setq rpl (or (save-match-data - (funcall fnc (org-link-unescape path) - desc0 'ascii)) - rpl)) - (when (and desc0 (not (equal desc0 link))) - (if org-export-ascii-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc)))))) - (setq line (replace-match rpl t t line)))) - (when custom-times - (setq line (org-translate-time line))) - (cond - ((string-match "^\\(\\*+\\)[ \t]+\\(.*\\)" line) - ;; a Headline - (setq first-heading-pos (or first-heading-pos (point))) - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (org-ascii-level-start level txt umax lines)) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (if (not table-open) - ;; New table starts - (setq table-open t table-buffer nil)) - ;; Accumulate lines - (setq table-buffer (cons line table-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer)) - (insert (mapconcat - (lambda (x) - (org-fix-indentation x org-ascii-current-indentation)) - (org-format-table-ascii table-buffer) - "\n") "\n"))) - (t - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" - line) - (setq line (replace-match "\\1\\3:" t nil line))) - (setq line (org-fix-indentation line org-ascii-current-indentation)) - ;; Remove forced line breaks - (if (string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match "" t t line))) - (if (and org-export-with-fixed-width - (string-match "^\\([ \t]*\\)\\(:\\( \\|$\\)\\)" line)) - (setq line (replace-match "\\1" nil nil line)) - (if wrap (setq line (org-export-ascii-wrap line wrap)))) - (insert line "\n")))) - - (org-export-ascii-push-links (nreverse link-buffer)) - - (normal-mode) - - ;; insert the table of contents - (when thetoc - (goto-char (point-min)) - (if (re-search-forward "^[ \t]*\\[TABLE-OF-CONTENTS\\][ \t]*$" nil t) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos)) - (mapc 'insert thetoc) - (or (looking-at "[ \t]*\n[ \t]*\n") - (insert "\n\n"))) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (make-string (- end beg) ?\ )))) - - ;; remove display and invisible chars - (let (beg end) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'display)) - (setq end (next-single-property-change beg 'display)) - (delete-region beg end) - (goto-char beg) - (insert "=>")) - (goto-char (point-min)) - (while (setq beg (next-single-property-change (point) 'org-cwidth)) - (setq end (next-single-property-change beg 'org-cwidth)) - (delete-region beg end) - (goto-char beg))) - (run-hooks 'org-export-ascii-final-hook) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "ASCII") - (message "Exporting... done")) - ;; Return the buffer or a string, according to how this function was called - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer)))) - -;;;###autoload -(defun org-export-ascii-preprocess (parameters) - "Do extra work for ASCII export." - ;; - ;; Realign tables to get rid of narrowing - (when org-export-ascii-table-widen-columns - (let ((org-table-do-narrow nil)) - (goto-char (point-min)) - (org-ascii-replace-entities) - (goto-char (point-min)) - (org-table-map-tables - (lambda () (org-if-unprotected (org-table-align))) - 'quietly))) - ;; Put quotes around verbatim text - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (org-if-unprotected-at (match-beginning 4) - (goto-char (match-end 2)) - (backward-delete-char 1) (insert "'") - (goto-char (match-beginning 2)) - (delete-char 1) (insert "`") - (goto-char (match-end 2)))) - ;; Remove target markers - (goto-char (point-min)) - (while (re-search-forward "<<<?\\([^<>]*\\)>>>?\\([ \t]*\\)" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1\\2"))) - ;; Remove list start counters - (goto-char (point-min)) - (while (org-list-search-forward - "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t) - (replace-match "")) - (remove-text-properties - (point-min) (point-max) - '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil))) - -(defun org-html-expand-for-ascii (line) - "Handle quoted HTML for ASCII export." - (if org-export-html-expand - (while (string-match "@<[^<>\n]*>" line) - ;; We just remove the tags for now. - (setq line (replace-match "" nil nil line)))) - line) - -(defun org-ascii-replace-entities () - "Replace entities with the ASCII representation." - (let (e) - (while (re-search-forward "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" nil t) - (org-if-unprotected-at (match-beginning 1) - (setq e (org-entity-get-representation (match-string 1) - org-export-ascii-entities)) - (and e (replace-match e t t)))))) - -(defun org-export-ascii-wrap (line where) - "Wrap LINE at or before WHERE." - (let ((ind (org-get-indentation line)) - pos) - (catch 'found - (loop for i from where downto (/ where 2) do - (and (equal (aref line i) ?\ ) - (setq pos i) - (throw 'found t)))) - (if pos - (concat (substring line 0 pos) "\n" - (make-string ind ?\ ) - (substring line (1+ pos))) - line))) - -(defun org-export-ascii-push-links (link-buffer) - "Push out links in the buffer." - (when link-buffer - ;; We still have links to push out. - (insert "\n") - (let ((ind "")) - (save-match-data - (if (save-excursion - (re-search-backward - (concat "^\\(\\([ \t]*\\)\\|\\(" - org-outline-regexp - "\\)\\)[^ \t\n]") nil t)) - (setq ind (or (match-string 2) - (make-string (length (match-string 3)) ?\ ))))) - (mapc (lambda (x) (insert ind "[" (car x) "]: " (cdr x) "\n")) - link-buffer)) - (insert "\n"))) - -(defun org-ascii-level-start (level title umax &optional lines) - "Insert a new level in ASCII export." - (let (char (n (- level umax 1)) (ind 0)) - (if (> level umax) - (progn - (insert (make-string (* 2 n) ?\ ) - (char-to-string (nth (% n (length org-export-ascii-bullets)) - org-export-ascii-bullets)) - " " title "\n") - ;; find the indentation of the next non-empty line - (catch 'stop - (while lines - (if (string-match "^\\* " (car lines)) (throw 'stop nil)) - (if (string-match "^\\([ \t]*\\)\\S-" (car lines)) - (throw 'stop (setq ind (org-get-indentation (car lines))))) - (pop lines))) - (setq org-ascii-current-indentation (cons (* 2 (1+ n)) ind))) - (if (or (not (equal (char-before) ?\n)) - (not (equal (char-before (1- (point))) ?\n))) - (insert "\n")) - (setq char (or (nth (1- level) org-export-ascii-underline) - (car (last org-export-ascii-underline)))) - (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match "" t t title)))) - (if org-export-with-section-numbers - (setq title (concat (org-section-number level) " " title))) - (insert title "\n" (make-string (string-width title) char) "\n") - (setq org-ascii-current-indentation '(0 . 0))))) - -(defun org-insert-centered (s &optional underline) - "Insert the string S centered and underline it with character UNDERLINE." - (let ((ind (max (/ (- fill-column (string-width s)) 2) 0))) - (insert (make-string ind ?\ ) s "\n") - (if underline - (insert (make-string ind ?\ ) - (make-string (string-width s) underline) - "\n")))) - -(defvar org-table-colgroup-info nil) -(defun org-format-table-ascii (lines) - "Format a table for ascii export." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (not (string-match "^[ \t]*|" (car lines))) - ;; Table made by table.el - test for spanning - lines - - ;; A normal org table - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - ;; Get rid of the vertical lines except for grouping - (if org-export-ascii-table-keep-all-vertical-lines - lines - (let ((vl (org-colgroup-info-to-vline-list org-table-colgroup-info)) - rtn line vl1 start) - (while (setq line (pop lines)) - (if (string-match org-table-hline-regexp line) - (and (string-match "|\\(.*\\)|" line) - (setq line (replace-match " \\1" t nil line))) - (setq start 0 vl1 vl) - (while (string-match "|" line start) - (setq start (match-end 0)) - (or (pop vl1) (setq line (replace-match " " t t line))))) - (push line rtn)) - (nreverse rtn))))) - -(defun org-colgroup-info-to-vline-list (info) - (let (vl new last) - (while info - (setq last new new (pop info)) - (if (or (memq last '(:end :startend)) - (memq new '(:start :startend))) - (push t vl) - (push nil vl))) - (setq vl (nreverse vl)) - (and vl (setcar vl nil)) - vl)) - -(provide 'org-ascii) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-ascii.el ends here diff --git a/lisp/org/org-beamer.el b/lisp/org/org-beamer.el deleted file mode 100644 index 78b57a4c00..0000000000 --- a/lisp/org/org-beamer.el +++ /dev/null @@ -1,657 +0,0 @@ -;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> -;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> -;; Keywords: org, wp, tex - -;; 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 library implement the special treatment needed by using the -;; beamer class during LaTeX export. - -;;; Code: - -(require 'org) -(require 'org-exp) - -(defvar org-export-latex-header) -(defvar org-export-latex-options-plist) -(defvar org-export-opt-plist) - -(defgroup org-beamer nil - "Options specific for using the beamer class in LaTeX export." - :tag "Org Beamer" - :group 'org-export-latex) - -(defcustom org-beamer-use-parts nil - "" - :group 'org-beamer - :version "24.1" - :type 'boolean) - -(defcustom org-beamer-frame-level 1 - "The level that should be interpreted as a frame. -The levels above this one will be translated into a sectioning structure. -Setting this to 2 will allow sections, 3 will allow subsections as well. -You can set this to 4 as well, if you at the same time set -`org-beamer-use-parts' to make the top levels `\part'." - :group 'org-beamer - :version "24.1" - :type '(choice - (const :tag "Frames need a BEAMER_env property" nil) - (integer :tag "Specific level makes a frame"))) - -(defcustom org-beamer-frame-default-options "" - "Default options string to use for frames, should contains the [brackets]. -And example for this is \"[allowframebreaks]\"." - :group 'org-beamer - :version "24.1" - :type '(string :tag "[options]")) - -(defcustom org-beamer-column-view-format - "%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)" - "Default column view format that should be used to fill the template." - :group 'org-beamer - :version "24.1" - :type '(choice - (const :tag "Do not insert Beamer column view format" nil) - (string :tag "Beamer column view format"))) - -(defcustom org-beamer-themes - "\\usetheme{default}\\usecolortheme{default}" - "Default string to be used for extra heading stuff in beamer presentations. -When a beamer template is filled, this will be the default for -BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}." - :group 'org-beamer - :version "24.1" - :type '(choice - (const :tag "Do not insert Beamer themes" nil) - (string :tag "Beamer themes"))) - -(defconst org-beamer-column-widths - "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" - "The column widths that should be installed as allowed property values.") - -(defconst org-beamer-transitions - "\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC" - "Transitions available for beamer. -These are just a completion help.") - -(defconst org-beamer-environments-default - '(("frame" "f" "dummy- special handling hard coded" "dummy") - ("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}") - ("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}") - ("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}") - ("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}") - ("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}") - ("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}") - ("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}") - ("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}") - ("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}") - ("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}") - ("example" "e" "\\begin{example}%a%U%x" "\\end{example}") - ("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}") - ("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}") - ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}") - ("normal" "h" "%h" "") ; Emit the heading as normal text - ("note" "n" "\\note%o%a{%h" "}") - ("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading - ("ignoreheading" "i" "%%%% %h" "")) - "Environments triggered by properties in Beamer export. -These are the defaults - for user definitions, see -`org-beamer-environments-extra'. -\"normal\" is a special fake environment, which emit the heading as -normal text. It is needed when an environment should be surrounded -by normal text. Since beamer export converts nodes into environments, -you need to have a node to end the environment. -For example - - ** a frame - some text - *** Blocktitle :B_block: - inside the block - *** After the block :B_normal: - continuing here - ** next frame") - -(defcustom org-beamer-environments-extra nil - "Environments triggered by tags in Beamer export. -Each entry has 4 elements: - -name Name of the environment -key Selection key for `org-beamer-select-environment' -open The opening template for the environment, with the following escapes - %a the action/overlay specification - %A the default action/overlay specification - %o the options argument of the template - %h the headline text - %H if there is headline text, that text in {} braces - %U if there is headline text, that text in [] brackets - %x the content of the BEAMER_extra property -close The closing string of the environment." - - :group 'org-beamer - :version "24.1" - :type '(repeat - (list - (string :tag "Environment") - (string :tag "Selection key") - (string :tag "Begin") - (string :tag "End")))) - -(defcustom org-beamer-inherited-properties nil - "Properties that should be inherited during beamer export." - :group 'org-beamer - :type '(repeat - (string :tag "Property"))) - -(defvar org-beamer-frame-level-now nil) -(defvar org-beamer-header-extra nil) -(defvar org-beamer-export-is-beamer-p nil) -(defvar org-beamer-inside-frame-at-level nil) -(defvar org-beamer-columns-open nil) -(defvar org-beamer-column-open nil) - -(defun org-beamer-cleanup-column-width (width) - "Make sure the width is not empty, and that it has a unit." - (setq width (org-trim (or width ""))) - (unless (string-match "\\S-" width) (setq width "0.5")) - (if (string-match "\\`[.0-9]+\\'" width) - (setq width (concat width "\\textwidth"))) - width) - -(defun org-beamer-open-column (&optional width opt) - (org-beamer-close-column-maybe) - (setq org-beamer-column-open t) - (setq width (org-beamer-cleanup-column-width width)) - (insert (format "\\begin{column}%s{%s}\n" (or opt "") width))) -(defun org-beamer-close-column-maybe () - (when org-beamer-column-open - (setq org-beamer-column-open nil) - (insert "\\end{column}\n"))) -(defun org-beamer-open-columns-maybe (&optional opts) - (unless org-beamer-columns-open - (setq org-beamer-columns-open t) - (insert (format "\\begin{columns}%s\n" (or opts ""))))) -(defun org-beamer-close-columns-maybe () - (org-beamer-close-column-maybe) - (when org-beamer-columns-open - (setq org-beamer-columns-open nil) - (insert "\\end{columns}\n"))) - -(defun org-beamer-select-environment () - "Select the environment to be used by beamer for this entry. -While this uses (for convenience) a tag selection interface, the result -of this command will be that the BEAMER_env *property* of the entry is set. - -In addition to this, the command will also set a tag as a visual aid, but -the tag does not have any semantic meaning." - (interactive) - (let* ((envs (append org-beamer-environments-extra - org-beamer-environments-default)) - (org-tag-alist - (append '((:startgroup)) - (mapcar (lambda (e) (cons (concat "B_" (car e)) - (string-to-char (nth 1 e)))) - envs) - '((:endgroup)) - '(("BMCOL" . ?|)))) - (org-fast-tag-selection-single-key t)) - (org-set-tags) - (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) - (cond - ((equal org-last-tag-selection-key ?|) - (if (string-match ":BMCOL:" tags) - (org-set-property "BEAMER_col" (read-string "Column width: ")) - (org-delete-property "BEAMER_col"))) - ((string-match (concat ":B_\\(" - (mapconcat 'car envs "\\|") - "\\):") - tags) - (org-entry-put nil "BEAMER_env" (match-string 1 tags))) - (t (org-entry-delete nil "BEAMER_env")))))) - -;;;###autoload -(defun org-beamer-sectioning (level text) - "Return the sectioning entry for the current headline. -LEVEL is the reduced level of the headline. -TEXT is the text of the headline, everything except the leading stars. -The return value is a cons cell. The car is the headline text, usually -just TEXT, but possibly modified if options have been extracted from the -text. The cdr is the sectioning entry, similar to what is given -in org-export-latex-classes." - (let* ((frame-level (or org-beamer-frame-level-now org-beamer-frame-level)) - (default - (if org-beamer-use-parts - '((1 . ("\\part{%s}" . "\\part*{%s}")) - (2 . ("\\section{%s}" . "\\section*{%s}")) - (3 . ("\\subsection{%s}" . "\\subsection*{%s}"))) - '((1 . ("\\section{%s}" . "\\section*{%s}")) - (2 . ("\\subsection{%s}" . "\\subsection*{%s}"))))) - (envs (append org-beamer-environments-extra - org-beamer-environments-default)) - (props (org-get-text-property-any 0 'org-props text)) - (in "") (out "") org-beamer-option org-beamer-action org-beamer-defaction org-beamer-environment org-beamer-extra - columns-option column-option - env have-text ass tmp) - (if (= frame-level 0) (setq frame-level nil)) - (when (and org-beamer-inside-frame-at-level - (<= level org-beamer-inside-frame-at-level)) - (setq org-beamer-inside-frame-at-level nil)) - (when (setq tmp (org-beamer-assoc-not-empty "BEAMER_col" props)) - (if (and (string-match "\\`[0-9.]+\\'" tmp) - (or (= (string-to-number tmp) 1.0) - (= (string-to-number tmp) 0.0))) - ;; column width 1 means close columns, go back to full width - (org-beamer-close-columns-maybe) - (when (setq ass (assoc "BEAMER_envargs" props)) - (let (case-fold-search) - (while (string-match "C\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) - (setq columns-option (match-string 1 (cdr ass))) - (setcdr ass (replace-match "" t t (cdr ass)))) - (while (string-match "c\\(\\[[^][]*\\]\\|<[^<>]*>\\)" (cdr ass)) - (setq column-option (match-string 1 (cdr ass))) - (setcdr ass (replace-match "" t t (cdr ass)))))) - (org-beamer-open-columns-maybe columns-option) - (org-beamer-open-column tmp column-option))) - (cond - ((or (equal (cdr (assoc "BEAMER_env" props)) "frame") - (and frame-level (= level frame-level))) - ;; A frame - (org-beamer-get-special props) - - (setq in (org-fill-template - "\\begin{frame}%a%A%o%T%S%x" - (list (cons "a" (or org-beamer-action "")) - (cons "A" (or org-beamer-defaction "")) - (cons "o" (or org-beamer-option org-beamer-frame-default-options "")) - (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) "")) - (cons "h" "%s") - (cons "T" (if (string-match "\\S-" text) - "\n\\frametitle{%s}" "")) - (cons "S" (if (string-match "\\\\\\\\" text) - "\n\\framesubtitle{%s}" "")))) - out (copy-sequence "\\end{frame}")) - (org-add-props out - '(org-insert-hook org-beamer-close-columns-maybe)) - (setq org-beamer-inside-frame-at-level level) - (cons text (list in out in out))) - ((and (setq env (cdr (assoc "BEAMER_env" props))) - (setq ass (assoc env envs))) - ;; A beamer environment selected by the BEAMER_env property - (if (string-match "[ \t]+:[ \t]*$" text) - (setq text (replace-match "" t t text))) - (if (member env '("note" "noteNH")) - ;; There should be no labels in a note, so we remove the targets - ;; FIXME??? - (remove-text-properties 0 (length text) '(target nil) text)) - (org-beamer-get-special props) - (setq text (org-trim text)) - (setq have-text (string-match "\\S-" text)) - (setq in (org-fill-template - (nth 2 ass) - (list (cons "a" (or org-beamer-action "")) - (cons "A" (or org-beamer-defaction "")) - (cons "o" (or org-beamer-option "")) - (cons "x" (if org-beamer-extra (concat "\n" org-beamer-extra) "")) - (cons "h" "%s") - (cons "H" (if have-text (concat "{" text "}") "")) - (cons "U" (if have-text (concat "[" text "]") "")))) - out (nth 3 ass)) - (cond - ((equal out "\\end{columns}") - (setq org-beamer-columns-open t) - (setq out (org-add-props (copy-sequence out) - '(org-insert-hook - (lambda () - (org-beamer-close-column-maybe) - (setq org-beamer-columns-open nil)))))) - ((equal out "\\end{column}") - (org-beamer-open-columns-maybe))) - (cons text (list in out in out))) - ((and (not org-beamer-inside-frame-at-level) - (or (not frame-level) - (< level frame-level)) - (assoc level default)) - ;; Normal sectioning - (cons text (cdr (assoc level default)))) - (t nil)))) - -(defvar org-beamer-extra) -(defvar org-beamer-option) -(defvar org-beamer-action) -(defvar org-beamer-defaction) -(defvar org-beamer-environment) -(defun org-beamer-get-special (props) - "Extract an option, action, and default action string from text. -The variables org-beamer-option, org-beamer-action, org-beamer-defaction, -org-beamer-extra are all scoped into this function dynamically." - (let (tmp) - (setq org-beamer-environment (org-beamer-assoc-not-empty "BEAMER_env" props)) - (setq org-beamer-extra (org-beamer-assoc-not-empty "BEAMER_extra" props)) - (when org-beamer-extra - (setq org-beamer-extra (replace-regexp-in-string "\\\\n" "\n" org-beamer-extra))) - (setq tmp (org-beamer-assoc-not-empty "BEAMER_envargs" props)) - (when tmp - (setq tmp (copy-sequence tmp)) - (if (string-match "\\[<[^][<>]*>\\]" tmp) - (setq org-beamer-defaction (match-string 0 tmp) - tmp (replace-match "" t t tmp))) - (if (string-match "\\[[^][]*\\]" tmp) - (setq org-beamer-option (match-string 0 tmp) - tmp (replace-match "" t t tmp))) - (if (string-match "<[^<>]*>" tmp) - (setq org-beamer-action (match-string 0 tmp) - tmp (replace-match "" t t tmp)))))) - -(defun org-beamer-assoc-not-empty (elt list) - (let ((tmp (cdr (assoc elt list)))) - (and tmp (string-match "\\S-" tmp) tmp))) - - -(defvar org-beamer-mode-map (make-sparse-keymap) - "The keymap for `org-beamer-mode'.") -(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) - -;;;###autoload -(define-minor-mode org-beamer-mode - "Special support for editing Org-mode files made to export to beamer." - nil " Bm" nil) -(when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords - 'org-mode - '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) - 'prepent)) - -(defun org-beamer-place-default-actions-for-lists () - "Find default overlay specifications in items, and move them. -The need to be after the begin statement of the environment." - (when org-beamer-export-is-beamer-p - (let (dovl) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\begin{\\(itemize\\|enumerate\\|description\\)}[ \t\n]*\\\\item\\>\\( ?\\(<[^<>\n]*>\\|\\[[^][\n*]\\]\\)\\)?[ \t]*\\S-" nil t) - (if (setq dovl (cdr (assoc "BEAMER_dovl" - (get-text-property (match-end 0) - 'org-props)))) - (save-excursion - (goto-char (1+ (match-end 1))) - (insert dovl))))))) - -(defun org-beamer-amend-header () - "Add `org-beamer-header-extra' to the LaTeX header. -If the file contains the string BEAMER-HEADER-EXTRA-HERE on a line -by itself, it will be replaced with `org-beamer-header-extra'. If not, -the value will be inserted right after the documentclass statement." - (when (and org-beamer-export-is-beamer-p - org-beamer-header-extra) - (goto-char (point-min)) - (cond - ((re-search-forward - "^[ \t]*\\[?BEAMER-HEADER-EXTRA\\(-HERE\\)?\\]?[ \t]*$" nil t) - (replace-match org-beamer-header-extra t t) - (or (bolp) (insert "\n"))) - ((re-search-forward "^[ \t]*\\\\begin{document}" nil t) - (beginning-of-line 1) - (insert org-beamer-header-extra) - (or (bolp) (insert "\n")))))) - -(defcustom org-beamer-fragile-re "\\\\\\(verb\\|lstinline\\)\\|^[ \t]*\\\\begin{\\(verbatim\\|lstlisting\\|minted\\)}" - "If this regexp matches in a frame, the frame is marked as fragile." - :group 'org-beamer - :version "24.1" - :type 'regexp) - -(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) - "The special face for beamer tags." - :group 'org-beamer) - - -;; Functions to initialize and post-process -;; These functions will be hooked into various places in the export process - -(defun org-beamer-initialize-open-trackers () - "Reset variables that track if certain environments are open during export." - (setq org-beamer-columns-open nil) - (setq org-beamer-column-open nil) - (setq org-beamer-inside-frame-at-level nil) - (setq org-beamer-export-is-beamer-p nil)) - -(defun org-beamer-after-initial-vars () - "Find special settings for beamer and store them. -The effect is that these values will be accessible during export." - ;; First verify that we are exporting using the beamer class - (setq org-beamer-export-is-beamer-p - (string-match "\\\\documentclass\\(\\[[^][]*?\\]\\)?{beamer}" - org-export-latex-header)) - (when org-beamer-export-is-beamer-p - ;; Find the frame level - (setq org-beamer-frame-level-now - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "BEAMER_FRAME_LEVEL" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward - "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :beamer-frame-level) - org-beamer-frame-level)) - ;; Normalize the value so that the functions can trust the value - (cond - ((not org-beamer-frame-level-now) - (setq org-beamer-frame-level-now nil)) - ((stringp org-beamer-frame-level-now) - (setq org-beamer-frame-level-now - (string-to-number org-beamer-frame-level-now)))) - ;; Find the header additions, most likely theme commands - (setq org-beamer-header-extra - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "BEAMER_HEADER_EXTRA" - 'selective)))) - (save-excursion - (save-restriction - (widen) - (let ((txt "")) - (goto-char (point-min)) - (while (re-search-forward - "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$" - nil t) - (setq txt (concat txt "\n" (match-string 1)))) - (if (> (length txt) 0) (substring txt 1))))) - (plist-get org-export-latex-options-plist - :beamer-header-extra))) - (let ((inhibit-read-only t) - (case-fold-search nil) - props) - (org-unmodified - (remove-text-properties (point-min) (point-max) '(org-props nil)) - (org-map-entries - '(progn - (setq props (org-entry-properties nil 'standard)) - (if (and (not (assoc "BEAMER_env" props)) - (looking-at ".*?:B_\\(note\\(NH\\)?\\):")) - (push (cons "BEAMER_env" (match-string 1)) props)) - (when (org-bound-and-true-p org-beamer-inherited-properties) - (mapc (lambda (p) - (unless (assoc p props) - (let ((v (org-entry-get nil p 'inherit))) - (and v (push (cons p v) props))))) - org-beamer-inherited-properties)) - (put-text-property (point-at-bol) (point-at-eol) 'org-props props))) - (setq org-export-latex-options-plist - (plist-put org-export-latex-options-plist :tags nil)))))) - -(defun org-beamer-auto-fragile-frames () - "Mark any frames containing verbatim environments as fragile. -This function will run in the final LaTeX document." - (when org-beamer-export-is-beamer-p - (let (opts) - (goto-char (point-min)) - ;; Find something that might be fragile - (while (re-search-forward org-beamer-fragile-re nil t) - (save-excursion - ;; Are we inside a frame here? - (when (and (re-search-backward "^[ \t]*\\\\\\(begin\\|end\\){frame}\\(<[^>]*>\\)?" - nil t) - (equal (match-string 1) "begin")) - ;; yes, inside a frame, make sure "fragile" is one of the options - (goto-char (match-end 0)) - (if (not (looking-at "\\[.*?\\]")) - (insert "[fragile]") - (setq opts (substring (match-string 0) 1 -1)) - (delete-region (match-beginning 0) (match-end 0)) - (setq opts (org-split-string opts ",")) - (add-to-list 'opts "fragile") - (insert "[" (mapconcat 'identity opts ",") "]")))))))) - -(defcustom org-beamer-outline-frame-title "Outline" - "Default title of a frame containing an outline." - :group 'org-beamer - :version "24.1" - :type '(string :tag "Outline frame title") - ) - -(defcustom org-beamer-outline-frame-options nil - "Outline frame options appended after \\begin{frame}. -You might want to put e.g. [allowframebreaks=0.9] here. Remember to -include square brackets." - :group 'org-beamer - :version "24.1" - :type '(string :tag "Outline frame options") - ) - -(defun org-beamer-fix-toc () - "Fix the table of contents by removing the vspace line." - (when org-beamer-export-is-beamer-p - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "\\(\\\\setcounter{tocdepth.*\n\\\\tableofcontents.*\n\\)\\(\\\\vspace\\*.*\\)" - nil t) - (replace-match - (concat "\\\\begin{frame}" org-beamer-outline-frame-options - "\n\\\\frametitle{" - org-beamer-outline-frame-title - "}\n\\1\\\\end{frame}") - t nil))))) - -(defun org-beamer-property-changed (property value) - "Track the BEAMER_env property with tags." - (cond - ((equal property "BEAMER_env") - (save-excursion - (org-back-to-heading t) - (let ((tags (org-get-tags))) - (setq tags (delq nil (mapcar (lambda (x) - (if (string-match "^B_" x) nil x)) - tags))) - (org-set-tags-to tags)) - (when (and value (stringp value) (string-match "\\S-" value)) - (org-toggle-tag (concat "B_" value) 'on)))) - ((equal property "BEAMER_col") - (org-toggle-tag "BMCOL" (if (and value (string-match "\\S-" value)) - 'on 'off))))) - -(defun org-beamer-select-beamer-code () - "Take code marked for BEAMER and turn it into marked for LaTeX." - (when org-beamer-export-is-beamer-p - (goto-char (point-min)) - (while (re-search-forward - "^\\([ \]*#\\+\\(begin_\\|end_\\)?\\)\\(beamer\\)\\>" nil t) - (replace-match "\\1latex")))) - -;; OK, hook all these functions into appropriate places -(add-hook 'org-export-first-hook - 'org-beamer-initialize-open-trackers) -(add-hook 'org-property-changed-functions - 'org-beamer-property-changed) -(add-hook 'org-export-latex-after-initial-vars-hook - 'org-beamer-after-initial-vars) -(add-hook 'org-export-latex-final-hook - 'org-beamer-place-default-actions-for-lists) -(add-hook 'org-export-latex-final-hook - 'org-beamer-auto-fragile-frames) -(add-hook 'org-export-latex-final-hook - 'org-beamer-fix-toc) -(add-hook 'org-export-latex-final-hook - 'org-beamer-amend-header) -(add-hook 'org-export-preprocess-before-selecting-backend-code-hook - 'org-beamer-select-beamer-code) - -(defun org-insert-beamer-options-template (&optional kind) - "Insert a settings template, to make sure users do this right." - (interactive (progn - (message "Current [s]ubtree or [g]lobal?") - (if (equal (read-char-exclusive) ?g) - (list 'global) - (list 'subtree)))) - (if (eq kind 'subtree) - (progn - (org-back-to-heading t) - (org-reveal) - (org-entry-put nil "LaTeX_CLASS" "beamer") - (org-entry-put nil "LaTeX_CLASS_OPTIONS" "[presentation]") - (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") - (org-entry-put nil "BEAMER_FRAME_LEVEL" (number-to-string - org-beamer-frame-level)) - (when org-beamer-themes - (org-entry-put nil "BEAMER_HEADER_EXTRA" org-beamer-themes)) - (when org-beamer-column-view-format - (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) - (org-entry-put nil "BEAMER_col_ALL" "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC")) - (insert "#+LaTeX_CLASS: beamer\n") - (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") - (insert (format "#+BEAMER_FRAME_LEVEL: %d\n" org-beamer-frame-level) "\n") - (when org-beamer-themes - (insert "#+BEAMER_HEADER_EXTRA: " org-beamer-themes "\n")) - (when org-beamer-column-view-format - (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) - (insert "#+PROPERTY: BEAMER_col_ALL 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0 :ETC\n"))) - - -(defun org-beamer-allowed-property-values (property) - "Supply allowed values for BEAMER properties." - (cond - ((and (equal property "BEAMER_env") - (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_env have been defined, - ;; supply all defined environments - (mapcar 'car (append org-beamer-environments-extra - org-beamer-environments-default))) - ((and (equal property "BEAMER_col") - (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_col have been defined, - ;; supply some - '("0.1" "0.2" "0.3" "0.4" "0.5" "0.6" "0.7" "0.8" "0.9" "" ":ETC")) - (t nil))) - -(add-hook 'org-property-allowed-value-functions - 'org-beamer-allowed-property-values) - -(provide 'org-beamer) - -;;; org-beamer.el ends here diff --git a/lisp/org/org-exp-blocks.el b/lisp/org/org-exp-blocks.el deleted file mode 100644 index d3789ad3aa..0000000000 --- a/lisp/org/org-exp-blocks.el +++ /dev/null @@ -1,402 +0,0 @@ -;;; org-exp-blocks.el --- pre-process blocks when exporting org files - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte - -;; 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 is a utility for pre-processing blocks in org files before -;; export using the `org-export-preprocess-hook'. It can be used for -;; exporting new types of blocks from org-mode files and also for -;; changing the default export behavior of existing org-mode blocks. -;; The `org-export-blocks' and `org-export-interblocks' variables can -;; be used to control how blocks and the spaces between blocks -;; respectively are processed upon export. -;; -;; The type of a block is defined as the string following =#+begin_=, -;; so for example the following block would be of type ditaa. Note -;; that both upper or lower case are allowed in =#+BEGIN_= and -;; =#+END_=. -;; -;; #+begin_ditaa blue.png -r -S -;; +---------+ -;; | cBLU | -;; | | -;; | +----+ -;; | |cPNK| -;; | | | -;; +----+----+ -;; #+end_ditaa -;; -;;; Currently Implemented Block Types -;; -;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert -;; ascii pictures to actual images using ditaa -;; http://ditaa.sourceforge.net/. To use this set -;; `org-ditaa-jar-path' to the path to ditaa.jar on your -;; system (should be set automatically in most cases) . -;; -;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert -;; graphs defined using the dot graphing language to images -;; using the dot utility. For information on dot see -;; http://www.graphviz.org/ -;; -;; export-comment :: Wrap comments with titles and author information, -;; in their own divs with author-specific ids allowing for -;; css coloring of comments based on the author. -;; -;;; Adding new blocks -;; -;; When adding a new block type first define a formatting function -;; along the same lines as `org-export-blocks-format-dot' and then use -;; `org-export-blocks-add-block' to add your block type to -;; `org-export-blocks'. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'find-func) -(require 'org-compat) - -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-remove-indentation "org" (code &optional n)) - -(defvar org-protecting-blocks nil) ; From org.el - -(defun org-export-blocks-set (var value) - "Set the value of `org-export-blocks' and install fontification." - (set var value) - (mapc (lambda (spec) - (if (nth 2 spec) - (setq org-protecting-blocks - (delete (symbol-name (car spec)) - org-protecting-blocks)) - (add-to-list 'org-protecting-blocks - (symbol-name (car spec))))) - value)) - -(defcustom org-export-blocks - '((export-comment org-export-blocks-format-comment t) - (ditaa org-export-blocks-format-ditaa nil) - (dot org-export-blocks-format-dot nil)) - "Use this alist to associate block types with block exporting functions. -The type of a block is determined by the text immediately -following the '#+BEGIN_' portion of the block header. Each block -export function should accept three arguments." - :group 'org-export-general - :type '(repeat - (list - (symbol :tag "Block name") - (function :tag "Block formatter") - (boolean :tag "Fontify content as Org syntax"))) - :set 'org-export-blocks-set) - -(defun org-export-blocks-add-block (block-spec) - "Add a new block type to `org-export-blocks'. -BLOCK-SPEC should be a three element list the first element of -which should indicate the name of the block, the second element -should be the formatting function called by -`org-export-blocks-preprocess' and the third element a flag -indicating whether these types of blocks should be fontified in -org-mode buffers (see `org-protecting-blocks'). For example the -BLOCK-SPEC for ditaa blocks is as follows. - - (ditaa org-export-blocks-format-ditaa nil)" - (unless (member block-spec org-export-blocks) - (setq org-export-blocks (cons block-spec org-export-blocks)) - (org-export-blocks-set 'org-export-blocks org-export-blocks))) - -(defcustom org-export-interblocks - '() - "Use this a-list to associate block types with block exporting functions. -The type of a block is determined by the text immediately -following the '#+BEGIN_' portion of the block header. Each block -export function should accept three arguments." - :group 'org-export-general - :type 'alist) - -(defcustom org-export-blocks-witheld - '(hidden) - "List of block types (see `org-export-blocks') which should not be exported." - :group 'org-export-general - :type 'list) - -(defcustom org-export-blocks-postblock-hook nil - "Run after blocks have been processed with `org-export-blocks-preprocess'." - :group 'org-export-general - :version "24.1" - :type 'hook) - -(defun org-export-blocks-html-quote (body &optional open close) - "Protect BODY from org html export. -The optional OPEN and CLOSE tags will be inserted around BODY." - (concat - "\n#+BEGIN_HTML\n" - (or open "") - body (if (string-match "\n$" body) "" "\n") - (or close "") - "#+END_HTML\n")) - -(defun org-export-blocks-latex-quote (body &optional open close) - "Protect BODY from org latex export. -The optional OPEN and CLOSE tags will be inserted around BODY." - (concat - "\n#+BEGIN_LaTeX\n" - (or open "") - body (if (string-match "\n$" body) "" "\n") - (or close "") - "#+END_LaTeX\n")) - -(defvar org-src-preserve-indentation) ; From org-src.el -(defun org-export-blocks-preprocess () - "Export all blocks according to the `org-export-blocks' block export alist. -Does not export block types specified in specified in BLOCKS -which defaults to the value of `org-export-blocks-witheld'." - (interactive) - (save-window-excursion - (let ((case-fold-search t) - (interblock (lambda (start end) - (mapcar (lambda (pair) (funcall (second pair) start end)) - org-export-interblocks))) - matched indentation type types func - start end body headers preserve-indent progress-marker) - (goto-char (point-min)) - (setq start (point)) - (let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]")) - (while (re-search-forward beg-re nil t) - (let* ((match-start (copy-marker (match-beginning 0))) - (body-start (copy-marker (match-end 0))) - (indentation (length (match-string 1))) - (inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s" - (regexp-quote (downcase (match-string 2))))) - (type (intern (downcase (match-string 2)))) - (headers (save-match-data - (org-split-string (match-string 3) "[ \t]+"))) - (balanced 1) - (preserve-indent (or org-src-preserve-indentation - (member "-i" headers))) - match-end) - (while (and (not (zerop balanced)) - (re-search-forward inner-re nil t)) - (if (string= (downcase (match-string 1)) "end") - (decf balanced) - (incf balanced))) - (when (not (zerop balanced)) - (error "Unbalanced begin/end_%s blocks with %S" - type (buffer-substring match-start (point)))) - (setq match-end (copy-marker (match-end 0))) - (unless preserve-indent - (setq body (save-match-data (org-remove-indentation - (buffer-substring - body-start (match-beginning 0)))))) - (unless (memq type types) (setq types (cons type types))) - (save-match-data (funcall interblock start match-start)) - (when (setq func (cadr (assoc type org-export-blocks))) - (let ((replacement (save-match-data - (if (memq type org-export-blocks-witheld) "" - (apply func body headers))))) - ;; ;; un-comment this code after the org-element merge - ;; (save-match-data - ;; (when (and replacement (string= replacement "")) - ;; (delete-region - ;; (car (org-element-collect-affiliated-keyword)) - ;; match-start))) - (when replacement - (delete-region match-start match-end) - (goto-char match-start) (insert replacement) - (if preserve-indent - ;; indent only the code block markers - (save-excursion - (indent-line-to indentation) ; indent end_block - (goto-char match-start) - (indent-line-to indentation)) ; indent begin_block - ;; indent everything - (indent-code-rigidly match-start (point) indentation))))) - ;; cleanup markers - (set-marker match-start nil) - (set-marker body-start nil) - (set-marker match-end nil)) - (setq start (point)))) - (funcall interblock start (point-max)) - (run-hooks 'org-export-blocks-postblock-hook)))) - -;;================================================================================ -;; type specific functions - -;;-------------------------------------------------------------------------------- -;; ditaa: create images from ASCII art using the ditaa utility -(defcustom org-ditaa-jar-path (expand-file-name - "ditaa.jar" - (file-name-as-directory - (expand-file-name - "scripts" - (file-name-as-directory - (expand-file-name - "../contrib" - (file-name-directory (org-find-library-dir "org"))))))) - "Path to the ditaa jar executable." - :group 'org-babel - :type 'string) - -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-export-blocks-format-ditaa (body &rest headers) - "DEPRECATED: use begin_src ditaa code blocks - -Pass block BODY to the ditaa utility creating an image. -Specify the path at which the image should be saved as the first -element of headers, any additional elements of headers will be -passed to the ditaa utility as command line arguments." - (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks") - (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) - (data-file (make-temp-file "org-ditaa")) - (hash (progn - (set-text-properties 0 (length body) nil body) - (sha1 (prin1-to-string (list body args))))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) - (unless (file-exists-p org-ditaa-jar-path) - (error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path))) - (setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body) - body - (mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1))) - (org-split-string body "\n") - "\n"))) - (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)) - (shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")))) - -;;-------------------------------------------------------------------------------- -;; dot: create graphs using the dot graphing language -;; (require the dot executable to be in your path) -(defun org-export-blocks-format-dot (body &rest headers) - "DEPRECATED: use \"#+begin_src dot\" code blocks - -Pass block BODY to the dot graphing utility creating an image. -Specify the path at which the image should be saved as the first -element of headers, any additional elements of headers will be -passed to the dot utility as command line arguments. Don't -forget to specify the output type for the dot command, so if you -are exporting to a file with a name like 'image.png' you should -include a '-Tpng' argument, and your block should look like the -following. - -#+begin_dot models.png -Tpng -digraph data_relationships { - \"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"] - \"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"] - \"data_requirement\" -> \"data_product\" -} -#+end_dot" - (message "begin_dot blocks are DEPRECATED, use begin_src blocks") - (let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " "))) - (data-file (make-temp-file "org-ditaa")) - (hash (progn - (set-text-properties 0 (length body) nil body) - (sha1 (prin1-to-string (list body args))))) - (raw-out-file (if headers (car headers))) - (out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file) - (cons (match-string 1 raw-out-file) - (match-string 2 raw-out-file)) - (cons raw-out-file "png"))) - (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) - (prog1 - (cond - ((member org-export-current-backend '(html latex docbook)) - (unless (file-exists-p out-file) - (mapc ;; remove old hashed versions of this file - (lambda (file) - (when (and (string-match (concat (regexp-quote (car out-file-parts)) - "_\\([[:alnum:]]+\\)\\." - (regexp-quote (cdr out-file-parts))) - file) - (= (length (match-string 1 out-file)) 40)) - (delete-file (expand-file-name file - (file-name-directory out-file))))) - (directory-files (or (file-name-directory out-file) - default-directory))) - (with-temp-file data-file (insert body)) - (message (concat "dot " data-file " " args " -o " out-file)) - (shell-command (concat "dot " data-file " " args " -o " out-file))) - (format "\n[[file:%s]]\n" out-file)) - (t (concat - "\n#+BEGIN_EXAMPLE\n" - body (if (string-match "\n$" body) "" "\n") - "#+END_EXAMPLE\n"))) - (message "begin_dot blocks are DEPRECATED, use begin_src blocks")))) - -;;-------------------------------------------------------------------------------- -;; comment: export comments in author-specific css-stylable divs -(defun org-export-blocks-format-comment (body &rest headers) - "Format comment BODY by OWNER and return it formatted for export. -Currently, this only does something for HTML export, for all -other backends, it converts the comment into an EXAMPLE segment." - (let ((owner (if headers (car headers))) - (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) - (cond - ((eq org-export-current-backend 'html) ;; We are exporting to HTML - (concat "#+BEGIN_HTML\n" - "<div class=\"org-comment\"" - (if owner (format " id=\"org-comment-%s\" " owner)) - ">\n" - (if owner (concat "<b>" owner "</b> ") "") - (if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n") - "<p>\n" - "#+END_HTML\n" - body - "\n#+BEGIN_HTML\n" - "</p>\n" - "</div>\n" - "#+END_HTML\n")) - (t ;; This is not HTML, so just make it an example. - (concat "#+BEGIN_EXAMPLE\n" - (if title (concat "Title:" title "\n") "") - (if owner (concat "By:" owner "\n") "") - body - (if (string-match "\n\\'" body) "" "\n") - "#+END_EXAMPLE\n"))))) - -(provide 'org-exp-blocks) - -;;; org-exp-blocks.el ends here diff --git a/lisp/org/org-exp.el b/lisp/org/org-exp.el deleted file mode 100644 index 82b9003e4f..0000000000 --- a/lisp/org/org-exp.el +++ /dev/null @@ -1,3354 +0,0 @@ -;;; org-exp.el --- Export internals for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;;; Code: - -(require 'org) -(require 'org-macs) -(require 'org-agenda) -(require 'org-exp-blocks) -(require 'ob-exp) -(require 'org-src) - -(eval-when-compile - (require 'cl)) - -(declare-function org-export-latex-preprocess "org-latex" (parameters)) -(declare-function org-export-ascii-preprocess "org-ascii" (parameters)) -(declare-function org-export-html-preprocess "org-html" (parameters)) -(declare-function org-export-docbook-preprocess "org-docbook" (parameters)) -(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ()) -(declare-function org-export-htmlize-region-for-paste "org-html" (beg end)) -(declare-function htmlize-buffer "ext:htmlize" (&optional buffer)) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) -(declare-function org-table-cookie-line-p "org-table" (line)) -(declare-function org-table-colgroup-line-p "org-table" (line)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-unescape-code-in-region "org-src" (beg end)) - -(autoload 'org-export-generic "org-export-generic" "Export using the generic exporter" t) - -(autoload 'org-export-as-odt "org-odt" - "Export the outline to a OpenDocument Text file." t) -(autoload 'org-export-as-odt-and-open "org-odt" - "Export the outline to a OpenDocument Text file and open it." t) - -(defgroup org-export nil - "Options for exporting org-listings." - :tag "Org Export" - :group 'org) - -(defgroup org-export-general nil - "General options for exporting Org-mode files." - :tag "Org Export General" - :group 'org-export) - -(defcustom org-export-allow-BIND 'confirm - "Non-nil means allow #+BIND to define local variable values for export. -This is a potential security risk, which is why the user must confirm the -use of these lines." - :group 'org-export-general - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Make the user confirm for each file" confirm))) - -;; FIXME -(defvar org-export-publishing-directory nil) - -(defcustom org-export-show-temporary-export-buffer t - "Non-nil means show buffer after exporting to temp buffer. -When Org exports to a file, the buffer visiting that file is ever -shown, but remains buried. However, when exporting to a temporary -buffer, that buffer is popped up in a second window. When this variable -is nil, the buffer remains buried also in these cases." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-copy-to-kill-ring t - "Non-nil means exported stuff will also be pushed onto the kill ring." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-kill-product-buffer-when-displayed nil - "Non-nil means kill the product buffer if it is displayed immediately. -This applied to the commands `org-export-as-html-and-open' and -`org-export-as-pdf-and-open'." - :group 'org-export-general - :version "24.1" - :type 'boolean) - -(defcustom org-export-run-in-background nil - "Non-nil means export and publishing commands will run in background. -This works by starting up a separate Emacs process visiting the same file -and doing the export from there. -Not all export commands are affected by this - only the ones which -actually write to a file, and that do not depend on the buffer state. -\\<org-mode-map> -If this option is nil, you can still get background export by calling -`org-export' with a double prefix arg: \ -\\[universal-argument] \\[universal-argument] \\[org-export]. - -If this option is t, the double prefix can be used to exceptionally -force an export command into the current process." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-initial-scope 'buffer - "The initial scope when exporting with `org-export'. -This variable can be either set to 'buffer or 'subtree." - :group 'org-export-general - :version "24.1" - :type '(choice - (const :tag "Export current buffer" 'buffer) - (const :tag "Export current subtree" 'subtree))) - -(defcustom org-export-select-tags '("export") - "Tags that select a tree for export. -If any such tag is found in a buffer, all trees that do not carry one -of these tags will be deleted before export. -Inside trees that are selected like this, you can still deselect a -subtree by tagging it with one of the `org-export-exclude-tags'." - :group 'org-export-general - :type '(repeat (string :tag "Tag"))) - -(defcustom org-export-exclude-tags '("noexport") - "Tags that exclude a tree from export. -All trees carrying any of these tags will be excluded from export. -This is without condition, so even subtrees inside that carry one of the -`org-export-select-tags' will be removed." - :group 'org-export-general - :type '(repeat (string :tag "Tag"))) - -;; FIXME: rename, this is a general variable -(defcustom org-export-html-expand t - "Non-nil means for HTML export, treat @<...> as HTML tag. -When nil, these tags will be exported as plain text and therefore -not be interpreted by a browser. - -This option can also be set with the +OPTIONS line, e.g. \"@:nil\"." - :group 'org-export-html - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-special-strings t - "Non-nil means interpret \"\-\", \"--\" and \"---\" for export. -When this option is turned on, these strings will be exported as: - - Org HTML LaTeX - -----+----------+-------- - \\- ­ \\- - -- – -- - --- — --- - ... … \ldots - -This option can also be set with the +OPTIONS line, e.g. \"-:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-html-link-up "" - "Where should the \"UP\" link of exported HTML pages lead?" - :group 'org-export-html - :group 'org-export-general - :type '(string :tag "File or URL")) - -(defcustom org-export-html-link-home "" - "Where should the \"HOME\" link of exported HTML pages lead?" - :group 'org-export-html - :group 'org-export-general - :type '(string :tag "File or URL")) - -(defcustom org-export-language-setup - '(("en" "Author" "Date" "Table of Contents" "Footnotes") - ("ca" "Autor" "Data" "Índex" "Peus de pàgina") - ("cs" "Autor" "Datum" "Obsah" "Pozn\xe1mky pod carou") - ("da" "Ophavsmand" "Dato" "Indhold" "Fodnoter") - ("de" "Autor" "Datum" "Inhaltsverzeichnis" "Fußnoten") - ("eo" "Aŭtoro" "Dato" "Enhavo" "Piednotoj") - ("es" "Autor" "Fecha" "Índice" "Pies de página") - ("fi" "Tekijä" "Päivämäärä" "Sisällysluettelo" "Alaviitteet") - ("fr" "Auteur" "Date" "Sommaire" "Notes de bas de page") - ("hu" "Szerzõ" "Dátum" "Tartalomjegyzék" "Lábjegyzet") - ("is" "Höfundur" "Dagsetning" "Efnisyfirlit" "Aftanmálsgreinar") - ("it" "Autore" "Data" "Indice" "Note a piè di pagina") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("ja" "著者" "日付" "目次" "脚注") - ("ja" "著者" "日付" "目次" "脚注") - ("nl" "Auteur" "Datum" "Inhoudsopgave" "Voetnoten") - ("no" "Forfatter" "Dato" "Innhold" "Fotnoter") - ("nb" "Forfatter" "Dato" "Innhold" "Fotnoter") ;; nb = Norsk (bokm.l) - ("nn" "Forfattar" "Dato" "Innhald" "Fotnotar") ;; nn = Norsk (nynorsk) - ("pl" "Autor" "Data" "Spis treści" "Przypis") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("ru" "Автор" "Дата" "Содержание" "Сноски") - ("ru" "Автор" "Дата" "Содержание" "Сноски") - ("sv" "Författare" "Datum" "Innehåll" "Fotnoter") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("uk" "Автор" "Дата" "Зміст" "Примітки") - ("uk" "Автор" "Дата" "Зміст" "Примітки") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("zh-CN" "作者" "日期" "目录" "脚注") - ("zh-CN" "作者" "日期" "目录" "脚注") - ;; Use numeric character entities for proper rendering of non-UTF8 documents - ;; ("zh-TW" "作者" "日期" "目錄" "腳註") - ("zh-TW" "作者" "日期" "目錄" "腳註")) - "Terms used in export text, translated to different languages. -Use the variable `org-export-default-language' to set the language, -or use the +OPTION lines for a per-file setting." - :group 'org-export-general - :type '(repeat - (list - (string :tag "HTML language tag") - (string :tag "Author") - (string :tag "Date") - (string :tag "Table of Contents") - (string :tag "Footnotes")))) - -(defcustom org-export-default-language "en" - "The default language for export and clocktable translations, as a string. -This should have an association in `org-export-language-setup' -and in `org-clock-clocktable-language-setup'." - :group 'org-export-general - :type 'string) - -(defcustom org-export-date-timestamp-format "%Y-%m-%d" - "Time string format for Org timestamps in the #+DATE option." - :group 'org-export-general - :version "24.1" - :type 'string) - -(defvar org-export-page-description "" - "The page description, for the XHTML meta tag. -This is best set with the #+DESCRIPTION line in a file, it does not make -sense to set this globally.") - -(defvar org-export-page-keywords "" - "The page description, for the XHTML meta tag. -This is best set with the #+KEYWORDS line in a file, it does not make -sense to set this globally.") - -(defcustom org-export-skip-text-before-1st-heading nil - "Non-nil means skip all text before the first headline when exporting. -When nil, that text is exported as well." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-headline-levels 3 - "The last level which is still exported as a headline. -Inferior levels will produce itemize lists when exported. -Note that a numeric prefix argument to an exporter function overrides -this setting. - -This option can also be set with the +OPTIONS line, e.g. \"H:2\"." - :group 'org-export-general - :type 'integer) - -(defcustom org-export-with-section-numbers t - "Non-nil means add section numbers to headlines when exporting. - -This option can also be set with the +OPTIONS line, e.g. \"num:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-section-number-format '((("1" ".")) . "") - "Format of section numbers for export. -The variable has two components. -1. A list of lists, each indicating a counter type and a separator. - The counter type can be any of \"1\", \"A\", \"a\", \"I\", or \"i\". - It causes causes numeric, alphabetic, or roman counters, respectively. - The separator is only used if another counter for a subsection is being - added. - If there are more numbered section levels than entries in this lists, - then the last entry will be reused. -2. A terminator string that will be added after the entire - section number." - :group 'org-export-general - :type '(cons - (repeat - (list - (string :tag "Counter Type") - (string :tag "Separator "))) - (string :tag "Terminator"))) - -(defcustom org-export-with-toc t - "Non-nil means create a table of contents in exported files. -The TOC contains headlines with levels up to`org-export-headline-levels'. -When an integer, include levels up to N in the toc, this may then be -different from `org-export-headline-levels', but it will not be allowed -to be larger than the number of headline levels. -When nil, no table of contents is made. - -Headlines which contain any TODO items will be marked with \"(*)\" in -ASCII export, and with red color in HTML output, if the option -`org-export-mark-todo-in-toc' is set. - -In HTML output, the TOC will be clickable. - -This option can also be set with the +OPTIONS line, e.g. \"toc:nil\" -or \"toc:3\"." - :group 'org-export-general - :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) - -(defcustom org-export-mark-todo-in-toc nil - "Non-nil means mark TOC lines that contain any open TODO items." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-todo-keywords t - "Non-nil means include TODO keywords in export. -When nil, remove all these keywords from the export." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tasks t - "Non-nil means include TODO items for export. -This may have the following values: -t include tasks independent of state. -todo include only tasks that are not yet done. -done include only tasks that are already done. -nil remove all tasks before export -list of TODO kwds keep only tasks with these keywords" - :group 'org-export-general - :version "24.1" - :type '(choice - (const :tag "All tasks" t) - (const :tag "No tasks" nil) - (const :tag "Not-done tasks" todo) - (const :tag "Only done tasks" done) - (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) - -(defcustom org-export-with-priority nil - "Non-nil means include priority cookies in export. -When nil, remove priority cookies for export." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-preserve-breaks nil - "Non-nil means preserve all line breaks when exporting. -Normally, in HTML output paragraphs will be reformatted. In ASCII -export, line breaks will always be preserved, regardless of this variable. - -This option can also be set with the +OPTIONS line, e.g. \"\\n:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-archived-trees 'headline - "Whether subtrees with the ARCHIVE tag should be exported. -This can have three different values -nil Do not export, pretend this tree is not present -t Do export the entire tree -headline Only export the headline, but skip the tree below it." - :group 'org-export-general - :group 'org-archive - :type '(choice - (const :tag "not at all" nil) - (const :tag "headline only" 'headline) - (const :tag "entirely" t))) - -(defcustom org-export-author-info t - "Non-nil means insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"author:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-email-info nil - "Non-nil means insert author name and email into the exported file. - -This option can also be set with the +OPTIONS line, -e.g. \"email:t\"." - :group 'org-export-general - :version "24.1" - :type 'boolean) - -(defcustom org-export-creator-info t - "Non-nil means the postamble should contain a creator sentence. -This sentence is \"HTML generated by org-mode XX in emacs XXX\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-time-stamp-file t - "Non-nil means insert a time stamp into the exported file. -The time stamp shows when the file was created. - -This option can also be set with the +OPTIONS line, -e.g. \"timestamp:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-timestamps t - "If nil, do not export time stamps and associated keywords." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-remove-timestamps-from-toc t - "If t, remove timestamps from the table of contents entries." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tags 'not-in-toc - "If nil, do not export tags, just remove them from headlines. -If this is the symbol `not-in-toc', tags will be removed from table of -contents entries, but still be shown in the headlines of the document. - -This option can also be set with the +OPTIONS line, e.g. \"tags:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) - -(defcustom org-export-with-drawers nil - "Non-nil means export with drawers like the property drawer. -When t, all drawers are exported. This may also be a list of -drawer names to export." - :group 'org-export-general - :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")))) - -(defvar org-export-first-hook nil - "Hook called as the first thing in each exporter. -Point will be still in the original buffer. -Good for general initialization") - -(defvar org-export-preprocess-hook nil - "Hook for preprocessing an export buffer. -Pretty much the first thing when exporting is running this hook. -Point will be in a temporary buffer that contains a copy of -the original buffer, or of the section that is being exported. -All the other hooks in the org-export-preprocess... category -also work in that temporary buffer, already modified by various -stages of the processing.") - -(defvar org-export-preprocess-after-include-files-hook nil - "Hook for preprocessing an export buffer. -This is run after the contents of included files have been inserted.") - -(defvar org-export-preprocess-after-tree-selection-hook nil - "Hook for preprocessing an export buffer. -This is run after selection of trees to be exported has happened. -This selection includes tags-based selection, as well as removal -of commented and archived trees.") - -(defvar org-export-preprocess-after-headline-targets-hook nil - "Hook for preprocessing export buffer. -This is run just after the headline targets have been defined and -the target-alist has been set up.") - -(defvar org-export-preprocess-before-selecting-backend-code-hook nil - "Hook for preprocessing an export buffer. -This is run just before backend-specific blocks get selected.") - -(defvar org-export-preprocess-after-blockquote-hook nil - "Hook for preprocessing an export buffer. -This is run after blockquote/quote/verse/center have been marked -with cookies.") - -(defvar org-export-preprocess-after-radio-targets-hook nil - "Hook for preprocessing an export buffer. -This is run after radio target processing.") - -(defvar org-export-preprocess-before-normalizing-links-hook nil - "Hook for preprocessing an export buffer. -This hook is run before links are normalized.") - -(defvar org-export-preprocess-before-backend-specifics-hook nil - "Hook run before backend-specific functions are called during preprocessing.") - -(defvar org-export-preprocess-final-hook nil - "Hook for preprocessing an export buffer. -This is run as the last thing in the preprocessing buffer, just before -returning the buffer string to the backend.") - -(defgroup org-export-translation nil - "Options for translating special ascii sequences for the export backends." - :tag "Org Export Translation" - :group 'org-export) - -(defcustom org-export-with-emphasize t - "Non-nil means interpret *word*, /word/, and _word_ as emphasized text. -If the export target supports emphasizing text, the word will be -typeset in bold, italic, or underlined, respectively. Works only for -single words, but you can say: I *really* *mean* *this*. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"*:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-footnotes t - "If nil, export [1] as a footnote marker. -Lines starting with [1] will be formatted as footnotes. - -This option can also be set with the +OPTIONS line, e.g. \"f:nil\"." - :group 'org-export-translation - :type 'boolean) - -(defcustom org-export-with-TeX-macros t - "Non-nil means interpret simple TeX-like macros when exporting. -For example, HTML export converts \\alpha to α and \\AA to Å. -Not only real TeX macros will work here, but the standard HTML entities -for math can be used as macro names as well. For a list of supported -names in HTML export, see the constant `org-entities' and the user option -`org-entities-user'. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"TeX:nil\"." - :group 'org-export-translation - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-with-LaTeX-fragments t - "Non-nil means process LaTeX math fragments for HTML display. -When set, the exporter will find and process LaTeX environments if the -\\begin line is the first non-white thing on a line. It will also find -and process the math delimiters like $a=b$ and \\( a=b \\) for inline math, -$$a=b$$ and \\=\\[ a=b \\] for display math. - -This option can also be set with the +OPTIONS line, e.g. \"LaTeX:mathjax\". - -Allowed values are: - -nil Don't do anything. -verbatim Keep everything in verbatim -dvipng Process the LaTeX fragments to images. - This will also include processing of non-math environments. -imagemagick Convert the LaTeX fragments to pdf files and use imagemagick - to convert pdf files to png files. -t Do MathJax preprocessing if there is at least on math snippet, - and arrange for MathJax.js to be loaded. - -The default is nil, because this option needs the `dvipng' program which -is not available on all systems." - :group 'org-export-translation - :group 'org-export-latex - :type '(choice - (const :tag "Do not process math in any way" nil) - (const :tag "Obsolete, use dvipng setting" t) - (const :tag "Use dvipng to make images" dvipng) - (const :tag "Use imagemagick to make images" imagemagick) - (const :tag "Use MathJax to display math" mathjax) - (const :tag "Leave math verbatim" verbatim))) - -(defcustom org-export-with-fixed-width t - "Non-nil means lines starting with \":\" will be in fixed width font. -This can be used to have pre-formatted text, fragments of code etc. For -example: - : ;; Some Lisp examples - : (while (defc cnt) - : (ding)) -will be looking just like this in also HTML. See also the QUOTE keyword. -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"::nil\"." - :group 'org-export-translation - :type 'boolean) - -(defgroup org-export-tables nil - "Options for exporting tables in Org-mode." - :tag "Org Export Tables" - :group 'org-export) - -(defcustom org-export-with-tables t - "If non-nil, lines starting with \"|\" define a table. -For example: - - | Name | Address | Birthday | - |-------------+----------+-----------| - | Arthur Dent | England | 29.2.2100 | - -Not all export backends support this. - -This option can also be set with the +OPTIONS line, e.g. \"|:nil\"." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-highlight-first-table-line t - "Non-nil means highlight the first table line. -In HTML export, this means use <th> instead of <td>. -In tables created with table.el, this applies to the first table line. -In Org-mode tables, all lines before the first horizontal separator -line will be formatted with <th> tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-special-lines t - "Remove special lines and marking characters in calculating tables. -This removes the special marking character column from tables that are set -up for spreadsheet calculations. It also removes the entire lines -marked with `!', `_', or `^'. The lines with `$' are kept, because -the values of constants may be useful to have." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-table-remove-empty-lines t - "Remove empty lines when exporting tables. -This is the global equivalent of the :remove-nil-lines option -when locally sending a table with #+ORGTBL." - :group 'org-export-tables - :version "24.1" - :type 'boolean) - -(defcustom org-export-prefer-native-exporter-for-tables nil - "Non-nil means always export tables created with table.el natively. -Natively means use the HTML code generator in table.el. -When nil, Org-mode's own HTML generator is used when possible (i.e. if -the table does not use row- or column-spanning). This has the -advantage, that the automatic HTML conversions for math symbols and -sub/superscripts can be applied. Org-mode's HTML generator is also -much faster. The LaTeX exporter always use the native exporter for -table.el tables." - :group 'org-export-tables - :type 'boolean) - -;;;; Exporting - -;;; Variables, constants, and parameter plists - -(defconst org-level-max 20) - -(defvar org-export-current-backend nil - "During export, this will be bound to a symbol such as 'html, - 'latex, 'docbook, 'ascii, etc, indicating which of the export - backends is in use. Otherwise it has the value nil. Users - should not attempt to change the value of this variable - directly, but it can be used in code to test whether export is - in progress, and if so, what the backend is.") - -(defvar org-current-export-file nil) ; dynamically scoped parameter -(defvar org-current-export-dir nil) ; dynamically scoped parameter -(defvar org-export-opt-plist nil - "Contains the current option plist.") -(defvar org-last-level nil) ; dynamically scoped variable -(defvar org-min-level nil) ; dynamically scoped variable -(defvar org-levels-open nil) ; dynamically scoped parameter -(defvar org-export-footnotes-data nil - "Alist of labels used in buffers, along with their definition.") -(defvar org-export-footnotes-seen nil - "Alist of labels encountered so far by the exporter, along with their definition.") - - -(defconst org-export-plist-vars - '((:link-up nil org-export-html-link-up) - (:link-home nil org-export-html-link-home) - (:language nil org-export-default-language) - (:keywords nil org-export-page-keywords) - (:description nil org-export-page-description) - (:customtime nil org-display-custom-times) - (:headline-levels "H" org-export-headline-levels) - (:section-numbers "num" org-export-with-section-numbers) - (:section-number-format nil org-export-section-number-format) - (:table-of-contents "toc" org-export-with-toc) - (:preserve-breaks "\\n" org-export-preserve-breaks) - (:archived-trees nil org-export-with-archived-trees) - (:emphasize "*" org-export-with-emphasize) - (:sub-superscript "^" org-export-with-sub-superscripts) - (:special-strings "-" org-export-with-special-strings) - (:footnotes "f" org-export-with-footnotes) - (:drawers "d" org-export-with-drawers) - (:tags "tags" org-export-with-tags) - (:todo-keywords "todo" org-export-with-todo-keywords) - (:tasks "tasks" org-export-with-tasks) - (:priority "pri" org-export-with-priority) - (:TeX-macros "TeX" org-export-with-TeX-macros) - (:LaTeX-fragments "LaTeX" org-export-with-LaTeX-fragments) - (:latex-listings nil org-export-latex-listings) - (:skip-before-1st-heading "skip" org-export-skip-text-before-1st-heading) - (:fixed-width ":" org-export-with-fixed-width) - (:timestamps "<" org-export-with-timestamps) - (:author nil user-full-name) - (:email nil user-mail-address) - (:author-info "author" org-export-author-info) - (:email-info "email" org-export-email-info) - (:creator-info "creator" org-export-creator-info) - (:time-stamp-file "timestamp" org-export-time-stamp-file) - (:tables "|" org-export-with-tables) - (:table-auto-headline nil org-export-highlight-first-table-line) - (:style-include-default nil org-export-html-style-include-default) - (:style-include-scripts nil org-export-html-style-include-scripts) - (:style nil org-export-html-style) - (:style-extra nil org-export-html-style-extra) - (:agenda-style nil org-agenda-export-html-style) - (:convert-org-links nil org-export-html-link-org-files-as-html) - (:inline-images nil org-export-html-inline-images) - (:html-extension nil org-export-html-extension) - (:html-preamble nil org-export-html-preamble) - (:html-postamble nil org-export-html-postamble) - (:xml-declaration nil org-export-html-xml-declaration) - (:html-table-tag nil org-export-html-table-tag) - (:expand-quoted-html "@" org-export-html-expand) - (:timestamp nil org-export-html-with-timestamp) - (:publishing-directory nil org-export-publishing-directory) - (:select-tags nil org-export-select-tags) - (:exclude-tags nil org-export-exclude-tags) - - (:latex-image-options nil org-export-latex-image-default-option)) - "List of properties that represent export/publishing variables. -Each element is a list of 3 items: -1. The property that is used internally, and also for org-publish-project-alist -2. The string that can be used in the OPTION lines to set this option, - or nil if this option cannot be changed in this way -3. The customization variable that sets the default for this option." - ) - -(defun org-default-export-plist () - "Return the property list with default settings for the export variables." - (let* ((infile (org-infile-export-plist)) - (letbind (plist-get infile :let-bind)) - (l org-export-plist-vars) rtn e s v) - (while (setq e (pop l)) - (setq s (nth 2 e) - v (cond - ((assq s letbind) (nth 1 (assq s letbind))) - ((boundp s) (symbol-value s))) - rtn (cons (car e) (cons v rtn)))) - rtn)) - -(defvar org-export-inbuffer-options-extra nil - "List of additional in-buffer options that should be detected. -Just before export, the buffer is scanned for options like #+TITLE, #+EMAIL, -etc. Extensions can add to this list to get their options detected, and they -can then add a function to `org-export-options-filters' to process these -options. -Each element in this list must be a list, with the in-buffer keyword as car, -and a property (a symbol) as the next element. All occurrences of the -keyword will be found, the values concatenated with a space character -in between, and the result stored in the export options property list.") - -(defvar org-export-options-filters nil - "Functions to be called to finalize the export/publishing options. -All these options are stored in a property list, and each of the functions -in this hook gets a chance to modify this property list. Each function -must accept the property list as an argument, and must return the (possibly -modified) list.") - -;; FIXME: should we fold case here? - -(defun org-infile-export-plist () - "Return the property list with file-local settings for export." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((re (org-make-options-regexp - (append - '("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE" - "MATHJAX" - "LINK_UP" "LINK_HOME" "SETUPFILE" "STYLE" - "LATEX_HEADER" "LATEX_CLASS" "LATEX_CLASS_OPTIONS" - "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" - "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") - (mapcar 'car org-export-inbuffer-options-extra)))) - (case-fold-search t) - p key val text options mathjax a pr style - latex-header latex-class latex-class-options macros letbind - ext-setup-or-nil setup-file setup-dir setup-contents (start 0)) - (while (or (and ext-setup-or-nil - (string-match re ext-setup-or-nil start) - (setq start (match-end 0))) - (and (setq ext-setup-or-nil nil start 0) - (re-search-forward re nil t))) - (setq key (upcase (org-match-string-no-properties 1 ext-setup-or-nil)) - val (org-match-string-no-properties 2 ext-setup-or-nil)) - (cond - ((setq a (assoc key org-export-inbuffer-options-extra)) - (setq pr (nth 1 a)) - (setq p (plist-put p pr (concat (plist-get p pr) " " val)))) - ((string-equal key "TITLE") (setq p (plist-put p :title val))) - ((string-equal key "AUTHOR")(setq p (plist-put p :author val))) - ((string-equal key "EMAIL") (setq p (plist-put p :email val))) - ((string-equal key "DATE") - ;; If date is an Org timestamp, convert it to a time - ;; string using `org-export-date-timestamp-format' - (when (string-match org-ts-regexp3 val) - (setq val (format-time-string - org-export-date-timestamp-format - (apply 'encode-time (org-parse-time-string - (match-string 0 val)))))) - (setq p (plist-put p :date val))) - ((string-equal key "KEYWORDS") (setq p (plist-put p :keywords val))) - ((string-equal key "DESCRIPTION") - (setq p (plist-put p :description val))) - ((string-equal key "LANGUAGE") (setq p (plist-put p :language val))) - ((string-equal key "STYLE") - (setq style (concat style "\n" val))) - ((string-equal key "LATEX_HEADER") - (setq latex-header (concat latex-header "\n" val))) - ((string-equal key "LATEX_CLASS") - (setq latex-class val)) - ((string-equal key "LATEX_CLASS_OPTIONS") - (setq latex-class-options val)) - ((string-equal key "TEXT") - (setq text (if text (concat text "\n" val) val))) - ((string-equal key "OPTIONS") - (setq options (concat val " " options))) - ((string-equal key "MATHJAX") - (setq mathjax (concat val " " mathjax))) - ((string-equal key "BIND") - (push (read (concat "(" val ")")) letbind)) - ((string-equal key "XSLT") - (setq p (plist-put p :xslt val))) - ((string-equal key "LINK_UP") - (setq p (plist-put p :link-up val))) - ((string-equal key "LINK_HOME") - (setq p (plist-put p :link-home val))) - ((string-equal key "EXPORT_SELECT_TAGS") - (setq p (plist-put p :select-tags (org-split-string val)))) - ((string-equal key "EXPORT_EXCLUDE_TAGS") - (setq p (plist-put p :exclude-tags (org-split-string val)))) - ((string-equal key "MACRO") - (push val macros)) - ((equal key "SETUPFILE") - (setq setup-file (org-remove-double-quotes (org-trim val)) - ;; take care of recursive inclusion of setupfiles - setup-file (if (or (file-name-absolute-p val) (not setup-dir)) - (expand-file-name setup-file) - (let ((default-directory setup-dir)) - (expand-file-name setup-file)))) - (setq setup-dir (file-name-directory setup-file)) - (setq setup-contents (org-file-contents setup-file 'noerror)) - (if (not ext-setup-or-nil) - (setq ext-setup-or-nil setup-contents start 0) - (setq ext-setup-or-nil - (concat (substring ext-setup-or-nil 0 start) - "\n" setup-contents "\n" - (substring ext-setup-or-nil start))))))) - (setq p (plist-put p :text text)) - (when (and letbind (org-export-confirm-letbind)) - (setq p (plist-put p :let-bind letbind))) - (when style (setq p (plist-put p :style-extra style))) - (when latex-header - (setq p (plist-put p :latex-header-extra (substring latex-header 1)))) - (when latex-class - (setq p (plist-put p :latex-class latex-class))) - (when latex-class-options - (setq p (plist-put p :latex-class-options latex-class-options))) - (when options - (setq p (org-export-add-options-to-plist p options))) - (when mathjax - (setq p (plist-put p :mathjax mathjax))) - ;; Add macro definitions - (setq p (plist-put p :macro-date "(eval (format-time-string \"$1\"))")) - (setq p (plist-put p :macro-time "(eval (format-time-string \"$1\"))")) - (setq p (plist-put p :macro-property "(eval (org-entry-get nil \"$1\" 'selective))")) - (setq p (plist-put - p :macro-modification-time - (and (buffer-file-name) - (file-exists-p (buffer-file-name)) - (concat - "(eval (format-time-string \"$1\" '" - (prin1-to-string (nth 5 (file-attributes - (buffer-file-name)))) - "))")))) - (setq p (plist-put p :macro-input-file (and (buffer-file-name) - (file-name-nondirectory - (buffer-file-name))))) - (while (setq val (pop macros)) - (when (string-match "^\\([-a-zA-Z0-9_]+\\)[ \t]+\\(.*?[ \t]*$\\)" val) - (setq p (plist-put - p (intern - (concat ":macro-" (downcase (match-string 1 val)))) - (org-export-interpolate-newlines (match-string 2 val)))))) - p)))) - -(defun org-export-interpolate-newlines (s) - (while (string-match "\\\\n" s) - (setq s (replace-match "\n" t t s))) - s) - -(defvar org-export-allow-BIND-local nil) -(defun org-export-confirm-letbind () - "Can we use #+BIND values during export? -By default this will ask for confirmation by the user, to divert possible -security risks." - (cond - ((not org-export-allow-BIND) nil) - ((eq org-export-allow-BIND t) t) - ((local-variable-p 'org-export-allow-BIND-local (current-buffer)) - org-export-allow-BIND-local) - (t (org-set-local 'org-export-allow-BIND-local - (yes-or-no-p "Allow BIND values in this buffer? "))))) - -(defun org-install-letbind () - "Install the values from #+BIND lines as local variables." - (let ((letbind (plist-get org-export-opt-plist :let-bind)) - pair) - (while (setq pair (pop letbind)) - (org-set-local (car pair) (nth 1 pair))))) - -(defun org-export-add-options-to-plist (p options) - "Parse an OPTIONS line and set values in the property list P." - (let (o) - (when options - (let ((op org-export-plist-vars)) - (while (setq o (pop op)) - (if (and (nth 1 o) - (string-match (concat "\\(\\`\\|[ \t]\\)" - (regexp-quote (nth 1 o)) - ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") - options)) - (setq p (plist-put p (car o) - (car (read-from-string - (match-string 2 options)))))))))) - p) - -(defun org-export-add-subtree-options (p pos) - "Add options in subtree at position POS to property list P." - (save-excursion - (goto-char pos) - (when (org-at-heading-p) - (let (a) - ;; This is actually read in `org-export-get-title-from-subtree' - ;; (when (setq a (org-entry-get pos "EXPORT_TITLE")) - ;; (setq p (plist-put p :title a))) - (when (setq a (org-entry-get pos "EXPORT_TEXT")) - (setq p (plist-put p :text a))) - (when (setq a (org-entry-get pos "EXPORT_AUTHOR")) - (setq p (plist-put p :author a))) - (when (setq a (org-entry-get pos "EXPORT_DATE")) - (setq p (plist-put p :date a))) - (when (setq a (org-entry-get pos "EXPORT_OPTIONS")) - (setq p (org-export-add-options-to-plist p a))))) - p)) - -(defun org-export-directory (type plist) - (let* ((val (plist-get plist :publishing-directory)) - (dir (if (listp val) - (or (cdr (assoc type val)) ".") - val))) - dir)) - -(defun org-export-process-option-filters (plist) - (let ((functions org-export-options-filters) f) - (while (setq f (pop functions)) - (setq plist (funcall f plist)))) - plist) - -;;;###autoload -(defun org-export (&optional arg) - "Export dispatcher for Org-mode. -When `org-export-run-in-background' is non-nil, try to run the command -in the background. This will be done only for commands that write -to a file. For details see the docstring of `org-export-run-in-background'. - -The prefix argument ARG will be passed to the exporter. However, if -ARG is a double universal prefix \\[universal-argument] \\[universal-argument], \ -that means to inverse the -value of `org-export-run-in-background'. - -If `org-export-initial-scope' is set to 'subtree, try to export -the current subtree, otherwise try to export the whole buffer. -Pressing `1' will switch between these two options." - (interactive "P") - (let* ((bg (org-xor (equal arg '(16)) org-export-run-in-background)) - (subtree-p (or (org-region-active-p) - (eq org-export-initial-scope 'subtree))) - (regb (and (org-region-active-p) (region-beginning))) - (rege (and (org-region-active-p) (region-end))) - (help "[t] insert the export option template -\[v] limit export to visible part of outline tree -\[1] switch buffer/subtree export -\[SPC] publish enclosing subtree (with LaTeX_CLASS or EXPORT_FILE_NAME prop) - -\[a/n/u] export as ASCII/Latin-1/UTF-8 [A/N/U] to temporary buffer - -\[h] export as HTML [H] to temporary buffer [R] export region -\[b] export as HTML and open in browser - -\[l] export as LaTeX [L] to temporary buffer -\[p] export as LaTeX and process to PDF [d] ... and open PDF file - -\[D] export as DocBook [V] export as DocBook, process to PDF, and open - -\[o] export as OpenDocument Text [O] ... and open - -\[j] export as TaskJuggler [J] ... and open - -\[m] export as Freemind mind map -\[x] export as XOXO -\[g] export using Wes Hardaker's generic exporter - -\[i] export current file as iCalendar file -\[I] export all agenda files as iCalendar files [c] ...as one combined file - -\[F] publish current file [P] publish current project -\[X] publish a project... [E] publish every projects") - (cmds - '((?t org-insert-export-options-template nil) - (?v org-export-visible nil) - (?a org-export-as-ascii t) - (?A org-export-as-ascii-to-buffer t) - (?n org-export-as-latin1 t) - (?N org-export-as-latin1-to-buffer t) - (?u org-export-as-utf8 t) - (?U org-export-as-utf8-to-buffer t) - (?h org-export-as-html t) - (?b org-export-as-html-and-open t) - (?H org-export-as-html-to-buffer nil) - (?R org-export-region-as-html nil) - (?x org-export-as-xoxo t) - (?g org-export-generic t) - (?D org-export-as-docbook t) - (?V org-export-as-docbook-pdf-and-open t) - (?o org-export-as-odt t) - (?O org-export-as-odt-and-open t) - (?j org-export-as-taskjuggler t) - (?J org-export-as-taskjuggler-and-open t) - (?m org-export-as-freemind t) - (?l org-export-as-latex t) - (?p org-export-as-pdf t) - (?d org-export-as-pdf-and-open t) - (?L org-export-as-latex-to-buffer nil) - (?i org-export-icalendar-this-file t) - (?I org-export-icalendar-all-agenda-files t) - (?c org-export-icalendar-combine-agenda-files t) - (?F org-publish-current-file t) - (?P org-publish-current-project t) - (?X org-publish t) - (?E org-publish-all t))) - r1 r2 ass - (cpos (point)) (cbuf (current-buffer)) bpos) - (save-excursion - (save-window-excursion - (if subtree-p - (message "Export subtree: ") - (message "Export buffer: ")) - (delete-other-windows) - (with-output-to-temp-buffer "*Org Export/Publishing Help*" - (princ help)) - (org-fit-window-to-buffer (get-buffer-window - "*Org Export/Publishing Help*")) - (while (eq (setq r1 (read-char-exclusive)) ?1) - (cond (subtree-p - (setq subtree-p nil) - (message "Export buffer: ")) - ((not subtree-p) - (setq subtree-p t) - (setq bpos (point)) - (org-mark-subtree) - (org-activate-mark) - (setq regb (and (org-region-active-p) (region-beginning))) - (setq rege (and (org-region-active-p) (region-end))) - (message "Export subtree: ")))) - (when (eq r1 ?\ ) - (let ((case-fold-search t) - (end (save-excursion (while (org-up-heading-safe)) (point)))) - (outline-next-heading) - (if (re-search-backward - "^[ \t]+\\(:latex_class:\\|:export_title:\\|:export_file_name:\\)[ \t]+\\S-" - end t) - (progn - (org-back-to-heading t) - (setq subtree-p t) - (setq bpos (point)) - (message "Select command (for subtree): ") - (setq r1 (read-char-exclusive))) - (error "No enclosing node with LaTeX_CLASS or EXPORT_TITLE or EXPORT_FILE_NAME") - ))))) - (if (fboundp 'redisplay) (redisplay)) ;; XEmacs does not have/need (redisplay) - (and bpos (goto-char bpos)) - (setq r2 (if (< r1 27) (+ r1 96) r1)) - (unless (setq ass (assq r2 cmds)) - (error "No command associated with key %c" r1)) - (if (and bg (nth 2 ass) - (not (buffer-base-buffer)) - (not (org-region-active-p))) - ;; execute in background - (let ((p (start-process - (concat "Exporting " (file-name-nondirectory (buffer-file-name))) - "*Org Processes*" - (expand-file-name invocation-name invocation-directory) - "-batch" - "-l" user-init-file - "--eval" "(require 'org-exp)" - "--eval" "(setq org-wait .2)" - (buffer-file-name) - "-f" (symbol-name (nth 1 ass))))) - (set-process-sentinel p 'org-export-process-sentinel) - (message "Background process \"%s\": started" p)) - ;; set the mark correctly when exporting a subtree - (if subtree-p (let (deactivate-mark) (push-mark rege t t) (goto-char regb))) - - (call-interactively (nth 1 ass)) - (when (and bpos (get-buffer-window cbuf)) - (let ((cw (selected-window))) - (select-window (get-buffer-window cbuf)) - (goto-char cpos) - (deactivate-mark) - (select-window cw)))))) - -(defun org-export-process-sentinel (process status) - (if (string-match "\n+\\'" status) - (setq status (substring status 0 -1))) - (message "Background process \"%s\": %s" process status)) - -;;; General functions for all backends - -(defvar org-export-target-aliases nil - "Alist of targets with invisible aliases.") -(defvar org-export-preferred-target-alist nil - "Alist of section id's with preferred aliases.") -(defvar org-export-id-target-alist nil - "Alist of section id's with preferred aliases.") -(defvar org-export-code-refs nil - "Alist of code references and line numbers.") - -(defun org-export-preprocess-string (string &rest parameters) - "Cleanup STRING so that the true exported has a more consistent source. -This function takes STRING, which should be a buffer-string of an org-file -to export. It then creates a temporary buffer where it does its job. -The result is then again returned as a string, and the exporter works -on this string to produce the exported version." - (interactive) - (let* ((org-export-current-backend (or (plist-get parameters :for-backend) - org-export-current-backend)) - (archived-trees (plist-get parameters :archived-trees)) - (inhibit-read-only t) - (drawers org-drawers) - (source-buffer (current-buffer)) - target-alist rtn) - - (setq org-export-target-aliases nil - org-export-preferred-target-alist nil - org-export-id-target-alist nil - org-export-code-refs nil) - - (with-temp-buffer - (erase-buffer) - (insert string) - (setq case-fold-search t) - - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) - '(read-only t))) - - ;; Remove license-to-kill stuff - ;; The caller marks some stuff for killing, stuff that has been - ;; used to create the page title, for example. - (org-export-kill-licensed-text) - - (let ((org-inhibit-startup t)) (org-mode)) - (setq case-fold-search t) - (org-clone-local-variables source-buffer "^\\(org-\\|orgtbl-\\)") - (org-install-letbind) - - ;; Call the hook - (run-hooks 'org-export-preprocess-hook) - - (untabify (point-min) (point-max)) - - ;; Handle include files, and call a hook - (org-export-handle-include-files-recurse) - (run-hooks 'org-export-preprocess-after-include-files-hook) - - ;; Get rid of archived trees - (org-export-remove-archived-trees archived-trees) - - ;; Remove comment environment and comment subtrees - (org-export-remove-comment-blocks-and-subtrees) - - ;; Get rid of excluded trees, and call a hook - (org-export-handle-export-tags (plist-get parameters :select-tags) - (plist-get parameters :exclude-tags)) - (run-hooks 'org-export-preprocess-after-tree-selection-hook) - - ;; Get rid of tasks, depending on configuration - (org-export-remove-tasks (plist-get parameters :tasks)) - - ;; Prepare footnotes for export. During that process, footnotes - ;; actually included in the exported part of the buffer go - ;; though some transformations: - - ;; 1. They have their label normalized (like "[N]"); - - ;; 2. They get moved at the same place in the buffer (usually at - ;; its end, but backends may define another place via - ;; `org-footnote-insert-pos-for-preprocessor'); - - ;; 3. The are stored in `org-export-footnotes-seen', while - ;; `org-export-preprocess-string' is applied to their - ;; definition. - - ;; Line-wise exporters ignore `org-export-footnotes-seen', as - ;; they interpret footnotes at the moment they see them in the - ;; buffer. Context-wise exporters grab all the info needed in - ;; that variable and delete moved definitions (as described in - ;; 2nd step). - (when (plist-get parameters :footnotes) - (org-footnote-normalize nil parameters)) - - ;; Change lists ending. Other parts of export may insert blank - ;; lines and lists' structure could be altered. - (org-export-mark-list-end) - - ;; Process the macros - (org-export-preprocess-apply-macros) - (run-hooks 'org-export-preprocess-after-macros-hook) - - ;; Export code blocks - (org-export-blocks-preprocess) - - ;; Mark lists with properties - (org-export-mark-list-properties) - - ;; Handle source code snippets - (org-export-replace-src-segments-and-examples) - - ;; Protect short examples marked by a leading colon - (org-export-protect-colon-examples) - - ;; Protected spaces - (org-export-convert-protected-spaces) - - ;; Find all headings and compute the targets for them - (setq target-alist (org-export-define-heading-targets target-alist)) - - (run-hooks 'org-export-preprocess-after-headline-targets-hook) - - ;; Find HTML special classes for headlines - (org-export-remember-html-container-classes) - - ;; Get rid of drawers - (org-export-remove-or-extract-drawers - drawers (plist-get parameters :drawers)) - - ;; Get the correct stuff before the first headline - (when (plist-get parameters :skip-before-1st-heading) - (goto-char (point-min)) - (when (re-search-forward "^\\(#.*\n\\)?\\*+[ \t]" nil t) - (delete-region (point-min) (match-beginning 0)) - (goto-char (point-min)) - (insert "\n"))) - (when (plist-get parameters :add-text) - (goto-char (point-min)) - (insert (plist-get parameters :add-text) "\n")) - - ;; Remove todo-keywords before exporting, if the user has requested so - (org-export-remove-headline-metadata parameters) - - ;; Find targets in comments and move them out of comments, - ;; but mark them as targets that should be invisible - (setq target-alist (org-export-handle-invisible-targets target-alist)) - - ;; Select and protect backend specific stuff, throw away stuff - ;; that is specific for other backends - (run-hooks 'org-export-preprocess-before-selecting-backend-code-hook) - (org-export-select-backend-specific-text) - - ;; Protect quoted subtrees - (org-export-protect-quoted-subtrees) - - ;; Remove clock lines - (org-export-remove-clock-lines) - - ;; Protect verbatim elements - (org-export-protect-verbatim) - - ;; Blockquotes, verse, and center - (org-export-mark-blockquote-verse-center) - (run-hooks 'org-export-preprocess-after-blockquote-hook) - - ;; Remove timestamps, if the user has requested so - (unless (plist-get parameters :timestamps) - (org-export-remove-timestamps)) - - ;; Attach captions to the correct object - (setq target-alist (org-export-attach-captions-and-attributes target-alist)) - - ;; Find matches for radio targets and turn them into internal links - (org-export-mark-radio-links) - (run-hooks 'org-export-preprocess-after-radio-targets-hook) - - ;; Find all links that contain a newline and put them into a single line - (org-export-concatenate-multiline-links) - - ;; Normalize links: Convert angle and plain links into bracket links - ;; and expand link abbreviations - (run-hooks 'org-export-preprocess-before-normalizing-links-hook) - (org-export-normalize-links) - - ;; Find all internal links. If they have a fuzzy match (i.e. not - ;; a *dedicated* target match, let the link point to the - ;; corresponding section. - (org-export-target-internal-links target-alist) - - ;; Find multiline emphasis and put them into single line - (when (plist-get parameters :emph-multiline) - (org-export-concatenate-multiline-emphasis)) - - ;; Remove special table lines, and store alignment information - (org-store-forced-table-alignment) - (when org-export-table-remove-special-lines - (org-export-remove-special-table-lines)) - - ;; Another hook - (run-hooks 'org-export-preprocess-before-backend-specifics-hook) - - ;; Backend-specific preprocessing - (let* ((backend-name (symbol-name org-export-current-backend)) - (f (intern (format "org-export-%s-preprocess" backend-name)))) - (require (intern (concat "org-" backend-name)) nil) - (funcall f parameters)) - - ;; Remove or replace comments - (org-export-handle-comments (plist-get parameters :comments)) - - ;; Remove #+TBLFM #+TBLNAME #+NAME #+RESULTS lines - (org-export-handle-metalines) - - ;; Run the final hook - (run-hooks 'org-export-preprocess-final-hook) - - (setq rtn (buffer-string))) - rtn)) - -(defun org-export-kill-licensed-text () - "Remove all text that is marked with a :org-license-to-kill property." - (let (p) - (while (setq p (text-property-any (point-min) (point-max) - :org-license-to-kill t)) - (delete-region - p (or (next-single-property-change p :org-license-to-kill) - (point-max)))))) - -(defvar org-export-define-heading-targets-headline-hook nil - "Hook that is run when a headline was matched during target search. -This is part of the preprocessing for export.") - -(defun org-export-define-heading-targets (target-alist) - "Find all headings and define the targets for them. -The new targets are added to TARGET-ALIST, which is also returned. -Also find all ID and CUSTOM_ID properties and store them." - (goto-char (point-min)) - (org-init-section-numbers) - (let ((re (concat "^" org-outline-regexp - "\\|" - "^[ \t]*:\\(ID\\|CUSTOM_ID\\):[ \t]*\\([^ \t\r\n]+\\)")) - level target last-section-target a id) - (while (re-search-forward re nil t) - (org-if-unprotected-at (match-beginning 0) - (if (match-end 2) - (progn - (setq id (org-match-string-no-properties 2)) - (push (cons id target) target-alist) - (setq a (or (assoc last-section-target org-export-target-aliases) - (progn - (push (list last-section-target) - org-export-target-aliases) - (car org-export-target-aliases)))) - (push (caar target-alist) (cdr a)) - (when (equal (match-string 1) "CUSTOM_ID") - (if (not (assoc last-section-target - org-export-preferred-target-alist)) - (push (cons last-section-target id) - org-export-preferred-target-alist))) - (when (equal (match-string 1) "ID") - (if (not (assoc last-section-target - org-export-id-target-alist)) - (push (cons last-section-target (concat "ID-" id)) - org-export-id-target-alist)))) - (setq level (org-reduced-level - (save-excursion (goto-char (point-at-bol)) - (org-outline-level)))) - (setq target (org-solidify-link-text - (format "sec-%s" (replace-regexp-in-string - "\\." "-" - (org-section-number level))))) - (setq last-section-target target) - (push (cons target target) target-alist) - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'target target)) - (run-hooks 'org-export-define-heading-targets-headline-hook))))) - target-alist) - -(defun org-export-handle-invisible-targets (target-alist) - "Find targets in comments and move them out of comments. -Mark them as invisible targets." - (let (target tmp a) - (goto-char (point-min)) - (while (re-search-forward "^#.*?\\(<<<?\\([^>\r\n]+\\)>>>?\\).*" nil t) - ;; Check if the line before or after is a headline with a target - (if (setq target (or (get-text-property (point-at-bol 0) 'target) - (get-text-property (point-at-bol 2) 'target))) - (progn - ;; use the existing target in a neighboring line - (setq tmp (match-string 2)) - (replace-match "") - (and (looking-at "\n") (delete-char 1)) - (push (cons (setq tmp (org-solidify-link-text tmp)) target) - target-alist) - (setq a (or (assoc target org-export-target-aliases) - (progn - (push (list target) org-export-target-aliases) - (car org-export-target-aliases)))) - (push tmp (cdr a))) - ;; Make an invisible target - (replace-match "\\1(INVISIBLE)")))) - target-alist) - -(defun org-export-target-internal-links (target-alist) - "Find all internal links and assign targets to them. -If a link has a fuzzy match (i.e. not a *dedicated* target match), -let the link point to the corresponding section. -This function also handles the id links, if they have a match in -the current file." - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((org-link-search-must-match-exact-headline t) - (md (match-data)) - (desc (match-end 2)) - (link (org-link-unescape (match-string 1))) - (slink (org-solidify-link-text link)) - found props pos cref - (target - (cond - ((= (string-to-char link) ?#) - ;; user wants exactly this link - link) - ((cdr (assoc slink target-alist)) - (or (cdr (assoc (assoc slink target-alist) - org-export-preferred-target-alist)) - (cdr (assoc slink target-alist)))) - ((and (string-match "^id:" link) - (cdr (assoc (substring link 3) target-alist)))) - ((string-match "^(\\(.*\\))$" link) - (setq cref (match-string 1 link)) - (concat "coderef:" cref)) - ((string-match org-link-types-re link) nil) - ((or (file-name-absolute-p link) - (string-match "^\\." link)) - nil) - (t - (let ((org-link-search-inhibit-query t)) - (save-excursion - (setq found (condition-case nil (org-link-search link) - (error nil))) - (when (and found - (or (org-at-heading-p) - (not (eq found 'dedicated)))) - (or (get-text-property (point) 'target) - (get-text-property - (max (point-min) - (1- (or (previous-single-property-change - (point) 'target) 0))) - 'target))))))))) - (when target - (set-match-data md) - (goto-char (match-beginning 1)) - (setq props (text-properties-at (point))) - (delete-region (match-beginning 1) (match-end 1)) - (setq pos (point)) - (insert target) - (unless desc (insert "][" link)) - (add-text-properties pos (point) props)))))) - -(defun org-export-remember-html-container-classes () - "Store the HTML_CONTAINER_CLASS properties in a text property." - (goto-char (point-min)) - (let (class) - (while (re-search-forward - "^[ \t]*:HTML_CONTAINER_CLASS:[ \t]+\\(.+\\)$" nil t) - (setq class (match-string 1)) - (save-excursion - (when (re-search-backward "^\\*" (point-min) t) - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) - 'html-container-class class)))))) - -(defvar org-export-format-drawer-function nil - "Function to be called to format the contents of a drawer. -The function must accept two parameters: - NAME the drawer name, like \"PROPERTIES\" - CONTENT the content of the drawer. -You can check the export backend through `org-export-current-backend'. -The function should return the text to be inserted into the buffer. -If this is nil, `org-export-format-drawer' is used as a default.") - -(defun org-export-remove-or-extract-drawers (all-drawers exp-drawers) - "Remove drawers, or extract and format the content. -ALL-DRAWERS is a list of all drawer names valid in the current buffer. -EXP-DRAWERS can be t to keep all drawer contents, or a list of drawers -whose content to keep. Any drawers that are in ALL-DRAWERS but not in -EXP-DRAWERS will be removed." - (goto-char (point-min)) - (let ((re (concat "^[ \t]*:\\(" - (mapconcat 'identity all-drawers "\\|") - "\\):[ \t]*$")) - name beg beg-content eol content) - (while (re-search-forward re nil t) - (org-if-unprotected - (setq name (match-string 1)) - (setq beg (match-beginning 0) - beg-content (1+ (point-at-eol)) - eol (point-at-eol)) - (if (not (and (re-search-forward - "^\\([ \t]*:END:[ \t]*\n?\\)\\|^\\*+[ \t]" nil t) - (match-end 1))) - (goto-char eol) - (goto-char (match-beginning 0)) - (and (looking-at ".*\n?") (replace-match "")) - (setq content (buffer-substring beg-content (point))) - (delete-region beg (point)) - (when (or (eq exp-drawers t) - (member name exp-drawers)) - (setq content (funcall (or org-export-format-drawer-function - 'org-export-format-drawer) - name content)) - (insert content))))))) - -(defun org-export-format-drawer (name content) - "Format the content of a drawer as a colon example." - (if (string-match "[ \t]+\\'" content) - (setq content (substring content (match-beginning 0)))) - (while (string-match "\\`[ \t]*\n" content) - (setq content (substring content (match-end 0)))) - (setq content (org-remove-indentation content)) - (setq content (concat ": " (mapconcat 'identity - (org-split-string content "\n") - "\n: ") - "\n")) - (setq content (concat " : " (upcase name) "\n" content)) - (org-add-props content nil 'org-protected t)) - -(defun org-export-handle-export-tags (select-tags exclude-tags) - "Modify the buffer, honoring SELECT-TAGS and EXCLUDE-TAGS. -Both arguments are lists of tags. -If any of SELECT-TAGS is found, all trees not marked by a SELECT-TAG -will be removed. -After that, all subtrees that are marked by EXCLUDE-TAGS will be -removed as well." - (remove-text-properties (point-min) (point-max) '(:org-delete t)) - (let* ((re-sel (concat ":\\(" (mapconcat 'regexp-quote - select-tags "\\|") - "\\):")) - (re-excl (concat ":\\(" (mapconcat 'regexp-quote - exclude-tags "\\|") - "\\):")) - beg end cont) - (goto-char (point-min)) - (when (and select-tags - (re-search-forward - (concat "^\\*+[ \t].*" re-sel "[^ \t\n]*[ \t]*$") nil t)) - ;; At least one tree is marked for export, this means - ;; all the unmarked stuff needs to go. - ;; Dig out the trees that should be exported - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point)) - (put-text-property beg (point-max) :org-delete t) - (while (re-search-forward re-sel nil t) - (when (org-at-heading-p) - (org-back-to-heading) - (remove-text-properties - (max (1- (point)) (point-min)) - (setq cont (save-excursion (org-end-of-subtree t t))) - '(:org-delete t)) - (while (and (org-up-heading-safe) - (get-text-property (point) :org-delete)) - (remove-text-properties (max (1- (point)) (point-min)) - (point-at-eol) '(:org-delete t))) - (goto-char cont)))) - ;; Remove the trees explicitly marked for noexport - (when exclude-tags - (goto-char (point-min)) - (while (re-search-forward re-excl nil t) - (when (org-at-heading-p) - (org-back-to-heading t) - (setq beg (point)) - (org-end-of-subtree t t) - (delete-region beg (point)) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe))))) - ;; Remove everything that is now still marked for deletion - (goto-char (point-min)) - (while (setq beg (text-property-any (point-min) (point-max) :org-delete t)) - (setq end (or (next-single-property-change beg :org-delete) - (point-max))) - (delete-region beg end)))) - -(defun org-export-remove-tasks (keep) - "Remove tasks depending on configuration. -When KEEP is nil, remove all tasks. -When KEEP is `todo', remove the tasks that are DONE. -When KEEP is `done', remove the tasks that are not yet done. -When it is a list of strings, keep only tasks with these TODO keywords." - (when (or (listp keep) (memq keep '(todo done nil))) - (let ((re (concat "^\\*+[ \t]+\\(" - (mapconcat - 'regexp-quote - (cond ((not keep) org-todo-keywords-1) - ((eq keep 'todo) org-done-keywords) - ((eq keep 'done) org-not-done-keywords) - ((listp keep) - (org-delete-all keep (copy-sequence - org-todo-keywords-1)))) - "\\|") - "\\)\\($\\|[ \t]\\)")) - (case-fold-search nil) - beg) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (org-if-unprotected - (setq beg (match-beginning 0)) - (org-end-of-subtree t t) - (if (looking-at "^\\*+[ \t]+END[ \t]*$") - ;; Kill the END line of the inline task - (goto-char (min (point-max) (1+ (match-end 0))))) - (delete-region beg (point))))))) - -(defun org-export-remove-archived-trees (export-archived-trees) - "Remove archived trees. -When EXPORT-ARCHIVED-TREES is `headline;, only the headline will be exported. -When it is t, the entire archived tree will be exported. -When it is nil the entire tree including the headline will be removed -from the buffer." - (let ((re-archive (concat ":" org-archive-tag ":")) - a b) - (when (not (eq export-archived-trees t)) - (goto-char (point-min)) - (while (re-search-forward re-archive nil t) - (if (not (org-at-heading-p t)) - (goto-char (point-at-eol)) - (beginning-of-line 1) - (setq a (if export-archived-trees - (1+ (point-at-eol)) (point)) - b (org-end-of-subtree t)) - (if (> b a) (delete-region a b))))))) - -(defun org-export-remove-headline-metadata (opts) - "Remove meta data from the headline, according to user options." - (let ((re org-complex-heading-regexp) - (todo (plist-get opts :todo-keywords)) - (tags (plist-get opts :tags)) - (pri (plist-get opts :priority)) - (elts '(1 2 3 4 5)) - (case-fold-search nil) - rpl) - (setq elts (delq nil (list 1 (if todo 2) (if pri 3) 4 (if tags 5)))) - (when (or (not todo) (not tags) (not pri)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (org-if-unprotected - (setq rpl (mapconcat (lambda (i) (if (match-end i) (match-string i) "")) - elts " ")) - (replace-match rpl t t)))))) - -(defun org-export-remove-timestamps () - "Remove timestamps and keywords for export." - (goto-char (point-min)) - (while (re-search-forward org-maybe-keyword-time-regexp nil t) - (backward-char 1) - (org-if-unprotected - (unless (save-match-data (org-at-table-p)) - (replace-match "") - (beginning-of-line 1) - (if (looking-at "[- \t]*\\(=>[- \t0-9:]*\\)?[ \t]*\n") - (replace-match "")))))) - -(defun org-export-remove-clock-lines () - "Remove clock lines for export." - (goto-char (point-min)) - (let ((re (concat "^[ \t]*" org-clock-string ".*\n?"))) - (while (re-search-forward re nil t) - (org-if-unprotected - (replace-match ""))))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defun org-export-protect-quoted-subtrees () - "Mark quoted subtrees with the protection property." - (let ((org-re-quote (format org-heading-keyword-regexp-format - org-quote-string))) - (goto-char (point-min)) - (while (re-search-forward org-re-quote nil t) - (goto-char (match-beginning 0)) - (end-of-line 1) - (add-text-properties (point) (org-end-of-subtree t) - '(org-protected t))))) - -(defun org-export-convert-protected-spaces () - "Convert strings like \\____ to protected spaces in all backends." - (goto-char (point-min)) - (while (re-search-forward "\\\\__+" nil t) - (org-if-unprotected-1 - (replace-match - (org-add-props - (cond - ((eq org-export-current-backend 'latex) - (format "\\hspace{%dex}" (- (match-end 0) (match-beginning 0)))) - ((eq org-export-current-backend 'html) - (org-add-props (match-string 0) nil - 'org-whitespace (- (match-end 0) (match-beginning 0)))) - ;; ((eq org-export-current-backend 'docbook)) - ((eq org-export-current-backend 'ascii) - (org-add-props (match-string 0) '(org-whitespace t))) - (t (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - '(org-protected t)) - t t)))) - -(defun org-export-protect-verbatim () - "Mark verbatim snippets with the protection property." - (goto-char (point-min)) - (while (re-search-forward org-verbatim-re nil t) - (org-if-unprotected - (add-text-properties (match-beginning 4) (match-end 4) - '(org-protected t org-verbatim-emph t)) - (goto-char (1+ (match-end 4)))))) - -(defun org-export-protect-colon-examples () - "Protect lines starting with a colon." - (goto-char (point-min)) - (let ((re "^[ \t]*:\\([ \t]\\|$\\)") beg) - (while (re-search-forward re nil t) - (beginning-of-line 1) - (setq beg (point)) - (while (looking-at re) - (end-of-line 1) - (or (eobp) (forward-char 1))) - (add-text-properties beg (if (bolp) (1- (point)) (point)) - '(org-protected t))))) - -(defvar org-export-backends - '(docbook html beamer ascii latex) - "List of Org supported export backends.") - -(defun org-export-select-backend-specific-text () - (let ((formatters org-export-backends) - (case-fold-search t) - backend backend-name beg beg-content end end-content ind) - - (while formatters - (setq backend (pop formatters) - backend-name (symbol-name backend)) - - ;; Handle #+BACKEND: stuff - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+" backend-name - ":[ \t]*\\(.*\\)") nil t) - (if (not (eq backend org-export-current-backend)) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) - (let ((ind (get-text-property (point-at-bol) 'original-indentation))) - (replace-match "\\1\\2" t) - (add-text-properties - (point-at-bol) (min (1+ (point-at-eol)) (point-max)) - `(org-protected t original-indentation ,ind org-native-text t))))) - ;; Delete #+ATTR_BACKEND: stuff of another backend. Those - ;; matching the current backend will be taken care of by - ;; `org-export-attach-captions-and-attributes' - (goto-char (point-min)) - (while (re-search-forward (concat "^\\([ \t]*\\)#\\+ATTR_" backend-name - ":[ \t]*\\(.*\\)") nil t) - (setq ind (org-get-indentation)) - (when (not (eq backend org-export-current-backend)) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; Handle #+BEGIN_BACKEND and #+END_BACKEND stuff - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*#\\+BEGIN_" backend-name "\\>.*\n?") - nil t) - (setq beg (match-beginning 0) beg-content (match-end 0)) - (setq ind (or (get-text-property beg 'original-indentation) - (save-excursion (goto-char beg) (org-get-indentation)))) - (when (re-search-forward (concat "^[ \t]*#\\+END_" backend-name "\\>.*\n?") - nil t) - (setq end (match-end 0) end-content (match-beginning 0)) - (if (eq backend org-export-current-backend) - ;; yes, keep this - (progn - (add-text-properties - beg-content end-content - `(org-protected t original-indentation ,ind org-native-text t)) - ;; strip protective commas - (org-unescape-code-in-region beg-content end-content) - (delete-region (match-beginning 0) (match-end 0)) - (save-excursion - (goto-char beg) - (delete-region (point) (1+ (point-at-eol))))) - ;; No, this is for a different backend, kill it - (delete-region beg end))))))) - -(defun org-export-mark-blockquote-verse-center () - "Mark block quote and verse environments with special cookies. -These special cookies will later be interpreted by the backend." - ;; Blockquotes - (let (type t1 ind beg end beg1 end1 content) - (goto-char (point-min)) - (while (re-search-forward - "^\\([ \t]*\\)#\\+\\(begin_\\(\\(block\\)?quote\\|verse\\|center\\)\\>.*\\)" - nil t) - (setq ind (length (match-string 1)) - type (downcase (match-string 3)) - t1 (if (equal type "quote") "blockquote" type)) - (setq beg (match-beginning 0) - beg1 (1+ (match-end 0))) - (when (re-search-forward (concat "^[ \t]*#\\+end_" type "\\>.*") nil t) - (setq end1 (1- (match-beginning 0)) - end (+ (point-at-eol) (if (looking-at "\n$") 1 0))) - (setq content (org-remove-indentation (buffer-substring beg1 end1))) - (setq content (concat "ORG-" (upcase t1) "-START\n" - content "\n" - "ORG-" (upcase t1) "-END\n")) - (delete-region beg end) - (insert (org-add-props content nil 'original-indentation ind)))))) - -(defun org-export-mark-list-end () - "Mark all list endings with a special string." - (unless (eq org-export-current-backend 'ascii) - (mapc - (lambda (e) - ;; For each type allowing list export, find every list, remove - ;; ending regexp if needed, and insert org-list-end. - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (when (eq (nth 2 (org-list-context)) e) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct)) - (top (point-at-bol)) - (top-ind (org-list-get-ind top struct))) - (goto-char bottom) - (when (and (not (looking-at "[ \t]*$")) - (looking-at org-list-end-re)) - (replace-match "")) - (unless (bolp) (insert "\n")) - ;; As org-list-end is inserted at column 0, it would end - ;; by indentation any list. It can be problematic when - ;; there are lists within lists: the inner list end would - ;; also become the outer list end. To avoid this, text - ;; property `original-indentation' is added, as - ;; `org-list-struct' pays attention to it when reading a - ;; list. - (insert (org-add-props - "ORG-LIST-END-MARKER\n" - (list 'original-indentation top-ind))))))) - (cons nil org-list-export-context)))) - -(defun org-export-mark-list-properties () - "Mark list with special properties. -These special properties will later be interpreted by the backend." - (let ((mark-list - (function - ;; Mark a list with 3 properties: `list-item' which is - ;; position at beginning of line, `list-struct' which is - ;; list structure, and `list-prevs' which is the alist of - ;; item and its predecessor. Leave point at list ending. - (lambda (ctxt) - (let* ((struct (org-list-struct)) - (top (org-list-get-top-point struct)) - (bottom (org-list-get-bottom-point struct)) - (prevs (org-list-prevs-alist struct)) - poi) - ;; Get every item and ending position, without dups and - ;; without bottom point of list. - (mapc (lambda (e) - (let ((pos (car e)) - (end (nth 6 e))) - (unless (memq pos poi) - (push pos poi)) - (unless (or (= end bottom) (memq end poi)) - (push end poi)))) - struct) - (setq poi (sort poi '<)) - ;; For every point of interest, mark the whole line with - ;; its position in list. - (mapc - (lambda (e) - (goto-char e) - (add-text-properties (point-at-bol) (point-at-eol) - (list 'list-item (point-at-bol) - 'list-struct struct - 'list-prevs prevs))) - poi) - ;; Take care of bottom point. As babel may have inserted - ;; a new list in buffer, list ending isn't always - ;; marked. Now mark every list ending and add properties - ;; useful to line processing exporters. - (goto-char bottom) - (when (or (looking-at "^ORG-LIST-END-MARKER\n") - (and (not (looking-at "[ \t]*$")) - (looking-at org-list-end-re))) - (replace-match "")) - (unless (bolp) (insert "\n")) - (insert - (org-add-props "ORG-LIST-END-MARKER\n" (list 'list-item bottom - 'list-struct struct - 'list-prevs prevs))) - ;; Following property is used by LaTeX exporter. - (add-text-properties top (point) (list 'list-context ctxt))))))) - ;; Mark lists except for backends not interpreting them. - (unless (eq org-export-current-backend 'ascii) - (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) - (mapc - (lambda (e) - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (let ((context (nth 2 (org-list-context)))) - (if (eq context e) - (funcall mark-list e) - (put-text-property (point-at-bol) (point-at-eol) - 'list-context context))))) - (cons nil org-list-export-context)))))) - -(defun org-export-attach-captions-and-attributes (target-alist) - "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. -If the next thing following is a table, add the text properties to the first -table line. If it is a link, add it to the line containing the link." - (goto-char (point-min)) - (remove-text-properties (point-min) (point-max) - '(org-caption nil org-attributes nil)) - (let ((case-fold-search t) - (re (concat "^[ \t]*#\\+caption:[ \t]+\\(.*\\)" - "\\|" - "^[ \t]*#\\+attr_" (symbol-name org-export-current-backend) ":[ \t]+\\(.*\\)" - "\\|" - "^[ \t]*#\\+label:[ \t]+\\(.*\\)" - "\\|" - "^[ \t]*\\(|[^-]\\)" - "\\|" - "^[ \t]*\\[\\[.*\\]\\][ \t]*$")) - cap shortn attr label end) - (while (re-search-forward re nil t) - (cond - ;; there is a caption - ((match-end 1) - (progn - (setq cap (concat cap (if cap " " "") (org-trim (match-string 1)))) - (when (string-match "\\[\\(.*\\)\\]{\\(.*\\)}" cap) - (setq shortn (match-string 1 cap) - cap (match-string 2 cap))) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; there is an attribute - ((match-end 2) - (progn - (setq attr (concat attr (if attr " " "") (org-trim (match-string 2)))) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - ;; there is a label - ((match-end 3) - (progn - (setq label (org-trim (match-string 3))) - (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) - (t - (setq end (if (match-end 4) - (let ((ee (org-table-end))) - (prog1 (1- (marker-position ee)) (move-marker ee nil))) - (point-at-eol))) - (add-text-properties (point-at-bol) end - (list 'org-caption cap - 'org-caption-shortn shortn - 'org-attributes attr - 'org-label label)) - (if label (push (cons label label) target-alist)) - (goto-char end) - (setq cap nil shortn nil attr nil label nil))))) - target-alist) - -(defun org-export-remove-comment-blocks-and-subtrees () - "Remove the comment environment, and also commented subtrees." - (let ((re-commented (format org-heading-keyword-regexp-format - org-comment-string)) - case-fold-search) - ;; Remove comment environment - (goto-char (point-min)) - (setq case-fold-search t) - (while (re-search-forward - "^#\\+begin_comment[ \t]*\n[^\000]*?\n#\\+end_comment\\>.*" nil t) - (replace-match "" t t)) - ;; Remove subtrees that are commented - (goto-char (point-min)) - (setq case-fold-search nil) - (while (re-search-forward re-commented nil t) - (goto-char (match-beginning 0)) - (delete-region (point) (org-end-of-subtree t))))) - -(defun org-export-handle-comments (org-commentsp) - "Remove comments, or convert to backend-specific format. -ORG-COMMENTSP can be a format string for publishing comments. -When it is nil, all comments will be removed." - (let ((re "^[ \t]*#\\( \\|$\\)")) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (let ((pos (match-beginning 0)) - (end (progn (forward-line) (point)))) - (if (get-text-property pos 'org-protected) - (forward-line) - (if (not org-commentsp) (delete-region pos end) - (add-text-properties pos end '(org-protected t)) - (replace-match - (org-add-props - (format org-commentsp (buffer-substring (match-end 0) end)) - nil 'org-protected t) - t t))))) - ;; Hack attack: previous implementation also removed keywords at - ;; column 0. Brainlessly do it again. - (goto-char (point-min)) - (while (re-search-forward "^#\\+" nil t) - (unless (get-text-property (point-at-bol) 'org-protected) - (delete-region (point-at-bol) (progn (forward-line) (point))))))) - -(defun org-export-handle-metalines () - "Remove tables and source blocks metalines. -This function should only be called after all block processing -has taken place." - (let ((re "^[ \t]*#\\+\\(tbl\\(?:name\\|fm\\)\\|results\\(?:\\[[a-z0-9]+\\]\\)?\\|name\\):\\(.*\n?\\)") - (case-fold-search t) - pos) - (goto-char (point-min)) - (while (or (looking-at re) - (re-search-forward re nil t)) - (setq pos (match-beginning 0)) - (if (get-text-property (match-beginning 1) 'org-protected) - (goto-char (1+ pos)) - (goto-char (1+ pos)) - (replace-match "") - (goto-char (max (point-min) (1- pos))))))) - -(defun org-export-mark-radio-links () - "Find all matches for radio targets and turn them into internal links." - (let ((re-radio (and org-target-link-regexp - (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)")))) - (goto-char (point-min)) - (when re-radio - (while (re-search-forward re-radio nil t) - (unless - (save-match-data - (or (org-in-regexp org-bracket-link-regexp) - (org-in-regexp org-plain-link-re) - (org-in-regexp "<<[^<>]+>>"))) - (org-if-unprotected - (replace-match "\\1[[\\2]]"))))))) - -(defun org-store-forced-table-alignment () - "Find table lines which force alignment, store the results in properties." - (let (line cnt cookies) - (goto-char (point-min)) - (while (re-search-forward "|[ \t]*<\\([lrc]?[0-9]+\\|[lrc]\\)>[ \t]*|" - nil t) - ;; OK, this looks like a table line with an alignment cookie - (org-if-unprotected - (setq line (buffer-substring (point-at-bol) (point-at-eol))) - (when (and (org-at-table-p) - (org-table-cookie-line-p line)) - (setq cnt 0 cookies nil) - (mapc - (lambda (x) - (setq cnt (1+ cnt)) - (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" x) - (let ((align (and (match-end 1) - (downcase (match-string 1 x)))) - (width (and (match-end 2) - (string-to-number (match-string 2 x))))) - (push (cons cnt (list align width)) cookies)))) - (org-split-string line "[ \t]*|[ \t]*")) - (add-text-properties (org-table-begin) (org-table-end) - (list 'org-col-cookies cookies)))) - (goto-char (point-at-eol))))) - -(defun org-export-remove-special-table-lines () - "Remove tables lines that are used for internal purposes. -Also, store forced alignment information found in such lines." - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*|" nil t) - (org-if-unprotected-at (1- (point)) - (beginning-of-line 1) - (if (or (looking-at "[ \t]*| *[!_^] *|") - (not - (memq - nil - (mapcar - (lambda (f) - (or (and org-export-table-remove-empty-lines (= (length f) 0)) - (string-match - "\\`<\\([0-9]\\|[lrc]\\|[lrc][0-9]+\\)>\\'" f))) - (org-split-string ;; FIXME, can't we do without splitting??? - (buffer-substring (point-at-bol) (point-at-eol)) - "[ \t]*|[ \t]*"))))) - (delete-region (max (point-min) (1- (point-at-bol))) - (point-at-eol)) - (end-of-line 1))))) - -(defun org-export-protect-sub-super (s) - (save-match-data - (while (string-match "\\([^\\\\]\\)\\([_^]\\)" s) - (setq s (replace-match "\\1\\\\\\2" nil nil s))) - s)) - -(defun org-export-normalize-links () - "Convert all links to bracket links, and expand link abbreviations." - (let ((re-plain-link (concat "\\([^[<]\\)" org-plain-link-re)) - (re-angle-link (concat "\\([^[]\\)" org-angle-link-re)) - nodesc) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (put-text-property (match-beginning 0) (match-end 0) 'org-normalized-link t)) - (goto-char (point-min)) - (while (re-search-forward re-plain-link nil t) - (unless (get-text-property (match-beginning 0) 'org-normalized-link) - (goto-char (1- (match-end 0))) - (org-if-unprotected-at (1+ (match-beginning 0)) - (let* ((s (concat (match-string 1) - "[[" (match-string 2) ":" (match-string 3) - "][" (match-string 2) ":" (org-export-protect-sub-super - (match-string 3)) - "]]"))) - ;; added 'org-link face to links - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t))))) - (goto-char (point-min)) - (while (re-search-forward re-angle-link nil t) - (goto-char (1- (match-end 0))) - (org-if-unprotected - (let* ((s (concat (match-string 1) - "[[" (match-string 2) ":" (match-string 3) - "][" (match-string 2) ":" (org-export-protect-sub-super - (match-string 3)) - "]]"))) - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp nil t) - (goto-char (1- (match-end 0))) - (setq nodesc (not (match-end 3))) - (org-if-unprotected - (let* ((xx (save-match-data - (org-translate-link - (org-link-expand-abbrev (match-string 1))))) - (s (concat - "[[" (org-add-props (copy-sequence xx) - nil 'org-protected t 'org-no-description nodesc) - "]" - (if (match-end 3) - (match-string 2) - (concat "[" (copy-sequence xx) - "]")) - "]"))) - (put-text-property 0 (length s) 'face 'org-link s) - (replace-match s t t)))))) - -(defun org-export-concatenate-multiline-links () - "Find multi-line links and put it all into a single line. -This is to make sure that the line-processing export backends -can work correctly." - (goto-char (point-min)) - (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[ \t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match "\\1 \\3") - (goto-char (match-beginning 0))))) - -(defun org-export-concatenate-multiline-emphasis () - "Find multi-line emphasis and put it all into a single line. -This is to make sure that the line-processing export backends -can work correctly." - (goto-char (point-min)) - (while (re-search-forward org-emph-re nil t) - (if (and (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (save-excursion (goto-char (match-beginning 0)) - (save-match-data - (and (not (org-at-table-p)) - (not (org-at-heading-p)))))) - (org-if-unprotected - (subst-char-in-region (match-beginning 0) (match-end 0) - ?\n ?\ t) - (goto-char (1- (match-end 0)))) - (goto-char (1+ (match-beginning 0)))))) - -(defun org-export-grab-title-from-buffer () - "Get a title for the current document, from looking at the buffer." - (let ((inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (let ((end (if (looking-at org-outline-regexp) - (point) - (save-excursion (outline-next-heading) (point))))) - (when (re-search-forward "^[ \t]*[^|# \t\r\n].*\n" end t) - ;; Mark the line so that it will not be exported as normal text. - (unless (org-in-block-p org-list-forbidden-blocks) - (org-unmodified - (add-text-properties (match-beginning 0) (match-end 0) - (list :org-license-to-kill t)))) - ;; Return the title string - (org-trim (match-string 0))))))) - -(defun org-export-get-title-from-subtree () - "Return subtree title and exclude it from export." - (let ((rbeg (region-beginning)) (rend (region-end)) - (inhibit-read-only t) - (tags (plist-get (org-infile-export-plist) :tags)) - title) - (save-excursion - (goto-char rbeg) - (when (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)) - (when (plist-member org-export-opt-plist :tags) - (setq tags (or (plist-get org-export-opt-plist :tags) tags))) - ;; This is a subtree, we take the title from the first heading - (goto-char rbeg) - (looking-at org-todo-line-tags-regexp) - (setq title (if (and (eq tags t) (match-string 4)) - (format "%s\t%s" (match-string 3) (match-string 4)) - (match-string 3))) - (org-unmodified - (add-text-properties (point) (1+ (point-at-eol)) - (list :org-license-to-kill t))) - (setq title (or (org-entry-get nil "EXPORT_TITLE") title)))) - title)) - -(defun org-solidify-link-text (s &optional alist) - "Take link text and make a safe target out of it." - (save-match-data - (let* ((rtn - (mapconcat - 'identity - (org-split-string s "[^a-zA-Z0-9_\\.-]+") "-")) - (a (assoc rtn alist))) - (or (cdr a) rtn)))) - -(defun org-get-min-level (lines &optional offset) - "Get the minimum level in LINES." - (let ((re "^\\(\\*+\\) ") l) - (catch 'exit - (while (setq l (pop lines)) - (if (string-match re l) - (throw 'exit (org-tr-level (- (length (match-string 1 l)) - (or offset 0)))))) - 1))) - -;; Variable holding the vector with section numbers -(defvar org-section-numbers (make-vector org-level-max 0)) - -(defun org-init-section-numbers () - "Initialize the vector for the section numbers." - (let* ((level -1) - (numbers (nreverse (org-split-string "" "\\."))) - (depth (1- (length org-section-numbers))) - (i depth) number-string) - (while (>= i 0) - (if (> i level) - (aset org-section-numbers i 0) - (setq number-string (or (car numbers) "0")) - (if (string-match "\\`[A-Z]\\'" number-string) - (aset org-section-numbers i - (- (string-to-char number-string) ?A -1)) - (aset org-section-numbers i (string-to-number number-string))) - (pop numbers)) - (setq i (1- i))))) - -(defun org-section-number (&optional level) - "Return a string with the current section number. -When LEVEL is non-nil, increase section numbers on that level." - (let* ((depth (1- (length org-section-numbers))) - (string "") - (fmts (car org-export-section-number-format)) - (term (cdr org-export-section-number-format)) - (sep "") - ctype fmt idx n) - (when level - (when (> level -1) - (aset org-section-numbers - level (1+ (aref org-section-numbers level)))) - (setq idx (1+ level)) - (while (<= idx depth) - (if (not (= idx 1)) - (aset org-section-numbers idx 0)) - (setq idx (1+ idx)))) - (setq idx 0) - (while (<= idx depth) - (when (> (aref org-section-numbers idx) 0) - (setq fmt (or (pop fmts) fmt) - ctype (car fmt) - n (aref org-section-numbers idx) - string (if (> n 0) - (concat string sep (org-number-to-counter n ctype)) - (concat string ".0")) - sep (nth 1 fmt))) - (setq idx (1+ idx))) - (save-match-data - (if (string-match "\\`\\([@0]\\.\\)+" string) - (setq string (replace-match "" t nil string))) - (if (string-match "\\(\\.0\\)+\\'" string) - (setq string (replace-match "" t nil string)))) - (concat string term))) - -(defun org-number-to-counter (n type) - "Concert number N to a string counter, according to TYPE. -TYPE must be a string, any of: - 1 number - A A,B,.... - a a,b,.... - I upper case roman numeral - i lower case roman numeral" - (cond - ((equal type "1") (number-to-string n)) - ((equal type "A") (char-to-string (+ ?A n -1))) - ((equal type "a") (char-to-string (+ ?a n -1))) - ((equal type "I") (org-number-to-roman n)) - ((equal type "i") (downcase (org-number-to-roman n))) - (t (error "Invalid counter type `%s'" type)))) - -(defun org-number-to-roman (n) - "Convert integer N into a roman numeral." - (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") - ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") - ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") - ( 1 . "I"))) - (res "")) - (if (<= n 0) - (number-to-string n) - (while roman - (if (>= n (caar roman)) - (setq n (- n (caar roman)) - res (concat res (cdar roman))) - (pop roman))) - res))) - -;;; Macros - -(defun org-export-preprocess-apply-macros () - "Replace macro references." - (goto-char (point-min)) - (let (sy val key args args2 ind-str s n) - (while (re-search-forward - "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" - nil t) - (unless (save-match-data (save-excursion - (goto-char (point-at-bol)) - (looking-at "[ \t]*#\\+macro"))) - ;; Get macro name (KEY), arguments (ARGS), and indentation of - ;; current line (IND-STR) as strings. - (setq key (downcase (match-string 1)) - args (match-string 3) - ind-str (save-match-data (save-excursion - (beginning-of-line) - (looking-at "^\\([ \t]*\\).*") - (match-string 1)))) - ;; When macro is defined, retrieve replacement text in VAL, - ;; and proceed with expansion. - (when (setq val (or (plist-get org-export-opt-plist - (intern (concat ":macro-" key))) - (plist-get org-export-opt-plist - (intern (concat ":" key))))) - (save-match-data - ;; If arguments are provided, first retrieve them properly - ;; (in ARGS, as a list), then replace them in VAL. - (when args - (setq args (org-split-string args ",") args2 nil) - (while args - (while (string-match "\\\\\\'" (car args)) - ;; Repair bad splits. - (setcar (cdr args) (concat (substring (car args) 0 -1) - "," (nth 1 args))) - (pop args)) - (push (pop args) args2)) - (setq args (mapcar 'org-trim (nreverse args2))) - (setq s 0) - (while (string-match "\\$\\([0-9]+\\)" val s) - (setq s (1+ (match-beginning 0)) - n (string-to-number (match-string 1 val))) - (and (>= (length args) n) - (setq val (replace-match (nth (1- n) args) t t val))))) - ;; VAL starts with "(eval": it is a sexp, `eval' it. - (when (string-match "\\`(eval\\>" val) - (setq val (eval (read val)))) - ;; Ensure VAL is a string (or nil) and that each new line - ;; is indented as the first one. - (setq val (and val - (mapconcat 'identity - (org-split-string - (if (stringp val) val (format "%s" val)) - "\n") - (concat "\n" ind-str))))) - ;; Eventually do the replacement, if VAL isn't nil. Move - ;; point at beginning of macro for recursive expansions. - (when val - (replace-match val t t) - (goto-char (match-beginning 0)))))))) - -(defun org-export-apply-macros-in-string (s) - "Apply the macros in string S." - (when s - (with-temp-buffer - (insert s) - (org-export-preprocess-apply-macros) - (buffer-string)))) - -;;; Include files - -(defun org-export-handle-include-files () - "Include the contents of include files, with proper formatting." - (let ((case-fold-search t) - params file markup lang start end prefix prefix1 switches all minlevel currentlevel addlevel lines) - (goto-char (point-min)) - (while (re-search-forward "^#\\+include:[ \t]+\\(.*\\)" nil t) - (setq params (read (concat "(" (match-string 1) ")")) - prefix (org-get-and-remove-property 'params :prefix) - prefix1 (org-get-and-remove-property 'params :prefix1) - minlevel (org-get-and-remove-property 'params :minlevel) - addlevel (org-get-and-remove-property 'params :addlevel) - lines (org-get-and-remove-property 'params :lines) - file (org-symname-or-string (pop params)) - markup (org-symname-or-string (pop params)) - lang (and (member markup '("src" "SRC")) - (org-symname-or-string (pop params))) - switches (mapconcat #'(lambda (x) (format "%s" x)) params " ") - start nil end nil) - (delete-region (match-beginning 0) (match-end 0)) - (setq currentlevel (or (org-current-level) 0)) - (if (or (not file) - (not (file-exists-p file)) - (not (file-readable-p file))) - (insert (format "CANNOT INCLUDE FILE %s" file)) - (setq all (cons file all)) - (when markup - (if (equal (downcase markup) "src") - (setq start (format "#+begin_src %s %s\n" - (or lang "fundamental") - (or switches "")) - end "#+end_src") - (setq start (format "#+begin_%s %s\n" markup switches) - end (format "#+end_%s" markup)))) - (insert (or start "")) - (insert (org-get-file-contents (expand-file-name file) - prefix prefix1 markup currentlevel minlevel addlevel lines)) - (or (bolp) (newline)) - (insert (or end "")))) - all)) - -(defun org-export-handle-include-files-recurse () - "Recursively include files aborting on circular inclusion." - (let ((now (list org-current-export-file)) all) - (while now - (setq all (append now all)) - (setq now (org-export-handle-include-files)) - (let ((intersection - (delq nil - (mapcar (lambda (el) (when (member el all) el)) now)))) - (when intersection - (error "Recursive #+INCLUDE: %S" intersection)))))) - -(defun org-get-file-contents (file &optional prefix prefix1 markup minlevel parentlevel addlevel lines) - "Get the contents of FILE and return them as a string. -If PREFIX is a string, prepend it to each line. If PREFIX1 -is a string, prepend it to the first line instead of PREFIX. -If MARKUP, don't protect org-like lines, the exporter will -take care of the block they are in. If ADDLEVEL is a number, -demote included file to current heading level+ADDLEVEL. -If LINES is a string specifying a range of lines, -include only those lines." - (if (stringp markup) (setq markup (downcase markup))) - (with-temp-buffer - (insert-file-contents file) - (when lines - (let* ((lines (split-string lines "-")) - (lbeg (string-to-number (car lines))) - (lend (string-to-number (cadr lines))) - (beg (if (zerop lbeg) (point-min) - (goto-char (point-min)) - (forward-line (1- lbeg)) - (point))) - (end (if (zerop lend) (point-max) - (goto-char (point-min)) - (forward-line (1- lend)) - (point)))) - (narrow-to-region beg end))) - (when (or prefix prefix1) - (goto-char (point-min)) - (while (not (eobp)) - (insert (or prefix1 prefix)) - (setq prefix1 "") - (beginning-of-line 2))) - (buffer-string) - (when (member markup '("src" "example")) - (goto-char (point-min)) - (while (re-search-forward "^\\([*#]\\|[ \t]*#\\+\\)" nil t) - (goto-char (match-beginning 0)) - (insert ",") - (end-of-line 1))) - (when minlevel - (dotimes (lvl minlevel) - (org-map-region 'org-demote (point-min) (point-max)))) - (when addlevel - (let ((inclevel (or (if (org-before-first-heading-p) - (1- (and (outline-next-heading) - (org-current-level))) - (1- (org-current-level))) - 0))) - (dotimes (level (- (+ parentlevel addlevel) inclevel)) - (org-map-region 'org-demote (point-min) (point-max))))) - (buffer-string))) - -(defun org-get-and-remove-property (listvar prop) - "Check if the value of LISTVAR contains PROP as a property. -If yes, return the value of that property (i.e. the element following -in the list) and remove property and value from the list in LISTVAR." - (let ((list (symbol-value listvar)) m v) - (when (setq m (member prop list)) - (setq v (nth 1 m)) - (if (equal (car list) prop) - (set listvar (cddr list)) - (setcdr (nthcdr (- (length list) (length m) 1) list) - (cddr m)) - (set listvar list))) - v)) - -(defun org-symname-or-string (s) - (if (symbolp s) - (if s (symbol-name s) s) - s)) - -;;; Fontification and line numbers for code examples - -(defvar org-export-last-code-line-counter-value 0) - -(defun org-export-replace-src-segments-and-examples () - "Replace source code segments with special code for export." - (setq org-export-last-code-line-counter-value 0) - (let ((case-fold-search t) - lang code trans opts indent caption) - (goto-char (point-min)) - (while (re-search-forward - "\\(^\\([ \t]*\\)#\\+BEGIN_SRC:?\\([ \t]+\\([^ \t\n]+\\)\\)?\\(.*\\)\n\\([^\000]+?\n\\)[ \t]*#\\+END_SRC.*\n?\\)\\|\\(^\\([ \t]*\\)#\\+BEGIN_EXAMPLE:?\\(?:[ \t]+\\(.*\\)\\)?\n\\([^\000]+?\n\\)[ \t]*#\\+END_EXAMPLE.*\n?\\)" - nil t) - (if (match-end 1) - (if (not (match-string 4)) - (error "Source block missing language specification: %s" - (let* ((body (match-string 6)) - (nothing (message "body:%s" body)) - (preview (or (and (string-match - "^[ \t]*\\([^\n\r]*\\)" body) - (match-string 1 body)) body))) - (if (> (length preview) 35) - (concat (substring preview 0 32) "...") - preview))) - ;; src segments - (setq lang (match-string 4) - opts (match-string 5) - code (match-string 6) - indent (length (match-string 2)) - caption (get-text-property 0 'org-caption (match-string 0)))) - (setq lang nil - opts (match-string 9) - code (match-string 10) - indent (length (match-string 8)) - caption (get-text-property 0 'org-caption (match-string 0)))) - - (setq trans (org-export-format-source-code-or-example - lang code opts indent caption)) - (replace-match trans t t)))) - -(defvar org-export-latex-verbatim-wrap) ;; defined in org-latex.el -(defvar org-export-latex-listings) ;; defined in org-latex.el -(defvar org-export-latex-listings-langs) ;; defined in org-latex.el -(defvar org-export-latex-listings-w-names) ;; defined in org-latex.el -(defvar org-export-latex-minted-langs) ;; defined in org-latex.el -(defvar org-export-latex-custom-lang-environments) ;; defined in org-latex.el -(defvar org-export-latex-listings-options) ;; defined in org-latex.el -(defvar org-export-latex-minted-options) ;; defined in org-latex.el - -(defun org-remove-formatting-on-newlines-in-region (beg end) - "Remove formatting on newline characters." - (interactive "r") - (save-excursion - (goto-char beg) - (while (progn (end-of-line) (< (point) end)) - (put-text-property (point) (1+ (point)) 'face nil) - (forward-char 1)))) - -(defun org-export-format-source-code-or-example - (lang code &optional opts indent caption) - "Format CODE from language LANG and return it formatted for export. -The CODE is marked up in `org-export-current-backend' format. - -Check if a function by name -\"org-<backend>-format-source-code-or-example\" is bound. If yes, -use it as the custom formatter. Otherwise, use the default -formatter. Default formatters are provided for docbook, html, -latex and ascii backends. For example, use -`org-html-format-source-code-or-example' to provide a custom -formatter for export to \"html\". - -If LANG is nil, do not add any fontification. -OPTS contains formatting options, like `-n' for triggering numbering lines, -and `+n' for continuing previous numbering. -Code formatting according to language currently only works for HTML. -Numbering lines works for all three major backends (html, latex, and ascii). -INDENT was the original indentation of the block." - (save-match-data - (let* ((backend-name (symbol-name org-export-current-backend)) - (backend-formatter - (intern (format "org-%s-format-source-code-or-example" - backend-name))) - (backend-feature (intern (concat "org-" backend-name))) - (backend-formatter - (and (require (intern (concat "org-" backend-name)) nil) - (fboundp backend-formatter) backend-formatter)) - num cont rtn rpllbl keepp textareap preserve-indentp cols rows fmt) - (setq opts (or opts "") - num (string-match "[-+]n\\>" opts) - cont (string-match "\\+n\\>" opts) - rpllbl (string-match "-r\\>" opts) - keepp (string-match "-k\\>" opts) - textareap (string-match "-t\\>" opts) - preserve-indentp (or org-src-preserve-indentation - (string-match "-i\\>" opts)) - cols (if (string-match "-w[ \t]+\\([0-9]+\\)" opts) - (string-to-number (match-string 1 opts)) - 80) - rows (if (string-match "-h[ \t]+\\([0-9]+\\)" opts) - (string-to-number (match-string 1 opts)) - (org-count-lines code)) - fmt (if (string-match "-l[ \t]+\"\\([^\"\n]+\\)\"" opts) - (match-string 1 opts))) - (when (and textareap (eq org-export-current-backend 'html)) - ;; we cannot use numbering or highlighting. - (setq num nil cont nil lang nil)) - (if keepp (setq rpllbl 'keep)) - (setq rtn (if preserve-indentp code (org-remove-indentation code))) - (when (string-match "^," rtn) - (setq rtn (with-temp-buffer - (insert rtn) - ;; Free up the protected lines - (goto-char (point-min)) - (while (re-search-forward "^," nil t) - (if (or (equal lang "org") - (save-match-data - (looking-at "\\([*#]\\|[ \t]*#\\+\\)"))) - (replace-match "")) - (end-of-line 1)) - (buffer-string)))) - ;; Now backend-specific coding - (setq rtn - (cond - (backend-formatter - (funcall backend-formatter rtn lang caption textareap cols rows num - cont rpllbl fmt)) - ((eq org-export-current-backend 'docbook) - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (concat "<programlisting><![CDATA[" - rtn - "]]></programlisting>\n")) - ((eq org-export-current-backend 'html) - ;; We are exporting to HTML - (when lang - (if (featurep 'xemacs) - (require 'htmlize) - (require 'htmlize nil t)) - (when (not (fboundp 'htmlize-region-for-paste)) - ;; we do not have htmlize.el, or an old version of it - (setq lang nil) - (message - "htmlize.el 1.34 or later is needed for source code formatting"))) - - (if lang - (let* ((lang-m (when lang - (or (cdr (assoc lang org-src-lang-modes)) - lang))) - (mode (and lang-m (intern - (concat - (if (symbolp lang-m) - (symbol-name lang-m) - lang-m) - "-mode")))) - (org-inhibit-startup t) - (org-startup-folded nil)) - (setq rtn - (with-temp-buffer - (insert rtn) - (if (functionp mode) - (funcall mode) - (fundamental-mode)) - (font-lock-fontify-buffer) - ;; markup each line separately - (org-remove-formatting-on-newlines-in-region (point-min) (point-max)) - (org-src-mode) - (set-buffer-modified-p nil) - (org-export-htmlize-region-for-paste - (point-min) (point-max)))) - (if (string-match "<pre\\([^>]*\\)>\n*" rtn) - (setq rtn - (concat - (if caption - (concat - "<div class=\"org-src-container\">" - (format - "<label class=\"org-src-name\">%s</label>" - caption)) - "") - (replace-match - (format "<pre class=\"src src-%s\">\n" lang) - t t rtn) - (if caption "</div>" ""))))) - (if textareap - (setq rtn (concat - (format "<p>\n<textarea cols=\"%d\" rows=\"%d\">" - cols rows) - rtn "</textarea>\n</p>\n")) - (with-temp-buffer - (insert rtn) - (goto-char (point-min)) - (while (re-search-forward "[<>&]" nil t) - (replace-match (cdr (assq (char-before) - '((?&."&")(?<."<")(?>.">")))) - t t)) - (setq rtn (buffer-string))) - (setq rtn (concat "<pre class=\"example\">\n" rtn "</pre>\n")))) - (unless textareap - (setq rtn (org-export-number-lines rtn 1 1 num cont rpllbl fmt))) - (if (string-match "\\(\\`<[^>]*>\\)\n" rtn) - (setq rtn (replace-match "\\1" t nil rtn))) - rtn) - ((eq org-export-current-backend 'latex) - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (cond - ((and lang org-export-latex-listings) - (let* ((make-option-string - (lambda (pair) - (concat (first pair) - (if (> (length (second pair)) 0) - (concat "=" (second pair)))))) - (lang-sym (intern lang)) - (minted-p (eq org-export-latex-listings 'minted)) - (listings-p (not minted-p)) - (backend-lang - (or (cadr - (assq - lang-sym - (cond - (minted-p org-export-latex-minted-langs) - (listings-p org-export-latex-listings-langs)))) - lang)) - (custom-environment - (cadr - (assq - lang-sym - org-export-latex-custom-lang-environments)))) - (concat - (when (and listings-p (not custom-environment)) - (format - "\\lstset{%s}\n" - (mapconcat - make-option-string - (append org-export-latex-listings-options - `(("language" ,backend-lang))) ","))) - (when (and caption org-export-latex-listings-w-names) - (format - "\n%s $\\equiv$ \n" - (replace-regexp-in-string "_" "\\\\_" caption))) - (cond - (custom-environment - (format "\\begin{%s}\n%s\\end{%s}\n" - custom-environment rtn custom-environment)) - (listings-p - (format "\\begin{%s}\n%s\\end{%s}" - "lstlisting" rtn "lstlisting")) - (minted-p - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - (mapconcat make-option-string - org-export-latex-minted-options ",") - backend-lang rtn)))))) - (t (concat (car org-export-latex-verbatim-wrap) - rtn (cdr org-export-latex-verbatim-wrap))))) - ((eq org-export-current-backend 'ascii) - ;; This is not HTML or LaTeX, so just make it an example. - (setq rtn (org-export-number-lines rtn 0 0 num cont rpllbl fmt)) - (concat caption "\n" - (concat - (mapconcat - (lambda (l) (concat " " l)) - (org-split-string rtn "\n") - "\n") - "\n"))) - (t - (error "Don't know how to markup source or example block in %s" - (upcase backend-name))))) - (setq rtn - (concat - "\n#+BEGIN_" backend-name "\n" - (org-add-props rtn - '(org-protected t org-example t org-native-text t)) - "\n#+END_" backend-name "\n")) - (org-add-props rtn nil 'original-indentation indent)))) - -(defun org-export-number-lines (text &optional skip1 skip2 number cont - replace-labels label-format preprocess) - "Apply line numbers to literal examples and handle code references. -Handle user-specified options under info node `(org)Literal -examples' and return the modified source block. - -TEXT contains the source or example block. - -SKIP1 and SKIP2 are the number of lines that are to be skipped at -the beginning and end of TEXT. Use these to skip over -backend-specific lines pre-pended or appended to the original -source block. - -NUMBER is non-nil if the literal example specifies \"+n\" or -\"-n\" switch. If NUMBER is non-nil add line numbers. - -CONT is non-nil if the literal example specifies \"+n\" switch. -If CONT is nil, start numbering this block from 1. Otherwise -continue numbering from the last numbered block. - -REPLACE-LABELS is dual-purpose. -1. It controls the retention of labels in the exported block. -2. It specifies in what manner the links (or references) to a - labeled line be formatted. - -REPLACE-LABELS is the symbol `keep' if the literal example -specifies \"-k\" option, is numeric if the literal example -specifies \"-r\" option and is nil otherwise. - -Handle REPLACE-LABELS as below: -- If nil, retain labels in the exported block and use - user-provided labels for referencing the labeled lines. -- If it is a number, remove labels in the exported block and use - one of line numbers or labels for referencing labeled lines based - on NUMBER option. -- If it is a keep, retain labels in the exported block and use - one of line numbers or labels for referencing labeled lines - based on NUMBER option. - -LABEL-FORMAT is the value of \"-l\" switch associated with -literal example. See `org-coderef-label-format'. - -PREPROCESS is intended for backend-agnostic handling of source -block numbering. When non-nil do the following: -- do not number the lines -- always strip the labels from exported block -- do not make the labeled line a target of an incoming link. - Instead mark the labeled line with `org-coderef' property and - store the label in it." - (setq skip1 (or skip1 0) skip2 (or skip2 0)) - (if (and number (not cont)) (setq org-export-last-code-line-counter-value 0)) - (with-temp-buffer - (insert text) - (goto-char (point-max)) - (skip-chars-backward " \t\n\r") - (delete-region (point) (point-max)) - (beginning-of-line (- 1 skip2)) - (let* ((last (org-current-line)) - (n org-export-last-code-line-counter-value) - (nmax (+ n (- last skip1))) - (fmt (format "%%%dd: " (length (number-to-string nmax)))) - (fm - (cond - ((eq org-export-current-backend 'html) (format "<span class=\"linenr\">%s</span>" - fmt)) - ((eq org-export-current-backend 'ascii) fmt) - ((eq org-export-current-backend 'latex) fmt) - ((eq org-export-current-backend 'docbook) fmt) - (t ""))) - (label-format (or label-format org-coderef-label-format)) - (label-pre (if (string-match "%s" label-format) - (substring label-format 0 (match-beginning 0)) - label-format)) - (label-post (if (string-match "%s" label-format) - (substring label-format (match-end 0)) - "")) - (lbl-re - (concat - ".*?\\S-.*?\\([ \t]*\\(" - (regexp-quote label-pre) - "\\([-a-zA-Z0-9_ ]+\\)" - (regexp-quote label-post) - "\\)\\)")) - ref) - - (org-goto-line (1+ skip1)) - (while (and (re-search-forward "^" nil t) (not (eobp)) (< n nmax)) - (when number (incf n)) - (if (or preprocess (not number)) - (forward-char 1) - (insert (format fm n))) - (when (looking-at lbl-re) - (setq ref (match-string 3)) - (cond ((numberp replace-labels) - ;; remove labels; use numbers for references when lines - ;; are numbered, use labels otherwise - (delete-region (match-beginning 1) (match-end 1)) - (push (cons ref (if (> n 0) n ref)) org-export-code-refs)) - ((eq replace-labels 'keep) - ;; don't remove labels; use numbers for references when - ;; lines are numbered, use labels otherwise - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (unless preprocess - (insert "(" ref ")")) - (push (cons ref (if (> n 0) n (concat "(" ref ")"))) - org-export-code-refs)) - (t - ;; don't remove labels and don't use numbers for - ;; references - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (unless preprocess - (insert "(" ref ")")) - (push (cons ref (concat "(" ref ")")) org-export-code-refs))) - (when (and (eq org-export-current-backend 'html) (not preprocess)) - (save-excursion - (beginning-of-line 1) - (insert (format "<span id=\"coderef-%s\" class=\"coderef-off\">" - ref)) - (end-of-line 1) - (insert "</span>"))) - (when preprocess - (add-text-properties - (point-at-bol) (point-at-eol) (list 'org-coderef ref))))) - (setq org-export-last-code-line-counter-value n) - (goto-char (point-max)) - (newline) - (buffer-string)))) - -(defun org-search-todo-below (line lines level) - "Search the subtree below LINE for any TODO entries." - (let ((rest (cdr (memq line lines))) - (re org-todo-line-regexp) - line lv todo) - (catch 'exit - (while (setq line (pop rest)) - (if (string-match re line) - (progn - (setq lv (- (match-end 1) (match-beginning 1)) - todo (and (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords)))) - ; TODO, not DONE - (if (<= lv level) (throw 'exit nil)) - (if todo (throw 'exit t)))))))) - -;;;###autoload -(defun org-export-visible (type arg) - "Create a copy of the visible part of the current buffer, and export it. -The copy is created in a temporary buffer and removed after use. -TYPE is the final key (as a string) that also selects the export command in -the \\<org-mode-map>\\[org-export] export dispatcher. -As a special case, if the you type SPC at the prompt, the temporary -org-mode file will not be removed but presented to you so that you can -continue to use it. The prefix arg ARG is passed through to the exporting -command." - (interactive - (list (progn - (message "Export visible: [a]SCII [h]tml [b]rowse HTML [H/R]buffer with HTML [D]ocBook [l]atex [p]df [d]view pdf [L]atex buffer [x]OXO [ ]keep buffer") - (read-char-exclusive)) - current-prefix-arg)) - (if (not (member type '(?a ?n ?u ?\C-a ?b ?\C-b ?h ?D ?x ?\ ?l ?p ?d ?L ?H ?R))) - (error "Invalid export key")) - (let* ((binding (cdr (assoc type - '( - (?a . org-export-as-ascii) - (?A . org-export-as-ascii-to-buffer) - (?n . org-export-as-latin1) - (?N . org-export-as-latin1-to-buffer) - (?u . org-export-as-utf8) - (?U . org-export-as-utf8-to-buffer) - (?\C-a . org-export-as-ascii) - (?b . org-export-as-html-and-open) - (?\C-b . org-export-as-html-and-open) - (?h . org-export-as-html) - (?H . org-export-as-html-to-buffer) - (?R . org-export-region-as-html) - (?D . org-export-as-docbook) - - (?l . org-export-as-latex) - (?p . org-export-as-pdf) - (?d . org-export-as-pdf-and-open) - (?L . org-export-as-latex-to-buffer) - - (?x . org-export-as-xoxo))))) - (keepp (equal type ?\ )) - (file buffer-file-name) - (buffer (get-buffer-create "*Org Export Visible*")) - s e) - ;; Need to hack the drawers here. - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-drawer-regexp nil t) - (goto-char (match-beginning 1)) - (or (outline-invisible-p) (org-flag-drawer nil)))) - (with-current-buffer buffer (erase-buffer)) - (save-excursion - (setq s (goto-char (point-min))) - (while (not (= (point) (point-max))) - (goto-char (org-find-invisible)) - (append-to-buffer buffer s (point)) - (setq s (goto-char (org-find-visible)))) - (org-cycle-hide-drawers 'all) - (goto-char (point-min)) - (unless keepp - ;; Copy all comment lines to the end, to make sure #+ settings are - ;; still available for the second export step. Kind of a hack, but - ;; does do the trick. - (if (looking-at "#[^\r\n]*") - (append-to-buffer buffer (match-beginning 0) (1+ (match-end 0)))) - (when (re-search-forward "^\\*+[ \t]+" nil t) - (while (re-search-backward "[\n\r]#[^\n\r]*" nil t) - (append-to-buffer buffer (1+ (match-beginning 0)) - (min (point-max) (1+ (match-end 0))))))) - (set-buffer buffer) - (let ((buffer-file-name file) - (org-inhibit-startup t)) - (org-mode) - (show-all) - (unless keepp (funcall binding arg)))) - (if (not keepp) - (kill-buffer buffer) - (switch-to-buffer-other-window buffer) - (goto-char (point-min))))) - -(defvar org-export-htmlized-org-css-url) ;; defined in org-html.el - -(defun org-export-string (string fmt &optional dir) - "Export STRING to FMT using existing export facilities. -During export STRING is saved to a temporary file whose location -could vary. Optional argument DIR can be used to force the -directory in which the temporary file is created during export -which can be useful for resolving relative paths. Dir defaults -to the value of `temporary-file-directory'." - (let ((temporary-file-directory (or dir temporary-file-directory)) - (tmp-file (make-temp-file "org-"))) - (unwind-protect - (with-temp-buffer - (insert string) - (write-file tmp-file) - (org-load-modules-maybe) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (eval ;; convert to fmt -- mimicking `org-run-like-in-org-mode' - (list 'let org-local-vars - (list (intern (format "org-export-as-%s" fmt)) - nil nil ''string t dir)))) - (delete-file tmp-file)))) - -;;;###autoload -(defun org-export-as-org (arg &optional ext-plist to-buffer body-only pub-dir) - "Make a copy with not-exporting stuff removed. -The purpose of this function is to provide a way to export the source -Org file of a webpage in Org format, but with sensitive and/or irrelevant -stuff removed. This command will remove the following: - -- archived trees (if the variable `org-export-with-archived-trees' is nil) -- comment blocks and trees starting with the COMMENT keyword -- only trees that are consistent with `org-export-select-tags' - and `org-export-exclude-tags'. - -The only arguments that will be used are EXT-PLIST and PUB-DIR, -all the others will be ignored (but are present so that the general -mechanism to call publishing functions will work). - -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When PUB-DIR is set, use this as the publishing -directory." - (interactive "P") - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (or pub-dir - (org-export-directory :org opt-plist))) - (file-name-sans-extension - (file-name-nondirectory bfname)) - ".org")) - (filename (and filename - (if (equal (file-truename filename) - (file-truename bfname)) - (concat (file-name-sans-extension filename) - "-source." - (file-name-extension filename)) - filename))) - (backup-inhibited t) - (buffer (find-file-noselect filename)) - (region (buffer-string)) - str-ret) - (save-excursion - (org-pop-to-buffer-same-window buffer) - (erase-buffer) - (insert region) - (let ((org-inhibit-startup t)) (org-mode)) - (org-install-letbind) - - ;; Get rid of archived trees - (org-export-remove-archived-trees (plist-get opt-plist :archived-trees)) - - ;; Remove comment environment and comment subtrees - (org-export-remove-comment-blocks-and-subtrees) - - ;; Get rid of excluded trees - (org-export-handle-export-tags (plist-get opt-plist :select-tags) - (plist-get opt-plist :exclude-tags)) - - (when (or (plist-get opt-plist :plain-source) - (not (or (plist-get opt-plist :plain-source) - (plist-get opt-plist :htmlized-source)))) - ;; Either nothing special is requested (default call) - ;; or the plain source is explicitly requested - ;; so: save it - (save-buffer)) - (when (plist-get opt-plist :htmlized-source) - ;; Make the htmlized version - (require 'htmlize) - (require 'org-html) - (font-lock-fontify-buffer) - (let* ((htmlize-output-type 'css) - (newbuf (htmlize-buffer))) - (with-current-buffer newbuf - (when org-export-htmlized-org-css-url - (goto-char (point-min)) - (and (re-search-forward - "<style type=\"text/css\">[^\000]*?\n[ \t]*</style>.*" - nil t) - (replace-match - (format - "<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">" - org-export-htmlized-org-css-url) - t t))) - (write-file (concat filename ".html"))) - (kill-buffer newbuf))) - (set-buffer-modified-p nil) - (if (equal to-buffer 'string) - (progn (setq str-ret (buffer-string)) - (kill-buffer (current-buffer)) - str-ret) - (kill-buffer (current-buffer)))))) - -(defvar org-archive-location) ;; gets loaded with the org-archive require. -(defun org-get-current-options () - "Return a string with current options as keyword options. -Does include HTML export options as well as TODO and CATEGORY stuff." - (require 'org-archive) - (format - "#+TITLE: %s -#+AUTHOR: %s -#+EMAIL: %s -#+DATE: %s -#+DESCRIPTION: -#+KEYWORDS: -#+LANGUAGE: %s -#+OPTIONS: H:%d num:%s toc:%s \\n:%s @:%s ::%s |:%s ^:%s -:%s f:%s *:%s <:%s -#+OPTIONS: TeX:%s LaTeX:%s skip:%s d:%s todo:%s pri:%s tags:%s -%s -#+EXPORT_SELECT_TAGS: %s -#+EXPORT_EXCLUDE_TAGS: %s -#+LINK_UP: %s -#+LINK_HOME: %s -#+XSLT: -#+CATEGORY: %s -#+SEQ_TODO: %s -#+TYP_TODO: %s -#+PRIORITIES: %c %c %c -#+DRAWERS: %s -#+STARTUP: %s %s %s %s %s -#+TAGS: %s -#+FILETAGS: %s -#+ARCHIVE: %s -#+LINK: %s -" - (buffer-name) (user-full-name) user-mail-address - (format-time-string (substring (car org-time-stamp-formats) 1 -1)) - org-export-default-language - org-export-headline-levels - org-export-with-section-numbers - org-export-with-toc - org-export-preserve-breaks - org-export-html-expand - org-export-with-fixed-width - org-export-with-tables - org-export-with-sub-superscripts - org-export-with-special-strings - org-export-with-footnotes - org-export-with-emphasize - org-export-with-timestamps - org-export-with-TeX-macros - org-export-with-LaTeX-fragments - org-export-skip-text-before-1st-heading - org-export-with-drawers - org-export-with-todo-keywords - org-export-with-priority - org-export-with-tags - (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "") - (mapconcat 'identity org-export-select-tags " ") - (mapconcat 'identity org-export-exclude-tags " ") - org-export-html-link-up - org-export-html-link-home - (or (ignore-errors - (file-name-sans-extension - (file-name-nondirectory (buffer-file-name (buffer-base-buffer))))) - "NOFILENAME") - "TODO FEEDBACK VERIFY DONE" - "Me Jason Marie DONE" - org-highest-priority org-lowest-priority org-default-priority - (mapconcat 'identity org-drawers " ") - (cdr (assoc org-startup-folded - '((nil . "showall") (t . "overview") (content . "content")))) - (if org-odd-levels-only "odd" "oddeven") - (if org-hide-leading-stars "hidestars" "showstars") - (if org-startup-align-all-tables "align" "noalign") - (cond ((eq org-log-done t) "logdone") - ((equal org-log-done 'note) "lognotedone") - ((not org-log-done) "nologdone")) - (or (mapconcat (lambda (x) - (cond - ((equal :startgroup (car x)) "{") - ((equal :endgroup (car x)) "}") - ((equal :newline (car x)) "") - ((cdr x) (format "%s(%c)" (car x) (cdr x))) - (t (car x)))) - (or org-tag-alist (org-get-buffer-tags)) " ") "") - (mapconcat 'identity org-file-tags " ") - org-archive-location - "org file:~/org/%s.org")) - -(defun org-insert-export-options-template () - "Insert into the buffer a template with information for exporting." - (interactive) - (if (not (bolp)) (newline)) - (let ((s (org-get-current-options))) - (and (string-match "#\\+CATEGORY" s) - (setq s (substring s 0 (match-beginning 0)))) - (insert s))) - -(defvar org-table-colgroup-info nil) - -(defun org-table-clean-before-export (lines &optional maybe-quoted) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (setq org-table-colgroup-info nil) - (if (memq nil - (mapcar - (lambda (x) (or (string-match "^[ \t]*|-" x) - (string-match - (if maybe-quoted - "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|" - "^[ \t]*| *\\([\#!$*_^ /]\\) *|") - x))) - lines)) - ;; No special marking column - (progn - (setq org-table-clean-did-remove-column nil) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - (t x))) - lines))) - ;; there is a special marking column - (setq org-table-clean-did-remove-column t) - (delq nil - (mapcar - (lambda (x) - (cond - ((org-table-colgroup-line-p x) - ;; This line contains colgroup info, extract it - ;; and then discard the line - (setq org-table-colgroup-info - (mapcar (lambda (x) - (cond ((member x '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x) - ;; ignore this line - nil) - ((or (string-match "^\\([ \t]*\\)|-+\\+" x) - (string-match "^\\([ \t]*\\)|[^|]*|" x)) - ;; remove the first column - (replace-match "\\1|" t nil x)))) - lines)))) - -(defun org-export-cleanup-toc-line (s) - "Remove tags and timestamps from lines going into the toc." - (if (not s) - "" ; Return a string when argument is nil - (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) - (setq s (replace-match "" t t s)))) - (when org-export-remove-timestamps-from-toc - (while (string-match org-maybe-keyword-time-regexp s) - (setq s (replace-match "" t t s)))) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (match-string (if (match-end 3) 3 1) s) - t t s))) - (while (string-match "\\[\\([0-9]\\|fn:[^]]*\\)\\]" s) - (setq s (replace-match "" t t s))) - s)) - - -(defun org-get-text-property-any (pos prop &optional object) - (or (get-text-property pos prop object) - (and (setq pos (next-single-property-change pos prop object)) - (get-text-property pos prop object)))) - -(defun org-export-get-coderef-format (path desc) - (save-match-data - (if (and desc (string-match - (regexp-quote (concat "(" path ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")))) - -(defun org-export-push-to-kill-ring (format) - "Push buffer content to kill ring. -The depends on the variable `org-export-copy-to-kill-ring'." - (when org-export-copy-to-kill-ring - (org-kill-new (buffer-string)) - (when (fboundp 'x-set-selection) - (ignore-errors (x-set-selection 'PRIMARY (buffer-string))) - (ignore-errors (x-set-selection 'CLIPBOARD (buffer-string)))) - (message "%s export done, pushed to kill ring and clipboard" format))) - -(provide 'org-exp) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-exp.el ends here diff --git a/lisp/org/org-freemind.el b/lisp/org/org-freemind.el deleted file mode 100644 index 2ee58501ca..0000000000 --- a/lisp/org/org-freemind.el +++ /dev/null @@ -1,1227 +0,0 @@ -;;; org-freemind.el --- Export Org files to freemind - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Lennart Borgman (lennart O borgman A gmail O com) -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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/>. - -;; -------------------------------------------------------------------- -;; Features that might be required by this library: -;; -;; `backquote', `bytecomp', `cl', `easymenu', `font-lock', -;; `noutline', `org', `org-compat', `org-faces', `org-footnote', -;; `org-list', `org-macs', `org-src', `outline', `syntax', -;; `time-date', `xml'. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; This file tries to implement some functions useful for -;; transformation between org-mode and FreeMind files. -;; -;; Here are the commands you can use: -;; -;; M-x `org-freemind-from-org-mode' -;; M-x `org-freemind-from-org-mode-node' -;; M-x `org-freemind-from-org-sparse-tree' -;; -;; M-x `org-freemind-to-org-mode' -;; -;; M-x `org-freemind-show' -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Change log: -;; -;; 2009-02-15: Added check for next level=current+1 -;; 2009-02-21: Fixed bug in `org-freemind-to-org-mode'. -;; 2009-10-25: Added support for `org-odd-levels-only'. -;; Added y/n question before showing in FreeMind. -;; 2009-11-04: Added support for #+BEGIN_HTML. -;; -;;; Code: - -(require 'xml) -(require 'org) - ;(require 'rx) -(require 'org-exp) -(eval-when-compile (require 'cl)) - -(defgroup org-freemind nil - "Customization group for org-freemind export/import." - :group 'org) - -;; Fix-me: I am not sure these are useful: -;; -;; (defcustom org-freemind-main-fgcolor "black" -;; "Color of main node's text." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-main-color "black" -;; "Background color of main node." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-child-fgcolor "black" -;; "Color of child nodes' text." -;; :type 'color -;; :group 'org-freemind) - -;; (defcustom org-freemind-child-color "black" -;; "Background color of child nodes." -;; :type 'color -;; :group 'org-freemind) - -(defvar org-freemind-node-style nil "Internal use.") - -(defcustom org-freemind-node-styles nil - "Styles to apply to node. -NOT READY YET." - :type '(repeat - (list :tag "Node styles for file" - (regexp :tag "File name") - (repeat - (list :tag "Node" - (regexp :tag "Node name regexp") - (set :tag "Node properties" - (list :format "%v" (const :format "" node-style) - (choice :tag "Style" - :value bubble - (const bubble) - (const fork))) - (list :format "%v" (const :format "" color) - (color :tag "Color" :value "red")) - (list :format "%v" (const :format "" background-color) - (color :tag "Background color" :value "yellow")) - (list :format "%v" (const :format "" edge-color) - (color :tag "Edge color" :value "green")) - (list :format "%v" (const :format "" edge-style) - (choice :tag "Edge style" :value bezier - (const :tag "Linear" linear) - (const :tag "Bezier" bezier) - (const :tag "Sharp Linear" sharp-linear) - (const :tag "Sharp Bezier" sharp-bezier))) - (list :format "%v" (const :format "" edge-width) - (choice :tag "Edge width" :value thin - (const :tag "Parent" parent) - (const :tag "Thin" thin) - (const 1) - (const 2) - (const 4) - (const 8))) - (list :format "%v" (const :format "" italic) - (const :tag "Italic font" t)) - (list :format "%v" (const :format "" bold) - (const :tag "Bold font" t)) - (list :format "%v" (const :format "" font-name) - (string :tag "Font name" :value "SansSerif")) - (list :format "%v" (const :format "" font-size) - (integer :tag "Font size" :value 12))))))) - :group 'org-freemind) - -;;;###autoload -(defun org-export-as-freemind (&optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the current buffer as a Freemind file. -If there is an active region, export only the region. HIDDEN is -obsolete and does nothing. EXT-PLIST is a property list with -external parameters overriding org-mode's default settings, but -still inferior to file-local settings. When TO-BUFFER is -non-nil, create a buffer with that name and export to that -buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind but just return the resulting HTML as a string. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of the document (all top level -sections). When PUB-DIR is set, use this as the publishing -directory. - -See `org-freemind-from-org-mode' for more information." - (interactive "P") - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist))) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - (bfname (buffer-file-name (or (buffer-base-buffer) (current-buffer)))) - (filename (concat (file-name-as-directory - (or pub-dir - (org-export-directory :ascii opt-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory bfname))) - ".mm"))) - (when (file-exists-p filename) - (delete-file filename)) - (cond - (subtree-p - (org-freemind-from-org-mode-node (line-number-at-pos rbeg) - filename)) - (t (org-freemind-from-org-mode bfname filename))))) - -;;;###autoload -(defun org-freemind-show (mm-file) - "Show file MM-FILE in Freemind." - (interactive - (list - (save-match-data - (let ((name (read-file-name "FreeMind file: " - nil nil nil - (if (buffer-file-name) - (let* ((name-ext (file-name-nondirectory (buffer-file-name))) - (name (file-name-sans-extension name-ext)) - (ext (file-name-extension name-ext))) - (cond - ((string= "mm" ext) - name-ext) - ((string= "org" ext) - (let ((name-mm (concat name ".mm"))) - (if (file-exists-p name-mm) - name-mm - (message "Not exported to Freemind format yet") - ""))) - (t - ""))) - "") - ;; Fix-me: Is this an Emacs bug? - ;; This predicate function is never - ;; called. - (lambda (fn) - (string-match "^mm$" (file-name-extension fn)))))) - (setq name (expand-file-name name)) - name)))) - (org-open-file mm-file)) - -(defconst org-freemind-org-nfix "--org-mode: ") - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Format converters - -(defun org-freemind-escape-str-from-org (org-str) - "Do some html-escaping of ORG-STR and return the result. -The characters \"&<> will be escaped." - (let ((chars (append org-str nil)) - (fm-str "")) - (dolist (cc chars) - (setq fm-str - (concat fm-str - (if (< cc 160) - (cond - ((= cc ?\") """) - ((= cc ?\&) "&") - ((= cc ?\<) "<") - ((= cc ?\>) ">") - (t (char-to-string cc))) - ;; Formatting as &#number; is maybe needed - ;; according to a bug report from kazuo - ;; fujimoto, but I have now instead added a xml - ;; processing instruction saying that the mm - ;; file is utf-8: - ;; - ;; (format "&#x%x;" (- cc ;; ?\x800)) - (format "&#x%x;" (encode-char cc 'ucs)) - )))) - fm-str)) - -;;(org-freemind-unescape-str-to-org "mA≌B<C<=") -;;(org-freemind-unescape-str-to-org "<<") -(defun org-freemind-unescape-str-to-org (fm-str) - "Do some html-unescaping of FM-STR and return the result. -This is the opposite of `org-freemind-escape-str-from-org' but it -will also unescape &#nn;." - (let ((org-str fm-str)) - (setq org-str (replace-regexp-in-string """ "\"" org-str)) - (setq org-str (replace-regexp-in-string "&" "&" org-str)) - (setq org-str (replace-regexp-in-string "<" "<" org-str)) - (setq org-str (replace-regexp-in-string ">" ">" org-str)) - (setq org-str (replace-regexp-in-string - "&#x\\([a-f0-9]\\{2,4\\}\\);" - (lambda (m) - (char-to-string - (+ (string-to-number (match-string 1 m) 16) - 0 ;?\x800 ;; What is this for? Encoding? - ))) - org-str)))) - -;; (let* ((str1 "a quote: \", an amp: &, lt: <; over 256: öåäÖÅÄ") -;; (str2 (org-freemind-escape-str-from-org str1)) -;; (str3 (org-freemind-unescape-str-to-org str2))) -;; (unless (string= str1 str3) -;; (error "Error str3=%s" str3))) - -(defun org-freemind-convert-links-helper (matched) - "Helper for `org-freemind-convert-links-from-org'. -MATCHED is the link just matched." - (let* ((link (match-string 1 matched)) - (text (match-string 2 matched)) - (ext (file-name-extension link)) - (col-pos (org-string-match-p ":" link)) - (is-img (and (image-type-from-file-name link) - (let ((url-type (substring link 0 col-pos))) - (member url-type '("file" "http" "https"))))) - ) - (if is-img - ;; Fix-me: I can't find a way to get the border to "shrink - ;; wrap" around the image using <div>. - ;; - ;; (concat "<div style=\"border: solid 1px #ddd; width:auto;\">" - ;; "<img src=\"" link "\" alt=\"" text "\" />" - ;; "<br />" - ;; "<i>" text "</i>" - ;; "</div>") - (concat "<table border=\"0\" style=\"border: solid 1px #ddd;\"><tr><td>" - "<img src=\"" link "\" alt=\"" text "\" />" - "<br />" - "<i>" text "</i>" - "</td></tr></table>") - (concat "<a href=\"" link "\">" text "</a>")))) - -(defun org-freemind-convert-links-from-org (org-str) - "Convert org links in ORG-STR to freemind links and return the result." - (let ((fm-str (replace-regexp-in-string - ;;(rx (not (any "[\"")) - ;; (submatch - ;; "http" - ;; (opt ?\s) - ;; "://" - ;; (1+ - ;; (any "-%.?@a-zA-Z0-9()_/:~=&#")))) - "[^\"[]\\(http ?://[--:#%&()=?-Z_a-z~]+\\)" - "[[\\1][\\1]]" - org-str - nil ;; fixedcase - nil ;; literal - 1 ;; subexp - ))) - (replace-regexp-in-string - ;;(rx "[[" - ;; (submatch (*? nonl)) - ;; "][" - ;; (submatch (*? nonl)) - ;; "]]") - "\\[\\[\\(.*?\\)]\\[\\(.*?\\)]]" - ;;"<a href=\"\\1\">\\2</a>" - 'org-freemind-convert-links-helper - fm-str t t))) - -;;(org-freemind-convert-links-to-org "<a href=\"http://www.somewhere/\">link-text</a>") -(defun org-freemind-convert-links-to-org (fm-str) - "Convert freemind links in FM-STR to org links and return the result." - (let ((org-str (replace-regexp-in-string - ;;(rx "<a" - ;; space - ;; (0+ - ;; (0+ (not (any ">"))) - ;; space) - ;; "href=\"" - ;; (submatch (0+ (not (any "\"")))) - ;; "\"" - ;; (0+ (not (any ">"))) - ;; ">" - ;; (submatch (0+ (not (any "<")))) - ;; "</a>") - "<a[[:space:]]\\(?:[^>]*[[:space:]]\\)*href=\"\\([^\"]*\\)\"[^>]*>\\([^<]*\\)</a>" - "[[\\1][\\2]]" - fm-str))) - org-str)) - -;; Fix-me: -;;(defun org-freemind-convert-drawers-from-org (text) -;; ) - -;; (let* ((str1 "[[http://www.somewhere/][link-text]") -;; (str2 (org-freemind-convert-links-from-org str1)) -;; (str3 (org-freemind-convert-links-to-org str2))) -;; (unless (string= str1 str3) -;; (error "Error str3=%s" str3))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Org => FreeMind - -(defvar org-freemind-bol-helper-base-indent nil) - -(defun org-freemind-bol-helper (matched) - "Helper for `org-freemind-convert-text-p'. -MATCHED is the link just matched." - (let ((res "") - (bi org-freemind-bol-helper-base-indent)) - (dolist (cc (append matched nil)) - (if (= 32 cc) - ;;(setq res (concat res " ")) - ;; We need to use the numerical version. Otherwise Freemind - ;; ver 0.9.0 RC9 can not export to html/javascript. - (progn - (if (< 0 bi) - (setq bi (1- bi)) - (setq res (concat res " ")))) - (setq res (concat res (char-to-string cc))))) - res)) -;; (setq x (replace-regexp-in-string "\n +" 'org-freemind-bol-nbsp-helper "\n ")) - -(defun org-freemind-convert-text-p (text) - "Convert TEXT to html with <p> paragraphs." - ;; (string-match-p "[^ ]" " a") - (setq org-freemind-bol-helper-base-indent (org-string-match-p "[^ ]" text)) - (setq text (org-freemind-escape-str-from-org text)) - - (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(/\\)\\([^/]+\\)\\(/\\)\\([[:space:]]\\)" "\\1<i>\\3</i>\\5" text)) - (setq text (replace-regexp-in-string "\\([[:space:]]\\)\\(\*\\)\\([^*]+\\)\\(\*\\)\\([[:space:]]\\)" "\\1<b>\\3</b>\\5" text)) - - (setq text (concat "<p>" text)) - (setq text (replace-regexp-in-string "\n[[:blank:]]*\n" "</p><p>" text)) - (setq text (replace-regexp-in-string "\\(?:<p>\\|\n\\) +" 'org-freemind-bol-helper text)) - (setq text (replace-regexp-in-string "\n" "<br />" text)) - (setq text (concat text "</p>")) - - (org-freemind-convert-links-from-org text)) - -(defcustom org-freemind-node-css-style - "p { margin-top: 3px; margin-bottom: 3px; }" - "CSS style for Freemind nodes." - ;; Fix-me: I do not understand this. It worked to export from Freemind - ;; with this setting now, but not before??? Was this perhaps a java - ;; bug or is it a windows xp bug (some resource gets exhausted if you - ;; use sticky keys which I do). - :version "24.1" - :group 'org-freemind) - -(defun org-freemind-org-text-to-freemind-subnode/note (node-name start end drawers-regexp) - "Convert text part of org node to freemind subnode or note. -Convert the text part of the org node named NODE-NAME. The text -is in the current buffer between START and END. Drawers matching -DRAWERS-REGEXP are converted to freemind notes." - ;; fix-me: doc - (let ((text (buffer-substring-no-properties start end)) - (node-res "") - (note-res "")) - (save-match-data - ;;(setq text (org-freemind-escape-str-from-org text)) - ;; First see if there is something that should be moved to the - ;; note part: - (let (drawers) - (while (string-match drawers-regexp text) - (setq drawers (cons (match-string 0 text) drawers)) - (setq text - (concat (substring text 0 (match-beginning 0)) - (substring text (match-end 0)))) - ) - (when drawers - (dolist (drawer drawers) - (let ((lines (split-string drawer "\n"))) - (dolist (line lines) - (setq note-res (concat - note-res - org-freemind-org-nfix line "<br />\n"))) - )))) - - (when (> (length note-res) 0) - (setq note-res (concat - "<richcontent TYPE=\"NOTE\"><html>\n" - "<head>\n" - "</head>\n" - "<body>\n" - note-res - "</body>\n" - "</html>\n" - "</richcontent>\n"))) - - ;; There is always an LF char: - (when (> (length text) 1) - (setq node-res (concat - "<node style=\"bubble\" background_color=\"#eeee00\">\n" - "<richcontent TYPE=\"NODE\"><html>\n" - "<head>\n" - (if (= 0 (length org-freemind-node-css-style)) - "" - (concat - "<style type=\"text/css\">\n" - "<!--\n" - org-freemind-node-css-style - "-->\n" - "</style>\n")) - "</head>\n" - "<body>\n")) - (let ((begin-html-mark (regexp-quote "#+BEGIN_HTML")) - (end-html-mark (regexp-quote "#+END_HTML")) - head - end-pos - end-pos-match - ) - ;; Take care of #+BEGIN_HTML - #+END_HTML - (while (string-match begin-html-mark text) - (setq head (substring text 0 (match-beginning 0))) - (setq end-pos-match (match-end 0)) - (setq node-res (concat node-res - (org-freemind-convert-text-p head))) - (setq text (substring text end-pos-match)) - (setq end-pos (string-match end-html-mark text)) - (if end-pos - (setq end-pos-match (match-end 0)) - (message "org-freemind: Missing #+END_HTML") - (setq end-pos (length text)) - (setq end-pos-match end-pos)) - (setq node-res (concat node-res - (substring text 0 end-pos))) - (setq text (substring text end-pos-match))) - (setq node-res (concat node-res - (org-freemind-convert-text-p text)))) - (setq node-res (concat - node-res - "</body>\n" - "</html>\n" - "</richcontent>\n" - ;; Put a note that this is for the parent node - ;; "<richcontent TYPE=\"NOTE\"><html>" - ;; "<head>" - ;; "</head>" - ;; "<body>" - ;; "<p>" - ;; "-- This is more about \"" node-name "\" --" - ;; "</p>" - ;; "</body>" - ;; "</html>" - ;; "</richcontent>\n" - note-res - "</node>\n" ;; ok - ))) - (list node-res note-res)))) - -(defun org-freemind-write-node (mm-buffer drawers-regexp - num-left-nodes base-level - current-level next-level this-m2 - this-node-end - this-children-visible - next-node-start - next-has-some-visible-child) - (let* (this-icons - this-bg-color - this-m2-link - this-m2-escaped - this-rich-node - this-rich-note - ) - (when (string-match "TODO" this-m2) - (setq this-m2 (replace-match "" nil nil this-m2)) - (add-to-list 'this-icons "button_cancel") - (setq this-bg-color "#ffff88") - (when (string-match "\\[#\\(.\\)\\]" this-m2) - (let ((prior (string-to-char (match-string 1 this-m2)))) - (setq this-m2 (replace-match "" nil nil this-m2)) - (cond - ((= prior ?A) - (add-to-list 'this-icons "full-1") - (setq this-bg-color "#ff0000")) - ((= prior ?B) - (add-to-list 'this-icons "full-2") - (setq this-bg-color "#ffaa00")) - ((= prior ?C) - (add-to-list 'this-icons "full-3") - (setq this-bg-color "#ffdd00")) - ((= prior ?D) - (add-to-list 'this-icons "full-4") - (setq this-bg-color "#ffff00")) - ((= prior ?E) - (add-to-list 'this-icons "full-5")) - ((= prior ?F) - (add-to-list 'this-icons "full-6")) - ((= prior ?G) - (add-to-list 'this-icons "full-7")) - )))) - (setq this-m2 (org-trim this-m2)) - (when (string-match org-bracket-link-analytic-regexp this-m2) - (setq this-m2-link (concat "link=\"" (match-string 1 this-m2) - (match-string 3 this-m2) "\" ") - this-m2 (replace-match "\\5" nil nil this-m2 0))) - (setq this-m2-escaped (org-freemind-escape-str-from-org this-m2)) - (let ((node-notes (org-freemind-org-text-to-freemind-subnode/note - this-m2-escaped - this-node-end - (1- next-node-start) - drawers-regexp))) - (setq this-rich-node (nth 0 node-notes)) - (setq this-rich-note (nth 1 node-notes))) - (with-current-buffer mm-buffer - (insert "<node " (if this-m2-link this-m2-link "") - "text=\"" this-m2-escaped "\"") - (org-freemind-get-node-style this-m2) - (when (> next-level current-level) - (unless (or this-children-visible - next-has-some-visible-child) - (insert " folded=\"true\""))) - (when (and (= current-level (1+ base-level)) - (> num-left-nodes 0)) - (setq num-left-nodes (1- num-left-nodes)) - (insert " position=\"left\"")) - (when this-bg-color - (insert " background_color=\"" this-bg-color "\"")) - (insert ">\n") - (when this-icons - (dolist (icon this-icons) - (insert "<icon builtin=\"" icon "\"/>\n"))) - ) - (with-current-buffer mm-buffer - ;;(when this-rich-note (insert this-rich-note)) - (when this-rich-node (insert this-rich-node)))) - num-left-nodes) - -(defun org-freemind-check-overwrite (file interactively) - "Check if file FILE already exists. -If FILE does not exist return t. - -If INTERACTIVELY is non-nil ask if the file should be replaced -and return t/nil if it should/should not be replaced. - -Otherwise give an error say the file exists." - (if (file-exists-p file) - (if interactively - (y-or-n-p (format "File %s exists, replace it? " file)) - (error "File %s already exists" file)) - t)) - -(defvar org-freemind-node-pattern - ;;(rx bol - ;; (submatch (1+ "*")) - ;; (1+ space) - ;; (submatch (*? nonl)) - ;; eol) - "^\\(\\*+\\)[[:space:]]+\\(.*?\\)$") - -(defun org-freemind-look-for-visible-child (node-level) - (save-excursion - (save-match-data - (let ((found-visible-child nil)) - (while (and (not found-visible-child) - (re-search-forward org-freemind-node-pattern nil t)) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (>= node-level level) - (setq found-visible-child 'none) - (unless (get-char-property (line-beginning-position) 'invisible) - (setq found-visible-child 'found))))) - (eq found-visible-child 'found) - )))) - -(defun org-freemind-goto-line (line) - "Go to line number LINE." - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)))) - -(defun org-freemind-write-mm-buffer (org-buffer mm-buffer node-at-line) - (with-current-buffer org-buffer - (dolist (node-style org-freemind-node-styles) - (when (org-string-match-p (car node-style) buffer-file-name) - (setq org-freemind-node-style (cadr node-style)))) - ;;(message "org-freemind-node-style =%s" org-freemind-node-style) - (save-match-data - (let* ((drawers (copy-sequence org-drawers)) - drawers-regexp - (num-top1-nodes 0) - (num-top2-nodes 0) - num-left-nodes - (unclosed-nodes 0) - (odd-only org-odd-levels-only) - (first-time t) - (current-level 1) - base-level - prev-node-end - rich-text - unfinished-tag - node-at-line-level - node-at-line-last) - (with-current-buffer mm-buffer - (erase-buffer) - (setq buffer-file-coding-system 'utf-8) - ;; Fix-me: Currently Freemind (ver 0.9.0 RC9) does not support this: - ;;(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n") - (insert "<map version=\"0.9.0\">\n") - (insert "<!-- To view this file, download free mind mapping software FreeMind from http://freemind.sourceforge.net -->\n")) - (save-excursion - ;; Get special buffer vars: - (goto-char (point-min)) - (message "Writing Freemind file...") - (while (re-search-forward "^#\\+DRAWERS:" nil t) - (let ((dr-txt (buffer-substring-no-properties (match-end 0) (line-end-position)))) - (setq drawers (append drawers (split-string dr-txt) nil)))) - (setq drawers-regexp - (concat "^[[:blank:]]*:" - (regexp-opt drawers) - ;;(rx ":" (0+ blank) - ;; "\n" - ;; (*? anything) - ;; "\n" - ;; (0+ blank) - ;; ":END:" - ;; (0+ blank) - ;; eol) - ":[[:blank:]]*\n\\(?:.\\|\n\\)*?\n[[:blank:]]*:END:[[:blank:]]*$" - )) - - (if node-at-line - ;; Get number of top nodes and last line for this node - (progn - (org-freemind-goto-line node-at-line) - (unless (looking-at org-freemind-node-pattern) - (error "No node at line %s" node-at-line)) - (setq node-at-line-level (length (match-string-no-properties 1))) - (forward-line) - (setq node-at-line-last - (catch 'last-line - (while (re-search-forward org-freemind-node-pattern nil t) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (<= level node-at-line-level) - (progn - (beginning-of-line) - (throw 'last-line (1- (point)))) - (if (= level (1+ node-at-line-level)) - (setq num-top2-nodes (1+ num-top2-nodes)))))))) - (setq current-level node-at-line-level) - (setq num-top1-nodes 1) - (org-freemind-goto-line node-at-line)) - - ;; First get number of top nodes - (goto-char (point-min)) - (while (re-search-forward org-freemind-node-pattern nil t) - (let* ((m1 (match-string-no-properties 1)) - (level (length m1))) - (if (= level 1) - (setq num-top1-nodes (1+ num-top1-nodes)) - (if (= level 2) - (setq num-top2-nodes (1+ num-top2-nodes)))))) - ;; If there is more than one top node we need to insert a node - ;; to keep them together. - (goto-char (point-min)) - (when (> num-top1-nodes 1) - (setq num-top2-nodes num-top1-nodes) - (setq current-level 0) - (let ((orig-name (if buffer-file-name - (file-name-nondirectory (buffer-file-name)) - (buffer-name)))) - (with-current-buffer mm-buffer - (insert "<node text=\"" orig-name "\" background_color=\"#00bfff\">\n" - ;; Put a note that this is for the parent node - "<richcontent TYPE=\"NOTE\"><html>" - "<head>" - "</head>" - "<body>" - "<p>" - org-freemind-org-nfix "WHOLE FILE" - "</p>" - "</body>" - "</html>" - "</richcontent>\n"))))) - - (setq num-left-nodes (floor num-top2-nodes 2)) - (setq base-level current-level) - (let (this-m2 - this-node-end - this-children-visible - next-m2 - next-node-start - next-level - next-has-some-visible-child - next-children-visible - ) - (while (and - (re-search-forward org-freemind-node-pattern nil t) - (if node-at-line-last (<= (point) node-at-line-last) t) - ) - (let* ((next-m1 (match-string-no-properties 1)) - (next-node-end (match-end 0)) - ) - (setq next-node-start (match-beginning 0)) - (setq next-m2 (match-string-no-properties 2)) - (setq next-level (length next-m1)) - (setq next-children-visible - (not (eq 'outline - (get-char-property (line-end-position) 'invisible)))) - (setq next-has-some-visible-child - (if next-children-visible t - (org-freemind-look-for-visible-child next-level))) - (when this-m2 - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child))) - (when (if (= num-top1-nodes 1) (> current-level base-level) t) - (while (>= current-level next-level) - (with-current-buffer mm-buffer - (insert "</node>\n") - (setq current-level - (- current-level (if odd-only 2 1)))))) - (setq this-node-end (1+ next-node-end)) - (setq this-m2 next-m2) - (setq current-level next-level) - (setq this-children-visible next-children-visible) - (forward-char) - )) -;;; (unless (if node-at-line-last -;;; (>= (point) node-at-line-last) -;;; nil) - ;; Write last node: - (setq this-m2 next-m2) - (setq current-level next-level) - (setq next-node-start (if node-at-line-last - (1+ node-at-line-last) - (point-max))) - (setq num-left-nodes (org-freemind-write-node mm-buffer drawers-regexp num-left-nodes base-level current-level next-level this-m2 this-node-end this-children-visible next-node-start next-has-some-visible-child)) - (with-current-buffer mm-buffer (insert "</node>\n")) - ;) - ) - (with-current-buffer mm-buffer - (while (> current-level base-level) - (insert "</node>\n") - (setq current-level - (- current-level (if odd-only 2 1))) - )) - (with-current-buffer mm-buffer - (insert "</map>") - (delete-trailing-whitespace) - (goto-char (point-min)) - )))))) - -(defun org-freemind-get-node-style (node-name) - "NOT READY YET." - ;;<node BACKGROUND_COLOR="#eeee00" CREATED="1234668815593" MODIFIED="1234668815593" STYLE="bubble"> - ;;<font BOLD="true" NAME="SansSerif" SIZE="12"/> - (let (node-styles - node-style) - (dolist (style-list org-freemind-node-style) - (let ((node-regexp (car style-list))) - (message "node-regexp=%s node-name=%s" node-regexp node-name) - (when (org-string-match-p node-regexp node-name) - ;;(setq node-style (org-freemind-do-apply-node-style style-list)) - (setq node-style (cadr style-list)) - (when node-style - (message "node-style=%s" node-style) - (setq node-styles (append node-styles node-style))) - ))))) - -(defun org-freemind-do-apply-node-style (style-list) - (message "style-list=%S" style-list) - (let ((node-style 'fork) - (color "red") - (background-color "yellow") - (edge-color "green") - (edge-style 'bezier) - (edge-width 'thin) - (italic t) - (bold t) - (font-name "SansSerif") - (font-size 12)) - (dolist (style (cadr style-list)) - (message " style=%s" style) - (let ((what (car style))) - (cond - ((eq what 'node-style) - (setq node-style (cadr style))) - ((eq what 'color) - (setq color (cadr style))) - ((eq what 'background-color) - (setq background-color (cadr style))) - - ((eq what 'edge-color) - (setq edge-color (cadr style))) - - ((eq what 'edge-style) - (setq edge-style (cadr style))) - - ((eq what 'edge-width) - (setq edge-width (cadr style))) - - ((eq what 'italic) - (setq italic (cadr style))) - - ((eq what 'bold) - (setq bold (cadr style))) - - ((eq what 'font-name) - (setq font-name (cadr style))) - - ((eq what 'font-size) - (setq font-size (cadr style))) - ) - (insert (format " style=\"%s\"" node-style)) - (insert (format " color=\"%s\"" color)) - (insert (format " background_color=\"%s\"" background-color)) - (insert ">\n") - (insert "<edge") - (insert (format " color=\"%s\"" edge-color)) - (insert (format " style=\"%s\"" edge-style)) - (insert (format " width=\"%s\"" edge-width)) - (insert "/>\n") - (insert "<font") - (insert (format " italic=\"%s\"" italic)) - (insert (format " bold=\"%s\"" bold)) - (insert (format " name=\"%s\"" font-name)) - (insert (format " size=\"%s\"" font-size)) - )))) - -;;;###autoload -(defun org-freemind-from-org-mode-node (node-line mm-file) - "Convert node at line NODE-LINE to the FreeMind file MM-FILE. -See `org-freemind-from-org-mode' for more information." - (interactive - (progn - (unless (org-back-to-heading nil) - (error "Can't find org-mode node start")) - (let* ((line (line-number-at-pos)) - (default-mm-file (concat (if buffer-file-name - (file-name-nondirectory buffer-file-name) - "nofile") - "-line-" (number-to-string line) - ".mm")) - (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) - (list line mm-file)))) - (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) - (let ((org-buffer (current-buffer)) - (mm-buffer (find-file-noselect mm-file))) - (org-freemind-write-mm-buffer org-buffer mm-buffer node-line) - (with-current-buffer mm-buffer - (basic-save-buffer) - (when (org-called-interactively-p 'any) - (switch-to-buffer-other-window mm-buffer) - (when (y-or-n-p "Show in FreeMind? ") - (org-freemind-show buffer-file-name))))))) - -;;;###autoload -(defun org-freemind-from-org-mode (org-file mm-file) - "Convert the `org-mode' file ORG-FILE to the FreeMind file MM-FILE. -All the nodes will be opened or closed in Freemind just as you -have them in `org-mode'. - -Note that exporting to Freemind also gives you an alternative way -to export from `org-mode' to html. You can create a dynamic html -version of the your org file, by first exporting to Freemind and -then exporting from Freemind to html. The 'As -XHTML (JavaScript)' version in Freemind works very well \(and you -can use a CSS stylesheet to style it)." - ;; Fix-me: better doc, include recommendations etc. - (interactive - (let* ((org-file buffer-file-name) - (default-mm-file (concat - (if org-file - (file-name-nondirectory org-file) - "nofile") - ".mm")) - (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) - (list org-file mm-file))) - (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) - (let ((org-buffer (if org-file (find-file-noselect org-file) (current-buffer))) - (mm-buffer (find-file-noselect mm-file))) - (org-freemind-write-mm-buffer org-buffer mm-buffer nil) - (with-current-buffer mm-buffer - (basic-save-buffer) - (when (org-called-interactively-p 'any) - (switch-to-buffer-other-window mm-buffer) - (when (y-or-n-p "Show in FreeMind? ") - (org-freemind-show buffer-file-name))))))) - -;;;###autoload -(defun org-freemind-from-org-sparse-tree (org-buffer mm-file) - "Convert visible part of buffer ORG-BUFFER to FreeMind file MM-FILE." - (interactive - (let* ((org-file buffer-file-name) - (default-mm-file (concat - (if org-file - (file-name-nondirectory org-file) - "nofile") - "-sparse.mm")) - (mm-file (read-file-name "Output FreeMind file: " nil nil nil default-mm-file))) - (list (current-buffer) mm-file))) - (when (org-freemind-check-overwrite mm-file (org-called-interactively-p 'any)) - (let (org-buffer - (mm-buffer (find-file-noselect mm-file))) - (save-window-excursion - (org-export-visible ?\ nil) - (setq org-buffer (current-buffer))) - (org-freemind-write-mm-buffer org-buffer mm-buffer nil) - (with-current-buffer mm-buffer - (basic-save-buffer) - (when (org-called-interactively-p 'any) - (switch-to-buffer-other-window mm-buffer) - (when (y-or-n-p "Show in FreeMind? ") - (org-freemind-show buffer-file-name))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; FreeMind => Org - -;; (sort '(b a c) 'org-freemind-lt-symbols) -(defun org-freemind-lt-symbols (sym-a sym-b) - (string< (symbol-name sym-a) (symbol-name sym-b))) -;; (sort '((b . 1) (a . 2) (c . 3)) 'org-freemind-lt-xml-attrs) -(defun org-freemind-lt-xml-attrs (attr-a attr-b) - (string< (symbol-name (car attr-a)) (symbol-name (car attr-b)))) - -;; xml-parse-region gives things like -;; ((p nil "\n" -;; (a -;; ((href . "link")) -;; "text") -;; "\n" -;; (b nil "hej") -;; "\n")) - -;; '(a . nil) - -;; (org-freemind-symbols= 'a (car '(A B))) -(defsubst org-freemind-symbols= (sym-a sym-b) - "Return t if downcased names of SYM-A and SYM-B are equal. -SYM-A and SYM-B should be symbols." - (or (eq sym-a sym-b) - (string= (downcase (symbol-name sym-a)) - (downcase (symbol-name sym-b))))) - -(defun org-freemind-get-children (parent path) - "Find children node to PARENT from PATH. -PATH should be a list of steps, where each step has the form - - '(NODE-NAME (ATTR-NAME . ATTR-VALUE))" - ;; Fix-me: maybe implement op? step: Name, number, attr, attr op val - ;; Fix-me: case insensitive version for children? - (let* ((children (if (not (listp (car parent))) - (cddr parent) - (let (cs) - (dolist (p parent) - (dolist (c (cddr p)) - (add-to-list 'cs c))) - cs) - )) - (step (car path)) - (step-node (if (listp step) (car step) step)) - (step-attr-list (when (listp step) (sort (cdr step) 'org-freemind-lt-xml-attrs))) - (path-tail (cdr path)) - path-children) - (dolist (child children) - ;; skip xml.el formatting nodes - (unless (stringp child) - ;; compare node name - (when (if (not step-node) - t ;; any node name - (org-freemind-symbols= step-node (car child))) - (if (not step-attr-list) - ;;(throw 'path-child child) ;; no attr to care about - (add-to-list 'path-children child) - (let* ((child-attr-list (cadr child)) - (step-attr-copy (copy-sequence step-attr-list))) - (dolist (child-attr child-attr-list) - ;; Compare attr names: - (when (org-freemind-symbols= (caar step-attr-copy) (car child-attr)) - ;; Compare values: - (let ((step-val (cdar step-attr-copy)) - (child-val (cdr child-attr))) - (when (if (not step-val) - t ;; any value - (string= step-val child-val)) - (setq step-attr-copy (cdr step-attr-copy)))))) - ;; Did we find all? - (unless step-attr-copy - ;;(throw 'path-child child) - (add-to-list 'path-children child) - )))))) - (if path-tail - (org-freemind-get-children path-children path-tail) - path-children))) - -(defun org-freemind-get-richcontent-node (node) - (let ((rc-nodes - (org-freemind-get-children node '((richcontent (type . "NODE")) html body)))) - (when (> (length rc-nodes) 1) - (lwarn t :warning "Unexpected structure: several <richcontent type=\"NODE\" ...>")) - (car rc-nodes))) - -(defun org-freemind-get-richcontent-note (node) - (let ((rc-notes - (org-freemind-get-children node '((richcontent (type . "NOTE")) html body)))) - (when (> (length rc-notes) 1) - (lwarn t :warning "Unexpected structure: several <richcontent type=\"NOTE\" ...>")) - (car rc-notes))) - -(defun org-freemind-test-get-tree-text () - (let ((node '(p nil "\n" - (a - ((href . "link")) - "text") - "\n" - (b nil "hej") - "\n"))) - (org-freemind-get-tree-text node))) -;; (org-freemind-test-get-tree-text) - -(defun org-freemind-get-tree-text (node) - (when node - (let ((ntxt "") - (link nil) - (lf-after nil)) - (dolist (n node) - (case n - ;;(a (setq is-link t) ) - ((h1 h2 h3 h4 h5 h6 p) - ;;(setq ntxt (concat "\n" ntxt)) - (setq lf-after 2)) - (br - (setq lf-after 1)) - (t - (cond - ((stringp n) - (when (string= n "\n") (setq n "")) - (if link - (setq ntxt (concat ntxt - "[[" link "][" n "]]")) - (setq ntxt (concat ntxt n)))) - ((and n (listp n)) - (if (symbolp (car n)) - (setq ntxt (concat ntxt (org-freemind-get-tree-text n))) - ;; This should be the attributes: - (dolist (att-val n) - (let ((att (car att-val)) - (val (cdr att-val))) - (when (eq att 'href) - (setq link val)))))))))) - (if lf-after - (setq ntxt (concat ntxt (make-string lf-after ?\n))) - (setq ntxt (concat ntxt " "))) - ;;(setq ntxt (concat ntxt (format "{%s}" n))) - ntxt))) - -(defun org-freemind-get-richcontent-node-text (node) - "Get the node text as from the richcontent node NODE." - (save-match-data - (let* ((rc (org-freemind-get-richcontent-node node)) - (txt (org-freemind-get-tree-text rc))) - ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) - txt - ))) - -(defun org-freemind-get-richcontent-note-text (node) - "Get the node text as from the richcontent note NODE." - (save-match-data - (let* ((rc (org-freemind-get-richcontent-note node)) - (txt (when rc (org-freemind-get-tree-text rc)))) - ;;(when txt (setq txt (replace-regexp-in-string "[[:space:]]+" " " txt))) - txt - ))) - -(defun org-freemind-get-icon-names (node) - (let* ((icon-nodes (org-freemind-get-children node '((icon )))) - names) - (dolist (icn icon-nodes) - (setq names (cons (cdr (assq 'builtin (cadr icn))) names))) - ;; (icon (builtin . "full-1")) - names)) - -(defun org-freemind-node-to-org (node level skip-levels) - (let ((qname (car node)) - (attributes (cadr node)) - text - ;; Fix-me: note is never inserted - (note (org-freemind-get-richcontent-note-text node)) - (mark "-- This is more about ") - (icons (org-freemind-get-icon-names node)) - (children (cddr node))) - (when (< 0 (- level skip-levels)) - (dolist (attrib attributes) - (case (car attrib) - ('TEXT (setq text (cdr attrib))) - ('text (setq text (cdr attrib))))) - (unless text - ;; There should be a richcontent node holding the text: - (setq text (org-freemind-get-richcontent-node-text node))) - (when icons - (when (member "full-1" icons) (setq text (concat "[#A] " text))) - (when (member "full-2" icons) (setq text (concat "[#B] " text))) - (when (member "full-3" icons) (setq text (concat "[#C] " text))) - (when (member "full-4" icons) (setq text (concat "[#D] " text))) - (when (member "full-5" icons) (setq text (concat "[#E] " text))) - (when (member "full-6" icons) (setq text (concat "[#F] " text))) - (when (member "full-7" icons) (setq text (concat "[#G] " text))) - (when (member "button_cancel" icons) (setq text (concat "TODO " text))) - ) - (if (and note - (string= mark (substring note 0 (length mark)))) - (progn - (setq text (replace-regexp-in-string "\n $" "" text)) - (insert text)) - (case qname - ('node - (insert (make-string (- level skip-levels) ?*) " " text "\n") - (when note - (insert ":COMMENT:\n" note "\n:END:\n")) - )))) - (dolist (child children) - (unless (or (null child) - (stringp child)) - (org-freemind-node-to-org child (1+ level) skip-levels))))) - -;; Fix-me: put back special things, like drawers that are stored in -;; the notes. Should maybe all notes contents be put in drawers? -;;;###autoload -(defun org-freemind-to-org-mode (mm-file org-file) - "Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE." - (interactive - (save-match-data - (let* ((mm-file (buffer-file-name)) - (default-org-file (concat (file-name-nondirectory mm-file) ".org")) - (org-file (read-file-name "Output org-mode file: " nil nil nil default-org-file))) - (list mm-file org-file)))) - (when (org-freemind-check-overwrite org-file (org-called-interactively-p 'any)) - (let ((mm-buffer (find-file-noselect mm-file)) - (org-buffer (find-file-noselect org-file))) - (with-current-buffer mm-buffer - (let* ((xml-list (xml-parse-file mm-file)) - (top-node (cadr (cddar xml-list))) - (note (org-freemind-get-richcontent-note-text top-node)) - (skip-levels - (if (and note - (string-match "^--org-mode: WHOLE FILE$" note)) - 1 - 0))) - (with-current-buffer org-buffer - (erase-buffer) - (org-freemind-node-to-org top-node 1 skip-levels) - (goto-char (point-min)) - (org-set-tags t t) ;; Align all tags - ) - (switch-to-buffer-other-window org-buffer) - ))))) - -(provide 'org-freemind) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; coding: utf-8 -;; End: - -;;; org-freemind.el ends here diff --git a/lisp/org/org-html.el b/lisp/org/org-html.el deleted file mode 100644 index ca90f855aa..0000000000 --- a/lisp/org/org-html.el +++ /dev/null @@ -1,2761 +0,0 @@ -;;; org-html.el --- HTML export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;;; Code: - -(require 'org-exp) -(require 'format-spec) - -(eval-when-compile (require 'cl)) - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defgroup org-export-html nil - "Options specific for HTML export of Org-mode files." - :tag "Org Export HTML" - :group 'org-export) - -(defcustom org-export-html-footnotes-section "<div id=\"footnotes\"> -<h2 class=\"footnotes\">%s: </h2> -<div id=\"text-footnotes\"> -%s -</div> -</div>" - "Format for the footnotes section. -Should contain a two instances of %s. The first will be replaced with the -language-specific word for \"Footnotes\", the second one will be replaced -by the footnotes themselves." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-footnote-format "<sup>%s</sup>" - "The format for the footnote reference. -%s will be replaced by the footnote reference itself." - :group 'org-export-html - :type 'string) - - -(defcustom org-export-html-footnote-separator "<sup>, </sup>" - "Text used to separate footnotes." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-coding-system nil - "Coding system for HTML export, defaults to `buffer-file-coding-system'." - :group 'org-export-html - :type 'coding-system) - -(defcustom org-export-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-xml-declaration - '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>") - ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>")) - "The extension for exported HTML files. -%s will be replaced with the charset of the exported file. -This may be a string, or an alist with export extensions -and corresponding declarations." - :group 'org-export-html - :type '(choice - (string :tag "Single declaration") - (repeat :tag "Dependent on extension" - (cons (string :tag "Extension") - (string :tag "Declaration"))))) - -(defcustom org-export-html-style-include-scripts t - "Non-nil means include the JavaScript snippets in exported HTML files. -The actual script is defined in `org-export-html-scripts' and should -not be modified." - :group 'org-export-html - :type 'boolean) - -(defvar org-export-html-scripts - "<script type=\"text/javascript\"> -/* -@licstart The following is the entire license notice for the -JavaScript code in this tag. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code in this tag is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code in this tag. -*/ -<!--/*--><![CDATA[/*><!--*/ - function CodeHighlightOn(elem, id) - { - var target = document.getElementById(id); - if(null != target) { - elem.cacheClassElem = elem.className; - elem.cacheClassTarget = target.className; - target.className = \"code-highlighted\"; - elem.className = \"code-highlighted\"; - } - } - function CodeHighlightOff(elem, id) - { - var target = document.getElementById(id); - if(elem.cacheClassElem) - elem.className = elem.cacheClassElem; - if(elem.cacheClassTarget) - target.className = elem.cacheClassTarget; - } -/*]]>*///--> -</script>" - "Basic JavaScript that is needed by HTML files produced by Org-mode.") - -(defconst org-export-html-style-default - "<style type=\"text/css\"> - <!--/*--><![CDATA[/*><!--*/ - html { font-family: Times, serif; font-size: 12pt; } - .title { text-align: center; } - .todo { color: red; } - .done { color: green; } - .tag { background-color: #add8e6; font-weight:normal } - .target { } - .timestamp { color: #bebebe; } - .timestamp-kwd { color: #5f9ea0; } - .right {margin-left:auto; margin-right:0px; text-align:right;} - .left {margin-left:0px; margin-right:auto; text-align:left;} - .center {margin-left:auto; margin-right:auto; text-align:center;} - p.verse { margin-left: 3% } - pre { - border: 1pt solid #AEBDCC; - background-color: #F3F5F7; - padding: 5pt; - font-family: courier, monospace; - font-size: 90%; - overflow:auto; - } - table { border-collapse: collapse; } - td, th { vertical-align: top; } - th.right { text-align:center; } - th.left { text-align:center; } - th.center { text-align:center; } - td.right { text-align:right; } - td.left { text-align:left; } - td.center { text-align:center; } - dt { font-weight: bold; } - div.figure { padding: 0.5em; } - div.figure p { text-align: center; } - div.inlinetask { - padding:10px; - border:2px solid gray; - margin:10px; - background: #ffffcc; - } - textarea { overflow-x: auto; } - .linenr { font-size:smaller } - .code-highlighted {background-color:#ffff00;} - .org-info-js_info-navigation { border-style:none; } - #org-info-js_console-label { font-size:10px; font-weight:bold; - white-space:nowrap; } - .org-info-js_search-highlight {background-color:#ffff00; color:#000000; - font-weight:bold; } - /*]]>*/--> -</style>" - "The default style specification for exported HTML files. -Please use the variables `org-export-html-style' and -`org-export-html-style-extra' to add to this style. If you wish to not -have the default style included, customize the variable -`org-export-html-style-include-default'.") - -(defcustom org-export-html-style-include-default t - "Non-nil means include the default style in exported HTML files. -The actual style is defined in `org-export-html-style-default' and should -not be modified. Use the variables `org-export-html-style' to add -your own style information." - :group 'org-export-html - :type 'boolean) - -;;;###autoload -(put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) - -(defcustom org-export-html-style "" - "Org-wide style definitions for exported HTML files. - -This variable needs to contain the full HTML structure to provide a style, -including the surrounding HTML tags. If you set the value of this variable, -you should consider to include definitions for the following classes: - title, todo, done, timestamp, timestamp-kwd, tag, target. - -For example, a valid value would be: - - <style type=\"text/css\"> - <![CDATA[ - p { font-weight: normal; color: gray; } - h1 { color: black; } - .title { text-align: center; } - .todo, .timestamp-kwd { color: red; } - .done { color: green; } - ]]> - </style> - -If you'd like to refer to an external style file, use something like - - <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\"> - -As the value of this option simply gets inserted into the HTML <head> header, -you can \"misuse\" it to add arbitrary text to the header. -See also the variable `org-export-html-style-extra'." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style 'safe-local-variable 'stringp) - -(defcustom org-export-html-style-extra "" - "Additional style information for HTML export. -The value of this variable is inserted into the HTML buffer right after -the value of `org-export-html-style'. Use this variable for per-file -settings of style information, and do not forget to surround the style -settings with <style>...</style> tags." - :group 'org-export-html - :type 'string) -;;;###autoload -(put 'org-export-html-style-extra 'safe-local-variable 'stringp) - -(defcustom org-export-html-mathjax-options - '((path "http://orgmode.org/mathjax/MathJax.js") - (scale "100") - (align "center") - (indent "2em") - (mathml nil)) - "Options for MathJax setup. - -path The path where to find MathJax -scale Scaling for the HTML-CSS backend, usually between 100 and 133 -align How to align display math: left, center, or right -indent If align is not center, how far from the left/right side? -mathml Should a MathML player be used if available? - This is faster and reduces bandwidth use, but currently - sometimes has lower spacing quality. Therefore, the default is - nil. When browsers get better, this switch can be flipped. - -You can also customize this for each buffer, using something like - -#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" - :group 'org-export-html - :version "24.1" - :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) - -(defun org-export-html-mathjax-config (template options in-buffer) - "Insert the user setup into the matchjax template." - (let (name val (yes " ") (no "// ") x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (setq template - (replace-regexp-in-string - (concat "%" (upcase (symbol-name name))) val template t t))) - options) - (setq val (nth 1 (assq 'mathml options))) - (if (string-match (concat "\\<mathml:") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - ;; Exchange prefixes depending on mathml setting - (if (not val) (setq x yes yes no no x)) - ;; Replace cookies to turn on or off the config/jax lines - (if (string-match ":MMLYES:" template) - (setq template (replace-match yes t t template))) - (if (string-match ":MMLNO:" template) - (setq template (replace-match no t t template))) - ;; Return the modified template - template)) - -(defcustom org-export-html-mathjax-template - "<script type=\"text/javascript\" src=\"%PATH\"> -/** - * - * @source: %PATH - * - * @licstart The following is the entire license notice for the - * JavaScript code in %PATH. - * - * Copyright (C) 2012-2013 MathJax - * - * Licensed under the Apache License, Version 2.0 (the \"License\"); - * you may not use this file except in compliance with the License. - * You may obtain a copy of the License at - * - * http://www.apache.org/licenses/LICENSE-2.0 - * - * Unless required by applicable law or agreed to in writing, software - * distributed under the License is distributed on an \"AS IS\" BASIS, - * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - * See the License for the specific language governing permissions and - * limitations under the License. - * - * @licend The above is the entire license notice - * for the JavaScript code in %PATH. - * - */ - -/* -@licstart The following is the entire license notice for the -JavaScript code below. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code below is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code below. -*/ -<!--/*--><![CDATA[/*><!--*/ - MathJax.Hub.Config({ - // Only one of the two following lines, depending on user settings - // First allows browser-native MathML display, second forces HTML/CSS - :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"], - :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"], - extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\", - \"TeX/noUndefined.js\"], - tex2jax: { - inlineMath: [ [\"\\\\(\",\"\\\\)\"] ], - displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ], - skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"], - ignoreClass: \"tex2jax_ignore\", - processEscapes: false, - processEnvironments: true, - preview: \"TeX\" - }, - showProcessingMessages: true, - displayAlign: \"%ALIGN\", - displayIndent: \"%INDENT\", - - \"HTML-CSS\": { - scale: %SCALE, - availableFonts: [\"STIX\",\"TeX\"], - preferredFont: \"TeX\", - webFont: \"TeX\", - imageFont: \"TeX\", - showMathMenu: true, - }, - MMLorHTML: { - prefer: { - MSIE: \"MML\", - Firefox: \"MML\", - Opera: \"HTML\", - other: \"HTML\" - } - } - }); -/*]]>*///--> -</script>" - "The MathJax setup for XHTML files." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-tag-class-prefix "" - "Prefix to class names for TODO keywords. -Each tag gets a class given by the tag itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-todo-kwd-class-prefix "" - "Prefix to class names for TODO keywords. -Each TODO keyword gets a class given by the keyword itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-headline-anchor-format "<a name=\"%s\" id=\"%s\"></a>" - "Format for anchors in HTML headlines. -It requires to %s: both will be replaced by the anchor referring -to the headline (e.g. \"sec-2\"). When set to `nil', don't insert -HTML anchors in headlines." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-preamble t - "Non-nil means insert a preamble in HTML export. - -When `t', insert a string as defined by one of the formatting -strings in `org-export-html-preamble-format'. When set to a -string, this string overrides `org-export-html-preamble-format'. -When set to a function, apply this function and insert the -returned string. The function takes no argument, but you can -use `opt-plist' to access the current export options. - -Setting :html-preamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No preamble" nil) - (const :tag "Default preamble" t) - (string :tag "Custom format string") - (function :tag "Function (must return a string)"))) - -(defcustom org-export-html-preamble-format '(("en" "")) - "Alist of languages and format strings for the HTML preamble. - -To enable the HTML exporter to use these formats, you need to set -`org-export-html-preamble' to `t'. - -The first element of each list is the language code, as used for -the #+LANGUAGE keyword. - -The second element of each list is a format string to format the -preamble itself. This format string can contain these elements: - -%t stands for the title. -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-postamble 'auto - "Non-nil means insert a postamble in HTML export. - -When `t', insert a string as defined by the format string in -`org-export-html-postamble-format'. When set to a string, this -string overrides `org-export-html-postamble-format'. When set to -'auto, discard `org-export-html-postamble-format' and honor -`org-export-author/email/creator-info' variables. When set to a -function, apply this function and insert the returned string. -The function takes no argument, but you can use `opt-plist' to -access the current export options. - -Setting :html-postamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No postamble" nil) - (const :tag "Auto preamble" 'auto) - (const :tag "Default format string" t) - (string :tag "Custom format string") - (function :tag "Function (must return a string)"))) - -(defcustom org-export-html-postamble-format - '(("en" "<p class=\"author\">Author: %a (%e)</p> -<p class=\"date\">Date: %d</p> -<p class=\"creator\">Generated by %c</p> -<p class=\"xhtml-validation\">%v</p> -")) - "Alist of languages and format strings for the HTML postamble. - -To enable the HTML exporter to use these formats, you need to set -`org-export-html-postamble' to `t'. - -The first element of each list is the language code, as used for -the #+LANGUAGE keyword. - -The second element of each list is a format string to format the -postamble itself. This format string can contain these elements: - -%a stands for the author's name. -%e stands for the author's email. -%d stands for the date. -%c will be replaced by information about Org/Emacs versions. -%v will be replaced by `org-export-html-validation-link'. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :version "24.1" - :type 'string) - -(defcustom org-export-html-home/up-format - "<div id=\"org-div-home-and-up\" style=\"text-align:right;font-size:70%%;white-space:nowrap;\"> - <a accesskey=\"h\" href=\"%s\"> UP </a> - | - <a accesskey=\"H\" href=\"%s\"> HOME </a> -</div>" - "Snippet used to insert the HOME and UP links. -This is a format string, the first %s will receive the UP link, -the second the HOME link. If both `org-export-html-link-up' and -`org-export-html-link-home' are empty, the entire snippet will be -ignored." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-toplevel-hlevel 2 - "The <H> level for level 1 headings in HTML export. -This is also important for the classes that will be wrapped around headlines -and outline structure. If this variable is 1, the top-level headlines will -be <h1>, and the corresponding classes will be outline-1, section-number-1, -and outline-text-1. If this is 2, all of these will get a 2 instead. -The default for this variable is 2, because we use <h1> for formatting the -document title." - :group 'org-export-html - :type 'string) - -(defcustom org-export-html-link-org-files-as-html t - "Non-nil means make file links to `file.org' point to `file.html'. -When org-mode is exporting an org-mode file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked org-mode file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -(defcustom org-export-html-inline-images 'maybe - "Non-nil means inline images into exported HTML pages. -This is done using an <img> tag. When nil, an anchor with href is used to -link to the image. If this option is `maybe', then images in links with -an empty description will be inlined, while images with a description will -be linked only." - :group 'org-export-html - :type '(choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When there is no description" maybe))) - -(defcustom org-export-html-inline-image-extensions - '("png" "jpeg" "jpg" "gif" "svg") - "Extensions of image files that can be inlined into HTML." - :group 'org-export-html - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-html-table-tag - "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">" - "The HTML tag that is used to start a table. -This must be a <table> tag, but you may change the options like -borders and spacing." - :group 'org-export-html - :type 'string) - -(defcustom org-export-table-header-tags '("<th scope=\"%s\"%s>" . "</th>") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-export-html-table-use-header-tags-for-first-column'. -See also the variable `org-export-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-data-tags '("<td%s>" . "</td>") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-export-html-table-align-individual-fields'." - :group 'org-export-tables - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-export-table-row-tags '("<tr>" . "</tr>") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be evaluated -for each row in order to construct the table row tags. During evaluation, -the variable `head' will be true when this is a header line, nil when this -is a body line. And the variable `nline' will contain the line number, -starting from 1 in the first header line. For example - - (setq org-export-table-row-tags - (cons '(if head - \"<tr>\" - (if (= (mod nline 2) 1) - \"<tr class=\\\"tr-odd\\\">\" - \"<tr class=\\\"tr-even\\\">\")) - \"</tr>\")) - -will give even lines the class \"tr-even\" and odd lines the class \"tr-odd\"." - :group 'org-export-tables - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) - -(defcustom org-export-html-table-align-individual-fields t - "Non-nil means attach style attributes for alignment to each table field. -When nil, alignment will only be specified in the column tags, but this -is ignored by some browsers (like Firefox, Safari). Opera does it right -though." - :group 'org-export-tables - :version "24.1" - :type 'boolean) - -(defcustom org-export-html-table-use-header-tags-for-first-column nil - "Non-nil means format column one in tables with header tags. -When nil, also column one will use data tags." - :group 'org-export-tables - :type 'boolean) - -(defcustom org-export-html-validation-link - "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>" - "Link to HTML validation service." - :group 'org-export-html - :type 'string) - -;; FIXME Obsolete since Org 7.7 -;; Use the :timestamp option or `org-export-time-stamp-file' instead -(defvar org-export-html-with-timestamp nil - "If non-nil, write container for HTML-helper-mode timestamp.") - -;; FIXME Obsolete since Org 7.7 -(defvar org-export-html-html-helper-timestamp - "\n<p><br/><br/>\n<!-- hhmts start --> <!-- hhmts end --></p>\n" - "The HTML tag used as timestamp delimiter for HTML-helper-mode.") - -(defcustom org-export-html-protect-char-alist - '(("&" . "&") - ("<" . "<") - (">" . ">")) - "Alist of characters to be converted by `org-html-protect'." - :group 'org-export-html - :version "24.1" - :type '(repeat (cons (string :tag "Character") - (string :tag "HTML equivalent")))) - -(defgroup org-export-htmlize nil - "Options for processing examples with htmlize.el." - :tag "Org Export Htmlize" - :group 'org-export-html) - -(defcustom org-export-htmlize-output-type 'inline-css - "Output type to be used by htmlize when formatting code snippets. -Choices are `css', to export the CSS selectors only, or `inline-css', to -export the CSS attribute values inline in the HTML. We use as default -`inline-css', in order to make the resulting HTML self-containing. - -However, this will fail when using Emacs in batch mode for export, because -then no rich font definitions are in place. It will also not be good if -people with different Emacs setup contribute HTML files to a website, -because the fonts will represent the individual setups. In these cases, -it is much better to let Org/Htmlize assign classes only, and to use -a style file to define the look of these classes. -To get a start for your css file, start Emacs session and make sure that -all the faces you are interested in are defined, for example by loading files -in all modes you want. Then, use the command -\\[org-export-htmlize-generate-css] to extract class definitions." - :group 'org-export-htmlize - :type '(choice (const css) (const inline-css))) - -(defcustom org-export-htmlize-css-font-prefix "org-" - "The prefix for CSS class names for htmlize font specifications." - :group 'org-export-htmlize - :type 'string) - -(defcustom org-export-htmlized-org-css-url nil - "URL pointing to a CSS file defining text colors for htmlized Emacs buffers. -Normally when creating an htmlized version of an Org buffer, htmlize will -create CSS to define the font colors. However, this does not work when -converting in batch mode, and it also can look bad if different people -with different fontification setup work on the same website. -When this variable is non-nil, creating an htmlized version of an Org buffer -using `org-export-as-org' will remove the internal CSS section and replace it -with a link to this URL." - :group 'org-export-htmlize - :type '(choice - (const :tag "Keep internal css" nil) - (string :tag "URL or local href"))) - -;; FIXME: The following variable is obsolete since Org 7.7 but is -;; still declared and checked within code for compatibility reasons. -;; Use the custom variables `org-export-html-divs' instead. -(defvar org-export-html-content-div "content" - "The name of the container DIV that holds all the page contents. - -This variable is obsolete since Org version 7.7. -Please set `org-export-html-divs' instead.") - -(defcustom org-export-html-divs '("preamble" "content" "postamble") - "The name of the main divs for HTML export. -This is a list of three strings, the first one for the preamble -DIV, the second one for the content DIV and the third one for the -postamble DIV." - :group 'org-export-html - :version "24.1" - :type '(list - (string :tag " Div for the preamble:") - (string :tag " Div for the content:") - (string :tag "Div for the postamble:"))) - -(defcustom org-export-html-date-format-string "%Y-%m-%dT%R%z" - "Format string to format the date and time. - -The default is an extended format of the ISO 8601 specification." - :group 'org-export-html - :version "24.1" - :type 'string) - -;;; Hooks - -(defvar org-export-html-after-blockquotes-hook nil - "Hook run during HTML export, after blockquote, verse, center are done.") - -(defvar org-export-html-final-hook nil - "Hook run at the end of HTML export, in the new buffer.") - -;;; HTML export - -(defun org-export-html-preprocess (parameters) - "Convert LaTeX fragments to images." - (when (and org-current-export-file - (plist-get parameters :LaTeX-fragments)) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - org-current-export-file))) - org-current-export-dir nil "Creating LaTeX image %s" - nil nil - (cond - ((eq (plist-get parameters :LaTeX-fragments) 'verbatim) 'verbatim) - ((eq (plist-get parameters :LaTeX-fragments) 'mathjax ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) t ) 'mathjax) - ((eq (plist-get parameters :LaTeX-fragments) 'imagemagick) 'imagemagick) - ((eq (plist-get parameters :LaTeX-fragments) 'dvipng ) 'dvipng)))) - (goto-char (point-min)) - (let (label l1) - (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) - (org-if-unprotected-at (match-beginning 1) - (setq label (match-string 1)) - (save-match-data - (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label) - (setq l1 (substring label (match-beginning 1))) - (setq l1 label))) - (replace-match (format "[[#%s][%s]]" label l1) t t))))) - -;;;###autoload -(defun org-export-as-html-and-open (arg) - "Export the outline as HTML and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-export-as-html arg) - (org-open-file buffer-file-name) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (current-buffer)))) - -;;;###autoload -(defun org-export-as-html-batch () - "Call the function `org-export-as-html'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-html-batch" - (org-export-as-html org-export-headline-levels)) - -;;;###autoload -(defun org-export-as-html-to-buffer (arg) - "Call `org-export-as-html` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-html'." - (interactive "P") - (org-export-as-html arg nil "*Org HTML Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org HTML Export*"))) - -;;;###autoload -(defun org-replace-region-by-html (beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use this -command to convert it." - (interactive "r") - (let (reg html buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq html (org-export-region-as-html - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq html (org-export-region-as-html - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert html))) - -;;;###autoload -(defun org-export-region-as-html (beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-export-region-as-html beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org HTML Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-html nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar html-table-tag nil) ; dynamically scoped into this. -(defvar org-par-open nil) - -;;; org-html-cvt-link-fn -(defconst org-html-cvt-link-fn - nil - "Function to convert link URLs to exportable URLs. -Takes two arguments, TYPE and PATH. -Returns exportable url as (TYPE PATH), or nil to signal that it -didn't handle this case. -Intended to be locally bound around a call to `org-export-as-html'." ) - -(defun org-html-cvt-org-as-html (opt-plist type path) - "Convert an org filename to an equivalent html filename. -If TYPE is not file, just return `nil'. -See variable `org-export-html-link-org-files-as-html'" - - (save-match-data - (and - org-export-html-link-org-files-as-html - (string= type "file") - (string-match "\\.org$" path) - (progn - (list - "file" - (concat - (substring path 0 (match-beginning 0)) - "." - (plist-get opt-plist :html-extension))))))) - - -;;; org-html-should-inline-p -(defun org-html-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. -The decision to inline the FILENAME link is based on the current -settings. DESCP is the boolean of whether there was a link -description. See variables `org-export-html-inline-images' and -`org-export-html-inline-image-extensions'." - (declare (special - org-export-html-inline-images - org-export-html-inline-image-extensions)) - (and (or (eq t org-export-html-inline-images) - (and org-export-html-inline-images (not descp))) - (org-file-image-p - filename org-export-html-inline-image-extensions))) - -;;; org-html-make-link -(defun org-html-make-link (opt-plist type path fragment desc attr - may-inline-p) - "Make an HTML link. -OPT-PLIST is an options list. -TYPE is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the \"a\" element. -MAY-INLINE-P allows inlining it as an image." - - (declare (special org-par-open)) - (save-match-data - (let* ((filename path) - ;;First pass. Just sanity stuff. - (components-1 - (cond - ((string= type "file") - (list - type - ;;Substitute just if original path was absolute. - ;;(Otherwise path must remain relative) - (if (file-name-absolute-p path) - (concat "file://" (expand-file-name path)) - path))) - ((string= type "") - (list nil path)) - (t (list type path)))) - - ;;Second pass. Components converted so they can refer - ;;to a remote site. - (components-2 - (or - (and org-html-cvt-link-fn - (apply org-html-cvt-link-fn - opt-plist components-1)) - (apply #'org-html-cvt-org-as-html - opt-plist components-1) - components-1)) - (type (first components-2)) - (thefile (second components-2))) - - - ;;Third pass. Build final link except for leading type - ;;spec. - (cond - ((or - (not type) - (string= type "http") - (string= type "https") - (string= type "file") - (string= type "coderef")) - (if fragment - (setq thefile (concat thefile "#" fragment)))) - - (t)) - - ;;Final URL-build, for all types. - (setq thefile - (let - ((str (org-export-html-format-href thefile))) - (if (and type (not (or (string= "file" type) - (string= "coderef" type)))) - (concat type ":" str) - str))) - - (if (and - may-inline-p - ;;Can't inline a URL with a fragment. - (not fragment)) - (progn - (message "image %s %s" thefile org-par-open) - (org-export-html-format-image thefile org-par-open)) - (concat - "<a href=\"" thefile "\"" (if attr (concat " " attr)) ">" - (org-export-html-format-desc desc) - "</a>"))))) - -(defun org-html-handle-links (org-line opt-plist) - "Return ORG-LINE with markup of Org mode links. -OPT-PLIST is the export options list." - (let ((start 0) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (link-validate (plist-get opt-plist :link-validation-function)) - type id-file fnc - rpl path attr desc descp desc1 desc2 link) - (while (string-match org-bracket-link-analytic-regexp++ org-line start) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 org-line)))) - (setq type (cond - ((match-end 2) (match-string 2 org-line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 org-line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props - (concat "<img src=\"" desc "\" " - (when (save-match-data (string-match "width=" attr)) - (prog1 (concat attr " ") (setq attr ""))) - "alt=\"" - (file-name-nondirectory desc) "\"/>") - '(org-protected t)))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - nil))) - - ((string= type "coderef") - (let* - ((coderef-str (format "coderef-%s" path)) - (attr-1 - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" - coderef-str coderef-str))) - (setq rpl - (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl - (save-match-data - (funcall fnc (org-link-unescape path) desc1 'html)))) - - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<i><" type ":" - (save-match-data (org-link-unescape path)) - "></i>")))) - (setq org-line (replace-match rpl t t org-line) - start (+ start (length rpl)))) - org-line)) - -;;; org-export-as-html - -(defvar org-heading-keyword-regexp-format) ; defined in org.el - -;;;###autoload -(defun org-export-as-html (arg &optional ext-plist to-buffer body-only pub-dir) - "Export the outline as a pretty HTML file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting HTML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -<body>...</body>, without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting...") - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* ((opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (body-only (or body-only (plist-get opt-plist :body-only))) - (style (concat (if (plist-get opt-plist :style-include-default) - org-export-html-style-default) - (plist-get opt-plist :style) - (plist-get opt-plist :style-extra) - "\n" - (if (plist-get opt-plist :style-include-scripts) - org-export-html-scripts))) - (html-extension (plist-get opt-plist :html-extension)) - valid thetoc have-headings first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (org-line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." html-extension) - (file-name-as-directory - (or pub-dir (org-export-directory :html opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) (get-buffer-create "*Org HTML Export*")) - (t (get-buffer-create to-buffer))) - (find-file-noselect filename))) - (org-levels-open (make-vector org-level-max nil)) - (date (org-html-expand (plist-get opt-plist :date))) - (author (org-html-expand (plist-get opt-plist :author))) - (html-validation-link (or org-export-html-validation-link "")) - (title (org-html-expand - (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - (link-up (and (plist-get opt-plist :link-up) - (string-match "\\S-" (plist-get opt-plist :link-up)) - (plist-get opt-plist :link-up))) - (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) - (dummy (setq opt-plist (plist-put opt-plist :title title))) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (inquote nil) - (infixed nil) - (inverse nil) - (email (plist-get opt-plist :email)) - (language (plist-get opt-plist :language)) - (keywords (org-html-expand (plist-get opt-plist :keywords))) - (description (org-html-expand (plist-get opt-plist :description))) - (num (plist-get opt-plist :section-numbers)) - (lang-words nil) - (head-count 0) cnt - (start 0) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-html-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-html-coding-system - coding-system)) - (charset (and coding-system-for-write - (fboundp 'coding-system-get) - (coding-system-get coding-system-for-write - 'mime-charset))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-have-math nil) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (custom-id (or (org-entry-get nil "CUSTOM_ID" t) "")) - (footnote-def-prefix (format "fn-%s" custom-id)) - (footnote-ref-prefix (format "fnr-%s" custom-id)) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'html - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - (mathjax - (if (or (eq (plist-get opt-plist :LaTeX-fragments) 'mathjax) - (and org-export-have-math - (eq (plist-get opt-plist :LaTeX-fragments) t))) - - (org-export-html-mathjax-config - org-export-html-mathjax-template - org-export-html-mathjax-options - (or (plist-get opt-plist :mathjax) "")) - "")) - table-open - table-buffer table-orig-buffer - ind - rpl path attr desc descp desc1 desc2 link - snumber fnc - footnotes footref-seen - href) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - - (setq org-min-level (org-get-min-level lines level-offset)) - (setq org-last-level org-min-level) - (org-init-section-numbers) - - (cond - ((and date (string-match "%" date)) - (setq date (format-time-string date))) - (date) - (t (setq date (format-time-string org-export-html-date-format-string)))) - - ;; Get the language-dependent settings - (setq lang-words (or (assoc language org-export-language-setup) - (assoc "en" org-export-language-setup))) - - ;; Switch to the output buffer - (set-buffer buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (unless body-only - ;; File header - (insert (format - "%s -<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" - \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\"> -<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\"> -<head> -<title>%s</title> -<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/> -<meta name=\"title\" content=\"%s\"/> -<meta name=\"generator\" content=\"Org-mode\"/> -<meta name=\"generated\" content=\"%s\"/> -<meta name=\"author\" content=\"%s\"/> -<meta name=\"description\" content=\"%s\"/> -<meta name=\"keywords\" content=\"%s\"/> -%s -%s -</head> -<body> -%s -" - (format - (or (and (stringp org-export-html-xml-declaration) - org-export-html-xml-declaration) - (cdr (assoc html-extension org-export-html-xml-declaration)) - (cdr (assoc "html" org-export-html-xml-declaration)) - - "") - (or charset "iso-8859-1")) - language language - title - (or charset "iso-8859-1") - title date author description keywords - style - mathjax - (if (or link-up link-home) - (concat - (format org-export-html-home/up-format - (or link-up link-home) - (or link-home link-up)) - "\n") - ""))) - - ;; insert html preamble - (when (plist-get opt-plist :html-preamble) - (let ((html-pre (plist-get opt-plist :html-preamble)) - (html-pre-real-contents "")) - (cond ((stringp html-pre) - (setq html-pre-real-contents - (format-spec html-pre `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email))))) - ((functionp html-pre) - (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n") - (if (stringp (funcall html-pre)) (insert (funcall html-pre))) - (insert "\n</div>\n")) - (t - (setq html-pre-real-contents - (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-preamble-format)) - (cadr (assoc "en" org-export-html-preamble-format))) - `((?t . ,title) (?a . ,author) - (?d . ,date) (?e . ,email)))))) - ;; don't output an empty preamble DIV - (unless (and (functionp html-pre) - (equal html-pre-real-contents "")) - (insert "<div id=\"" (nth 0 org-export-html-divs) "\">\n") - (insert html-pre-real-contents) - (insert "\n</div>\n")))) - - ;; begin wrap around body - (insert (format "\n<div id=\"%s\">" - ;; FIXME org-export-html-content-div is obsolete since 7.7 - (or org-export-html-content-div - (nth 1 org-export-html-divs))) - ;; FIXME this should go in the preamble but is here so - ;; that org-infojs can still find it - "\n<h1 class=\"title\">" title "</h1>\n")) - - ;; insert body - (if org-export-with-toc - (progn - (push (format "<h%d>%s</h%d>\n" - org-export-html-toplevel-hlevel - (nth 3 lang-words) - org-export-html-toplevel-hlevel) - thetoc) - (push "<div id=\"text-table-of-contents\">\n" thetoc) - (push "<ul>\n<li>" thetoc) - (setq lines - (mapcar - #'(lambda (org-line) - (if (and (string-match org-todo-line-regexp org-line) - (not (get-text-property 0 'org-protected org-line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 org-line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 org-line) - org-done-keywords))) - ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - org-line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq txt (replace-match - " <span class=\"tag\">\\1</span>" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if (and num (if (integerp num) - (>= num level) - num)) - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n<ul>\n<li>" thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "</li>\n</ul>" thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp org-line) - (setq org-line (replace-match - (concat "@<span class=\"target\">" - (match-string 1 org-line) "@</span> ") - t t org-line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "-" (format "sec-%s" snumber))) - (setq href (org-solidify-link-text - (or (cdr (assoc href - org-export-preferred-target-alist)) href))) - (push - (format - (if todo - "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" - "</li>\n<li><a href=\"#%s\">%s</a>") - href txt) thetoc) - - (setq org-last-level level))))) - org-line) - lines)) - (while (> org-last-level (1- org-min-level)) - (setq org-last-level (1- org-last-level)) - (push "</li>\n</ul>\n" thetoc)) - (push "</div>\n" thetoc) - (setq thetoc (if have-headings (nreverse thetoc) nil)))) - - (setq head-count 0) - (org-init-section-numbers) - - (org-open-par) - - (while (setq org-line (pop lines) origline org-line) - (catch 'nextline - - ;; end of quote section? - (when (and inquote (string-match org-outline-regexp-bol org-line)) - (insert "</pre>\n") - (org-open-par) - (setq inquote nil)) - ;; inside a quote section? - (when inquote - (insert (org-html-protect org-line) "\n") - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" org-line)) - (when (not infixed) - (setq infixed t) - (org-close-par-maybe) - - (insert "<pre class=\"example\">\n")) - (insert (org-html-protect (match-string 3 org-line)) "\n") - (when (or (not lines) - (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" - (car lines)))) - (setq infixed nil) - (insert "</pre>\n") - (org-open-par)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (and (get-text-property 0 'org-protected org-line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-protected org-line) 10000) - (length org-line)))) - (let (par (ind (get-text-property 0 'original-indentation org-line))) - (when (re-search-backward - "\\(<p>\\)\\([ \t\r\n]*\\)\\=" (- (point) 100) t) - (setq par (match-string 1)) - (replace-match "\\2\n")) - (insert org-line "\n") - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (insert (pop lines) "\n")) - (and par (insert "<p>\n"))) - (throw 'nextline nil)) - - ;; Blockquotes, verse, and center - (when (equal "ORG-BLOCKQUOTE-START" org-line) - (org-close-par-maybe) - (insert "<blockquote>\n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-BLOCKQUOTE-END" org-line) - (org-close-par-maybe) - (insert "\n</blockquote>\n") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-START" org-line) - (org-close-par-maybe) - (insert "\n<p class=\"verse\">\n") - (setq org-par-open t) - (setq inverse t) - (throw 'nextline nil)) - (when (equal "ORG-VERSE-END" org-line) - (insert "</p>\n") - (setq org-par-open nil) - (org-open-par) - (setq inverse nil) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-START" org-line) - (org-close-par-maybe) - (insert "\n<div style=\"text-align: center\">") - (org-open-par) - (throw 'nextline nil)) - (when (equal "ORG-CENTER-END" org-line) - (org-close-par-maybe) - (insert "\n</div>") - (org-open-par) - (throw 'nextline nil)) - (run-hooks 'org-export-html-after-blockquotes-hook) - (when inverse - (let ((i (org-get-string-indentation org-line))) - (if (> i 0) - (setq org-line (concat (mapconcat 'identity - (make-list (* 2 i) "\\nbsp") "") - " " (org-trim org-line)))) - (unless (string-match "\\\\\\\\[ \t]*$" org-line) - (setq org-line (concat org-line "\\\\"))))) - - ;; make targets to anchors - (setq start 0) - (while (string-match - "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" org-line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected org-line) - (setq start (match-end 1))) - ((match-end 2) - (setq org-line (replace-match - (format - "@<a name=\"%s\" id=\"%s\">@</a>" - (org-solidify-link-text (match-string 1 org-line)) - (org-solidify-link-text (match-string 1 org-line))) - t t org-line))) - ((and org-export-with-toc (equal (string-to-char org-line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq org-line (replace-match - (concat "@<span class=\"target\">" - (match-string 1 org-line) "@</span> ") - ;; (concat "@<i>" (match-string 1 org-line) "@</i> ") - t t org-line))) - (t - (setq org-line (replace-match - (concat "@<a name=\"" - (org-solidify-link-text (match-string 1 org-line)) - "\" class=\"target\">" (match-string 1 org-line) - "@</a> ") - t t org-line))))) - - (setq org-line (org-html-handle-time-stamps org-line)) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp org-line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" org-line) - (setq org-line (org-html-expand org-line))) - - ;; Format the links - (setq org-line (org-html-handle-links org-line opt-plist)) - - ;; TODO items - (if (and org-todo-line-regexp - (string-match org-todo-line-regexp org-line) - (match-beginning 2)) - - (setq org-line - (concat (substring org-line 0 (match-beginning 2)) - "<span class=\"" - (if (member (match-string 2 org-line) - org-done-keywords) - "done" "todo") - " " (org-export-html-get-todo-kwd-class-name - (match-string 2 org-line)) - "\">" (match-string 2 org-line) - "</span>" (substring org-line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)\\[\\([0-9]+\\)\\]" org-line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected org-line) - (not (get-text-property (match-beginning 2) 'org-footnote org-line))) - (setq start (match-end 2)) - (let ((n (match-string 2 org-line)) extra a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq extra (format ".%d" (cdr a)))) - (setq extra "") - (push (cons n 1) footref-seen)) - (setq org-line - (replace-match - (concat - (format - (concat "%s" - (format org-export-html-footnote-format - (concat "<a class=\"footref\" name=\"" footnote-ref-prefix ".%s%s\" href=\"#" footnote-def-prefix ".%s\">%s</a>"))) - (or (match-string 1 org-line) "") n extra n n) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring org-line (match-end 0)))) - org-export-html-footnote-separator - "")) - t t org-line)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" org-line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (or (match-string 2 org-line) "")) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (setq first-heading-pos (or first-heading-pos (point))) - (org-html-level-start level txt umax - (and org-export-with-toc (<= level umax)) - head-count opt-plist) - - ;; QUOTES - (when (string-match quote-re org-line) - (org-close-par-maybe) - (insert "<pre>") - (setq inquote t))) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" org-line)) - (when (not table-open) - ;; New table starts - (setq table-open t table-buffer nil table-orig-buffer nil)) - - ;; Accumulate lines - (setq table-buffer (cons org-line table-buffer) - table-orig-buffer (cons origline table-orig-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer) - table-orig-buffer (nreverse table-orig-buffer)) - (org-close-par-maybe) - (insert (org-format-table-html table-buffer table-orig-buffer)))) - - ;; Normal lines - - (t - ;; This line either is list item or end a list. - (when (get-text-property 0 'list-item org-line) - (setq org-line (org-html-export-list-line - org-line - (get-text-property 0 'list-item org-line) - (get-text-property 0 'list-struct org-line) - (get-text-property 0 'list-prevs org-line)))) - - ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" org-line) - (if org-par-open - (insert "\n</p>\n<hr/>\n<p>\n") - (insert "\n<hr/>\n")) - (throw 'nextline nil)) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (if (string-match "^ [-+*]-\\|^[ \t]*$" org-line) (org-open-par)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - org-line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" org-line) - (org-close-par-maybe) - (let ((n (match-string 1 org-line))) - (setq org-par-open t - org-line (replace-match - (format - (concat "<p class=\"footnote\">" - (format org-export-html-footnote-format - (concat - "<a class=\"footnum\" name=\"" footnote-def-prefix ".%s\" href=\"#" footnote-ref-prefix ".%s\">%s</a>"))) - n n n) t t org-line))))) - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" org-line) - (setq org-line (replace-match "<br/>" t t org-line))) - (org-export-preserve-breaks - (setq org-line (concat org-line "<br/>")))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-par-open - (string-match "\\\\par\\>" org-line start)) - ;; Leave a space in the </p> so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected org-line)) - (setq org-line (replace-match "</p ><p >" t t org-line))) - (setq start (match-end 0)))) - - (insert org-line "\n"))))) - - ;; Properly close all local lists and other lists - (when inquote - (insert "</pre>\n") - (org-open-par)) - - (org-html-level-start 1 nil umax - (and org-export-with-toc (<= level umax)) - head-count opt-plist) - ;; the </div> to close the last text-... div. - (when (and (> umax 0) first-heading-pos) (insert "</div>\n")) - - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - "\\(\\(<p class=\"footnote\">\\)[^\000]*?\\)\\(\\(\\2\\)\\|\\'\\)" - nil t) - (push (match-string 1) footnotes) - (replace-match "\\4" t nil) - (goto-char (match-beginning 0)))) - (when footnotes - (insert (format org-export-html-footnotes-section - (nth 4 lang-words) - (mapconcat 'identity (nreverse footnotes) "\n")) - "\n")) - (let ((bib (org-export-html-get-bibliography))) - (when bib - (insert "\n" bib "\n"))) - - (unless body-only - ;; end wrap around body - (insert "</div>\n") - - ;; export html postamble - (let ((html-post (plist-get opt-plist :html-postamble)) - (email - (mapconcat (lambda(e) - (format "<a href=\"mailto:%s\">%s</a>" e e)) - (split-string email ",+ *") - ", ")) - (creator-info - (concat "<a href=\"http://orgmode.org\">Org</a> version " - (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version " - (number-to-string emacs-major-version)))) - - (when (plist-get opt-plist :html-postamble) - (insert "\n<div id=\"" (nth 2 org-export-html-divs) "\">\n") - (cond ((stringp html-post) - (insert (format-spec html-post - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link))))) - ((functionp html-post) - (if (stringp (funcall html-post)) (insert (funcall html-post)))) - ((eq html-post 'auto) - ;; fall back on default postamble - (when (plist-get opt-plist :time-stamp-file) - (insert "<p class=\"date\">" (nth 2 lang-words) ": " date "</p>\n")) - (when (and (plist-get opt-plist :author-info) author) - (insert "<p class=\"author\">" (nth 1 lang-words) ": " author "</p>\n")) - (when (and (plist-get opt-plist :email-info) email) - (insert "<p class=\"email\">" email "</p>\n")) - (when (plist-get opt-plist :creator-info) - (insert "<p class=\"creator\">" - (concat "<a href=\"http://orgmode.org\">Org</a> version " - (org-version) " with <a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> version " - (number-to-string emacs-major-version) "</p>\n"))) - (insert html-validation-link "\n")) - (t - (insert (format-spec - (or (cadr (assoc (nth 0 lang-words) - org-export-html-postamble-format)) - (cadr (assoc "en" org-export-html-postamble-format))) - `((?a . ,author) (?e . ,email) - (?d . ,date) (?c . ,creator-info) - (?v . ,html-validation-link)))))) - (insert "\n</div>")))) - - ;; FIXME `org-export-html-with-timestamp' has been declared - ;; obsolete since Org 7.7 -- don't forget to remove this. - (if org-export-html-with-timestamp - (insert org-export-html-html-helper-timestamp)) - - (unless body-only (insert "\n</body>\n</html>\n")) - - (unless (plist-get opt-plist :buffer-will-be-killed) - (normal-mode) - (if (eq major-mode (default-value 'major-mode)) - (html-mode))) - - ;; insert the table of contents - (goto-char (point-min)) - (when thetoc - (if (or (re-search-forward - "<p>\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*</p>" nil t) - (re-search-forward - "\\[TABLE-OF-CONTENTS\\]" nil t)) - (progn - (goto-char (match-beginning 0)) - (replace-match "")) - (goto-char first-heading-pos) - (when (looking-at "\\s-*</p>") - (goto-char (match-end 0)) - (insert "\n"))) - (insert "<div id=\"table-of-contents\">\n") - (let ((beg (point))) - (mapc 'insert thetoc) - (insert "</div>\n") - (while (re-search-backward "<li>[ \r\n\t]*</li>\n?" beg t) - (replace-match "")))) - ;; remove empty paragraphs - (goto-char (point-min)) - (while (re-search-forward "<p>[ \r\n\t]*</p>" nil t) - (replace-match "")) - (goto-char (point-min)) - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "<span style=\"visibility:hidden;\">%s</span>" - (make-string n ?x))))) - ;; Remove empty lines at the beginning of the file. - (goto-char (point-min)) - (when (looking-at "\\s-+\n") (replace-match "")) - ;; Remove display properties - (remove-text-properties (point-min) (point-max) '(display t)) - ;; Run the hook - (run-hooks 'org-export-html-final-hook) - (or to-buffer (save-buffer)) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "HTML") - (message "Exporting... done")) - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer))))) - -(defun org-export-html-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-export-html-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-html-do-expand s)) - s)) - -(defun org-export-html-format-image (src par-open) - "Create image tag with source and attributes." - (save-match-data - (if (string-match (regexp-quote org-latex-preview-ltxpng-directory) src) - (format "<img src=\"%s\" alt=\"%s\"/>" - src (org-find-text-property-in-string 'org-latex-src src)) - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src))) - (setq caption (and caption (org-html-do-expand caption))) - (concat - (if caption - (format "%s<div %sclass=\"figure\"> -<p>" - (if org-par-open "</p>\n" "") - (if label (format "id=\"%s\" " (org-solidify-link-text label)) ""))) - (format "<img src=\"%s\"%s />" - src - (if (string-match "\\<alt=" (or attr "")) - (concat " " attr ) - (concat " " attr " alt=\"" src "\""))) - (if caption - (format "</p>%s -</div>%s" - (concat "\n<p>" caption "</p>") - (if org-par-open "\n<p>" "")))))))) - -(defun org-export-html-get-bibliography () - "Find bibliography, cut it out and return it." - (catch 'exit - (let (beg end (cnt 1) bib) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^[ \t]*<div \\(id\\|class\\)=\"bibliography\"" nil t) - (setq beg (match-beginning 0)) - (while (re-search-forward "</?div\\>" nil t) - (setq cnt (+ cnt (if (string= (match-string 0) "<div") +1 -1))) - (when (= cnt 0) - (and (looking-at ">") (forward-char 1)) - (setq bib (buffer-substring beg (point))) - (delete-region beg (point)) - (throw 'exit bib)))) - nil)))) - -(defvar org-table-number-regexp) ; defined in org-table.el -(defun org-format-table-html (lines olines &optional no-css) - "Find out which HTML converter to use and return the HTML code. -NO-CSS is passed to the exporter." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-format-org-table-html lines nil no-css) - ;; Table made by table.el - (or (org-format-table-table-html-using-table-generate-source - olines (not org-export-prefer-native-exporter-for-tables)) - ;; We are here only when table.el table has NO col or row - ;; spanning and the user prefers using org's own converter for - ;; exporting of such simple table.el tables. - (org-format-table-table-html lines)))) - -(defvar org-table-number-fraction) ; defined in org-table.el -(defun org-format-org-table-html (lines &optional splice no-css) - "Format a table into HTML. -LINES is a list of lines. Optional argument SPLICE means, do not -insert header and surrounding <table> tags, just format the lines. -Optional argument NO-CSS means use XHTML attributes instead of CSS -for formatting. This is required for the DocBook exporter." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - - (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) - (label (org-find-text-property-in-string 'org-label (car lines))) - (col-cookies (org-find-text-property-in-string 'org-col-cookies - (car lines))) - (attributes (org-find-text-property-in-string 'org-attributes - (car lines))) - (html-table-tag (org-export-splice-attributes - html-table-tag attributes)) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines))))) - (nline 0) fnum nfields i (cnt 0) - tbopen org-line fields html gr colgropen rowstart rowend - ali align aligns n) - (setq caption (and caption (org-html-do-expand caption))) - (when (and col-cookies org-table-clean-did-remove-column) - (setq col-cookies - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) - (if splice (setq head nil)) - (unless splice (push (if head "<thead>" "<tbody>") html)) - (setq tbopen t) - (while (setq org-line (pop lines)) - (catch 'next-line - (if (string-match "^[ \t]*|-" org-line) - (progn - (unless splice - (push (if head "</thead>" "</tbody>") html) - (if lines (push "<tbody>" html) (setq tbopen nil))) - (setq head nil) ;; head ends here, first time around - ;; ignore this line - (throw 'next-line t))) - ;; Break the line into fields - (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) - (unless fnum (setq fnum (make-vector (length fields) 0) - nfields (length fnum))) - (setq nline (1+ nline) i -1 - rowstart (eval (car org-export-table-row-tags)) - rowend (eval (cdr org-export-table-row-tags))) - (push (concat rowstart - (mapconcat - (lambda (x) - (setq i (1+ i) ali (format "@@class%03d@@" i)) - (if (and (< i nfields) ; make sure no rogue line causes an error here - (string-match org-table-number-regexp x)) - (incf (aref fnum i))) - (cond - (head - (concat - (format (car org-export-table-header-tags) - "col" ali) - x - (cdr org-export-table-header-tags))) - ((and (= i 0) org-export-html-table-use-header-tags-for-first-column) - (concat - (format (car org-export-table-header-tags) - "row" ali) - x - (cdr org-export-table-header-tags))) - (t - (concat (format (car org-export-table-data-tags) ali) - x - (cdr org-export-table-data-tags))))) - fields "") - rowend) - html))) - (unless splice (if tbopen (push "</tbody>" html))) - (unless splice (push "</table>\n" html)) - (setq html (nreverse html)) - (unless splice - ;; Put in col tags with the alignment (unfortunately often ignored...) - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - (setq i 0) - (push (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info) - i (1+ i) - align (if (nth 1 (assoc i col-cookies)) - (cdr (assoc (nth 1 (assoc i col-cookies)) - '(("l" . "left") ("r" . "right") - ("c" . "center")))) - (if (> (/ (float x) nline) - org-table-number-fraction) - "right" "left"))) - (push align aligns) - (format (if no-css - "%s<col align=\"%s\" />%s" - "%s<col class=\"%s\" />%s") - (if (memq gr '(:start :startend)) - (prog1 - (if colgropen - "</colgroup>\n<colgroup>" - "<colgroup>") - (setq colgropen t)) - "") - align - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "</colgroup>") - ""))) - fnum "") - html) - (setq aligns (nreverse aligns)) - (if colgropen (setq html (cons (car html) - (cons "</colgroup>" (cdr html))))) - ;; Since the output of HTML table formatter can also be used in - ;; DocBook document, include empty captions for the DocBook - ;; export only so that it produces valid XML. - (when (or caption (eq org-export-current-backend 'docbook)) - (push (format "<caption>%s</caption>" (or caption "")) html)) - (when label - (setq html-table-tag (org-export-splice-attributes html-table-tag (format "id=\"%s\"" (org-solidify-link-text label))))) - (push html-table-tag html)) - (setq html (mapcar - (lambda (x) - (replace-regexp-in-string - "@@class\\([0-9]+\\)@@" - (lambda (txt) - (if (not org-export-html-table-align-individual-fields) - "" - (setq n (string-to-number (match-string 1 txt))) - (format (if no-css " align=\"%s\"" " class=\"%s\"") - (or (nth n aligns) "left")))) - x)) - html)) - (concat (mapconcat 'identity html "\n") "\n"))) - -(defun org-export-splice-attributes (tag attributes) - "Read attributes in string ATTRIBUTES, add and replace in HTML tag TAG." - (if (not attributes) - tag - (let (oldatt newatt) - (setq oldatt (org-extract-attributes-from-string tag) - tag (pop oldatt) - newatt (cdr (org-extract-attributes-from-string attributes))) - (while newatt - (setq oldatt (plist-put oldatt (pop newatt) (pop newatt)))) - (if (string-match ">" tag) - (setq tag - (replace-match (concat (org-attributes-to-string oldatt) ">") - t t tag))) - tag))) - -(defun org-format-table-table-html (lines) - "Format a table generated by table.el into HTML. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (org-line field-buffer - (head org-export-highlight-first-table-line) - fields html empty i) - (setq html (concat html-table-tag "\n")) - (while (setq org-line (pop lines)) - (setq empty " ") - (catch 'next-line - (if (string-match "^[ \t]*\\+-" org-line) - (progn - (if field-buffer - (progn - (setq - html - (concat - html - "<tr>" - (mapconcat - (lambda (x) - (if (equal x "") (setq x empty)) - (if head - (concat - (format (car org-export-table-header-tags) "col" "") - x - (cdr org-export-table-header-tags)) - (concat (format (car org-export-table-data-tags) "") x - (cdr org-export-table-data-tags)))) - field-buffer "\n") - "</tr>\n")) - (setq head nil) - (setq field-buffer nil))) - ;; Ignore this line - (throw 'next-line t))) - ;; Break the line into fields and store the fields - (setq fields (org-split-string org-line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x "<br/>" (pop fields))) - field-buffer)) - (setq field-buffer fields)))) - (setq html (concat html "</table>\n")) - html)) - -(defun org-format-table-table-html-using-table-generate-source (lines - &optional - spanned-only) - "Format a table into html, using `table-generate-source' from table.el. -Use SPANNED-ONLY to suppress exporting of simple table.el tables. - -When SPANNED-ONLY is nil, all table.el tables are exported. When -SPANNED-ONLY is non-nil, only tables with either row or column -spans are exported. - -This routine returns the generated source or nil as appropriate. - -Refer docstring of `org-export-prefer-native-exporter-for-tables' -for further information." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (when (or (not spanned-only) - (let* ((dim (table-query-dimension)) - (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) - (not (= (* c r) cells)))) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (table-generate-source 'html " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max))))) - -(defun org-export-splice-style (style extra) - "Splice EXTRA into STYLE, just before \"</style>\"." - (if (and (stringp extra) - (string-match "\\S-" extra) - (string-match "</style>" style)) - (concat (substring style 0 (match-beginning 0)) - "\n" extra "\n" - (substring style (match-beginning 0))) - style)) - -(defun org-html-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (when org-maybe-keyword-time-regexp - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) - " @<span class=\"timestamp-wrapper\">" - (if (match-end 1) - (format "@<span class=\"timestamp-kwd\">%s @</span>" - (match-string 1 s))) - (format " @<span class=\"timestamp\">%s@</span>" - (substring - (org-translate-time (match-string 3 s)) 1 -1)) - "@</span>") - s (substring s (match-end 0))))) - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r "@<br/>"))) - r)))) - -(defvar htmlize-buffer-places) ; from htmlize.el -(defun org-export-htmlize-region-for-paste (beg end) - "Convert the region to HTML, using htmlize.el. -This is much like `htmlize-region-for-paste', only that it uses -the settings define in the org-... variables." - (let* ((htmlize-output-type org-export-htmlize-output-type) - (htmlize-css-name-prefix org-export-htmlize-css-font-prefix) - (htmlbuf (htmlize-region beg end))) - (unwind-protect - (with-current-buffer htmlbuf - (buffer-substring (plist-get htmlize-buffer-places 'content-start) - (plist-get htmlize-buffer-places 'content-end))) - (kill-buffer htmlbuf)))) - -(defun org-export-htmlize-generate-css () - "Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-export-htmlize-output-type' to `css', calls to -the function `org-export-htmlize-region-for-paste' will produce code -that uses these same face definitions." - (interactive) - (require 'htmlize) - (and (get-buffer "*html*") (kill-buffer "*html*")) - (with-temp-buffer - (let ((fl (face-list)) - (htmlize-css-name-prefix "org-") - (htmlize-output-type 'css) - f i) - (while (setq f (pop fl) - i (and f (face-attribute f :inherit))) - (when (and (symbolp f) (or (not i) (not (listp i)))) - (insert (org-add-props (copy-sequence "1") nil 'face f)))) - (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") - (goto-char (point-min)) - (if (re-search-forward "<style" nil t) - (delete-region (point-min) (match-beginning 0))) - (if (re-search-forward "</style>" nil t) - (delete-region (1+ (match-end 0)) (point-max))) - (beginning-of-line 1) - (if (looking-at " +") (replace-match "")) - (goto-char (point-min))) - -(defun org-html-protect (s) - "Convert characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (let ((cl org-export-html-protect-char-alist) c) - (while (setq c (pop cl)) - (let ((start 0)) - (while (string-match (car c) s start) - (setq s (replace-match (cdr c) t t s) - start (1+ (match-beginning 0)))))) - s)) - -(defun org-html-expand (string) - "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these. If STRING -is nil, return nil." - (when string - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-html-do-expand s) res) - (push l res)) - (push (org-html-do-expand string) res) - (apply 'concat (nreverse res))))) - -(defun org-html-do-expand (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-html-protect s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-export-html-convert-emphasize s))) - (if org-export-with-special-strings - (setq s (org-export-html-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-export-html-convert-sub-super s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-entity-get-representation wd 'html)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-export-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-export-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-export-html-convert-sub-super (string) - "Convert sub- and superscripts in STRING to HTML." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") "sub" "sup") - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - "<" key ">" c "</" key ">") - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defun org-export-html-convert-emphasize (string) - "Apply emphasis." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (nth 2 (assoc (match-string 3 string) org-emphasis-alist)) - (match-string 4 string) - (nth 3 (assoc (match-string 3 string) - org-emphasis-alist)) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-open-par () - "Insert <p>, but first close previous paragraph if any." - (org-close-par-maybe) - (insert "\n<p>") - (setq org-par-open t)) -(defun org-close-par-maybe () - "Close paragraph if there is one open." - (when org-par-open - (insert "</p>") - (setq org-par-open nil))) -(defun org-close-li (&optional type) - "Close <li> if necessary." - (org-close-par-maybe) - (insert (if (equal type "d") "</dd>\n" "</li>\n"))) - -(defvar body-only) ; dynamically scoped into this. -(defun org-html-level-start (level title umax with-toc head-count &optional opt-plist) - "Insert a new level in HTML export. -When TITLE is nil, just close all open levels." - (org-close-par-maybe) - (let* ((target (and title (org-get-text-property-any 0 'target title))) - (extra-targets (and target - (assoc target org-export-target-aliases))) - (extra-class (and title (org-get-text-property-any 0 'html-container-class title))) - (preferred (and target - (cdr (assoc target org-export-preferred-target-alist)))) - (l org-level-max) - (num (plist-get opt-plist :section-numbers)) - snumber snu href suffix) - (setq extra-targets (remove (or preferred target) extra-targets)) - (setq extra-targets - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (if (stringp org-export-html-headline-anchor-format) - (format org-export-html-headline-anchor-format x x) - "")) - extra-targets - "")) - (while (>= l level) - (if (aref org-levels-open (1- l)) - (progn - (org-html-level-close l umax) - (aset org-levels-open (1- l) nil))) - (setq l (1- l))) - (when title - ;; If title is nil, this means this function is called to close - ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq title (replace-match - (if org-export-with-tags - (save-match-data - (concat - " <span class=\"tag\">" - (mapconcat - (lambda (x) - (format "<span class=\"%s\">%s</span>" - (org-export-html-get-tag-class-name x) - x)) - (org-split-string (match-string 1 title) ":") - " ") - "</span>")) - "") - t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (progn - (org-close-li) - (if target - (insert (format "<li id=\"%s\">" (org-solidify-link-text (or preferred target))) - extra-targets title "<br/>\n") - (insert "<li>" title "<br/>\n"))) - (aset org-levels-open (1- level) t) - (org-close-par-maybe) - (if target - (insert (format "<ul>\n<li id=\"%s\">" (org-solidify-link-text (or preferred target))) - extra-targets title "<br/>\n") - (insert "<ul>\n<li>" title "<br/>\n")))) - (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level) - snu (replace-regexp-in-string "\\." "-" snumber)) - (setq level (+ level org-export-html-toplevel-hlevel -1)) - (if (and num (not body-only)) - (setq title (concat - (format "<span class=\"section-number-%d\">%s</span>" - level - (if (and num - (if (integerp num) - ;; fix up num to take into - ;; account the top-level - ;; heading value - (>= (+ num org-export-html-toplevel-hlevel -1) - level) - num)) - snumber - "")) - " " title))) - (unless (= head-count 1) (insert "\n</div>\n")) - (setq href (cdr (assoc (concat "sec-" snu) org-export-preferred-target-alist))) - (setq suffix (org-solidify-link-text (or href snu))) - (setq href (org-solidify-link-text (or href (concat "sec-" snu)))) - (insert (format "\n<div id=\"outline-container-%s\" class=\"outline-%d%s\">\n<h%d id=\"%s\">%s%s</h%d>\n<div class=\"outline-text-%d\" id=\"text-%s\">\n" - suffix level (if extra-class (concat " " extra-class) "") - level href - extra-targets - title level level suffix)) - (org-open-par))))) - -(defun org-export-html-get-tag-class-name (tag) - "Turn tag into a valid class name. -Replaces invalid characters with \"_\" and then prepends a prefix." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" tag) - (setq tag (replace-match "_" t t tag)))) - (concat org-export-html-tag-class-prefix tag)) - -(defun org-export-html-get-todo-kwd-class-name (kwd) - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\" and then prepends a prefix." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - (concat org-export-html-todo-kwd-class-prefix kwd)) - -(defun org-html-level-close (level max-outline-level) - "Terminate one level in HTML export." - (if (<= level max-outline-level) - (insert "</div>\n") - (org-close-li) - (insert "</ul>\n"))) - -(defun org-html-export-list-line (org-line pos struct prevs) - "Insert list syntax in export buffer. Return ORG-LINE, maybe modified. - -POS is the item position or org-line position the org-line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "d", "o" or - ;; "u". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "o") - ((eq 'descriptive type) "d") - (t "u")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - (org-close-par-maybe) - ;; Ending for every item - (org-close-li type) - ;; We're ending last item of the list: end list. - (when lastp - (insert (format "</%sl>\n" type)) - (org-open-par)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") org-line) - (let* ((checkbox (match-string 3 org-line)) - (desc-tag (or (match-string 4 org-line) "???")) - (body (or (match-string 5 org-line) "")) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - (when firstp - (org-close-par-maybe) - (insert (format "<%sl>\n" type))) - (insert (cond - ((equal type "d") - (format "<dt>%s</dt><dd>" desc-tag)) - ((and (equal type "o") counter) - (format "<li value=\"%s\">" counter)) - (t "<li>"))) - ;; If line had a checkbox, some additional modification is required. - (when checkbox - (setq body - (concat - (cond - ((string-match "X" checkbox) "<code>[X]</code> ") - ((string-match " " checkbox) "<code>[ ]</code> ") - (t "<code>[-]</code> ")) - body))) - ;; Return modified line - body)) - ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t org-line)))) - -(provide 'org-html) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-html.el ends here diff --git a/lisp/org/org-icalendar.el b/lisp/org/org-icalendar.el deleted file mode 100644 index 12cd0584fa..0000000000 --- a/lisp/org/org-icalendar.el +++ /dev/null @@ -1,692 +0,0 @@ -;;; org-icalendar.el --- iCalendar export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;;; Code: - -(require 'org-exp) - -(eval-when-compile (require 'cl)) - -(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export of Org-mode files." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-combined-agenda-icalendar-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-export-icalendar-all-agenda-files]. -The file name should be absolute, the file will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-alarm-time 0 - "Number of minutes for triggering an alarm for exported timed events. -A zero value (the default) turns off the definition of an alarm trigger -for timed events. If non-zero, alarms are created. - -- a single alarm per entry is defined -- The alarm will go off N minutes before the event -- only a DISPLAY action is defined." - :group 'org-export-icalendar - :version "24.1" - :type 'integer) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defcustom org-icalendar-combined-description nil - "Calendar description for the combined iCalendar (all agenda files)." - :group 'org-export-icalendar - :version "24.1" - :type 'string) - -(defcustom org-icalendar-use-plain-timestamp t - "Non-nil means make an event from every plain time stamp." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-honor-noexport-tag nil - "Non-nil means don't export entries with a tag in `org-export-exclude-tags'." - :group 'org-export-icalendar - :version "24.1" - :type 'boolean) - -(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) - "Contexts where iCalendar export should use a deadline time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Deadlines in TODO entries become calendar events. -event-if-not-todo Deadlines in non-TODO entries become calendar events. -todo-due Use deadlines in TODO entries as due-dates" - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag "Deadlines in non-TODO entries become events" - event-if-not-todo) - (const :tag "Deadline in TODO entries become events" - event-if-todo) - (const :tag "Deadlines in TODO entries become due-dates" - todo-due))) - -(defcustom org-icalendar-use-scheduled '(todo-start) - "Contexts where iCalendar export should use a scheduling time stamp. -This is a list with several symbols in it. Valid symbol are: - -event-if-todo Scheduling time stamps in TODO entries become an event. -event-if-not-todo Scheduling time stamps in non-TODO entries become an event. -todo-start Scheduling time stamps in TODO entries become start date. - Some calendar applications show TODO entries only after - that date." - :group 'org-export-icalendar - :type '(set :greedy t - (const :tag - "SCHEDULED timestamps in non-TODO entries become events" - event-if-not-todo) - (const :tag "SCHEDULED timestamps in TODO entries become events" - event-if-todo) - (const :tag "SCHEDULED in TODO entries become start date" - todo-start))) - -(defcustom org-icalendar-categories '(local-tags category) - "Items that should be entered into the categories field. -This is a list of symbols, the following are valid: - -category The Org-mode category of the current file or tree -todo-state The todo state, if any -local-tags The tags, defined in the current line -all-tags All tags, including inherited ones." - :group 'org-export-icalendar - :type '(repeat - (choice - (const :tag "The file or tree category" category) - (const :tag "The TODO state" todo-state) - (const :tag "Tags defined in current line" local-tags) - (const :tag "All tags, including inherited ones" all-tags)))) - -(defcustom org-icalendar-include-todo nil - "Non-nil means export to iCalendar files should also cover TODO items. -Valid values are: -nil don't include any TODO items -t include all TODO items that are not in a DONE state -unblocked include all TODO items that are not blocked -all include both done and not done items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "Unblocked" unblocked) - (const :tag "All" all))) - -(defvar org-icalendar-verify-function nil - "Function to verify entries for iCalendar export. -This can be set to a function that will be called at each entry that -is considered for export to iCalendar. When the function returns nil, -the entry will be skipped. When it returns a non-nil value, the entry -will be considered for export. -This is used internally when an agenda buffer is exported to an ics file, -to make sure that only entries currently listed in the agenda will end -up in the ics file. But for normal iCalendar export, you can use this -for whatever you need.") - -(defcustom org-icalendar-include-bbdb-anniversaries nil - "Non-nil means a combined iCalendar files should include anniversaries. -The anniversaries are define in the BBDB database." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-sexps t - "Non-nil means export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org-mode file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body 100 - "Amount of text below headline to be included in iCalendar export. -This is a number of characters that should maximally be included. -Properties, scheduling and clocking lines will always be removed. -The text will be inserted into the DESCRIPTION field." - :group 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-store-UID nil - "Non-nil means store any created UIDs in properties. -The iCalendar standard requires that all entries have a unique identifier. -Org will create these identifiers as needed. When this variable is non-nil, -the created UIDs will be stored in the ID property of the entry. Then the -next time this entry is exported, it will be exported with the same UID, -superseding the previous form of it. This is essential for -synchronization services. -This variable is not turned on by default because we want to avoid creating -a property drawer in every entry if people are only playing with this feature, -or if they are only using it locally." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-timezone (getenv "TZ") - "The time zone string for iCalendar export. -When nil or the empty string, use output from \(current-time-zone\)." - :group 'org-export-icalendar - :type '(choice - (const :tag "Unspecified" nil) - (string :tag "Time zone"))) - -;; Backward compatibility with previous variable -(defvar org-icalendar-use-UTC-date-time nil) -(defcustom org-icalendar-date-time-format - (if org-icalendar-use-UTC-date-time - ":%Y%m%dT%H%M%SZ" - ":%Y%m%dT%H%M%S") - "Format-string for exporting icalendar DATE-TIME. -See `format-time-string' for a full documentation. The only -difference is that `org-icalendar-timezone' is used for %Z. - -Interesting value are: - - \":%Y%m%dT%H%M%S\" for local time - - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone - - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" - - :group 'org-export-icalendar - :version "24.1" - :type '(choice - (const :tag "Local time" ":%Y%m%dT%H%M%S") - (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") - (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") - (string :tag "Explicit format"))) - -(defun org-icalendar-use-UTC-date-timep () - (char-equal (elt org-icalendar-date-time-format - (1- (length org-icalendar-date-time-format))) ?Z)) - -;;; iCalendar export - -;;;###autoload -(defun org-export-icalendar-this-file () - "Export current file as an iCalendar file. -The iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (org-export-icalendar nil buffer-file-name)) - -;;;###autoload -(defun org-export-icalendar-all-agenda-files () - "Export all files in the variable `org-agenda-files' to iCalendar .ics files. -Each iCalendar file will be located in the same directory as the Org-mode -file, but with extension `.ics'." - (interactive) - (apply 'org-export-icalendar nil (org-agenda-files t))) - -;;;###autoload -(defun org-export-icalendar-combine-agenda-files () - "Export all files in `org-agenda-files' to a single combined iCalendar file. -The file is stored under the name `org-combined-agenda-icalendar-file'." - (interactive) - (apply 'org-export-icalendar t (org-agenda-files t))) - -(defun org-export-icalendar (combine &rest files) - "Create iCalendar files for all elements of FILES. -If COMBINE is non-nil, combine all calendar entries into a single large -file and store it under the name `org-combined-agenda-icalendar-file'." - (save-excursion - (org-agenda-prepare-buffers files) - (let* ((dir (org-export-directory - :ical (list :publishing-directory - org-export-publishing-directory))) - file ical-file ical-buffer category started org-agenda-new-buffers) - (and (get-buffer "*ical-tmp*") (kill-buffer "*ical-tmp*")) - (when combine - (setq ical-file - (if (file-name-absolute-p org-combined-agenda-icalendar-file) - org-combined-agenda-icalendar-file - (expand-file-name org-combined-agenda-icalendar-file dir)) - ical-buffer (org-get-agenda-file-buffer ical-file)) - (set-buffer ical-buffer) (erase-buffer)) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file)) - (unless combine - (setq ical-file (concat (file-name-as-directory dir) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".ics")) - (setq ical-buffer (org-get-agenda-file-buffer ical-file)) - (with-current-buffer ical-buffer (erase-buffer))) - (setq category (or org-category - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)))) - (if (symbolp category) (setq category (symbol-name category))) - (let ((standard-output ical-buffer)) - (if combine - (and (not started) (setq started t) - (org-icalendar-start-file org-icalendar-combined-name)) - (org-icalendar-start-file category)) - (org-icalendar-print-entries combine) - (when (or (and combine (not files)) (not combine)) - (when (and combine org-icalendar-include-bbdb-anniversaries) - (require 'org-bbdb) - (org-bbdb-anniv-export-ical)) - (org-icalendar-finish-file) - (set-buffer ical-buffer) - (run-hooks 'org-before-save-iCalendar-file-hook) - (save-buffer) - (run-hooks 'org-after-save-iCalendar-file-hook) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))))) - (org-release-buffers org-agenda-new-buffers)))) - -(defvar org-before-save-iCalendar-file-hook nil - "Hook run before an iCalendar file has been saved. -This can be used to modify the result of the export.") - -(defvar org-after-save-iCalendar-file-hook nil - "Hook run after an iCalendar file has been saved. -The iCalendar buffer is still current when this hook is run. -A good way to use this is to tell a desktop calendar application to re-read -the iCalendar file.") - -(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el -(defun org-icalendar-print-entries (&optional combine) - "Print iCalendar entries for the current Org-mode file to `standard-output'. -When COMBINE is non nil, add the category to each line." - (require 'org-agenda) - (let ((re1 (concat org-ts-regexp "\\|<%%([^>\n]+>")) - (re2 (concat "--?-?\\(" org-ts-regexp "\\)")) - (dts (org-icalendar-ts-to-string - (format-time-string (cdr org-time-stamp-formats) (current-time)) - "DTSTART")) - hd ts ts2 state status (inc t) pos b sexp rrule - scheduledp deadlinep todo prefix due start tags - tmp pri categories location summary desc uid alarm alarm-time - (sexp-buffer (get-buffer-create "*ical-tmp*"))) - (org-refresh-category-properties) - (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re1 nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq pos (match-beginning 0) - ts (match-string 0) - tags (org-get-tags-at) - inc t - hd (condition-case nil - (org-icalendar-cleanup-string - (org-get-heading t)) - (error (throw :skip nil))) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new))) - categories (org-export-get-categories) - alarm-time (get-text-property (point) 'org-appt-warntime) - alarm-time (if alarm-time (string-to-number alarm-time) 0) - alarm "" - deadlinep nil scheduledp nil) - (setq tmp (buffer-substring (max (point-min) (- pos org-ds-keyword-length)) pos) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - todo (org-get-todo-state)) - ;; donep (org-entry-is-done-p) - (if (looking-at re2) - (progn - (goto-char (match-end 0)) - (setq ts2 (match-string 1) - inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2)))) - (setq ts2 (if (string-match "[0-9]\\{1,2\\}:[0-9][0-9]-\\([0-9]\\{1,2\\}:[0-9][0-9]\\)" ts) - (progn - (setq inc nil) - (replace-match "\\1" t nil ts)) - ts))) - (when (and (not org-icalendar-use-plain-timestamp) - (not deadlinep) (not scheduledp)) - (throw :skip t)) - ;; don't export entries with a :noexport: tag - (when (and org-icalendar-honor-noexport-tag - (delq nil (mapcar (lambda(x) - (member x org-export-exclude-tags)) tags))) - (throw :skip t)) - (when (and - deadlinep - (if todo - (not (memq 'event-if-todo org-icalendar-use-deadline)) - (not (memq 'event-if-not-todo org-icalendar-use-deadline)))) - (throw :skip t)) - (when (and - scheduledp - (if todo - (not (memq 'event-if-todo org-icalendar-use-scheduled)) - (not (memq 'event-if-not-todo org-icalendar-use-scheduled)))) - (throw :skip t)) - (setq prefix (if deadlinep "DL-" (if scheduledp "SC-" "TS-"))) - (if (or (string-match org-tr-regexp hd) - (string-match org-ts-regexp hd)) - (setq hd (replace-match "" t t hd))) - (if (string-match "\\+\\([0-9]+\\)\\([hdwmy]\\)>" ts) - (setq rrule - (concat "\nRRULE:FREQ=" - (cdr (assoc - (match-string 2 ts) - '(("h" . "HOURLY")("d" . "DAILY")("w" . "WEEKLY") - ("m" . "MONTHLY")("y" . "YEARLY")))) - ";INTERVAL=" (match-string 1 ts))) - (setq rrule "")) - (setq summary (or summary hd)) - ;; create an alarm entry if the entry is timed. this is not very general in that: - ;; (a) only one alarm per entry is defined, - ;; (b) only minutes are allowed for the trigger period ahead of the start time, and - ;; (c) only a DISPLAY action is defined. - ;; [ESF] - (let ((t1 (ignore-errors (org-parse-time-string ts 'nodefault)))) - (if (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) - (car t1) (nth 1 t1) (nth 2 t1)) - (setq alarm (format "\nBEGIN:VALARM\nACTION:DISPLAY\nDESCRIPTION:%s\nTRIGGER:-P0DT0H%dM0S\nEND:VALARM" - summary (or alarm-time org-icalendar-alarm-time))) - (setq alarm ""))) - (if (string-match org-bracket-link-regexp summary) - (setq summary - (replace-match (if (match-end 3) - (match-string 3 summary) - (match-string 1 summary)) - t t summary))) - (if deadlinep (setq summary (concat "DL: " summary))) - (if scheduledp (setq summary (concat "S: " summary))) - (if (string-match "\\`<%%" ts) - (with-current-buffer sexp-buffer - (let ((entry (substring ts 1 -1))) - (put-text-property 0 1 'uid - (concat " " prefix uid) entry) - (insert entry " " summary "\n"))) - (princ (format "BEGIN:VEVENT -UID: %s -%s -%s%s -SUMMARY:%s%s%s -CATEGORIES:%s%s -END:VEVENT\n" - (concat prefix uid) - (org-icalendar-ts-to-string ts "DTSTART") - (org-icalendar-ts-to-string ts2 "DTEND" inc) - rrule summary - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - categories - alarm))))) - (when (and org-icalendar-include-sexps - (condition-case nil (require 'icalendar) (error nil)) - (fboundp 'icalendar-export-region)) - ;; Get all the literal sexps - (goto-char (point-min)) - (while (re-search-forward "^&?%%(" nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq b (match-beginning 0)) - (goto-char (1- (match-end 0))) - (forward-sexp 1) - (end-of-line 1) - (setq sexp (buffer-substring b (point))) - (with-current-buffer sexp-buffer - (insert sexp "\n")))) - (princ (org-diary-to-ical-string sexp-buffer)) - (kill-buffer sexp-buffer)) - - (when org-icalendar-include-todo - (setq prefix "TODO-") - (goto-char (point-min)) - (while (re-search-forward org-complex-heading-regexp nil t) - (catch :skip - (org-agenda-skip) - (when org-icalendar-verify-function - (unless (save-match-data - (funcall org-icalendar-verify-function)) - (outline-next-heading) - (backward-char 1) - (throw :skip nil))) - (setq state (match-string 2)) - (setq status (if (member state org-done-keywords) - "COMPLETED" "NEEDS-ACTION")) - (when (and state - (cond - ;; check if the state is one we should use - ((eq org-icalendar-include-todo 'all) - ;; all should be included - t) - ((eq org-icalendar-include-todo 'unblocked) - ;; only undone entries that are not blocked - (and (member state org-not-done-keywords) - (or (not org-blocker-hook) - (save-match-data - (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point-at-bol) - :from 'todo - :to 'done)))))) - ((eq org-icalendar-include-todo t) - ;; include everything that is not done - (member state org-not-done-keywords)))) - (setq hd (match-string 4) - summary (org-icalendar-cleanup-string - (org-entry-get nil "SUMMARY")) - desc (org-icalendar-cleanup-string - (or (org-entry-get nil "DESCRIPTION") - (and org-icalendar-include-body (org-get-entry))) - t org-icalendar-include-body) - location (org-icalendar-cleanup-string - (org-entry-get nil "LOCATION" 'selective)) - due (and (member 'todo-due org-icalendar-use-deadline) - (org-entry-get nil "DEADLINE")) - start (and (member 'todo-start org-icalendar-use-scheduled) - (org-entry-get nil "SCHEDULED")) - categories (org-export-get-categories) - uid (if org-icalendar-store-UID - (org-id-get-create) - (or (org-id-get) (org-id-new)))) - (and due (setq due (org-icalendar-ts-to-string due "DUE"))) - (and start (setq start (org-icalendar-ts-to-string start "DTSTART"))) - - (if (string-match org-bracket-link-regexp hd) - (setq hd (replace-match (if (match-end 3) (match-string 3 hd) - (match-string 1 hd)) - t t hd))) - (if (string-match org-priority-regexp hd) - (setq pri (string-to-char (match-string 2 hd)) - hd (concat (substring hd 0 (match-beginning 1)) - (substring hd (match-end 1)))) - (setq pri org-default-priority)) - (setq pri (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority org-highest-priority)))))) - - (princ (format "BEGIN:VTODO -UID: %s -%s -SUMMARY:%s%s%s%s -CATEGORIES:%s -SEQUENCE:1 -PRIORITY:%d -STATUS:%s -END:VTODO\n" - (concat prefix uid) - (or start dts) - (or summary hd) - (if (and location (string-match "\\S-" location)) - (concat "\nLOCATION: " location) "") - (if (and desc (string-match "\\S-" desc)) - (concat "\nDESCRIPTION: " desc) "") - (if due (concat "\n" due) "") - categories - pri status))))))))) - -(defun org-export-get-categories () - "Get categories according to `org-icalendar-categories'." - (let ((cs org-icalendar-categories) c rtn tmp) - (while (setq c (pop cs)) - (cond - ((eq c 'category) (push (org-get-category) rtn)) - ((eq c 'todo-state) - (setq tmp (org-get-todo-state)) - (and tmp (push tmp rtn))) - ((eq c 'local-tags) - (setq rtn (append (nreverse (org-get-local-tags-at (point))) rtn))) - ((eq c 'all-tags) - (setq rtn (append (nreverse (org-get-tags-at (point))) rtn))))) - (mapconcat 'identity (nreverse rtn) ","))) - -(defun org-icalendar-cleanup-string (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s)))) - (setq s (replace-regexp-in-string "[[:space:]]+" " " s))) - (let ((start 0)) - (while (string-match "\\([,;]\\)" s start) - (setq start (+ (match-beginning 0) 2) - s (replace-match "\\\\\\1" nil nil s)))) - (setq s (org-trim s)) - (when is-body - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s)))) - (if is-body - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - s)) - -(defun org-icalendar-cleanup-string-rfc2455 (s &optional is-body maxlength) - "Take out stuff and quote what needs to be quoted. -When IS-BODY is non-nil, assume that this is the body of an item, clean up -whitespace, newlines, drawers, and timestamps, and cut it down to MAXLENGTH -characters. -This seems to be more like RFC 2455, but it causes problems, so it is -not used right now." - (if (not s) - nil - (if is-body - (let ((re (concat "\\(" org-drawer-regexp "\\)[^\000]*?:END:.*\n?")) - (re2 (concat "^[ \t]*" org-keyword-time-regexp ".*\n?"))) - (while (string-match re s) (setq s (replace-match "" t t s))) - (while (string-match re2 s) (setq s (replace-match "" t t s))) - (setq s (org-trim s)) - (while (string-match "[ \t]*\n[ \t]*" s) - (setq s (replace-match "\\n" t t s))) - (if maxlength - (if (and (numberp maxlength) - (> (length s) maxlength)) - (setq s (substring s 0 maxlength))))) - (setq s (org-trim s))) - (while (string-match "\"" s) (setq s (replace-match "''" t t s))) - (when (string-match "[;,:]" s) (setq s (concat "\"" s "\""))) - s)) - -(defun org-icalendar-start-file (name) - "Start an iCalendar file by inserting the header." - (let ((user user-full-name) - (name (or name "unknown")) - (timezone (if (> (length org-icalendar-timezone) 0) - org-icalendar-timezone - (cadr (current-time-zone)))) - (description org-icalendar-combined-description)) - (princ - (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org-mode//EN -X-WR-TIMEZONE:%s -X-WR-CALDESC:%s -CALSCALE:GREGORIAN\n" name user timezone description)))) - -(defun org-icalendar-finish-file () - "Finish an iCalendar file by inserting the END statement." - (princ "END:VCALENDAR\n")) - -(defun org-icalendar-ts-to-string (s keyword &optional inc) - "Take a time string S and convert it to iCalendar format. -KEYWORD is added in front, to make a complete line like DTSTART.... -When INC is non-nil, increase the hour by two (if time string contains -a time), or the day by one (if it does not contain a time)." - (let ((t1 (ignore-errors (org-parse-time-string s 'nodefault))) - t2 fmt have-time time) - (if (not t1) - "" - (if (and (car t1) (nth 1 t1) (nth 2 t1)) - (setq t2 t1 have-time t) - (setq t2 (org-parse-time-string s))) - (let ((s (car t2)) (mi (nth 1 t2)) (h (nth 2 t2)) - (d (nth 3 t2)) (m (nth 4 t2)) (y (nth 5 t2))) - (when inc - (if have-time - (if org-agenda-default-appointment-duration - (setq mi (+ org-agenda-default-appointment-duration mi)) - (setq h (+ 2 h))) - (setq d (1+ d)))) - (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time - (replace-regexp-in-string "%Z" - org-icalendar-timezone - org-icalendar-date-time-format t) - ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time - (and (org-icalendar-use-UTC-date-timep) - have-time)))))) - -(provide 'org-icalendar) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-icalendar.el ends here diff --git a/lisp/org/org-jsinfo.el b/lisp/org/org-jsinfo.el deleted file mode 100644 index 08c01108b9..0000000000 --- a/lisp/org/org-jsinfo.el +++ /dev/null @@ -1,262 +0,0 @@ -;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 implements the support for Sebastian Rose's JavaScript -;; org-info.js to display an org-mode file exported to HTML in an -;; Info-like way, or using folding similar to the outline structure -;; org org-mode itself. - -;; Documentation for using this module is in the Org manual. The script -;; itself is documented by Sebastian Rose in a file distributed with -;; the script. FIXME: Accurate pointers! - -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org-exp) -(require 'org-html) - -(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt)) -(add-hook 'org-export-options-filters 'org-infojs-handle-options) - -(defgroup org-infojs nil - "Options specific for using org-info.js in HTML export of Org-mode files." - :tag "Org Export HTML INFOJS" - :group 'org-export-html) - -(defcustom org-export-html-use-infojs 'when-configured - "Should Sebastian Rose's Java Script org-info.js be linked into HTML files? -This option can be nil or t to never or always use the script. It can -also be the symbol `when-configured', meaning that the script will be -linked into the export file if and only if there is a \"#+INFOJS_OPT:\" -line in the buffer. See also the variable `org-infojs-options'." - :group 'org-export-html - :group 'org-infojs - :type '(choice - (const :tag "Never" nil) - (const :tag "When configured in buffer" when-configured) - (const :tag "Always" t))) - -(defconst org-infojs-opts-table - '((path PATH "http://orgmode.org/org-info.js") - (view VIEW "info") - (toc TOC :table-of-contents) - (ftoc FIXED_TOC "0") - (tdepth TOC_DEPTH "max") - (sdepth SECTION_DEPTH "max") - (mouse MOUSE_HINT "underline") - (buttons VIEW_BUTTONS "0") - (ltoc LOCAL_TOC "1") - (up LINK_UP :link-up) - (home LINK_HOME :link-home)) - "JavaScript options, long form for script, default values.") - -(defvar org-infojs-options) -(when (and (boundp 'org-infojs-options) - (assq 'runs org-infojs-options)) - (setq org-infojs-options (delq (assq 'runs org-infojs-options) - org-infojs-options))) - -(defcustom org-infojs-options - (mapcar (lambda (x) (cons (car x) (nth 2 x))) - org-infojs-opts-table) - "Options settings for the INFOJS JavaScript. -Each of the options must have an entry in `org-export-html/infojs-opts-table'. -The value can either be a string that will be passed to the script, or -a property. This property is then assumed to be a property that is defined -by the Export/Publishing setup of Org. -The `sdepth' and `tdepth' parameters can also be set to \"max\", which -means to use the maximum value consistent with other options." - :group 'org-infojs - :type - `(set :greedy t :inline t - ,@(mapcar - (lambda (x) - (list 'cons (list 'const (car x)) - '(choice - (symbol :tag "Publishing/Export property") - (string :tag "Value")))) - org-infojs-opts-table))) - -(defcustom org-infojs-template - "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"> -/** - * - * @source: %SCRIPT_PATH - * - * @licstart The following is the entire license notice for the - * JavaScript code in %SCRIPT_PATH. - * - * Copyright (C) 2012-2013 Sebastian Rose - * - * - * The JavaScript code in this tag is free software: you can - * redistribute it and/or modify it under the terms of the GNU - * General Public License (GNU GPL) as published by the Free Software - * Foundation, either version 3 of the License, or (at your option) - * any later version. The code is distributed WITHOUT ANY WARRANTY; - * without even the implied warranty of MERCHANTABILITY or FITNESS - * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - * - * As additional permission under GNU GPL version 3 section 7, you - * may distribute non-source (e.g., minimized or compacted) forms of - * that code without the copy of the GNU GPL normally required by - * section 4, provided you include this license notice and a URL - * through which recipients can access the Corresponding Source. - * - * @licend The above is the entire license notice - * for the JavaScript code in %SCRIPT_PATH. - * - */ -</script> - -<script type=\"text/javascript\"> - -/* -@licstart The following is the entire license notice for the -JavaScript code in this tag. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code in this tag is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code in this tag. -*/ - -<!--/*--><![CDATA[/*><!--*/ -%MANAGER_OPTIONS -org_html_manager.setup(); // activate after the parameters are set -/*]]>*///--> -</script>" - "The template for the export style additions when org-info.js is used. -Option settings will replace the %MANAGER-OPTIONS cookie." - :group 'org-infojs - :type 'string) - -(defun org-infojs-handle-options (exp-plist) - "Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly." - (if (or (not org-export-html-use-infojs) - (and (eq org-export-html-use-infojs 'when-configured) - (or (not (plist-get exp-plist :infojs-opt)) - (string-match "\\<view:nil\\>" - (plist-get exp-plist :infojs-opt))))) - ;; We do not want to use the script - exp-plist - ;; We do want to use the script, set it up - (let ((template org-infojs-template) - (ptoc (plist-get exp-plist :table-of-contents)) - (hlevels (plist-get exp-plist :headline-levels)) - tdepth sdepth s v e opt var val table default) - (setq sdepth hlevels - tdepth hlevels) - (if (integerp ptoc) (setq tdepth (min ptoc tdepth))) - (setq v (plist-get exp-plist :infojs-opt) - table org-infojs-opts-table) - (while (setq e (pop table)) - (setq opt (car e) var (nth 1 e) - default (cdr (assoc opt org-infojs-options))) - (and (symbolp default) (not (memq default '(t nil))) - (setq default (plist-get exp-plist default))) - (if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v)) - (setq val (match-string 1 v)) - (setq val default)) - (cond - ((eq opt 'path) - (setq template - (replace-regexp-in-string "%SCRIPT_PATH" val template t t))) - ((eq opt 'sdepth) - (if (integerp (read val)) - (setq sdepth (min (read val) hlevels)))) - ((eq opt 'tdepth) - (if (integerp (read val)) - (setq tdepth (min (read val) hlevels)))) - (t - (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) s)))) - - ;; Now we set the depth of the *generated* TOC to SDEPTH, because the - ;; toc will actually determine the splitting. How much of the toc will - ;; actually be displayed is governed by the TDEPTH option. - (setq exp-plist (plist-put exp-plist :table-of-contents sdepth)) - - ;; The table of contents should not show more sections then we generate - (setq tdepth (min tdepth sdepth)) - (push (cons "TOC_DEPTH" tdepth) s) - - (setq s (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) (cdr x))) - s "\n")) - (when (and s (> (length s) 0)) - (and (string-match "%MANAGER_OPTIONS" template) - (setq s (replace-match s t t template)) - (setq exp-plist - (plist-put - exp-plist :style-extra - (concat (or (plist-get exp-plist :style-extra) "") "\n" s))))) - ;; This script absolutely needs the table of contents, to we change that - ;; setting - (if (not (plist-get exp-plist :table-of-contents)) - (setq exp-plist (plist-put exp-plist :table-of-contents t))) - ;; Return the modified property list - exp-plist))) - -(defun org-infojs-options-inbuffer-template () - (format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s" - (if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil) - (let ((a (cdr (assoc 'toc org-infojs-options)))) - (cond ((memq a '(nil t)) a) - (t (plist-get (org-infile-export-plist) :table-of-contents)))) - (if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil) - (cdr (assoc 'mouse org-infojs-options)) - (cdr (assoc 'buttons org-infojs-options)) - (cdr (assoc 'path org-infojs-options)))) - -(provide 'org-infojs) -(provide 'org-jsinfo) - -;;; org-jsinfo.el ends here diff --git a/lisp/org/org-latex.el b/lisp/org/org-latex.el deleted file mode 100644 index 609bcbee10..0000000000 --- a/lisp/org/org-latex.el +++ /dev/null @@ -1,2901 +0,0 @@ -;;; org-latex.el --- LaTeX exporter for org-mode -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Emacs Lisp Archive Entry -;; Filename: org-latex.el -;; Author: Bastien Guerry <bzg AT gnu DOT org> -;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com> -;; Keywords: org, wp, tex -;; Description: Converts an org-mode buffer into LaTeX - -;; 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 library implements a LaTeX exporter for org-mode. -;; -;; It is part of Org and will be autoloaded -;; -;; The interactive functions are similar to those of the HTML exporter: -;; -;; M-x `org-export-as-latex' -;; M-x `org-export-as-pdf' -;; M-x `org-export-as-pdf-and-open' -;; M-x `org-export-as-latex-batch' -;; M-x `org-export-as-latex-to-buffer' -;; M-x `org-export-region-as-latex' -;; M-x `org-replace-region-by-latex' -;; -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'footnote) -(require 'org) -(require 'org-exp) -(require 'org-macs) -(require 'org-beamer) - -;;; Variables: -(defvar org-export-latex-class nil) -(defvar org-export-latex-class-options nil) -(defvar org-export-latex-header nil) -(defvar org-export-latex-append-header nil) -(defvar org-export-latex-options-plist nil) -(defvar org-export-latex-todo-keywords-1 nil) -(defvar org-export-latex-complex-heading-re nil) -(defvar org-export-latex-not-done-keywords nil) -(defvar org-export-latex-done-keywords nil) -(defvar org-export-latex-display-custom-times nil) -(defvar org-export-latex-all-targets-re nil) -(defvar org-export-latex-add-level 0) -(defvar org-export-latex-footmark-seen nil - "List of footnotes markers seen so far by exporter.") -(defvar org-export-latex-sectioning "") -(defvar org-export-latex-sectioning-depth 0) -(defvar org-export-latex-special-keyword-regexp - (concat "\\<\\(" org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string"\\)") - "Regexp matching special time planning keywords plus the time after it.") -(defvar org-re-quote) ; dynamically scoped from org.el -(defvar org-commentsp) ; dynamically scoped from org.el - -;;; User variables: - -(defgroup org-export-latex nil - "Options for exporting Org-mode files to LaTeX." - :tag "Org Export LaTeX" - :group 'org-export) - -(defcustom org-export-latex-default-class "article" - "The default LaTeX class." - :group 'org-export-latex - :type '(string :tag "LaTeX class")) - -(defcustom org-export-latex-classes - '(("article" - "\\documentclass[11pt]{article}" - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}") - ("\\paragraph{%s}" . "\\paragraph*{%s}") - ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) - ("report" - "\\documentclass[11pt]{report}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("book" - "\\documentclass[11pt]{book}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("beamer" - "\\documentclass{beamer}" - org-beamer-sectioning - )) - "Alist of LaTeX classes and associated header and structure. -If #+LaTeX_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: - - \(class-name - header-string - (numbered-section . unnumbered-section\) - ...\) - -The header string ------------------ - -The HEADER-STRING is the header that will be inserted into the LaTeX file. -It should contain the \\documentclass macro, and anything else that is needed -for this setup. To this header, the following commands will be added: - -- Calls to \\usepackage for all packages mentioned in the variables - `org-export-latex-default-packages-alist' and - `org-export-latex-packages-alist'. Thus, your header definitions should - avoid to also request these packages. - -- Lines specified via \"#+LaTeX_HEADER:\" - -If you need more control about the sequence in which the header is built -up, or if you want to exclude one of these building blocks for a particular -class, you can use the following macro-like placeholders. - - [DEFAULT-PACKAGES] \\usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \\usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LaTeX_HEADER - [NO-EXTRA] do not include #+LaTeX_HEADER stuff - [BEAMER-HEADER-EXTRA] the beamer extra headers - -So a header like - - \\documentclass{article} - [NO-DEFAULT-PACKAGES] - [EXTRA] - \\providecommand{\\alert}[1]{\\textbf{#1}} - [PACKAGES] - -will omit the default packages, and will include the #+LaTeX_HEADER lines, -then have a call to \\providecommand, and then place \\usepackage commands -based on the content of `org-export-latex-packages-alist'. - -If your header or `org-export-latex-default-packages-alist' inserts -\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be replaced with -a coding system derived from `buffer-file-coding-system'. See also the -variable `org-export-latex-inputenc-alist' for a way to influence this -mechanism. - -The sectioning structure ------------------------- - -The sectioning structure of the class is given by the elements following -the header string. For each sectioning level, a number of strings is -specified. A %s formatter is mandatory in each section string and will -be replaced by the title of the section. - -Instead of a cons cell (numbered . unnumbered), you can also provide a list -of 2 or 4 elements, - - (numbered-open numbered-close) - -or - - (numbered-open numbered-close unnumbered-open unnumbered-close) - -providing opening and closing strings for a LaTeX environment that should -represent the document section. The opening clause should have a %s -to represent the section title. - -Instead of a list of sectioning commands, you can also specify a -function name. That function will be called with two parameters, -the (reduced) level of the headline, and the headline text. The function -must return a cons cell with the (possibly modified) headline text, and the -sectioning list in the cdr." - :group 'org-export-latex - :type '(repeat - (list (string :tag "LaTeX class") - (string :tag "LaTeX header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (list :tag "Environment" - (string :tag "Opening (numbered)") - (string :tag "Closing (numbered)") - (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)")) - (function :tag "Hook computing sectioning")))))) - -(defcustom org-export-latex-inputenc-alist nil - "Alist of inputenc coding system names, and what should really be used. -For example, adding an entry - - (\"utf8\" . \"utf8x\") - -will cause \\usepackage[utf8x]{inputenc} to be used for buffers that -are written as utf8 files." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (cons - (string :tag "Derived from buffer") - (string :tag "Use this instead")))) - - -(defcustom org-export-latex-emphasis-alist - '(("*" "\\textbf{%s}" nil) - ("/" "\\emph{%s}" nil) - ("_" "\\underline{%s}" nil) - ("+" "\\st{%s}" nil) - ("=" "\\protectedtexttt" t) - ("~" "\\verb" t)) - "Alist of LaTeX expressions to convert emphasis fontifiers. -Each element of the list is a list of three elements. -The first element is the character used as a marker for fontification. -The second element is a format string to wrap fontified text with. -If it is \"\\verb\", Org will automatically select a delimiter -character that is not in the string. \"\\protectedtexttt\" will use \\texttt -to typeset and try to protect special characters. -The third element decides whether to protect converted text from other -conversions." - :group 'org-export-latex - :type 'alist) - -(defcustom org-export-latex-title-command "\\maketitle" - "The command used to insert the title just after \\begin{document}. -If this string contains the formatting specification \"%s\" then -it will be used as a format string, passing the title as an -argument." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-import-inbuffer-stuff nil - "Non-nil means define TeX macros for Org's inbuffer definitions. -For example \orgTITLE for #+TITLE." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-date-format - "\\today" - "Format string for \\date{...}." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-todo-keyword-markup "\\textbf{%s}" - "Markup for TODO keywords, as a printf format. -This can be a single format for all keywords, a cons cell with separate -formats for not-done and done states, or an association list with setup -for individual keywords. If a keyword shows up for which there is no -markup defined, the first one in the association list will be used." - :group 'org-export-latex - :type '(choice - (string :tag "Default") - (cons :tag "Distinguish undone and done" - (string :tag "Not-DONE states") - (string :tag "DONE states")) - (repeat :tag "Per keyword markup" - (cons - (string :tag "Keyword") - (string :tag "Markup"))))) - -(defcustom org-export-latex-tag-markup "\\textbf{%s}" - "Markup for tags, as a printf format." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-timestamp-markup "\\textit{%s}" - "A printf format string to be applied to time stamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-timestamp-inactive-markup "\\textit{%s}" - "A printf format string to be applied to inactive time stamps." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-timestamp-keyword-markup "\\texttt{%s}" - "A printf format string to be applied to time stamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-export-latex-href-format "\\href{%s}{%s}" - "A printf format string to be applied to href links. -The format must contain either two %s instances or just one. -If it contains two %s instances, the first will be filled with -the link, the second with the link description. If it contains -only one, the %s will be filled with the link." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-hyperref-format "\\hyperref[%s]{%s}" - "A printf format string to be applied to hyperref links. -The format must contain one or two %s instances. The first one -will be filled with the link, the second with its description." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-hyperref-options-format - "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={Emacs Org-mode version %s}}\n" - "A format string for hyperref options. -When non-nil, it must contain three %s format specifications -which will respectively be replaced by the document's keywords, -its description and the Org's version number, as a string. Set -this option to the empty string if you don't want to include -hyperref options altogether." - :type 'string - :version "24.3" - :group 'org-export-latex) - -(defcustom org-export-latex-footnote-separator "\\textsuperscript{,}\\," - "Text used to separate footnotes." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-quotes - '(("fr" ("\\(\\s-\\|[[(]\\)\"" . "«~") ("\\(\\S-\\)\"" . "~»") ("\\(\\s-\\|(\\)'" . "'")) - ("en" ("\\(\\s-\\|[[(]\\)\"" . "``") ("\\(\\S-\\)\"" . "''") ("\\(\\s-\\|(\\)'" . "`"))) - "Alist for quotes to use when converting english double-quotes. - -The CAR of each item in this alist is the language code. -The CDR of each item in this alist is a list of three CONS: -- the first CONS defines the opening quote; -- the second CONS defines the closing quote; -- the last CONS defines single quotes. - -For each item in a CONS, the first string is a regexp -for allowed characters before/after the quote, the second -string defines the replacement string for this quote." - :group 'org-export-latex - :version "24.1" - :type '(list - (cons :tag "Opening quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")) - (cons :tag "Closing quote" - (string :tag "Regexp for char after ") - (string :tag "Replacement quote ")) - (cons :tag "Single quote" - (string :tag "Regexp for char before") - (string :tag "Replacement quote ")))) - -(defcustom org-export-latex-tables-verbatim nil - "When non-nil, tables are exported verbatim." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-tables-centered t - "When non-nil, tables are exported in a center environment." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-table-caption-above t - "When non-nil, the caption is set above the table. When nil, -the caption is set below the table." - :group 'org-export-latex - :version "24.1" - :type 'boolean) - -(defcustom org-export-latex-tables-column-borders nil - "When non-nil, grouping columns can cause outer vertical lines in tables. -When nil, grouping causes only separation lines between groups." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-tables-tstart nil - "LaTeX command for top rule for tables." - :group 'org-export-latex - :version "24.1" - :type '(choice - (const :tag "Nothing" nil) - (string :tag "String") - (const :tag "Booktabs default: \\toprule" "\\toprule"))) - -(defcustom org-export-latex-tables-hline "\\hline" - "LaTeX command to use for a rule somewhere in the middle of a table." - :group 'org-export-latex - :version "24.1" - :type '(choice - (string :tag "String") - (const :tag "Standard: \\hline" "\\hline") - (const :tag "Booktabs default: \\midrule" "\\midrule"))) - -(defcustom org-export-latex-tables-tend nil - "LaTeX command for bottom rule for tables." - :group 'org-export-latex - :version "24.1" - :type '(choice - (const :tag "Nothing" nil) - (string :tag "String") - (const :tag "Booktabs default: \\bottomrule" "\\bottomrule"))) - -(defcustom org-export-latex-low-levels 'itemize - "How to convert sections below the current level of sectioning. -This is specified by the `org-export-headline-levels' option or the -value of \"H:\" in Org's #+OPTION line. - -This can be either nil (skip the sections), `description', `itemize', -or `enumerate' (convert the sections as the corresponding list type), or -a string to be used instead of \\section{%s}. In this latter case, -the %s stands here for the inserted headline and is mandatory. - -It may also be a list of three string to define a user-defined environment -that should be used. The first string should be the like -\"\\begin{itemize}\", the second should be like \"\\item %s %s\" with up -to two occurrences of %s for the title and a label, respectively. The third -string should be like \"\\end{itemize\"." - :group 'org-export-latex - :type '(choice (const :tag "Ignore" nil) - (const :tag "Convert as descriptive list" description) - (const :tag "Convert as itemized list" itemize) - (const :tag "Convert as enumerated list" enumerate) - (list :tag "User-defined environment" - :value ("\\begin{itemize}" "\\end{itemize}" "\\item %s") - (string :tag "Start") - (string :tag "End") - (string :tag "item")) - (string :tag "Use a section string" :value "\\subparagraph{%s}"))) - -(defcustom org-export-latex-list-parameters - '(:cbon "$\\boxtimes$" :cboff "$\\Box$" :cbtrans "$\\boxminus$") - "Parameters for the LaTeX list exporter. -These parameters will be passed on to `org-list-to-latex', which in turn -will pass them (combined with the LaTeX default list parameters) to -`org-list-to-generic'." - :group 'org-export-latex - :type 'plist) - -(defcustom org-export-latex-verbatim-wrap - '("\\begin{verbatim}\n" . "\\end{verbatim}") - "Environment to be wrapped around a fixed-width section in LaTeX export. -This is a cons with two strings, to be added before and after the -fixed-with text. - -Defaults to \\begin{verbatim} and \\end{verbatim}." - :group 'org-export-translation - :group 'org-export-latex - :type '(cons (string :tag "Open") - (string :tag "Close"))) - -(defcustom org-export-latex-listings nil - "Non-nil means export source code using the listings package. -This package will fontify source code, possibly even with color. -If you want to use this, you also need to make LaTeX use the -listings package, and if you want to have color, the color -package. Just add these to `org-export-latex-packages-alist', -for example using customize, or with something like - - (require 'org-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"listings\")) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"color\")) - -Alternatively, - - (setq org-export-latex-listings 'minted) - -causes source code to be exported using the minted package as -opposed to listings. If you want to use minted, you need to add -the minted package to `org-export-latex-packages-alist', for -example using customize, or with - - (require 'org-latex) - (add-to-list 'org-export-latex-packages-alist '(\"\" \"minted\")) - -In addition, it is necessary to install -pygments (http://pygments.org), and to configure the variable -`org-latex-to-pdf-process' so that the -shell-escape option is -passed to pdflatex. -" - :group 'org-export-latex - :type 'boolean) - -(defcustom org-export-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") - (c "C") (cc "C++") - (fortran "fortran") - (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") - (html "HTML") (xml "XML") - (tex "TeX") (latex "TeX") - (shell-script "bash") - (gnuplot "Gnuplot") - (ocaml "Caml") (caml "Caml") - (sql "SQL") (sqlite "sql")) - "Alist mapping languages to their listing language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language parameter -for the listings package. If the mode name and the listings name are -the same, the language does not need an entry in this list - but it does not -hurt if it is present." - :group 'org-export-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-export-latex-listings-w-names t - "Non-nil means export names of named code blocks. -Code blocks exported with the listings package (controlled by the -`org-export-latex-listings' variable) can be named in the style -of noweb." - :group 'org-export-latex - :version "24.1" - :type 'boolean) - -(defcustom org-export-latex-minted-langs - '((emacs-lisp "common-lisp") - (cc "c++") - (cperl "perl") - (shell-script "bash") - (caml "ocaml")) - "Alist mapping languages to their minted language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language parameter -for the minted package. If the mode name and the listings name are -the same, the language does not need an entry in this list - but it does not -hurt if it is present. - -Note that minted uses all lower case for language identifiers, -and that the full list of language identifiers can be obtained -with: -pygmentize -L lexers -" - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-export-latex-listings-options nil - "Association list of options for the latex listings package. - -These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-export-latex-listings-options - '((\"basicstyle\" \"\\small\") - (\"keywordstyle\" \"\\color{black}\\bfseries\\underbar\"))) - -will typeset the code in a small size font with underlined, bold -black keywords. - -Note that the same options will be applied to blocks of all -languages." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (string :tag "Listings option name ") - (string :tag "Listings option value")))) - -(defcustom org-export-latex-minted-options nil - "Association list of options for the latex minted package. - -These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-export-latex-minted-options - '((\"bgcolor\" \"bg\") (\"frame\" \"lines\"))) - -will result in src blocks being exported with - -\\begin{minted}[bgcolor=bg,frame=lines]{<LANG>} - -as the start of the minted environment. Note that the same -options will be applied to blocks of all languages." - :group 'org-export-latex - :version "24.1" - :type '(repeat - (list - (string :tag "Minted option name ") - (string :tag "Minted option value")))) - -(defvar org-export-latex-custom-lang-environments nil - "Association list mapping languages to language-specific latex - environments used during export of src blocks by the listings - and minted latex packages. For example, - - (setq org-export-latex-custom-lang-environments - '((python \"pythoncode\"))) - - would have the effect that if org encounters begin_src python - during latex export it will output - - \\begin{pythoncode} - <src block body> - \\end{pythoncode}") - -(defcustom org-export-latex-remove-from-headlines - '(:todo nil :priority nil :tags nil) - "A plist of keywords to remove from headlines. OBSOLETE. -Non-nil means remove this keyword type from the headline. - -Don't remove the keys, just change their values. - -Obsolete, this variable is no longer used. Use the separate -variables `org-export-with-todo-keywords', `org-export-with-priority', -and `org-export-with-tags' instead." - :type 'plist - :group 'org-export-latex) - -(defcustom org-export-latex-image-default-option "width=.9\\linewidth" - "Default option for images." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-default-figure-position "htb" - "Default position for latex figures." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-tabular-environment "tabular" - "Default environment used to build tables." - :group 'org-export-latex - :version "24.1" - :type 'string) - -(defcustom org-export-latex-link-with-unknown-path-format "\\texttt{%s}" - "Format string for links with unknown path type." - :group 'org-export-latex - :version "24.3" - :type 'string) - -(defcustom org-export-latex-inline-image-extensions - '("pdf" "jpeg" "jpg" "png" "ps" "eps") - "Extensions of image files that can be inlined into LaTeX. -Note that the image extension *actually* allowed depend on the way the -LaTeX file is processed. When used with pdflatex, pdf, jpg and png images -are OK. When processing through dvi to Postscript, only ps and eps are -allowed. The default we use here encompasses both." - :group 'org-export-latex - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-latex-coding-system nil - "Coding system for the exported LaTeX file." - :group 'org-export-latex - :type 'coding-system) - -(defgroup org-export-pdf nil - "Options for exporting Org-mode files to PDF, via LaTeX." - :tag "Org Export PDF" - :group 'org-export-latex - :group 'org-export) - -(defcustom org-latex-to-pdf-process - '("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file and process latex -fragments to pdf files.By default,this is a list of strings,and each of -strings will be given to the shell as a command. %f in the command will -be replaced by the full file name, %b by the file base name (i.e. without -extension) and %o by the base directory of the file. - -If you set `org-create-formula-image-program' -`org-export-with-LaTeX-fragments' to 'imagemagick, you can add a -sublist which contains your own command(s) for LaTeX fragments -previewing, like this: - - '(\"xelatex -interaction nonstopmode -output-directory %o %f\" - \"xelatex -interaction nonstopmode -output-directory %o %f\" - ;; use below command(s) to convert latex fragments - (\"xelatex %f\")) - -With no such sublist, the default command used to convert LaTeX -fragments will be the first string in the list. - -The reason why this is a list is that it usually takes several runs of -`pdflatex', maybe mixed with a call to `bibtex'. Org does not have a clever -mechanism to detect which of these commands have to be run to get to a stable -result, and it also does not do any error checking. - -By default, Org uses 3 runs of `pdflatex' to do the processing. If you -have texi2dvi on your system and if that does not cause the infamous -egrep/locale bug: - - http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html - -then `texi2dvi' is the superior choice. Org does offer it as one -of the customize options. - -Alternatively, this may be a Lisp function that does the processing, so you -could use this to apply the machinery of AUCTeX or the Emacs LaTeX mode. -This function should accept the file name as its single argument." - :group 'org-export-pdf - :type '(choice - (repeat :tag "Shell command sequence" - (string :tag "Shell command")) - (const :tag "2 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "pdflatex,bibtex,pdflatex,pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "2 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "xelatex,bibtex,xelatex,xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "texi2dvi" - ("texi2dvi -p -b -c -V %f")) - (const :tag "rubber" - ("rubber -d --into %o %f")) - (function))) - -(defcustom org-export-pdf-logfiles - '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") - "The list of file extensions to consider as LaTeX logfiles." - :group 'org-export-pdf - :version "24.1" - :type '(repeat (string :tag "Extension"))) - -(defcustom org-export-pdf-remove-logfiles t - "Non-nil means remove the logfiles produced by PDF production. -These are the .aux, .log, .out, and .toc files." - :group 'org-export-pdf - :type 'boolean) - -;;; Hooks - -(defvar org-export-latex-after-initial-vars-hook nil - "Hook run before LaTeX export. -The exact moment is after the initial variables like org-export-latex-class -have been determined from the environment.") - -(defvar org-export-latex-after-blockquotes-hook nil - "Hook run during LaTeX export, after blockquote, verse, center are done.") - -(defvar org-export-latex-final-hook nil - "Hook run in the finalized LaTeX buffer.") - -(defvar org-export-latex-after-save-hook nil - "Hook run in the finalized LaTeX buffer, after it has been saved.") - -;;; Autoload functions: - -;;;###autoload -(defun org-export-as-latex-batch () - "Call `org-export-as-latex', may be used in batch processing. -For example: - -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-latex-batch" - (org-export-as-latex org-export-headline-levels)) - -;;;###autoload -(defun org-export-as-latex-to-buffer (arg) - "Call `org-export-as-latex` with output to a temporary buffer. -No file is created. The prefix ARG is passed through to `org-export-as-latex'." - (interactive "P") - (org-export-as-latex arg nil "*Org LaTeX Export*") - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window "*Org LaTeX Export*"))) - -;;;###autoload -(defun org-replace-region-by-latex (beg end) - "Replace the region from BEG to END with its LaTeX export. -It assumes the region has `org-mode' syntax, and then convert it to -LaTeX. This can be used in any buffer. For example, you could -write an itemized list in `org-mode' syntax in an LaTeX buffer and -then use this command to convert it." - (interactive "r") - (let (reg latex buf) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq latex (org-export-region-as-latex - beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq latex (org-export-region-as-latex - (point-min) (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert latex))) - -;;;###autoload -(defun org-export-region-as-latex (beg end &optional body-only buffer) - "Convert region from BEG to END in `org-mode' buffer to LaTeX. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted LaTeX. If BUFFER is the symbol `string', return the -produced LaTeX as a string and leave no buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq latex (org-export-region-as-latex beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (interactive "r\nP") - (when (org-called-interactively-p 'any) - (setq buffer "*Org LaTeX Export*")) - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-export-as-latex - nil ext-plist - buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -;;;###autoload -(defun org-export-as-latex (arg &optional ext-plist to-buffer body-only pub-dir) - "Export current buffer to a LaTeX file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will be exported -depending on `org-export-latex-low-levels'. The default is to -convert them as description lists. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local settings. -When TO-BUFFER is non-nil, create a buffer with that name and export -to that buffer. If TO-BUFFER is the symbol `string', don't leave any -buffer behind and just return the resulting LaTeX as a string, with -no LaTeX header. -When BODY-ONLY is set, don't produce the file header and footer, -simply return the content of \\begin{document}...\\end{document}, -without even the \\begin{document} and \\end{document} commands. -When PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (when (and (not body-only) arg (listp arg)) (setq body-only t)) - (run-hooks 'org-export-first-hook) - - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (message "Exporting to LaTeX...") - (org-unmodified - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill nil)))) - (org-update-radio-target-regexp) - (org-export-latex-set-initial-vars ext-plist arg) - (setq org-export-opt-plist org-export-latex-options-plist - org-export-footnotes-data (org-footnote-all-labels 'with-defs) - org-export-footnotes-seen nil - org-export-latex-footmark-seen nil) - (org-install-letbind) - (run-hooks 'org-export-latex-after-initial-vars-hook) - (let* ((wcf (current-window-configuration)) - (opt-plist - (org-export-process-option-filters org-export-latex-options-plist)) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; Make sure the variable contains the updated values. - (org-export-latex-options-plist (setq org-export-opt-plist opt-plist)) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-export-directory :html opt-plist))) - (org-current-export-file buffer-file-name) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "No Title")) - (filename - (and (not to-buffer) - (concat - (file-name-as-directory - (or pub-dir - (org-export-directory :LaTeX org-export-latex-options-plist))) - (file-name-sans-extension - (or (and subtree-p - (org-entry-get rbeg "EXPORT_FILE_NAME" t)) - (file-name-nondirectory ;sans-extension - (or buffer-file-name - (error "Don't know which export file to use"))))) - ".tex"))) - (filename - (and filename - (if (equal (file-truename filename) - (file-truename (or buffer-file-name "dummy.org"))) - (concat filename ".tex") - filename))) - (auto-insert nil); Avoid any auto-insert stuff for the new file - (TeX-master (boundp 'TeX-master)) - (buffer (if to-buffer - (if (eq to-buffer 'string) - (get-buffer-create "*Org LaTeX Export*") - (get-buffer-create to-buffer)) - (find-file-noselect filename))) - (odd org-odd-levels-only) - (header (org-export-latex-make-header title opt-plist)) - (skip (cond (subtree-p nil) - (region-p nil) - (t (plist-get opt-plist :skip-before-1st-heading)))) - (text (plist-get opt-plist :text)) - (org-export-preprocess-hook - (cons - `(lambda () (org-set-local 'org-complex-heading-regexp - ,org-export-latex-complex-heading-re)) - org-export-preprocess-hook)) - (first-lines (if skip "" (org-export-latex-first-lines - opt-plist - (if subtree-p - (save-excursion - (goto-char rbeg) - (point-at-bol 2)) - rbeg) - (if region-p rend)))) - (coding-system (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system)) - (coding-system-for-write (or org-export-latex-coding-system - coding-system)) - (save-buffer-coding-system (or org-export-latex-coding-system - coding-system)) - (region (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (text - (and text (string-match "\\S-" text) - (org-export-preprocess-string - text - :emph-multiline t - :for-backend 'latex - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :drawers (plist-get opt-plist :drawers) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :add-text nil - :skip-before-1st-heading skip - :select-tags nil - :exclude-tags nil - :LaTeX-fragments nil))) - (string-for-export - (org-export-preprocess-string - region - :emph-multiline t - :for-backend 'latex - :comments nil - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :drawers (plist-get opt-plist :drawers) - :timestamps (plist-get opt-plist :timestamps) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :add-text (if (eq to-buffer 'string) nil text) - :skip-before-1st-heading skip - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :LaTeX-fragments nil))) - - (set-buffer buffer) - (erase-buffer) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - ;; insert the header and initial document commands - (unless (or (eq to-buffer 'string) body-only) - (insert header)) - - ;; insert text found in #+TEXT - (when (and text (not (eq to-buffer 'string))) - (insert (org-export-latex-content - text '(lists tables fixed-width keywords)) - "\n\n")) - - ;; insert lines before the first headline - (unless (or skip (string-match "^\\*" first-lines)) - (insert first-lines)) - - ;; export the content of headlines - (org-export-latex-global - (with-temp-buffer - (insert string-for-export) - (goto-char (point-min)) - (when (re-search-forward "^\\(\\*+\\) " nil t) - (let* ((asters (length (match-string 1))) - (level (if odd (- asters 2) (- asters 1)))) - (setq org-export-latex-add-level - (if odd (1- (/ (1+ asters) 2)) (1- asters))) - (org-export-latex-parse-global level odd))))) - - ;; finalization - (unless body-only (insert "\n\\end{document}")) - - ;; Attach description terms to the \item macro - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\\\item\\([ \t]+\\)\\[" nil t) - (delete-region (match-beginning 1) (match-end 1))) - - ;; Relocate the table of contents - (goto-char (point-min)) - (when (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) - (goto-char (point-min)) - (while (re-search-forward "\\\\tableofcontents\\>[ \t]*\n?" nil t) - (replace-match "")) - (goto-char (point-min)) - (and (re-search-forward "\\[TABLE-OF-CONTENTS\\]" nil t) - (replace-match "\\tableofcontents" t t))) - - ;; Cleanup forced line ends in items where they are not needed - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*\n\\\\begin" - nil t) - (delete-region (match-beginning 1) (match-end 1))) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\item\\>.*\\(\\\\\\\\\\)[ \t]*\\(\n\\\\label.*\\)*" - nil t) - (if (looking-at "[\n \t]+") - (replace-match "\n"))) - - ;; Ensure we have a final newline - (goto-char (point-max)) - (or (eq (char-before) ?\n) - (insert ?\n)) - - (run-hooks 'org-export-latex-final-hook) - (if to-buffer - (unless (eq major-mode 'latex-mode) (latex-mode)) - (save-buffer)) - (org-export-latex-fix-inputenc) - (run-hooks 'org-export-latex-after-save-hook) - (goto-char (point-min)) - (or (org-export-push-to-kill-ring "LaTeX") - (message "Exporting to LaTeX...done")) - (prog1 - (if (eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer))) - (current-buffer)) - (set-window-configuration wcf)))) - -;;;###autoload -(defun org-export-as-pdf (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export as LaTeX, then process through to PDF." - (interactive "P") - (message "Exporting to PDF...") - (let* ((wconfig (current-window-configuration)) - (lbuf (org-export-as-latex arg ext-plist to-buffer body-only pub-dir)) - (file (buffer-file-name lbuf)) - (base (file-name-sans-extension (buffer-file-name lbuf))) - (pdffile (concat base ".pdf")) - (cmds (if (eq org-export-latex-listings 'minted) - ;; automatically add -shell-escape when needed - (mapcar (lambda (cmd) - (replace-regexp-in-string - "pdflatex " "pdflatex -shell-escape " cmd)) - org-latex-to-pdf-process) - org-latex-to-pdf-process)) - (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) - (bibtex-p (with-current-buffer lbuf - (save-excursion - (goto-char (point-min)) - (re-search-forward "\\\\bibliography{" nil t)))) - cmd output-dir errors) - (with-current-buffer outbuf (erase-buffer)) - (message (concat "Processing LaTeX file " file "...")) - (setq output-dir (file-name-directory file)) - (with-current-buffer lbuf - (save-excursion - (if (and cmds (symbolp cmds)) - (funcall cmds (shell-quote-argument file)) - (while cmds - (setq cmd (pop cmds)) - (cond - ((not (listp cmd)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%f" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument file)) - t t cmd))) - (while (string-match "%o" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument output-dir)) - t t cmd))) - (shell-command cmd outbuf))))))) - (message (concat "Processing LaTeX file " file "...done")) - (setq errors (org-export-latex-get-error outbuf)) - (if (not (file-exists-p pdffile)) - (error (concat "PDF file " pdffile " was not produced" - (if errors (concat ":" errors "") ""))) - (set-window-configuration wconfig) - (when org-export-pdf-remove-logfiles - (dolist (ext org-export-pdf-logfiles) - (setq file (concat base "." ext)) - (and (file-exists-p file) (delete-file file)))) - (message (concat - "Exporting to PDF...done" - (if errors - (concat ", with some errors:" errors) - ""))) - pdffile))) - -(defun org-export-latex-get-error (buf) - "Collect the kinds of errors that remain in pdflatex processing." - (with-current-buffer buf - (save-excursion - (goto-char (point-max)) - (when (re-search-backward "^[ \t]*This is pdf.*?TeX.*?Version" nil t) - ;; OK, we are at the location of the final run - (let ((pos (point)) (errors "") (case-fold-search t)) - (if (re-search-forward "Reference.*?undefined" nil t) - (setq errors (concat errors " [undefined reference]"))) - (goto-char pos) - (if (re-search-forward "Citation.*?undefined" nil t) - (setq errors (concat errors " [undefined citation]"))) - (goto-char pos) - (if (re-search-forward "Undefined control sequence" nil t) - (setq errors (concat errors " [undefined control sequence]"))) - (and (org-string-nw-p errors) errors)))))) - -;;;###autoload -(defun org-export-as-pdf-and-open (arg) - "Export as LaTeX, then process through to PDF, and open." - (interactive "P") - (let ((pdffile (org-export-as-pdf arg))) - (if pdffile - (progn - (org-open-file pdffile) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (find-buffer-visiting - (concat (file-name-sans-extension (buffer-file-name)) - ".tex"))))) - (error "PDF file was not produced")))) - -;;; Parsing functions: - -(defun org-export-latex-parse-global (level odd) - "Parse the current buffer recursively, starting at LEVEL. -If ODD is non-nil, assume the buffer only contains odd sections. -Return a list reflecting the document structure." - (save-excursion - (goto-char (point-min)) - (let* ((cnt 0) output - (depth org-export-latex-sectioning-depth)) - (while (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \\(.*\\)$") - ;; make sure that there is no upper heading - (when (> level 0) - (save-excursion - (save-match-data - (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string level) - "\\}\\) \\(.*\\)$") nil t)))) t) - (setq cnt (1+ cnt)) - (let* ((pos (match-beginning 0)) - (heading (match-string 2)) - (nlevel (if odd (/ (+ 3 level) 2) (1+ level)))) - (save-excursion - (narrow-to-region - (point) - (save-match-data - (if (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 2 1) level)) - "\\}\\) \\(.*\\)$") nil t) - (match-beginning 0) - (point-max)))) - (goto-char (point-min)) - (setq output - (append output - (list - (list - `(pos . ,pos) - `(level . ,nlevel) - `(occur . ,cnt) - `(heading . ,heading) - `(content . ,(org-export-latex-parse-content)) - `(subcontent . ,(org-export-latex-parse-subcontent - level odd))))))) - (widen))) - (list output)))) - -(defun org-export-latex-parse-content () - "Extract the content of a section." - (let ((beg (point)) - (end (if (org-re-search-forward-unprotected "^\\(\\*\\)+ .*$" nil t) - (progn (beginning-of-line) (point)) - (point-max)))) - (buffer-substring beg end))) - -(defun org-export-latex-parse-subcontent (level odd) - "Extract the subcontent of a section at LEVEL. -If ODD Is non-nil, assume subcontent only contains odd sections." - (if (not (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 4 2) level)) - "\\}\\) \\(.*\\)$") - nil t)) - nil ; subcontent is nil - (org-export-latex-parse-global (+ (if odd 2 1) level) odd))) - -;;; Rendering functions: -(defun org-export-latex-global (content) - "Export CONTENT to LaTeX. -CONTENT is an element of the list produced by -`org-export-latex-parse-global'." - (if (eq (car content) 'subcontent) - (mapc 'org-export-latex-sub (cdr content)) - (org-export-latex-sub (car content)))) - -(defun org-export-latex-sub (subcontent) - "Export the list SUBCONTENT to LaTeX. -SUBCONTENT is an alist containing information about the headline -and its content." - (let ((num (plist-get org-export-latex-options-plist :section-numbers))) - (mapc (lambda(x) (org-export-latex-subcontent x num)) subcontent))) - -(defun org-export-latex-subcontent (subcontent num) - "Export each cell of SUBCONTENT to LaTeX. -If NUM is non-nil export numbered sections, otherwise use unnumbered -sections. If NUM is an integer, export the highest NUM levels as -numbered sections and lower levels as unnumbered sections." - (let* ((heading (cdr (assoc 'heading subcontent))) - (level (- (cdr (assoc 'level subcontent)) - org-export-latex-add-level)) - (occur (number-to-string (cdr (assoc 'occur subcontent)))) - (content (cdr (assoc 'content subcontent))) - (subcontent (cadr (assoc 'subcontent subcontent))) - (label (org-get-text-property-any 0 'target heading)) - (label-list (cons label (cdr (assoc label - org-export-target-aliases)))) - (sectioning org-export-latex-sectioning) - (depth org-export-latex-sectioning-depth) - main-heading sub-heading ctnt) - (when (symbolp (car sectioning)) - (setq sectioning (funcall (car sectioning) level heading)) - (when sectioning - (setq heading (car sectioning) - sectioning (cdr sectioning) - ;; target property migh have changed... - label (org-get-text-property-any 0 'target heading) - label-list (cons label (cdr (assoc label - org-export-target-aliases))))) - (if sectioning (setq sectioning (make-list 10 sectioning))) - (setq depth (if sectioning 10000 0))) - (if (string-match "[ \t]*\\\\\\\\[ \t]*" heading) - (setq main-heading (substring heading 0 (match-beginning 0)) - sub-heading (substring heading (match-end 0)))) - (setq heading (org-export-latex-fontify-headline heading) - sub-heading (and sub-heading - (org-export-latex-fontify-headline sub-heading)) - main-heading (and main-heading - (org-export-latex-fontify-headline main-heading))) - (cond - ;; Normal conversion - ((<= level depth) - (let* ((sec (nth (1- level) sectioning)) - (num (if (integerp num) - (>= num level) - num)) - start end) - (if (consp (cdr sec)) - (setq start (nth (if num 0 2) sec) - end (nth (if num 1 3) sec)) - (setq start (if num (car sec) (cdr sec)))) - (insert (format start (if main-heading main-heading heading) - (or sub-heading ""))) - (insert "\n") - (when label - (insert (mapconcat (lambda (l) (format "\\label{%s}" l)) - label-list "\n") "\n")) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) - (while (org-looking-back "\n\n") (backward-delete-char 1)) - (org-export-latex-sub subcontent))) - (when (and end (string-match "[^ \t]" end)) - (let ((hook (org-get-text-property-any 0 'org-insert-hook end))) - (and (functionp hook) (funcall hook))) - (insert end "\n")))) - ;; At a level under the hl option: we can drop this subsection - ((> level depth) - (cond ((eq org-export-latex-low-levels 'description) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert "\\begin{description}\n")) - (insert (format "\n\\item[%s]%s~\n" - heading - (if label (format "\\label{%s}" label) ""))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert "\\end{description} % ends low level\n")) - ((memq org-export-latex-low-levels '(itemize enumerate)) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert (format "\\begin{%s}\n" - (symbol-name org-export-latex-low-levels)))) - (let ((ctnt (org-export-latex-content content))) - (insert (format (if (not (equal (replace-regexp-in-string "\n" "" ctnt) "")) - "\n\\item %s\\\\\n%s%%" - "\n\\item %s\n%s%%") - heading - (if label (format "\\label{%s}" label) ""))) - (insert ctnt)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert (format "\\end{%s} %% ends low level\n" - (symbol-name org-export-latex-low-levels)))) - - ((and (listp org-export-latex-low-levels) - org-export-latex-low-levels) - (if (string-match "% ends low level$" - (buffer-substring (point-at-bol 0) (point))) - (delete-region (point-at-bol 0) (point)) - (insert (car org-export-latex-low-levels) "\n")) - (insert (format (nth 2 org-export-latex-low-levels) - heading - (if label (format "\\label{%s}" label) ""))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))) - (insert (nth 1 org-export-latex-low-levels) - " %% ends low level\n")) - - ((stringp org-export-latex-low-levels) - (insert (format org-export-latex-low-levels heading) "\n") - (when label (insert (format "\\label{%s}\n" label))) - (insert (org-export-latex-content content)) - (cond ((stringp subcontent) (insert subcontent)) - ((listp subcontent) (org-export-latex-sub subcontent))))))))) - -;;; Exporting internals: -(defun org-export-latex-set-initial-vars (ext-plist level) - "Store org local variables required for LaTeX export. -EXT-PLIST is an optional additional plist. -LEVEL indicates the default depth for export." - (setq org-export-latex-todo-keywords-1 org-todo-keywords-1 - org-export-latex-done-keywords org-done-keywords - org-export-latex-not-done-keywords org-not-done-keywords - org-export-latex-complex-heading-re org-complex-heading-regexp - org-export-latex-display-custom-times org-display-custom-times - org-export-latex-all-targets-re - (org-make-target-link-regexp (org-all-targets)) - org-export-latex-options-plist - (org-combine-plists (org-default-export-plist) ext-plist - (org-infile-export-plist)) - org-export-latex-class - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "LaTeX_CLASS" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\([-/a-zA-Z]+\\)" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :latex-class) - org-export-latex-default-class) - org-export-latex-class-options - (or (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (and (looking-at org-complex-heading-regexp) - (org-entry-get nil "LaTeX_CLASS_OPTIONS" 'selective)))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1)))) - (plist-get org-export-latex-options-plist :latex-class-options)) - org-export-latex-class - (or (car (assoc org-export-latex-class org-export-latex-classes)) - (error "No definition for class `%s' in `org-export-latex-classes'" - org-export-latex-class)) - org-export-latex-header - (cadr (assoc org-export-latex-class org-export-latex-classes)) - org-export-latex-sectioning - (cddr (assoc org-export-latex-class org-export-latex-classes)) - org-export-latex-sectioning-depth - (or level - (let ((hl-levels - (plist-get org-export-latex-options-plist :headline-levels)) - (sec-depth (length org-export-latex-sectioning))) - (if (> hl-levels sec-depth) sec-depth hl-levels)))) - (when (and org-export-latex-class-options - (string-match "\\S-" org-export-latex-class-options) - (string-match "^[ \t]*\\(\\\\documentclass\\)\\(\\[.*?\\]\\)?" - org-export-latex-header)) - (setq org-export-latex-header - (concat (substring org-export-latex-header 0 (match-end 1)) - org-export-latex-class-options - (substring org-export-latex-header (match-end 0)))))) - -(defvar org-export-latex-format-toc-function - 'org-export-latex-format-toc-default - "The function formatting returning the string to create the table of contents. -The function mus take one parameter, the depth of the table of contents.") - -(defun org-export-latex-make-header (title opt-plist) - "Make the LaTeX header and return it as a string. -TITLE is the current title from the buffer or region. -OPT-PLIST is the options plist for current buffer." - (let ((toc (plist-get opt-plist :table-of-contents)) - (author (org-export-apply-macros-in-string - (plist-get opt-plist :author))) - (email (replace-regexp-in-string - "_" "\\\\_" - (org-export-apply-macros-in-string - (plist-get opt-plist :email)))) - (description (org-export-apply-macros-in-string - (plist-get opt-plist :description))) - (keywords (org-export-apply-macros-in-string - (plist-get opt-plist :keywords)))) - (concat - (if (plist-get opt-plist :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; insert LaTeX custom header and packages from the list - (org-splice-latex-header - (org-export-apply-macros-in-string org-export-latex-header) - org-export-latex-default-packages-alist - org-export-latex-packages-alist nil - (org-export-apply-macros-in-string - (plist-get opt-plist :latex-header-extra))) - ;; append another special variable - (org-export-apply-macros-in-string org-export-latex-append-header) - ;; define alert if not yet defined - "\n\\providecommand{\\alert}[1]{\\textbf{#1}}" - ;; insert the title - (format - "\n\n\\title{%s}\n" - (org-export-latex-fontify-headline title)) - ;; insert author info - (if (plist-get opt-plist :author-info) - (format "\\author{%s%s}\n" - (org-export-latex-fontify-headline (or author user-full-name)) - (if (and (plist-get opt-plist :email-info) email - (string-match "\\S-" email)) - (format "\\thanks{%s}" email) - "")) - (format "%%\\author{%s}\n" - (org-export-latex-fontify-headline (or author user-full-name)))) - ;; insert the date - (format "\\date{%s}\n" - (format-time-string - (or (plist-get opt-plist :date) - org-export-latex-date-format))) - ;; add some hyperref options - (format org-export-latex-hyperref-options-format - (org-export-latex-fontify-headline keywords) - (org-export-latex-fontify-headline description) - (org-version)) - ;; beginning of the document - "\n\\begin{document}\n\n" - ;; insert the title command - (when (string-match "\\S-" title) - (if (string-match "%s" org-export-latex-title-command) - (format org-export-latex-title-command title) - org-export-latex-title-command)) - "\n\n" - ;; table of contents - (when (and org-export-with-toc - (plist-get opt-plist :section-numbers)) - (funcall org-export-latex-format-toc-function - (cond ((numberp toc) - (min toc (plist-get opt-plist :headline-levels))) - (toc (plist-get opt-plist :headline-levels)))))))) - -(defun org-export-latex-format-toc-default (depth) - (when depth - (format "\\setcounter{tocdepth}{%s}\n\\tableofcontents\n\\vspace*{1cm}\n" - depth))) - -(defun org-export-latex-first-lines (opt-plist &optional beg end) - "Export the first lines before first headline. -If BEG is non-nil, it is the beginning of the region. -If END is non-nil, it is the end of the region." - (save-excursion - (goto-char (or beg (point-min))) - (let* ((pt (point)) - (end (if (re-search-forward - (concat "^" (org-get-limited-outline-regexp)) end t) - (goto-char (match-beginning 0)) - (goto-char (or end (point-max)))))) - (prog1 - (org-export-latex-content - (org-export-preprocess-string - (buffer-substring pt end) - :for-backend 'latex - :emph-multiline t - :add-text nil - :comments nil - :skip-before-1st-heading nil - :LaTeX-fragments nil - :timestamps (plist-get opt-plist :timestamps) - :footnotes (plist-get opt-plist :footnotes))) - (org-unmodified - (let ((inhibit-read-only t) - (limit (max pt (1- end)))) - (add-text-properties pt limit - '(:org-license-to-kill t)) - (save-excursion - (goto-char pt) - (while (re-search-forward "^[ \t]*#\\+.*\n?" limit t) - (let ((case-fold-search t)) - (unless (org-string-match-p - "^[ \t]*#\\+\\(attr_\\|caption\\>\\|label\\>\\)" - (match-string 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(:org-license-to-kill t)))))))))))) - - -(defvar org-export-latex-header-defs nil - "The header definitions that might be used in the LaTeX body.") - -(defun org-export-latex-content (content &optional exclude-list) - "Convert CONTENT string to LaTeX. -Don't perform conversions that are in EXCLUDE-LIST. Recognized -conversion types are: quotation-marks, emphasis, sub-superscript, -links, keywords, lists, tables, fixed-width" - (with-temp-buffer - (org-install-letbind) - (insert content) - (unless (memq 'timestamps exclude-list) - (org-export-latex-time-stamps)) - (unless (memq 'quotation-marks exclude-list) - (org-export-latex-quotation-marks)) - (unless (memq 'emphasis exclude-list) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify))) - (unless (memq 'sub-superscript exclude-list) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript))) - (unless (memq 'links exclude-list) - (org-export-latex-links)) - (unless (memq 'keywords exclude-list) - (org-export-latex-keywords)) - (unless (memq 'lists exclude-list) - (org-export-latex-lists)) - (unless (memq 'tables exclude-list) - (org-export-latex-tables - (plist-get org-export-latex-options-plist :tables))) - (unless (memq 'fixed-width exclude-list) - (org-export-latex-fixed-width - (plist-get org-export-latex-options-plist :fixed-width))) - ;; return string - (buffer-substring (point-min) (point-max)))) - -(defun org-export-latex-protect-string (s) - "Add the org-protected property to string S." - (add-text-properties 0 (length s) '(org-protected t) s) s) - -(defun org-export-latex-protect-char-in-string (char-list string) - "Add org-protected text-property to char from CHAR-LIST in STRING." - (with-temp-buffer - (save-match-data - (insert string) - (goto-char (point-min)) - (while (re-search-forward (regexp-opt char-list) nil t) - (add-text-properties (match-beginning 0) - (match-end 0) '(org-protected t))) - (buffer-string)))) - -(defun org-export-latex-keywords-maybe (&optional remove-list) - "Maybe remove keywords depending on rules in REMOVE-LIST." - (goto-char (point-min)) - (let ((re-todo (mapconcat 'identity org-export-latex-todo-keywords-1 "\\|")) - (case-fold-search nil) - (todo-markup org-export-latex-todo-keyword-markup) - fmt) - ;; convert TODO keywords - (when (re-search-forward (concat "^\\(" re-todo "\\)") nil t) - (if (plist-get remove-list :todo) - (replace-match "") - (setq fmt (cond - ((stringp todo-markup) todo-markup) - ((and (consp todo-markup) (stringp (car todo-markup))) - (if (member (match-string 1) org-export-latex-done-keywords) - (cdr todo-markup) (car todo-markup))) - (t (cdr (or (assoc (match-string 1) todo-markup) - (car todo-markup)))))) - (replace-match (org-export-latex-protect-string - (format fmt (match-string 1))) t t))) - ;; convert priority string - (when (re-search-forward "\\[\\\\#.\\]" nil t) - (if (plist-get remove-list :priority) - (replace-match "") - (replace-match (format "\\textbf{%s}" (match-string 0)) t t))) - ;; convert tags - (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t) - (if (or (not org-export-with-tags) - (plist-get remove-list :tags)) - (replace-match "") - (replace-match - (org-export-latex-protect-string - (format org-export-latex-tag-markup - (save-match-data - (replace-regexp-in-string - "\\([_#]\\)" "\\\\\\1" (match-string 0))))) - t t))))) - -(defun org-export-latex-fontify-headline (string) - "Fontify special words in STRING." - (with-temp-buffer - ;; FIXME: org-inside-LaTeX-fragment-p doesn't work when the $...$ is at - ;; the beginning of the buffer - inserting "\n" is safe here though. - (insert "\n" string) - - ;; Preserve math snippets - - (let* ((matchers (plist-get org-format-latex-options :matchers)) - (re-list org-latex-regexps) - beg end re e m n block off) - ;; Check the different regular expressions - (while (setq e (pop re-list)) - (setq m (car e) re (nth 1 e) n (nth 2 e) - block (if (nth 3 e) "\n\n" "")) - (setq off (if (member m '("$" "$1")) 1 0)) - (when (and (member m matchers) (not (equal m "begin"))) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0)) - (add-text-properties beg end - '(org-protected t org-latex-math t)))))) - - ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{} - (goto-char (point-min)) - (let ((case-fold-search nil)) - (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t) - (unless (eq (char-before (match-beginning 1)) ?\\) - (org-if-unprotected-1 - (replace-match (org-export-latex-protect-string - (concat "\\" (match-string 1) - "{}")) t t))))) - (goto-char (point-min)) - (let ((re (concat "\\\\\\([a-zA-Z]+\\)" - "\\(?:<[^<>\n]*>\\)*" - "\\(?:\\[[^][\n]*?\\]\\)*" - "\\(?:<[^<>\n]*>\\)*" - "\\(" - (org-create-multibrace-regexp "{" "}" 3) - "\\)\\{1,3\\}"))) - (while (re-search-forward re nil t) - (unless (or - ;; check for comment line - (save-excursion (goto-char (match-beginning 0)) - (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may need conversion - (org-entity-get (match-string 1))) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify)) - (org-export-latex-time-stamps) - (org-export-latex-quotation-marks) - (org-export-latex-keywords-maybe) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript)) - (org-export-latex-links) - (org-trim (buffer-string)))) - -(defun org-export-latex-time-stamps () - "Format time stamps." - (goto-char (point-min)) - (let ((org-display-custom-times org-export-latex-display-custom-times)) - (while (re-search-forward org-ts-regexp-both nil t) - (org-if-unprotected-at (1- (point)) - (replace-match - (org-export-latex-protect-string - (format (if (string= "<" (substring (match-string 0) 0 1)) - org-export-latex-timestamp-markup - org-export-latex-timestamp-inactive-markup) - (substring (org-translate-time (match-string 0)) 1 -1))) - t t))))) - -(defun org-export-latex-quotation-marks () - "Export quotation marks depending on language conventions." - (mapc (lambda(l) - (goto-char (point-min)) - (while (re-search-forward (car l) nil t) - (let ((rpl (concat (match-string 1) - (org-export-latex-protect-string - (copy-sequence (cdr l)))))) - (org-if-unprotected-1 - (replace-match rpl t t))))) - (cdr (or (assoc (plist-get org-export-latex-options-plist :language) - org-export-latex-quotes) - ;; falls back on english - (assoc "en" org-export-latex-quotes))))) - -(defun org-export-latex-special-chars (sub-superscript) - "Export special characters to LaTeX. -If SUB-SUPERSCRIPT is non-nil, convert \\ and ^. -See the `org-export-latex.el' code for a complete conversion table." - (goto-char (point-min)) - (mapc (lambda(c) - (goto-char (point-min)) - (while (re-search-forward c nil t) - ;; Put the point where to check for org-protected - (unless (get-text-property (match-beginning 2) 'org-protected) - (cond ((member (match-string 2) '("\\$" "$")) - (if (equal (match-string 2) "\\$") - nil - (replace-match "\\$" t t))) - ((member (match-string 2) '("&" "%" "#")) - (if (equal (match-string 1) "\\") - (replace-match (match-string 2) t t) - (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t) - (backward-char 1))) - ((equal (match-string 2) "...") - (replace-match - (concat (match-string 1) - (org-export-latex-protect-string "\\ldots{}")) t t)) - ((equal (match-string 2) "~") - (cond ((equal (match-string 1) "\\") nil) - ((eq 'org-link (get-text-property 0 'face (match-string 2))) - (replace-match (concat (match-string 1) "\\~") t t)) - (t (replace-match - (org-export-latex-protect-string - (concat (match-string 1) "\\~{}")) t t)))) - ((member (match-string 2) '("{" "}")) - (unless (save-match-data (org-inside-latex-math-p)) - (if (equal (match-string 1) "\\") - (replace-match (match-string 2) t t) - (replace-match (concat (match-string 1) "\\" - (match-string 2)) t t))))) - (unless (save-match-data (or (org-inside-latex-math-p) (org-at-table-p))) - (cond ((equal (match-string 2) "\\") - (replace-match (or (save-match-data - (org-export-latex-treat-backslash-char - (match-string 1) - (or (match-string 3) ""))) - "") t t) - (when (and (get-text-property (1- (point)) 'org-entity) - (looking-at "{}")) - ;; OK, this was an entity replacement, and the user - ;; had terminated the entity with {}. Make sure - ;; {} is protected as well, and remove the extra {} - ;; inserted by the conversion. - (put-text-property (point) (+ 2 (point)) 'org-protected t) - (if (save-excursion (goto-char (max (- (point) 2) (point-min))) - (looking-at "{}")) - (replace-match "")) - (forward-char 2)) - (backward-char 1)) - ((member (match-string 2) '("_" "^")) - (replace-match (or (save-match-data - (org-export-latex-treat-sub-super-char - sub-superscript - (match-string 2) - (match-string 1) - (match-string 3))) "") t t) - (backward-char 1))))))) - '(;"^\\([^\n$]*?\\|^\\)\\(\\\\?\\$\\)\\([^\n$]*\\)$" - "\\(\\(\\\\?\\$\\)\\)" - "\\([a-zA-Z0-9()]+\\|[ \t\n]\\|\\b\\|\\\\\\)\\(_\\|\\^\\)\\({[^{}]+}\\|[a-zA-Z0-9]+\\|[ \t\n]\\|[:punct:]\\|)\\|{[a-zA-Z0-9]+}\\|([a-zA-Z0-9]+)\\)" - "\\(.\\|^\\)\\(\\\\\\)\\([ \t\n]\\|\\([&#%{}\"]\\|[a-zA-Z][a-zA-Z0-9]*\\)\\)" - "\\(^\\|.\\)\\([&#%{}~]\\|\\.\\.\\.\\)" - ;; (?\< . "\\textless{}") - ;; (?\> . "\\textgreater{}") - ))) - -(defun org-inside-latex-math-p () - (get-text-property (point) 'org-latex-math)) - -(defun org-export-latex-treat-sub-super-char - (subsup char string-before string-after) - "Convert the \"_\" and \"^\" characters to LaTeX. -SUBSUP corresponds to the ^: option in the #+OPTIONS line. -Convert CHAR depending on STRING-BEFORE and STRING-AFTER." - (cond ((equal string-before "\\") - (concat string-before char string-after)) - ((and (string-match "\\S-+" string-after)) - ;; this is part of a math formula - (cond ((eq 'org-link (get-text-property 0 'face char)) - (concat string-before "\\" char string-after)) - ((save-match-data (org-inside-latex-math-p)) - (if subsup - (cond ((eq 1 (length string-after)) - (concat string-before char string-after)) - ((string-match "[({]?\\([^)}]+\\)[)}]?" string-after) - (format "%s%s{%s}" string-before char - (match-string 1 string-after)))))) - ((and (> (length string-after) 1) - (or (eq subsup t) - (and (equal subsup '{}) (eq (string-to-char string-after) ?\{))) - (or (string-match "[{]?\\([^}]+\\)[}]?" string-after) - (string-match "[(]?\\([^)]+\\)[)]?" string-after))) - - (org-export-latex-protect-string - (format "%s$%s{%s}$" string-before char - (if (and (> (match-end 1) (1+ (match-beginning 1))) - (not (equal (substring string-after 0 2) "{\\"))) - (concat "\\mathrm{" (match-string 1 string-after) "}") - (match-string 1 string-after))))) - ((eq subsup t) (concat string-before "$" char string-after "$")) - (t (org-export-latex-protect-string - (concat string-before "\\" char "{}" string-after))))) - (t (org-export-latex-protect-string - (concat string-before "\\" char "{}" string-after))))) - -(defun org-export-latex-treat-backslash-char (string-before string-after) - "Convert the \"$\" special character to LaTeX. -The conversion is made depending of STRING-BEFORE and STRING-AFTER." - (let ((ass (org-entity-get string-after))) - (cond - (ass (org-add-props - (if (nth 2 ass) - (concat string-before - (org-export-latex-protect-string - (concat "$" (nth 1 ass) "$"))) - (concat string-before (org-export-latex-protect-string - (nth 1 ass)))) - nil 'org-entity t)) - ((and (not (string-match "^[ \n\t]" string-after)) - (not (string-match "[ \t]\\'\\|^" string-before))) - ;; backslash is inside a word - (concat string-before - (org-export-latex-protect-string - (concat "\\textbackslash{}" string-after)))) - ((not (or (equal string-after "") - (string-match "^[ \t\n]" string-after))) - ;; backslash might escape a character (like \#) or a user TeX - ;; macro (like \setcounter) - (concat string-before - (org-export-latex-protect-string (concat "\\" string-after)))) - ((and (string-match "^[ \t\n]" string-after) - (string-match "[ \t\n]\\'" string-before)) - ;; backslash is alone, convert it to $\backslash$ - (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after))) - (t (org-export-latex-protect-string - (concat string-before "\\textbackslash{}" string-after)))))) - -(defun org-export-latex-keywords () - "Convert special keywords to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-export-latex-special-keyword-regexp nil t) - (replace-match (format org-export-latex-timestamp-keyword-markup - (match-string 0)) t t) - (save-excursion - (beginning-of-line 1) - (unless (looking-at ".*\n[ \t]*\n") - (end-of-line 1) - (insert "\n"))))) - -(defun org-export-latex-fixed-width (opt) - "When OPT is non-nil convert fixed-width sections to LaTeX." - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:\\([ \t]\\|$\\)" nil t) - (unless (get-text-property (point) 'org-example) - (if opt - (progn (goto-char (match-beginning 0)) - (insert "\\begin{verbatim}\n") - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat (match-string 1) - (match-string 2)) t t) - (forward-line)) - (insert "\\end{verbatim}\n")) - (progn (goto-char (match-beginning 0)) - (while (looking-at "^\\([ \t]*\\):\\(\\([ \t]\\|$\\).*\\)$") - (replace-match (concat "%" (match-string 1) - (match-string 2)) t t) - (forward-line))))))) - -(defvar org-table-last-alignment) ; defined in org-table.el -(defvar org-table-last-column-widths) ; defined in org-table.el -(declare-function orgtbl-to-latex "org-table" (table params) t) -(defun org-export-latex-tables (insert) - "Convert tables to LaTeX and INSERT it." - ;; First, get the table.el tables - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\(\\+-[-+]*\\+\\)[ \t]*\n[ \t]*|" nil t) - (org-if-unprotected - (require 'table) - (org-export-latex-convert-table.el-table))) - - ;; And now the Org-mode tables - (goto-char (point-min)) - (while (re-search-forward "^\\([ \t]*\\)|" nil t) - (org-if-unprotected-at (1- (point)) - (org-table-align) - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (raw-table (buffer-substring beg end)) - (org-table-last-alignment (copy-sequence org-table-last-alignment)) - (org-table-last-column-widths (copy-sequence - org-table-last-column-widths)) - fnum fields line lines olines gr colgropen line-fmt align - caption width shortn label attr hfmt floatp placement - longtblp tblenv tabular-env) - (if org-export-latex-tables-verbatim - (let* ((tbl (concat "\\begin{verbatim}\n" raw-table - "\\end{verbatim}\n"))) - (apply 'delete-region (list beg end)) - (insert (org-export-latex-protect-string tbl))) - (progn - (setq caption (org-find-text-property-in-string - 'org-caption raw-table) - shortn (org-find-text-property-in-string - 'org-caption-shortn raw-table) - attr (org-find-text-property-in-string - 'org-attributes raw-table) - label (org-find-text-property-in-string - 'org-label raw-table) - longtblp (and attr (stringp attr) - (string-match "\\<longtable\\>" attr)) - tblenv (if (and attr (stringp attr)) - (cond ((string-match "\\<sidewaystable\\>" attr) - "sidewaystable") - ((or (string-match (regexp-quote "table*") attr) - (string-match "\\<multicolumn\\>" attr)) - "table*") - (t "table")) - "table") - tabular-env - (if (and attr (stringp attr) - (string-match "\\(tabular.\\)" attr)) - (match-string 1 attr) - org-export-latex-tabular-environment) - width (and attr (stringp attr) - (string-match "\\<width=\\([^ \t\n\r]+\\)" attr) - (match-string 1 attr)) - align (and attr (stringp attr) - (string-match "\\<align=\\([^ \t\n\r]+\\)" attr) - (match-string 1 attr)) - hfmt (and attr (stringp attr) - (string-match "\\<hfmt=\\(\\S-+\\)" attr) - (match-string 1 attr)) - floatp (or caption label (string= "table*" tblenv)) - placement (if (and attr - (stringp attr) - (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr)) - (match-string 1 attr) - (concat - "[" org-latex-default-figure-position "]"))) - (setq caption (and caption (org-export-latex-fontify-headline caption))) - (setq lines (org-split-string raw-table "\n")) - (apply 'delete-region (list beg end)) - (when org-export-table-remove-special-lines - (setq lines (org-table-clean-before-export lines 'maybe-quoted))) - (when org-table-clean-did-remove-column - (pop org-table-last-alignment) - (pop org-table-last-column-widths)) - ;; make a format string to reflect alignment - (setq olines lines) - (while (and (not line-fmt) (setq line (pop olines))) - (unless (string-match "^[ \t]*|-" line) - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (setq fnum (make-vector (length fields) 0)) - (setq line-fmt - (mapconcat - (lambda (x) - (setq gr (pop org-table-colgroup-info)) - (format "%s%%s%s" - (cond ((eq gr :start) - (prog1 (if colgropen "|" "|") - (setq colgropen t))) - ((eq gr :startend) - (prog1 (if colgropen "|" "|") - (setq colgropen nil))) - (t "")) - (if (memq gr '(:end :startend)) - (progn (setq colgropen nil) "|") - ""))) - fnum "")))) - ;; fix double || in line-fmt - (setq line-fmt (replace-regexp-in-string "||" "|" line-fmt)) - ;; maybe remove the first and last "|" - (when (and (not org-export-latex-tables-column-borders) - (string-match "^\\(|\\)?\\(.+\\)|$" line-fmt)) - (setq line-fmt (match-string 2 line-fmt))) - ;; format alignment - (unless align - (setq align (apply 'format - (cons line-fmt - (mapcar (lambda (x) (if x "r" "l")) - org-table-last-alignment))))) - ;; prepare the table to send to orgtbl-to-latex - (setq lines - (mapcar - (lambda(elem) - (or (and (string-match "[ \t]*|-+" elem) 'hline) - (org-split-string - (progn (set-text-properties 0 (length elem) nil elem) - (org-trim elem)) "|"))) - lines)) - (when insert - (insert (org-export-latex-protect-string - (concat - (if longtblp - (concat "\\begin{longtable}{" align "}\n") - (if floatp - (format "\\begin{%s}%s\n" tblenv placement))) - (if (and floatp org-export-latex-table-caption-above) - (format - "\\caption%s{%s} %s" - (if shortn (concat "[" shortn "]") "") - (or caption "") - (if label (format "\\label{%s}" label) ""))) - (if (and longtblp caption org-export-latex-table-caption-above) - "\\\\\n" "\n") - (if (and org-export-latex-tables-centered (not longtblp)) - "\\begin{center}\n") - (if (not longtblp) - (format "\\begin{%s}%s{%s}\n" - tabular-env - (if width (format "{%s}" width) "") - align)) - (orgtbl-to-latex - lines - `(:tstart ,org-export-latex-tables-tstart - :tend ,org-export-latex-tables-tend - :hline ,org-export-latex-tables-hline - :skipheadrule ,longtblp - :hfmt ,hfmt - :hlend ,(if longtblp - (format "\\\\ -%s -\\endhead -%s\\multicolumn{%d}{r}{Continued on next page}\\ -\\endfoot -\\endlastfoot" - org-export-latex-tables-hline - org-export-latex-tables-hline - (length org-table-last-alignment)) - nil))) - (if (not longtblp) (format "\n\\end{%s}" tabular-env)) - (if longtblp "\n" (if org-export-latex-tables-centered - "\n\\end{center}\n" "\n")) - (if (and floatp (not org-export-latex-table-caption-above)) - (format - "\\caption%s{%s} %s" - (if shortn (concat "[" shortn "]") "") - (or caption "") - (if label (format "\\label{%s}" label) ""))) - (if longtblp - "\\end{longtable}" - (if floatp (format "\\end{%s}" tblenv))))) - "\n\n")))))))) - -(defun org-export-latex-convert-table.el-table () - "Replace table.el table at point with LaTeX code." - (let (tbl caption shortn label line floatp attr align rmlines) - (setq line (buffer-substring (point-at-bol) (point-at-eol)) - label (org-get-text-property-any 0 'org-label line) - caption (org-get-text-property-any 0 'org-caption line) - shortn (org-get-text-property-any 0 'org-caption-shortn line) - attr (org-get-text-property-any 0 'org-attributes line) - align (and attr (stringp attr) - (string-match "\\<align=\\([^ \t\n\r,]+\\)" attr) - (match-string 1 attr)) - rmlines (and attr (stringp attr) - (string-match "\\<rmlines\\>" attr)) - floatp (or label caption)) - (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) - (table-generate-source 'latex "*org-export-table*" "caption") - (setq tbl (with-current-buffer "*org-export-table*" - (buffer-string))) - (while (string-match "^%.*\n" tbl) - (setq tbl (replace-match "" t t tbl))) - ;; fix the hlines - (when rmlines - (let ((n 0) lines) - (setq lines (mapcar (lambda (x) - (if (string-match "^\\\\hline$" x) - (progn - (setq n (1+ n)) - (if (= n 2) x nil)) - x)) - (org-split-string tbl "\n"))) - (setq tbl (mapconcat 'identity (delq nil lines) "\n")))) - (when (and align (string-match "\\\\begin{tabular}{.*}" tbl)) - (setq tbl (replace-match (concat "\\begin{tabular}{" align "}") - t t tbl))) - (and (get-buffer "*org-export-table*") - (kill-buffer (get-buffer "*org-export-table*"))) - (beginning-of-line 0) - (while (looking-at "[ \t]*\\(|\\|\\+-\\)") - (delete-region (point) (1+ (point-at-eol)))) - (when org-export-latex-tables-centered - (setq tbl (concat "\\begin{center}\n" tbl "\\end{center}"))) - (when floatp - (setq tbl (concat "\\begin{table}\n" - (if (not org-export-latex-table-caption-above) tbl) - (format "\\caption%s{%s%s}\n" - (if shortn (format "[%s]" shortn) "") - (if label (format "\\label{%s}" label) "") - (or caption "")) - (if org-export-latex-table-caption-above tbl) - "\n\\end{table}\n"))) - (insert (org-export-latex-protect-string tbl)))) - -(defun org-export-latex-fontify () - "Convert fontification to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-emph-re nil t) - ;; The match goes one char after the *string*, except at the end of a line - (let ((emph (assoc (match-string 3) - org-export-latex-emphasis-alist)) - (beg (match-beginning 0)) - (end (match-end 0)) - rpl s) - (unless emph - (message "`org-export-latex-emphasis-alist' has no entry for formatting triggered by \"%s\"" - (match-string 3))) - (unless (or (and (get-text-property (- (point) 2) 'org-protected) - (not (get-text-property - (- (point) 2) 'org-verbatim-emph))) - (equal (char-after (match-beginning 3)) - (char-after (1+ (match-beginning 3)))) - (save-excursion - (goto-char (match-beginning 1)) - (save-match-data - (and (org-at-table-p) - (string-match - "[|\n]" (buffer-substring beg end))))) - (and (equal (match-string 3) "+") - (save-match-data - (string-match "\\`-+\\'" (match-string 4))))) - (setq s (match-string 4)) - (setq rpl (concat (match-string 1) - (org-export-latex-emph-format (cadr emph) - (match-string 4)) - (match-string 5))) - (if (caddr emph) - (setq rpl (org-export-latex-protect-string rpl)) - (save-match-data - (if (string-match "\\`.?\\(\\\\[a-z]+{\\)\\(.*\\)\\(}\\).?\\'" rpl) - (progn - (add-text-properties (match-beginning 1) (match-end 1) - '(org-protected t) rpl) - (add-text-properties (match-beginning 3) (match-end 3) - '(org-protected t) rpl))))) - (replace-match rpl t t))) - (backward-char))) - -(defun org-export-latex-emph-format (format string) - "Format an emphasis string and handle the \\verb special case." - (when (member format '("\\verb" "\\protectedtexttt")) - (save-match-data - (if (equal format "\\verb") - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (catch 'exit - (loop for i from 0 to (1- (length ll)) do - (if (not (string-match (regexp-quote (substring ll i (1+ i))) - string)) - (progn - (setq format (concat "\\verb" (substring ll i (1+ i)) - "%s" (substring ll i (1+ i)))) - (throw 'exit nil)))))) - (let ((start 0) - (trans '(("\\" . "\\textbackslash{}") - ("~" . "\\textasciitilde{}") - ("^" . "\\textasciicircum{}"))) - (rtn "") char) - (while (string-match "[\\{}$%&_#~^]" string) - (setq char (match-string 0 string)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring string - 0 (match-beginning 0))))) - (setq string (substring string (1+ (match-beginning 0)))) - (setq char (or (cdr (assoc char trans)) (concat "\\" char)) - rtn (concat rtn char))) - (setq string (concat rtn string) format "\\texttt{%s}") - (while (string-match "--" string) - (setq string (replace-match "-{}-" t t string))))))) - (format format string)) - -(defun org-export-latex-links () - ;; Make sure to use the LaTeX hyperref and graphicx package - ;; or send some warnings. - "Convert links to LaTeX." - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-analytic-regexp++ nil t) - (org-if-unprotected-1 - (goto-char (match-beginning 0)) - (let* ((re-radio org-export-latex-all-targets-re) - (remove (list (match-beginning 0) (match-end 0))) - (raw-path (org-extract-attributes (match-string 3))) - (full-raw-path (concat (match-string 1) raw-path)) - (desc (match-string 5)) - (type (or (match-string 2) - (if (or (file-name-absolute-p raw-path) - (string-match "^\\.\\.?/" raw-path)) - "file"))) - (coderefp (equal type "coderef")) - (caption (org-find-text-property-in-string 'org-caption raw-path)) - (shortn (org-find-text-property-in-string 'org-caption-shortn raw-path)) - (attr (or (org-find-text-property-in-string 'org-attributes raw-path) - (plist-get org-export-latex-options-plist :latex-image-options))) - (label (org-find-text-property-in-string 'org-label raw-path)) - imgp radiop fnc - ;; define the path of the link - (path (cond - ((member type '("coderef")) - raw-path) - ((member type '("http" "https" "ftp")) - (concat type ":" raw-path)) - ((and re-radio (string-match re-radio raw-path)) - (setq radiop t)) - ((equal type "mailto") - (concat type ":" raw-path)) - ((equal type "file") - (if (and (org-file-image-p - (expand-file-name (org-link-unescape raw-path)) - org-export-latex-inline-image-extensions) - (or (get-text-property 0 'org-no-description raw-path) - (equal desc full-raw-path))) - (setq imgp t) - (progn (setq raw-path (org-link-unescape raw-path)) - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - (if (file-exists-p raw-path) - (concat type "://" (expand-file-name raw-path)) - (concat type "://" (org-export-directory - :LaTeX org-export-latex-options-plist) - raw-path)))))))) - ;; process with link inserting - (apply 'delete-region remove) - (setq caption (and caption (org-export-latex-fontify-headline caption))) - (cond ((and imgp - (plist-get org-export-latex-options-plist :inline-images)) - ;; OK, we need to inline an image - (insert - (org-export-latex-format-image raw-path caption label attr shortn))) - (coderefp - (insert (format - (org-export-get-coderef-format path desc) - (cdr (assoc path org-export-code-refs))))) - (radiop (insert (format org-export-latex-hyperref-format - (org-solidify-link-text raw-path) desc))) - ((not type) - (insert (format org-export-latex-hyperref-format - (org-remove-initial-hash - (org-solidify-link-text raw-path)) - desc))) - (path - (when (org-at-table-p) - ;; There is a strange problem when we have a link in a table, - ;; ampersands then cause a problem. I think this must be - ;; a LaTeX issue, but we here implement a work-around anyway. - (setq path (org-export-latex-protect-amp path) - desc (org-export-latex-protect-amp desc))) - (insert - (if (string-match "%s.*%s" org-export-latex-href-format) - (format org-export-latex-href-format path desc) - (format org-export-latex-href-format path)))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for formatting the link - (insert - (save-match-data - (funcall fnc (org-link-unescape raw-path) desc 'latex)))) - ;; Unrecognized path type - (t (insert (format org-export-latex-link-with-unknown-path-format desc)))))))) - - -(defun org-export-latex-format-image (path caption label attr &optional shortn) - "Format the image element, depending on user settings." - (let (ind floatp wrapp multicolumnp placement figenv) - (setq floatp (or caption label)) - (setq ind (org-get-text-property-any 0 'original-indentation path)) - (when (and attr (stringp attr)) - (if (string-match "[ \t]*\\<wrap\\>" attr) - (setq wrapp t floatp nil attr (replace-match "" t t attr))) - (if (string-match "[ \t]*\\<float\\>" attr) - (setq wrapp nil floatp t attr (replace-match "" t t attr))) - (if (string-match "[ \t]*\\<multicolumn\\>" attr) - (setq multicolumnp t attr (replace-match "" t t attr)))) - - (setq placement - (cond - (wrapp "{l}{0.5\\textwidth}") - (floatp (concat "[" org-latex-default-figure-position "]")) - (t ""))) - - (when (and attr (stringp attr) - (string-match "[ \t]*\\<placement=\\(\\S-+\\)" attr)) - (setq placement (match-string 1 attr) - attr (replace-match "" t t attr))) - (setq attr (and attr (org-trim attr))) - (when (or (not attr) (= (length attr) 0)) - (setq attr (cond (floatp "width=0.7\\textwidth") - (wrapp "width=0.48\\textwidth") - (t attr)))) - (setq figenv - (cond - (wrapp "\\begin{wrapfigure}%placement -\\centering -\\includegraphics[%attr]{%path} -\\caption%shortn{%labelcmd%caption} -\\end{wrapfigure}") - (multicolumnp "\\begin{figure*}%placement -\\centering -\\includegraphics[%attr]{%path} -\\caption%shortn{%labelcmd%caption} -\\end{figure*}") - (floatp "\\begin{figure}%placement -\\centering -\\includegraphics[%attr]{%path} -\\caption%shortn{%labelcmd%caption} -\\end{figure}") - (t "\\includegraphics[%attr]{%path}"))) - - - (setq figenv (mapconcat 'identity (split-string figenv "\n") - (save-excursion (beginning-of-line 1) - (looking-at "[ \t]*") - (concat "\n" (match-string 0))))) - - (if (and (not label) (not caption) - (string-match "^\\\\caption{.*\n" figenv)) - (setq figenv (replace-match "" t t figenv))) - (org-add-props - (org-fill-template - figenv - (list (cons "path" - (if (file-name-absolute-p path) - (expand-file-name path) - path)) - (cons "attr" attr) - (cons "shortn" (if shortn (format "[%s]" shortn) "")) - (cons "labelcmd" (if label (format "\\label{%s}" - label)"")) - (cons "caption" (or caption "")) - (cons "placement" (or placement "")))) - nil 'original-indentation ind))) - -(defun org-export-latex-protect-amp (s) - (while (string-match "\\([^\\\\]\\)\\(&\\)" s) - (setq s (replace-match (concat (match-string 1 s) "\\" (match-string 2 s)) - t t s))) - s) - -(defun org-remove-initial-hash (s) - (if (string-match "\\`#" s) - (substring s 1) - s)) -(defvar org-latex-entities) ; defined below -(defvar org-latex-entities-regexp) ; defined below - -(defun org-export-latex-preprocess (parameters) - "Clean stuff in the LaTeX export." - ;; Replace footnotes. - (when (plist-get parameters :footnotes) - (goto-char (point-min)) - (let (ref) - (while (setq ref (org-footnote-get-next-reference)) - (let* ((beg (nth 1 ref)) - (lbl (car ref)) - (def (nth 1 (assoc (string-to-number lbl) - (mapcar (lambda (e) (cdr e)) - org-export-footnotes-seen))))) - ;; Fix body for footnotes ending on a link or a list and - ;; remove definition from buffer. - (setq def - (concat def - (if (string-match "ORG-LIST-END-MARKER\\'" def) - "\n" " "))) - (org-footnote-delete-definitions lbl) - ;; Compute string to insert (FNOTE), and protect the outside - ;; macro from further transformation. When footnote at - ;; point is referring to a previously defined footnote, use - ;; \footnotemark. Otherwise, use \footnote. - (let ((fnote (if (member lbl org-export-latex-footmark-seen) - (org-export-latex-protect-string - (format "\\footnotemark[%s]" lbl)) - (push lbl org-export-latex-footmark-seen) - (concat (org-export-latex-protect-string "\\footnote{") - def - (org-export-latex-protect-string "}")))) - ;; Check if another footnote is immediately following. - ;; If so, add a separator in-between. - (sep (org-export-latex-protect-string - (if (save-excursion (goto-char (1- (nth 2 ref))) - (let ((next (org-footnote-get-next-reference))) - (and next (= (nth 1 next) (nth 2 ref))))) - org-export-latex-footnote-separator "")))) - (when (org-at-heading-p) - (setq fnote (concat (org-export-latex-protect-string "\\protect") - fnote))) - ;; Ensure a footnote at column 0 cannot end a list - ;; containing it. - (put-text-property 0 (length fnote) 'original-indentation 1000 fnote) - ;; Replace footnote reference with FNOTE and, maybe, SEP. - ;; `save-excursion' is required if there are two footnotes - ;; in a row. In that case, point would be left at the - ;; beginning of the second one, and - ;; `org-footnote-get-next-reference' would then skip it. - (goto-char beg) - (delete-region beg (nth 2 ref)) - (save-excursion (insert fnote sep))))))) - - ;; Remove footnote section tag for LaTeX - (goto-char (point-min)) - (while (re-search-forward - (concat "^" footnote-section-tag-regexp) nil t) - (org-if-unprotected - (replace-match ""))) - ;; Remove any left-over footnote definition. - (mapc (lambda (fn) (org-footnote-delete-definitions (car fn))) - org-export-footnotes-data) - (mapc (lambda (fn) (org-footnote-delete-definitions fn)) - org-export-latex-footmark-seen) - - ;; Preserve line breaks - (goto-char (point-min)) - (while (re-search-forward "\\\\\\\\" nil t) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))) - - ;; Preserve latex environments - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\\\begin{\\([a-zA-Z]+\\*?\\)}" nil t) - (org-if-unprotected - (let* ((start (progn (beginning-of-line) (point))) - (end (and (re-search-forward - (concat "^[ \t]*\\\\end{" - (regexp-quote (match-string 1)) - "}") nil t) - (point-at-eol)))) - (if end - (add-text-properties start end '(org-protected t)) - (goto-char (point-at-eol)))))) - - ;; Preserve math snippets - (let* ((matchers (plist-get org-format-latex-options :matchers)) - (re-list org-latex-regexps) - beg end re e m n block off) - ;; Check the different regular expressions - (while (setq e (pop re-list)) - (setq m (car e) re (nth 1 e) n (nth 2 e) - block (if (nth 3 e) "\n\n" "")) - (setq off (if (member m '("$" "$1")) 1 0)) - (when (and (member m matchers) (not (equal m "begin"))) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq beg (+ (match-beginning 0) off) end (- (match-end 0) 0)) - (add-text-properties beg end '(org-protected t org-latex-math t)))))) - - ;; Convert LaTeX to \LaTeX{} and TeX to \TeX{} - (goto-char (point-min)) - (let ((case-fold-search nil)) - (while (re-search-forward "\\<\\(\\(La\\)?TeX\\)\\>" nil t) - (unless (eq (char-before (match-beginning 1)) ?\\) - (org-if-unprotected-1 - (replace-match (org-export-latex-protect-string - (concat "\\" (match-string 1) - "{}")) t t))))) - - ;; Convert blockquotes - (goto-char (point-min)) - (while (search-forward "ORG-BLOCKQUOTE-START" nil t) - (org-replace-match-keep-properties "\\begin{quote}" t t)) - (goto-char (point-min)) - (while (search-forward "ORG-BLOCKQUOTE-END" nil t) - (org-replace-match-keep-properties "\\end{quote}" t t)) - - ;; Convert verse - (goto-char (point-min)) - (while (search-forward "ORG-VERSE-START" nil t) - (org-replace-match-keep-properties "\\begin{verse}" t t) - (beginning-of-line 2) - (while (and (not (looking-at "[ \t]*ORG-VERSE-END.*")) (not (eobp))) - (when (looking-at "\\([ \t]+\\)\\([^ \t\n]\\)") - (goto-char (match-end 1)) - (org-replace-match-keep-properties - (org-export-latex-protect-string - (concat "\\hspace*{1cm}" (match-string 2))) t t) - (beginning-of-line 1)) - (if (looking-at "[ \t]*$") - (insert (org-export-latex-protect-string "\\vspace*{1em}")) - (unless (looking-at ".*?[^ \t\n].*?\\\\\\\\[ \t]*$") - (end-of-line 1) - (insert "\\\\"))) - (beginning-of-line 2)) - (and (looking-at "[ \t]*ORG-VERSE-END.*") - (org-replace-match-keep-properties "\\end{verse}" t t))) - - ;; Convert #+INDEX to LaTeX \\index. - (goto-char (point-min)) - (let ((case-fold-search t) entry) - (while (re-search-forward - "^[ \t]*#\\+index:[ \t]*\\([^ \t\r\n].*?\\)[ \t]*$" - nil t) - (setq entry - (save-match-data - (org-export-latex-protect-string - (org-export-latex-fontify-headline (match-string 1))))) - (replace-match (format "\\index{%s}" entry) t t))) - - ;; Convert center - (goto-char (point-min)) - (while (search-forward "ORG-CENTER-START" nil t) - (org-replace-match-keep-properties "\\begin{center}" t t)) - (goto-char (point-min)) - (while (search-forward "ORG-CENTER-END" nil t) - (org-replace-match-keep-properties "\\end{center}" t t)) - - (run-hooks 'org-export-latex-after-blockquotes-hook) - - ;; Convert horizontal rules - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*-\\{5,\\}[ \t]*$" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string "\\hrule") t t))) - - ;; Protect LaTeX commands like \command[...]{...} or \command{...} - (goto-char (point-min)) - (let ((re (concat - "\\\\\\([a-zA-Z]+\\*?\\)" - "\\(?:<[^<>\n]*>\\)*" - "\\(?:\\[[^][\n]*?\\]\\)*" - "\\(?:<[^<>\n]*>\\)*" - "\\(" (org-create-multibrace-regexp "{" "}" 3) "\\)\\{1,3\\}"))) - (while (re-search-forward re nil t) - (unless (or - ;; Check for comment line. - (save-excursion (goto-char (match-beginning 0)) - (org-in-indented-comment-line)) - ;; Check if this is a defined entity, so that is may - ;; need conversion. - (org-entity-get (match-string 1)) - ;; Do not protect interior of footnotes. Those have - ;; already been taken care of earlier in the function. - ;; Yet, keep looking inside them for more commands. - (and (equal (match-string 1) "footnote") - (goto-char (match-end 1)))) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t))))) - - ;; Special case for \nbsp - (goto-char (point-min)) - (while (re-search-forward "\\\\nbsp\\({}\\|\\>\\)" nil t) - (org-if-unprotected - (replace-match (org-export-latex-protect-string "~")))) - - ;; Protect LaTeX entities - (goto-char (point-min)) - (while (re-search-forward org-latex-entities-regexp nil t) - (org-if-unprotected - (add-text-properties (match-beginning 0) (match-end 0) - '(org-protected t)))) - - ;; Replace radio links - (goto-char (point-min)) - (while (re-search-forward - (concat "<<<?" org-export-latex-all-targets-re - ">>>?\\((INVISIBLE)\\)?") nil t) - (org-if-unprotected-at (+ (match-beginning 0) 2) - (replace-match - (concat - (org-export-latex-protect-string - (format "\\label{%s}" (save-match-data (org-solidify-link-text - (match-string 1))))) - (if (match-string 2) "" (match-string 1))) - t t))) - - ;; Delete @<...> constructs - ;; Thanks to Daniel Clemente for this regexp - (goto-char (point-min)) - (while (re-search-forward "@<\\(?:[^\"\n]\\|\".*\"\\)*?>" nil t) - (org-if-unprotected - (replace-match "")))) - -(defun org-export-latex-fix-inputenc () - "Set the coding system in inputenc to what the buffer is." - (let* ((cs buffer-file-coding-system) - (opt (or (ignore-errors (latexenc-coding-system-to-inputenc cs)) - "utf8"))) - (when opt - ;; Translate if that is requested - (setq opt (or (cdr (assoc opt org-export-latex-inputenc-alist)) opt)) - ;; find the \usepackage statement and replace the option - (goto-char (point-min)) - (while (re-search-forward "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" - nil t) - (goto-char (match-beginning 1)) - (delete-region (match-beginning 1) (match-end 1)) - (insert opt)) - (and buffer-file-name - (save-buffer))))) - -;;; List handling: - -(defun org-export-latex-lists () - "Convert plain text lists in current buffer into LaTeX lists." - ;; `org-list-end-re' output has changed since preprocess from - ;; org-exp.el. Make sure it is taken into account. - (let ((org-list-end-re "^ORG-LIST-END-MARKER\n")) - (mapc - (lambda (e) - ;; For each type of context allowed for list export (E), find - ;; every list, parse it, delete it and insert resulting - ;; conversion to latex (RES), while keeping the same - ;; `original-indentation' property. - (let (res) - (goto-char (point-min)) - (while (re-search-forward (org-item-beginning-re) nil t) - (when (and (eq (get-text-property (point) 'list-context) e) - (not (get-text-property (point) 'org-example))) - (beginning-of-line) - (setq res - (org-list-to-latex - ;; Narrowing is needed because we're converting - ;; from inner functions to outer ones. - (save-restriction - (narrow-to-region (point) (point-max)) - (org-list-parse-list t)) - org-export-latex-list-parameters)) - ;; Extend previous value of original-indentation to the - ;; whole string - (insert (org-add-props res nil 'original-indentation - (org-find-text-property-in-string - 'original-indentation res))))))) - ;; List of allowed contexts for export, and the default one. - (append org-list-export-context '(nil))))) - -(defconst org-latex-entities - '("\\!" - "\\'" - "\\+" - "\\," - "\\-" - "\\:" - "\\;" - "\\<" - "\\=" - "\\>" - "\\Huge" - "\\LARGE" - "\\Large" - "\\Styles" - "\\\\" - "\\`" - "\\\"" - "\\addcontentsline" - "\\address" - "\\addtocontents" - "\\addtocounter" - "\\addtolength" - "\\addvspace" - "\\alph" - "\\appendix" - "\\arabic" - "\\author" - "\\begin{array}" - "\\begin{center}" - "\\begin{description}" - "\\begin{enumerate}" - "\\begin{eqnarray}" - "\\begin{equation}" - "\\begin{figure}" - "\\begin{flushleft}" - "\\begin{flushright}" - "\\begin{itemize}" - "\\begin{list}" - "\\begin{minipage}" - "\\begin{picture}" - "\\begin{quotation}" - "\\begin{quote}" - "\\begin{tabbing}" - "\\begin{table}" - "\\begin{tabular}" - "\\begin{thebibliography}" - "\\begin{theorem}" - "\\begin{titlepage}" - "\\begin{verbatim}" - "\\begin{verse}" - "\\bf" - "\\bf" - "\\bibitem" - "\\bigskip" - "\\cdots" - "\\centering" - "\\circle" - "\\cite" - "\\cleardoublepage" - "\\clearpage" - "\\cline" - "\\closing" - "\\dashbox" - "\\date" - "\\ddots" - "\\dotfill" - "\\em" - "\\fbox" - "\\flushbottom" - "\\fnsymbol" - "\\footnote" - "\\footnotemark" - "\\footnotesize" - "\\footnotetext" - "\\frac" - "\\frame" - "\\framebox" - "\\hfill" - "\\hline" - "\\hrulespace" - "\\hspace" - "\\huge" - "\\hyphenation" - "\\include" - "\\includeonly" - "\\indent" - "\\input" - "\\it" - "\\kill" - "\\label" - "\\large" - "\\ldots" - "\\line" - "\\linebreak" - "\\linethickness" - "\\listoffigures" - "\\listoftables" - "\\location" - "\\makebox" - "\\maketitle" - "\\mark" - "\\mbox" - "\\medskip" - "\\multicolumn" - "\\multiput" - "\\newcommand" - "\\newcounter" - "\\newenvironment" - "\\newfont" - "\\newlength" - "\\newline" - "\\newpage" - "\\newsavebox" - "\\newtheorem" - "\\nocite" - "\\nofiles" - "\\noindent" - "\\nolinebreak" - "\\nopagebreak" - "\\normalsize" - "\\onecolumn" - "\\opening" - "\\oval" - "\\overbrace" - "\\overline" - "\\pagebreak" - "\\pagenumbering" - "\\pageref" - "\\pagestyle" - "\\par" - "\\parbox" - "\\put" - "\\raggedbottom" - "\\raggedleft" - "\\raggedright" - "\\raisebox" - "\\ref" - "\\rm" - "\\roman" - "\\rule" - "\\savebox" - "\\sc" - "\\scriptsize" - "\\setcounter" - "\\setlength" - "\\settowidth" - "\\sf" - "\\shortstack" - "\\signature" - "\\sl" - "\\small" - "\\smallskip" - "\\sqrt" - "\\tableofcontents" - "\\telephone" - "\\thanks" - "\\thispagestyle" - "\\tiny" - "\\title" - "\\tt" - "\\twocolumn" - "\\typein" - "\\typeout" - "\\underbrace" - "\\underline" - "\\usebox" - "\\usecounter" - "\\value" - "\\vdots" - "\\vector" - "\\verb" - "\\vfill" - "\\vline" - "\\vspace") - "A list of LaTeX commands to be protected when performing conversion.") - -(defconst org-latex-entities-regexp - (let (names rest) - (dolist (x org-latex-entities) - (if (string-match "[a-zA-Z]$" x) - (push x names) - (push x rest))) - (concat "\\(" (regexp-opt (nreverse names)) "\\>\\)" - "\\|\\(" (regexp-opt (nreverse rest)) "\\)"))) - -(provide 'org-export-latex) -(provide 'org-latex) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-latex.el ends here diff --git a/lisp/org/org-lparse.el b/lisp/org/org-lparse.el deleted file mode 100644 index 11711353ff..0000000000 --- a/lisp/org/org-lparse.el +++ /dev/null @@ -1,2303 +0,0 @@ -;;; org-lparse.el --- Line-oriented parser-exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K <kjambunathan at gmail dot com> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; 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: - -;; `org-lparse' is the entry point for the generic line-oriented -;; exporter. `org-do-lparse' is the genericized version of the -;; original `org-export-as-html' routine. - -;; `org-lparse-native-backends' is a good starting point for -;; exploring the generic exporter. - -;; Following new interactive commands are provided by this library. -;; `org-lparse', `org-lparse-and-open', `org-lparse-to-buffer' -;; `org-replace-region-by', `org-lparse-region'. - -;; Note that the above routines correspond to the following routines -;; in the html exporter `org-export-as-html', -;; `org-export-as-html-and-open', `org-export-as-html-to-buffer', -;; `org-replace-region-by-html' and `org-export-region-as-html'. - -;; The new interactive command `org-lparse-convert' can be used to -;; convert documents between various formats. Use this to command, -;; for example, to convert odt file to doc or pdf format. - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-exp) -(require 'org-list) -(require 'format-spec) - -(defun org-lparse-and-open (target-backend native-backend arg - &optional file-or-buf) - "Export outline to TARGET-BACKEND via NATIVE-BACKEND and open exported file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists." - (let (f (file-or-buf (or file-or-buf - (org-lparse target-backend native-backend - arg 'hidden)))) - (when file-or-buf - (setq f (cond - ((bufferp file-or-buf) buffer-file-name) - ((file-exists-p file-or-buf) file-or-buf) - (t (error "org-lparse-and-open: This shouldn't happen")))) - (message "Opening file %s" f) - (org-open-file f 'system) - (when org-export-kill-product-buffer-when-displayed - (kill-buffer (current-buffer)))))) - -(defun org-lparse-batch (target-backend &optional native-backend) - "Call the function `org-lparse'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-lparse-batch" - (setq native-backend (or native-backend target-backend)) - (org-lparse target-backend native-backend - org-export-headline-levels 'hidden)) - -(defun org-lparse-to-buffer (backend arg) - "Call `org-lparse' with output to a temporary buffer. -No file is created. The prefix ARG is passed through to -`org-lparse'." - (let ((tempbuf (format "*Org %s Export*" (upcase backend)))) - (org-lparse backend backend arg nil nil tempbuf) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window tempbuf)))) - -(defun org-replace-region-by (backend beg end) - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you could write an -itemized list in org-mode syntax in an HTML buffer and then use -this command to convert it." - (let (reg backend-string buf pop-up-frames) - (save-window-excursion - (if (derived-mode-p 'org-mode) - (setq backend-string (org-lparse-region backend beg end t 'string)) - (setq reg (buffer-substring beg end) - buf (get-buffer-create "*Org tmp*")) - (with-current-buffer buf - (erase-buffer) - (insert reg) - (org-mode) - (setq backend-string (org-lparse-region backend (point-min) - (point-max) t 'string))) - (kill-buffer buf))) - (delete-region beg end) - (insert backend-string))) - -(defun org-lparse-region (backend beg end &optional body-only buffer) - "Convert region from BEG to END in org-mode buffer to HTML. -If prefix arg BODY-ONLY is set, omit file header, footer, and table of -contents, and only produce the region of converted text, useful for -cut-and-paste operations. -If BUFFER is a buffer or a string, use/create that buffer as a target -of the converted HTML. If BUFFER is the symbol `string', return the -produced HTML as a string and leave not buffer behind. For example, -a Lisp program could call this function in the following way: - - (setq html (org-lparse-region \"html\" beg end t 'string)) - -When called interactively, the output buffer is selected, and shown -in a window. A non-interactive call will only return the buffer." - (let ((transient-mark-mode t) (zmacs-regions t) - ext-plist rtn) - (setq ext-plist (plist-put ext-plist :ignore-subtree-p t)) - (goto-char end) - (set-mark (point)) ;; to activate the region - (goto-char beg) - (setq rtn (org-lparse backend backend nil nil ext-plist buffer body-only)) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (if (and (org-called-interactively-p 'any) (bufferp rtn)) - (switch-to-buffer-other-window rtn) - rtn))) - -(defvar org-lparse-par-open nil) - -(defun org-lparse-should-inline-p (filename descp) - "Return non-nil if link FILENAME should be inlined. -The decision to inline the FILENAME link is based on the current -settings. DESCP is the boolean of whether there was a link -description. See variables `org-export-html-inline-images' and -`org-export-html-inline-image-extensions'." - (let ((inline-images (org-lparse-get 'INLINE-IMAGES)) - (inline-image-extensions - (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (and (or (eq t inline-images) (and inline-images (not descp))) - (org-file-image-p filename inline-image-extensions)))) - -(defun org-lparse-format-org-link (line opt-plist) - "Return LINE with markup of Org mode links. -OPT-PLIST is the export options list." - (let ((start 0) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (link-validate (plist-get opt-plist :link-validation-function)) - type id-file fnc - rpl path attr desc descp desc1 desc2 link - org-lparse-link-description-is-image) - (while (string-match org-bracket-link-analytic-regexp++ line start) - (setq org-lparse-link-description-is-image nil) - (setq start (match-beginning 0)) - (setq path (save-match-data (org-link-unescape - (match-string 3 line)))) - (setq type (cond - ((match-end 2) (match-string 2 line)) - ((save-match-data - (or (file-name-absolute-p path) - (string-match "^\\.\\.?/" path))) - "file") - (t "internal"))) - (setq path (org-extract-attributes path)) - (setq attr (get-text-property 0 'org-attributes path)) - (setq desc1 (if (match-end 5) (match-string 5 line)) - desc2 (if (match-end 2) (concat type ":" path) path) - descp (and desc1 (not (equal desc1 desc2))) - desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted - (when (and descp (org-file-image-p - desc (org-lparse-get 'INLINE-IMAGE-EXTENSIONS))) - (setq org-lparse-link-description-is-image t) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (save-match-data - (setq desc (org-add-props - (org-lparse-format 'INLINE-IMAGE desc) - '(org-protected t))))) - (cond - ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist "" "" (org-solidify-link-text - (save-match-data - (org-link-unescape frag-0)) - nil) desc attr descp)))) - ((and (equal type "id") - (setq id-file (org-id-find-id-file path))) - ;; This is an id: link to another file (if it was the same file, - ;; it would have become an internal link...) - (save-match-data - (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc attr descp)))) - ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type path nil desc attr descp))) - ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-lparse-format - 'ORG-LINK opt-plist type path nil desc attr descp))) - - ((string= type "coderef") - (setq rpl (org-lparse-format - 'ORG-LINK opt-plist type "" path desc nil descp))) - - ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) - ;; The link protocol has a function for format the link - (setq rpl (save-match-data - (funcall fnc (org-link-unescape path) - desc1 (and (boundp 'org-lparse-backend) - (case org-lparse-backend - (xhtml 'html) - (t org-lparse-backend))))))) - ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) - - ;;The proper path, without a fragment - (path-1 - (first components)) - - ;;The raw fragment - (fragment-0 - (second components)) - - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) - - (setq rpl - (if - (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) - desc - (org-lparse-format - 'ORG-LINK opt-plist "file" path-1 fragment-1 - desc-2 attr descp)))))) - - (t - ;; just publish the path, as default - (setq rpl (concat "<i><" type ":" - (save-match-data (org-link-unescape path)) - "></i>")))) - (setq line (replace-match rpl t t line) - start (+ start (length rpl)))) - line)) - -(defvar org-lparse-par-open-stashed) ; bound during `org-do-lparse' -(defun org-lparse-stash-save-paragraph-state () - (assert (zerop org-lparse-par-open-stashed)) - (setq org-lparse-par-open-stashed org-lparse-par-open) - (setq org-lparse-par-open nil)) - -(defun org-lparse-stash-pop-paragraph-state () - (setq org-lparse-par-open org-lparse-par-open-stashed) - (setq org-lparse-par-open-stashed 0)) - -(defmacro with-org-lparse-preserve-paragraph-state (&rest body) - `(let ((org-lparse-do-open-par org-lparse-par-open)) - (org-lparse-end-paragraph) - ,@body - (when org-lparse-do-open-par - (org-lparse-begin-paragraph)))) -(def-edebug-spec with-org-lparse-preserve-paragraph-state (body)) - -(defvar org-lparse-native-backends nil - "List of native backends registered with `org-lparse'. -A backend can use `org-lparse-register-backend' to add itself to -this list. - -All native backends must implement a get routine and a mandatory -set of callback routines. - -The get routine must be named as org-<backend>-get where backend -is the name of the backend. The exporter uses `org-lparse-get' -and retrieves the backend-specific callback by querying for -ENTITY-CONTROL and ENTITY-FORMAT variables. - -For the sake of illustration, the html backend implements -`org-xhtml-get'. It returns -`org-xhtml-entity-control-callbacks-alist' and -`org-xhtml-entity-format-callbacks-alist' as the values of -ENTITY-CONTROL and ENTITY-FORMAT settings.") - -(defun org-lparse-register-backend (backend) - "Make BACKEND known to `org-lparse' library. -Add BACKEND to `org-lparse-native-backends'." - (when backend - (setq backend (cond - ((symbolp backend) (symbol-name backend)) - ((stringp backend) backend) - (t (error "Error while registering backend: %S" backend)))) - (add-to-list 'org-lparse-native-backends backend))) - -(defun org-lparse-unregister-backend (backend) - (setq org-lparse-native-backends - (remove (cond - ((symbolp backend) (symbol-name backend)) - ((stringp backend) backend)) - org-lparse-native-backends)) - (message "Unregistered backend %S" backend)) - -(defun org-lparse-do-reachable-formats (in-fmt) - "Return verbose info about formats to which IN-FMT can be converted. -Return a list where each element is of the -form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See -`org-export-odt-convert-processes' for CONVERTER-PROCESS and see -`org-export-odt-convert-capabilities' for OUTPUT-FMT-ALIST." - (let (reachable-formats) - (dolist (backend org-lparse-native-backends reachable-formats) - (let* ((converter (org-lparse-backend-get - backend 'CONVERT-METHOD)) - (capabilities (org-lparse-backend-get - backend 'CONVERT-CAPABILITIES))) - (when converter - (dolist (c capabilities) - (when (member in-fmt (nth 1 c)) - (push (cons converter (nth 2 c)) reachable-formats)))))))) - -(defun org-lparse-reachable-formats (in-fmt) - "Return list of formats to which IN-FMT can be converted. -The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." - (let (l) - (mapc (lambda (e) (add-to-list 'l e)) - (apply 'append (mapcar - (lambda (e) (mapcar 'car (cdr e))) - (org-lparse-do-reachable-formats in-fmt)))) - l)) - -(defun org-lparse-reachable-p (in-fmt out-fmt) - "Return non-nil if IN-FMT can be converted to OUT-FMT." - (catch 'done - (let ((reachable-formats (org-lparse-do-reachable-formats in-fmt))) - (dolist (e reachable-formats) - (let ((out-fmt-spec (assoc out-fmt (cdr e)))) - (when out-fmt-spec - (throw 'done (cons (car e) out-fmt-spec)))))))) - -(defun org-lparse-backend-is-native-p (backend) - (member backend org-lparse-native-backends)) - -(defun org-lparse (target-backend native-backend arg - &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline to various formats. -If there is an active region, export only the region. The -outline is first exported to NATIVE-BACKEND and optionally -converted to TARGET-BACKEND. See `org-lparse-native-backends' -for list of known native backends. Each native backend can -specify a converter and list of target backends it exports to -using the CONVERT-PROCESS and OTHER-BACKENDS settings of it's get -method. See `org-xhtml-get' for an illustrative example. - -ARG is a prefix argument that specifies how many levels of -outline should become headlines. The default is 3. Lower levels -will become bulleted lists. - -HIDDEN is obsolete and does nothing. - -EXT-PLIST is a property list that controls various aspects of -export. The settings here override org-mode's default settings -and but are inferior to file-local settings. - -TO-BUFFER dumps the exported lines to a buffer or a string -instead of a file. If TO-BUFFER is the symbol `string' return the -exported lines as a string. If TO-BUFFER is non-nil, create a -buffer with that name and export to that buffer. - -BODY-ONLY controls the presence of header and footer lines in -exported text. If BODY-ONLY is non-nil, don't produce the file -header and footer, simply return the content of <body>...</body>, -without even the body tags themselves. - -PUB-DIR specifies the publishing directory." - (let* ((org-lparse-backend (intern native-backend)) - (org-lparse-other-backend (and target-backend - (intern target-backend)))) - (add-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe) - (add-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote) - (unless (org-lparse-backend-is-native-p native-backend) - (error "Don't know how to export natively to backend %s" native-backend)) - - (unless (or (equal native-backend target-backend) - (org-lparse-reachable-p native-backend target-backend)) - (error "Don't know how to export to backend %s %s" target-backend - (format "via %s" native-backend))) - (run-hooks 'org-export-first-hook) - (prog1 - (org-do-lparse arg hidden ext-plist to-buffer body-only pub-dir) - (remove-hook 'org-export-preprocess-hook - 'org-lparse-strip-experimental-blocks-maybe) - (remove-hook 'org-export-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote)))) - -(defcustom org-lparse-use-flashy-warning nil - "Control flashing of messages logged with `org-lparse-warn'. -When non-nil, messages are fontified with warning face and the -exporter lingers for a while to catch user's attention." - :type 'boolean - :group 'org-lparse) - -(defun org-lparse-convert-read-params () - "Return IN-FILE and OUT-FMT params for `org-lparse-do-convert'. -This is a helper routine for interactive use." - (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) - (in-file (read-file-name "File to be converted: " - nil buffer-file-name t)) - (in-fmt (file-name-extension in-file)) - (out-fmt-choices (org-lparse-reachable-formats in-fmt)) - (out-fmt - (or (and out-fmt-choices - (funcall input "Output format: " - out-fmt-choices nil nil nil)) - (error - "No known converter or no known output formats for %s files" - in-fmt)))) - (list in-file out-fmt))) - -(eval-when-compile - (require 'browse-url)) - -(declare-function browse-url-file-url "browse-url" (file)) - -(defun org-lparse-do-convert (in-file out-fmt &optional prefix-arg) - "Workhorse routine for `org-export-odt-convert'." - (require 'browse-url) - (let* ((in-file (expand-file-name (or in-file buffer-file-name))) - (dummy (or (file-readable-p in-file) - (error "Cannot read %s" in-file))) - (in-fmt (file-name-extension in-file)) - (out-fmt (or out-fmt (error "Output format unspecified"))) - (how (or (org-lparse-reachable-p in-fmt out-fmt) - (error "Cannot convert from %s format to %s format?" - in-fmt out-fmt))) - (convert-process (car how)) - (out-file (concat (file-name-sans-extension in-file) "." - (nth 1 (or (cdr how) out-fmt)))) - (extra-options (or (nth 2 (cdr how)) "")) - (out-dir (file-name-directory in-file)) - (cmd (format-spec convert-process - `((?i . ,(shell-quote-argument in-file)) - (?I . ,(browse-url-file-url in-file)) - (?f . ,out-fmt) - (?o . ,out-file) - (?O . ,(browse-url-file-url out-file)) - (?d . , (shell-quote-argument out-dir)) - (?D . ,(browse-url-file-url out-dir)) - (?x . ,extra-options))))) - (when (file-exists-p out-file) - (delete-file out-file)) - - (message "Executing %s" cmd) - (let ((cmd-output (shell-command-to-string cmd))) - (message "%s" cmd-output)) - - (cond - ((file-exists-p out-file) - (message "Exported to %s" out-file) - (when prefix-arg - (message "Opening %s..." out-file) - (org-open-file out-file 'system)) - out-file) - (t - (message "Export to %s failed" out-file) - nil)))) - -(defvar org-lparse-insert-tag-with-newlines 'both) - -;; Following variables are let-bound during `org-lparse' -(defvar org-lparse-dyn-first-heading-pos) -(defvar org-lparse-toc) -(defvar org-lparse-entity-control-callbacks-alist) -(defvar org-lparse-entity-format-callbacks-alist) -(defvar org-lparse-backend nil - "The native backend to which the document is currently exported. -This variable is let bound during `org-lparse'. Valid values are -one of the symbols corresponding to `org-lparse-native-backends'. - -Compare this variable with `org-export-current-backend' which is -bound only during `org-export-preprocess-string' stage of the -export process. - -See also `org-lparse-other-backend'.") - -(defvar org-lparse-other-backend nil - "The target backend to which the document is currently exported. -This variable is let bound during `org-lparse'. This variable is -set to either `org-lparse-backend' or one of the symbols -corresponding to OTHER-BACKENDS specification of the -org-lparse-backend. - -For example, if a document is exported to \"odt\" then both -org-lparse-backend and org-lparse-other-backend are bound to -'odt. On the other hand, if a document is exported to \"odt\" -and then converted to \"doc\" then org-lparse-backend is set to -'odt and org-lparse-other-backend is set to 'doc.") - -(defvar org-lparse-body-only nil - "Bind this to BODY-ONLY arg of `org-lparse'.") - -(defvar org-lparse-to-buffer nil - "Bind this to TO-BUFFER arg of `org-lparse'.") - -(defun org-lparse-get-block-params (params) - (save-match-data - (when params - (setq params (org-trim params)) - (unless (string-match "\\`(.*)\\'" params) - (setq params (format "(%s)" params))) - (ignore-errors (read params))))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defvar org-lparse-special-blocks '("list-table" "annotation")) -(defun org-do-lparse (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline to various formats. -See `org-lparse' for more information. This function is a -html-agnostic version of the `org-export-as-html' function in 7.5 -version." - ;; Make sure we have a file name when we need it. - (when (and (not (or to-buffer body-only)) - (not buffer-file-name)) - (if (buffer-base-buffer) - (org-set-local 'buffer-file-name - (with-current-buffer (buffer-base-buffer) - buffer-file-name)) - (error "Need a file name to be able to export"))) - - (org-lparse-warn - (format "Exporting to %s using org-lparse..." - (upcase (symbol-name - (or org-lparse-backend org-lparse-other-backend))))) - - (setq-default org-todo-line-regexp org-todo-line-regexp) - (setq-default org-deadline-line-regexp org-deadline-line-regexp) - (setq-default org-done-keywords org-done-keywords) - (setq-default org-maybe-keyword-time-regexp org-maybe-keyword-time-regexp) - (let* (hfy-user-sheet-assoc ; let `htmlfontify' know that - ; we are interested in - ; collecting styles - org-lparse-encode-pending - org-lparse-par-open - (org-lparse-par-open-stashed 0) - - ;; list related vars - (org-lparse-list-stack '()) - - ;; list-table related vars - org-lparse-list-table-p - org-lparse-list-table:table-cell-open - org-lparse-list-table:table-row - org-lparse-list-table:lines - - org-lparse-outline-text-open - (org-lparse-latex-fragment-fallback ; currently used only by - ; odt exporter - (or (ignore-errors (org-lparse-get 'LATEX-FRAGMENT-FALLBACK)) - (if (and (org-check-external-command "latex" "" t) - (org-check-external-command "dvipng" "" t)) - 'dvipng - 'verbatim))) - (org-lparse-insert-tag-with-newlines 'both) - (org-lparse-to-buffer to-buffer) - (org-lparse-body-only body-only) - (org-lparse-entity-control-callbacks-alist - (org-lparse-get 'ENTITY-CONTROL)) - (org-lparse-entity-format-callbacks-alist - (org-lparse-get 'ENTITY-FORMAT)) - (opt-plist - (org-export-process-option-filters - (org-combine-plists (org-default-export-plist) - ext-plist - (org-infile-export-plist)))) - (body-only (or body-only (plist-get opt-plist :body-only))) - valid org-lparse-dyn-first-heading-pos - (odd org-odd-levels-only) - (region-p (org-region-active-p)) - (rbeg (and region-p (region-beginning))) - (rend (and region-p (region-end))) - (subtree-p - (if (plist-get opt-plist :ignore-subtree-p) - nil - (when region-p - (save-excursion - (goto-char rbeg) - (and (org-at-heading-p) - (>= (org-end-of-subtree t t) rend)))))) - (level-offset (if subtree-p - (save-excursion - (goto-char rbeg) - (+ (funcall outline-level) - (if org-odd-levels-only 1 0))) - 0)) - (opt-plist (setq org-export-opt-plist - (if subtree-p - (org-export-add-subtree-options opt-plist rbeg) - opt-plist))) - ;; The following two are dynamically scoped into other - ;; routines below. - (org-current-export-dir - (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist))) - (org-current-export-file buffer-file-name) - (level 0) (line "") (origline "") txt todo - (umax nil) - (umax-toc nil) - (filename (if to-buffer nil - (expand-file-name - (concat - (file-name-sans-extension - (or (and subtree-p - (org-entry-get (region-beginning) - "EXPORT_FILE_NAME" t)) - (file-name-nondirectory buffer-file-name))) - "." (org-lparse-get 'FILE-NAME-EXTENSION opt-plist)) - (file-name-as-directory - (or pub-dir (org-lparse-get 'EXPORT-DIR opt-plist)))))) - (current-dir (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - (auto-insert nil) ; Avoid any auto-insert stuff for the new file - (buffer (if to-buffer - (cond - ((eq to-buffer 'string) - (get-buffer-create (org-lparse-get 'EXPORT-BUFFER-NAME))) - (t (get-buffer-create to-buffer))) - (find-file-noselect - (or (let ((f (org-lparse-get 'INIT-METHOD))) - (and f (functionp f) (funcall f filename))) - filename)))) - (org-levels-open (make-vector org-level-max nil)) - (dummy (mapc - (lambda(p) - (let* ((val (plist-get opt-plist p)) - (val (org-xml-encode-org-text-skip-links val))) - (setq opt-plist (plist-put opt-plist p val)))) - '(:date :author :keywords :description))) - (date (plist-get opt-plist :date)) - (date (cond - ((and date (string-match "%" date)) - (format-time-string date)) - (date date) - (t (format-time-string "%Y-%m-%d %T %Z")))) - (dummy (setq opt-plist (plist-put opt-plist :effective-date date))) - (title (org-xml-encode-org-text-skip-links - (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED"))) - (dummy (setq opt-plist (plist-put opt-plist :title title))) - (html-table-tag (plist-get opt-plist :html-table-tag)) - (quote-re0 (concat "^ *" org-quote-string "\\( +\\|[ \t]*$\\)")) - (quote-re (format org-heading-keyword-regexp-format - org-quote-string)) - (org-lparse-dyn-current-environment nil) - ;; Get the language-dependent settings - (lang-words (or (assoc (plist-get opt-plist :language) - org-export-language-setup) - (assoc "en" org-export-language-setup))) - (dummy (setq opt-plist (plist-put opt-plist :lang-words lang-words))) - (head-count 0) cnt - (start 0) - (coding-system-for-write - (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-WRITE)) - (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (save-buffer-coding-system - (or (ignore-errors (org-lparse-get 'CODING-SYSTEM-FOR-SAVE)) - (and (boundp 'buffer-file-coding-system) - buffer-file-coding-system))) - (region - (buffer-substring - (if region-p (region-beginning) (point-min)) - (if region-p (region-end) (point-max)))) - (org-export-have-math nil) - (org-export-footnotes-seen nil) - (org-export-footnotes-data (org-footnote-all-labels 'with-defs)) - (org-footnote-insert-pos-for-preprocessor 'point-min) - (org-lparse-opt-plist opt-plist) - (lines - (org-split-string - (org-export-preprocess-string - region - :emph-multiline t - :for-backend (if (equal org-lparse-backend 'xhtml) ; hack - 'html - org-lparse-backend) - :skip-before-1st-heading - (plist-get opt-plist :skip-before-1st-heading) - :drawers (plist-get opt-plist :drawers) - :todo-keywords (plist-get opt-plist :todo-keywords) - :tasks (plist-get opt-plist :tasks) - :tags (plist-get opt-plist :tags) - :priority (plist-get opt-plist :priority) - :footnotes (plist-get opt-plist :footnotes) - :timestamps (plist-get opt-plist :timestamps) - :archived-trees - (plist-get opt-plist :archived-trees) - :select-tags (plist-get opt-plist :select-tags) - :exclude-tags (plist-get opt-plist :exclude-tags) - :add-text - (plist-get opt-plist :text) - :LaTeX-fragments - (plist-get opt-plist :LaTeX-fragments)) - "[\r\n]")) - table-open - table-buffer table-orig-buffer - ind - rpl path attr desc descp desc1 desc2 link - snumber fnc - footnotes footref-seen - org-lparse-output-buffer - org-lparse-footnote-definitions - org-lparse-footnote-number - ;; collection - org-lparse-collect-buffer - (org-lparse-collect-count 0) ; things will get haywire if - ; collections are chained. Use - ; this variable to assert this - ; pre-requisite - org-lparse-toc - href - ) - - (let ((inhibit-read-only t)) - (org-unmodified - (remove-text-properties (point-min) (point-max) - '(:org-license-to-kill t)))) - - (message "Exporting...") - (org-init-section-numbers) - - ;; Switch to the output buffer - (setq org-lparse-output-buffer buffer) - (set-buffer org-lparse-output-buffer) - (let ((inhibit-read-only t)) (erase-buffer)) - (fundamental-mode) - (org-install-letbind) - - (and (fboundp 'set-buffer-file-coding-system) - (set-buffer-file-coding-system coding-system-for-write)) - - (let ((case-fold-search nil) - (org-odd-levels-only odd)) - ;; create local variables for all options, to make sure all called - ;; functions get the correct information - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars) - (setq umax (if arg (prefix-numeric-value arg) - org-export-headline-levels)) - (setq umax-toc (if (integerp org-export-with-toc) - (min org-export-with-toc umax) - umax)) - (setq org-lparse-opt-plist - (plist-put org-lparse-opt-plist :headline-levels umax)) - - (when (and org-export-with-toc (not body-only)) - (setq lines (org-lparse-prepare-toc - lines level-offset opt-plist umax-toc))) - - (unless body-only - (org-lparse-begin 'DOCUMENT-CONTENT opt-plist) - (org-lparse-begin 'DOCUMENT-BODY opt-plist)) - - (setq head-count 0) - (org-init-section-numbers) - - (org-lparse-begin-paragraph) - - (while (setq line (pop lines) origline line) - (catch 'nextline - (when (and (org-lparse-current-environment-p 'quote) - (string-match org-outline-regexp-bol line)) - (org-lparse-end-environment 'quote)) - - (when (org-lparse-current-environment-p 'quote) - (org-lparse-insert 'LINE line) - (throw 'nextline nil)) - - ;; Fixed-width, verbatim lines (examples) - (when (and org-export-with-fixed-width - (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" line)) - (when (not (org-lparse-current-environment-p 'fixedwidth)) - (org-lparse-begin-environment 'fixedwidth)) - (org-lparse-insert 'LINE (match-string 3 line)) - (when (or (not lines) - (not (string-match "^[ \t]*:\\(\\([ \t]\\|$\\)\\(.*\\)\\)" - (car lines)))) - (org-lparse-end-environment 'fixedwidth)) - (throw 'nextline nil)) - - ;; Native Text - (when (and (get-text-property 0 'org-native-text line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-native-text line) 10000) - (length line)))) - (let ((ind (get-text-property 0 'original-indentation line))) - (org-lparse-begin-environment 'native) - (org-lparse-insert 'LINE line) - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property - 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-native-text (car lines)))) - (org-lparse-insert 'LINE (pop lines))) - (org-lparse-end-environment 'native)) - (throw 'nextline nil)) - - ;; Protected HTML - (when (and (get-text-property 0 'org-protected line) - ;; Make sure it is the entire line that is protected - (not (< (or (next-single-property-change - 0 'org-protected line) 10000) - (length line)))) - (let ((ind (get-text-property 0 'original-indentation line))) - (org-lparse-insert 'LINE line) - (while (and lines - (or (= (length (car lines)) 0) - (not ind) - (equal ind (get-text-property - 0 'original-indentation (car lines)))) - (or (= (length (car lines)) 0) - (get-text-property 0 'org-protected (car lines)))) - (org-lparse-insert 'LINE (pop lines)))) - (throw 'nextline nil)) - - ;; Blockquotes, verse, and center - (when (string-match - "^ORG-\\(.+\\)-\\(START\\|END\\)\\([ \t]+.*\\)?$" line) - (let* ((style (intern (downcase (match-string 1 line)))) - (env-options-plist (org-lparse-get-block-params - (match-string 3 line))) - (f (cdr (assoc (match-string 2 line) - '(("START" . org-lparse-begin-environment) - ("END" . org-lparse-end-environment)))))) - (when (memq style - (append - '(blockquote verse center) - (mapcar 'intern org-lparse-special-blocks))) - (funcall f style env-options-plist) - (throw 'nextline nil)))) - - (when (org-lparse-current-environment-p 'verse) - (let ((i (org-get-string-indentation line))) - (if (> i 0) - (setq line (concat - (let ((org-lparse-encode-pending t)) - (org-lparse-format 'SPACES (* 2 i))) - " " (org-trim line)))) - (unless (string-match "\\\\\\\\[ \t]*$" line) - (setq line (concat line "\\\\"))))) - - ;; make targets to anchors - (setq start 0) - (while (string-match - "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[ \t]*\n?" line start) - (cond - ((get-text-property (match-beginning 1) 'org-protected line) - (setq start (match-end 1))) - ((match-end 2) - (setq line (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'ANCHOR "" (org-solidify-link-text - (match-string 1 line)))) - t t line))) - ((and org-export-with-toc (equal (string-to-char line) ?*)) - ;; FIXME: NOT DEPENDENT on TOC????????????????????? - (setq line (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'FONTIFY (match-string 1 line) "target")) - ;; (concat "@<i>" (match-string 1 line) "@</i> ") - t t line))) - (t - (setq line (replace-match - (concat - (let ((org-lparse-encode-pending t)) - (org-lparse-format - 'ANCHOR (match-string 1 line) - (org-solidify-link-text (match-string 1 line)) - "target")) " ") - t t line))))) - - (let ((org-lparse-encode-pending t)) - (setq line (org-lparse-handle-time-stamps line))) - - ;; replace "&" by "&", "<" and ">" by "<" and ">" - ;; handle @<..> HTML tags (replace "@>..<" by "<..>") - ;; Also handle sub_superscripts and checkboxes - (or (string-match org-table-hline-regexp line) - (string-match "^[ \t]*\\([+]-\\||[ ]\\)[-+ |]*[+|][ \t]*$" line) - (setq line (org-xml-encode-org-text-skip-links line))) - - (setq line (org-lparse-format-org-link line opt-plist)) - - ;; TODO items - (if (and org-todo-line-regexp - (string-match org-todo-line-regexp line) - (match-beginning 2)) - (setq line (concat - (substring line 0 (match-beginning 2)) - (org-lparse-format 'TODO (match-string 2 line)) - (substring line (match-end 2))))) - - ;; Does this contain a reference to a footnote? - (when org-export-with-footnotes - (setq start 0) - (while (string-match "\\([^* \t].*?\\)[ \t]*\\[\\([0-9]+\\)\\]" line start) - ;; Discard protected matches not clearly identified as - ;; footnote markers. - (if (or (get-text-property (match-beginning 2) 'org-protected line) - (not (get-text-property (match-beginning 2) 'org-footnote line))) - (setq start (match-end 2)) - (let ((n (match-string 2 line)) refcnt a) - (if (setq a (assoc n footref-seen)) - (progn - (setcdr a (1+ (cdr a))) - (setq refcnt (cdr a))) - (setq refcnt 1) - (push (cons n 1) footref-seen)) - (setq line - (replace-match - (concat - (or (match-string 1 line) "") - (org-lparse-format - 'FOOTNOTE-REFERENCE - n (cdr (assoc n org-lparse-footnote-definitions)) - refcnt) - ;; If another footnote is following the - ;; current one, add a separator. - (if (save-match-data - (string-match "\\`\\[[0-9]+\\]" - (substring line (match-end 0)))) - (ignore-errors - (org-lparse-get 'FOOTNOTE-SEPARATOR)) - "")) - t t line)))))) - - (cond - ((string-match "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" line) - ;; This is a headline - (setq level (org-tr-level (- (match-end 1) (match-beginning 1) - level-offset)) - txt (match-string 2 line)) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (unless org-lparse-dyn-first-heading-pos - (setq org-lparse-dyn-first-heading-pos (point))) - (org-lparse-begin-level level txt umax head-count) - - ;; QUOTES - (when (string-match quote-re line) - (org-lparse-begin-environment 'quote))) - - ((and org-export-with-tables - (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) - (when (not table-open) - ;; New table starts - (setq table-open t table-buffer nil table-orig-buffer nil)) - - ;; Accumulate lines - (setq table-buffer (cons line table-buffer) - table-orig-buffer (cons origline table-orig-buffer)) - (when (or (not lines) - (not (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" - (car lines)))) - (setq table-open nil - table-buffer (nreverse table-buffer) - table-orig-buffer (nreverse table-orig-buffer)) - (org-lparse-end-paragraph) - (when org-lparse-list-table-p - (error "Regular tables are not allowed in a list-table block")) - (org-lparse-insert 'TABLE table-buffer table-orig-buffer))) - - ;; Normal lines - (t - ;; This line either is list item or end a list. - (when (get-text-property 0 'list-item line) - (setq line (org-lparse-export-list-line - line - (get-text-property 0 'list-item line) - (get-text-property 0 'list-struct line) - (get-text-property 0 'list-prevs line)))) - - ;; Horizontal line - (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) - (with-org-lparse-preserve-paragraph-state - (org-lparse-insert 'HORIZONTAL-LINE)) - (throw 'nextline nil)) - - ;; Empty lines start a new paragraph. If hand-formatted lists - ;; are not fully interpreted, lines starting with "-", "+", "*" - ;; also start a new paragraph. - (when (string-match "^ [-+*]-\\|^[ \t]*$" line) - (when org-lparse-footnote-number - (org-lparse-end-footnote-definition org-lparse-footnote-number) - (setq org-lparse-footnote-number nil)) - (org-lparse-begin-paragraph)) - - ;; Is this the start of a footnote? - (when org-export-with-footnotes - (when (and (boundp 'footnote-section-tag-regexp) - (string-match (concat "^" footnote-section-tag-regexp) - line)) - ;; ignore this line - (throw 'nextline nil)) - (when (string-match "^[ \t]*\\[\\([0-9]+\\)\\]" line) - (org-lparse-end-paragraph) - (setq org-lparse-footnote-number (match-string 1 line)) - (setq line (replace-match "" t t line)) - (org-lparse-begin-footnote-definition org-lparse-footnote-number))) - ;; Check if the line break needs to be conserved - (cond - ((string-match "\\\\\\\\[ \t]*$" line) - (setq line (replace-match - (org-lparse-format 'LINE-BREAK) - t t line))) - (org-export-preserve-breaks - (setq line (concat line (org-lparse-format 'LINE-BREAK))))) - - ;; Check if a paragraph should be started - (let ((start 0)) - (while (and org-lparse-par-open - (string-match "\\\\par\\>" line start)) - (error "FIXME") - ;; Leave a space in the </p> so that the footnote matcher - ;; does not see this. - (if (not (get-text-property (match-beginning 0) - 'org-protected line)) - (setq line (replace-match "</p ><p >" t t line))) - (setq start (match-end 0)))) - - (org-lparse-insert 'LINE line))))) - - ;; Properly close all local lists and other lists - (when (org-lparse-current-environment-p 'quote) - (org-lparse-end-environment 'quote)) - - (org-lparse-end-level 1 umax) - - ;; the </div> to close the last text-... div. - (when (and (> umax 0) org-lparse-dyn-first-heading-pos) - (org-lparse-end-outline-text-or-outline)) - - (org-lparse-end 'DOCUMENT-BODY opt-plist) - (unless body-only - (org-lparse-end 'DOCUMENT-CONTENT)) - - (org-lparse-end 'EXPORT) - - ;; kill collection buffer - (when org-lparse-collect-buffer - (kill-buffer org-lparse-collect-buffer)) - - (goto-char (point-min)) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done")) - - (cond - ((not to-buffer) - (let ((f (org-lparse-get 'SAVE-METHOD))) - (or (and f (functionp f) (funcall f filename opt-plist)) - (save-buffer))) - (or (and (boundp 'org-lparse-other-backend) - org-lparse-other-backend - (not (equal org-lparse-backend org-lparse-other-backend)) - (org-lparse-do-convert - buffer-file-name (symbol-name org-lparse-other-backend))) - (current-buffer))) - ((eq to-buffer 'string) - (prog1 (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer)))) - (t (current-buffer)))))) - -(defun org-lparse-format-table (lines olines) - "Returns backend-specific code for org-type and table-type tables." - (if (stringp lines) - (setq lines (org-split-string lines "\n"))) - (if (string-match "^[ \t]*|" (car lines)) - ;; A normal org table - (org-lparse-format-org-table lines nil) - ;; Table made by table.el - (or (org-lparse-format-table-table-using-table-generate-source - ;; FIXME: Need to take care of this during merge - (if (eq org-lparse-backend 'xhtml) 'html org-lparse-backend) - olines - (not org-export-prefer-native-exporter-for-tables)) - ;; We are here only when table.el table has NO col or row - ;; spanning and the user prefers using org's own converter for - ;; exporting of such simple table.el tables. - (org-lparse-format-table-table lines)))) - -(defun org-lparse-table-get-colalign-info (lines) - (let ((col-cookies (org-find-text-property-in-string - 'org-col-cookies (car lines)))) - (when (and col-cookies org-table-clean-did-remove-column) - (setq col-cookies - (mapcar (lambda (x) (cons (1- (car x)) (cdr x))) col-cookies))) - col-cookies)) - -(defvar org-lparse-table-style) -(defvar org-lparse-table-ncols) -(defvar org-lparse-table-rownum) -(defvar org-lparse-table-is-styled) -(defvar org-lparse-table-begin-marker) -(defvar org-lparse-table-num-numeric-items-per-column) -(defvar org-lparse-table-colalign-info) -(defvar org-lparse-table-colalign-vector) - -;; Following variables are defined in org-table.el -(defvar org-table-number-fraction) -(defvar org-table-number-regexp) -(defun org-lparse-org-table-to-list-table (lines &optional splice) - "Convert org-table to list-table. -LINES is a list of the form (ROW1 ROW2 ROW3 ...) where each -element is a `string' representing a single row of org-table. -Thus each ROW has vertical separators \"|\" separating the table -fields. A ROW could also be a row-group separator of the form -\"|---...|\". Return a list of the form (ROW1 ROW2 ROW3 -...). ROW could either be symbol `:hrule' or a list of the -form (FIELD1 FIELD2 FIELD3 ...) as appropriate." - (let (line lines-1) - (cond - (splice - (while (setq line (pop lines)) - (unless (string-match "^[ \t]*|-" line) - (push (org-split-string line "[ \t]*|[ \t]*") lines-1)))) - (t - (while (setq line (pop lines)) - (cond - ((string-match "^[ \t]*|-" line) - (when lines - (push :hrule lines-1))) - (t - (push (org-split-string line "[ \t]*|[ \t]*") lines-1)))))) - (nreverse lines-1))) - -(defun org-lparse-insert-org-table (lines &optional splice) - "Format a org-type table into backend-specific code. -LINES is a list of lines. Optional argument SPLICE means, do not -insert header and surrounding <table> tags, just format the lines. -Optional argument NO-CSS means use XHTML attributes instead of CSS -for formatting. This is required for the DocBook exporter." - (require 'org-table) - ;; Get rid of hlines at beginning and end - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (if (string-match "^[ \t]*|-" (car lines)) (setq lines (cdr lines))) - (setq lines (nreverse lines)) - (when org-export-table-remove-special-lines - ;; Check if the table has a marking column. If yes remove the - ;; column and the special lines - (setq lines (org-table-clean-before-export lines))) - (let* ((caption (org-find-text-property-in-string 'org-caption (car lines))) - (short-caption (or (org-find-text-property-in-string - 'org-caption-shortn (car lines)) caption)) - (caption (and caption (org-xml-encode-org-text caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (label (org-find-text-property-in-string 'org-label (car lines))) - (org-lparse-table-colalign-info (org-lparse-table-get-colalign-info lines)) - (attributes (org-find-text-property-in-string 'org-attributes - (car lines))) - (head (and org-export-highlight-first-table-line - (delq nil (mapcar - (lambda (x) (string-match "^[ \t]*|-" x)) - (cdr lines)))))) - (setq lines (org-lparse-org-table-to-list-table lines splice)) - (org-lparse-insert-list-table - lines splice caption label attributes head org-lparse-table-colalign-info - short-caption))) - -(defun org-lparse-insert-list-table (lines &optional splice - caption label attributes head - org-lparse-table-colalign-info - short-caption) - (or (featurep 'org-table) ; required for - (require 'org-table)) ; `org-table-number-regexp' - (let* ((org-lparse-table-rownum -1) org-lparse-table-ncols i (cnt 0) - tbopen fields line - org-lparse-table-cur-rowgrp-is-hdr - org-lparse-table-rowgrp-open - org-lparse-table-num-numeric-items-per-column - org-lparse-table-colalign-vector n - org-lparse-table-rowgrp-info - org-lparse-table-begin-marker - (org-lparse-table-style 'org-table) - org-lparse-table-is-styled) - (cond - (splice - (setq org-lparse-table-is-styled nil) - (while (setq line (pop lines)) - (insert (org-lparse-format-table-row line) "\n"))) - (t - (setq org-lparse-table-is-styled t) - (org-lparse-begin 'TABLE caption label attributes short-caption) - (setq org-lparse-table-begin-marker (point)) - (org-lparse-begin-table-rowgroup head) - (while (setq line (pop lines)) - (cond - ((equal line :hrule) - (org-lparse-begin-table-rowgroup)) - (t - (insert (org-lparse-format-table-row line) "\n")))) - (org-lparse-end 'TABLE-ROWGROUP) - (org-lparse-end-table))))) - -(defun org-lparse-format-org-table (lines &optional splice) - (with-temp-buffer - (org-lparse-insert-org-table lines splice) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun org-lparse-format-list-table (lines &optional splice) - (with-temp-buffer - (org-lparse-insert-list-table lines splice) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun org-lparse-insert-table-table (lines) - "Format a table generated by table.el into backend-specific code. -This conversion does *not* use `table-generate-source' from table.el. -This has the advantage that Org-mode's HTML conversions can be used. -But it has the disadvantage, that no cell- or row-spanning is allowed." - (let (line field-buffer - (org-lparse-table-cur-rowgrp-is-hdr - org-export-highlight-first-table-line) - (caption nil) - (short-caption nil) - (attributes nil) - (label nil) - (org-lparse-table-style 'table-table) - (org-lparse-table-is-styled nil) - fields org-lparse-table-ncols i (org-lparse-table-rownum -1) - (empty (org-lparse-format 'SPACES 1))) - (org-lparse-begin 'TABLE caption label attributes short-caption) - (while (setq line (pop lines)) - (cond - ((string-match "^[ \t]*\\+-" line) - (when field-buffer - (let ((org-export-table-row-tags '("<tr>" . "</tr>")) - ;; (org-export-html-table-use-header-tags-for-first-column nil) - ) - (insert (org-lparse-format-table-row field-buffer empty))) - (setq org-lparse-table-cur-rowgrp-is-hdr nil) - (setq field-buffer nil))) - (t - ;; Break the line into fields and store the fields - (setq fields (org-split-string line "[ \t]*|[ \t]*")) - (if field-buffer - (setq field-buffer (mapcar - (lambda (x) - (concat x (org-lparse-format 'LINE-BREAK) - (pop fields))) - field-buffer)) - (setq field-buffer fields))))) - (org-lparse-end-table))) - -(defun org-lparse-format-table-table (lines) - (with-temp-buffer - (org-lparse-insert-table-table lines) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defvar table-source-languages) ; defined in table.el -(defun org-lparse-format-table-table-using-table-generate-source (backend - lines - &optional - spanned-only) - "Format a table into BACKEND, using `table-generate-source' from table.el. -Use SPANNED-ONLY to suppress exporting of simple table.el tables. - -When SPANNED-ONLY is nil, all table.el tables are exported. When -SPANNED-ONLY is non-nil, only tables with either row or column -spans are exported. - -This routine returns the generated source or nil as appropriate. - -Refer docstring of `org-export-prefer-native-exporter-for-tables' -for further information." - (require 'table) - (with-current-buffer (get-buffer-create " org-tmp1 ") - (erase-buffer) - (insert (mapconcat 'identity lines "\n")) - (goto-char (point-min)) - (if (not (re-search-forward "|[^+]" nil t)) - (error "Error processing table")) - (table-recognize-table) - (when (or (not spanned-only) - (let* ((dim (table-query-dimension)) - (c (nth 4 dim)) (r (nth 5 dim)) (cells (nth 6 dim))) - (not (= (* c r) cells)))) - (with-current-buffer (get-buffer-create " org-tmp2 ") (erase-buffer)) - (cond - ((member backend table-source-languages) - (table-generate-source backend " org-tmp2 ") - (set-buffer " org-tmp2 ") - (buffer-substring (point-min) (point-max))) - (t - ;; table.el doesn't support the given backend. Currently this - ;; happens in case of odt export. Strip the table from the - ;; generated document. A better alternative would be to embed - ;; the table as ascii text in the output document. - (org-lparse-warn - (concat - "Found table.el-type table in the source org file. " - (format "table.el doesn't support %s backend. " - (upcase (symbol-name backend))) - "Skipping ahead ...")) - ""))))) - -(defun org-lparse-handle-time-stamps (s) - "Format time stamps in string S, or remove them." - (catch 'exit - (let (r b) - (when org-maybe-keyword-time-regexp - (while (string-match org-maybe-keyword-time-regexp s) - (or b (setq b (substring s 0 (match-beginning 0)))) - (setq r (concat - r (substring s 0 (match-beginning 0)) " " - (org-lparse-format - 'FONTIFY - (concat - (if (match-end 1) - (org-lparse-format - 'FONTIFY - (match-string 1 s) "timestamp-kwd")) - " " - (org-lparse-format - 'FONTIFY - (substring (org-translate-time (match-string 3 s)) 1 -1) - "timestamp")) - "timestamp-wrapper")) - s (substring s (match-end 0))))) - - ;; Line break if line started and ended with time stamp stuff - (if (not r) - s - (setq r (concat r s)) - (unless (string-match "\\S-" (concat b s)) - (setq r (concat r (org-lparse-format 'LINE-BREAK)))) - r)))) - -(defun org-xml-encode-plain-text (s) - "Convert plain text characters to HTML equivalent. -Possible conversions are set in `org-export-html-protect-char-alist'." - (let ((cl (org-lparse-get 'PLAIN-TEXT-MAP)) c) - (while (setq c (pop cl)) - (let ((start 0)) - (while (string-match (car c) s start) - (setq s (replace-match (cdr c) t t s) - start (1+ (match-beginning 0)))))) - s)) - -(defun org-xml-encode-org-text-skip-links (string) - "Prepare STRING for HTML export. Apply all active conversions. -If there are links in the string, don't modify these. If STRING -is nil, return nil." - (when string - (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) - m s l res) - (while (setq m (string-match re string)) - (setq s (substring string 0 m) - l (match-string 0 string) - string (substring string (match-end 0))) - (push (org-xml-encode-org-text s) res) - (push l res)) - (push (org-xml-encode-org-text string) res) - (apply 'concat (nreverse res))))) - -(defun org-xml-encode-org-text (s) - "Apply all active conversions to translate special ASCII to HTML." - (setq s (org-xml-encode-plain-text s)) - (if org-export-html-expand - (while (string-match "@<\\([^&]*\\)>" s) - (setq s (replace-match "<\\1>" t nil s)))) - (if org-export-with-emphasize - (setq s (org-lparse-apply-char-styles s))) - (if org-export-with-special-strings - (setq s (org-lparse-convert-special-strings s))) - (if org-export-with-sub-superscripts - (setq s (org-lparse-apply-sub-superscript-styles s))) - (if org-export-with-TeX-macros - (let ((start 0) wd rep) - (while (setq start (string-match "\\\\\\([a-zA-Z]+[0-9]*\\)\\({}\\)?" - s start)) - (if (get-text-property (match-beginning 0) 'org-protected s) - (setq start (match-end 0)) - (setq wd (match-string 1 s)) - (if (setq rep (org-lparse-format 'ORG-ENTITY wd)) - (setq s (replace-match rep t t s)) - (setq start (+ start (length wd)))))))) - s) - -(defun org-lparse-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all (org-lparse-get 'SPECIAL-STRING-REGEXPS)) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (if (get-text-property (match-beginning 0) 'org-protected string) - (setq start (match-end 0)) - (setq string (replace-match rpl t nil string))))) - string)) - -(defun org-lparse-apply-sub-superscript-styles (string) - "Apply subscript and superscript styles to STRING. -Use `org-export-with-sub-superscripts' to control application of -sub and superscript styles." - (let (key c (s 0) (requireb (eq org-export-with-sub-superscripts '{}))) - (while (string-match org-match-substring-regexp string s) - (cond - ((and requireb (match-end 8)) (setq s (match-end 2))) - ((get-text-property (match-beginning 2) 'org-protected string) - (setq s (match-end 2))) - (t - (setq s (match-end 1) - key (if (string= (match-string 2 string) "_") - 'subscript 'superscript) - c (or (match-string 8 string) - (match-string 6 string) - (match-string 5 string)) - string (replace-match - (concat (match-string 1 string) - (org-lparse-format 'FONTIFY c key)) - t t string))))) - (while (string-match "\\\\\\([_^]\\)" string) - (setq string (replace-match (match-string 1 string) t t string))) - string)) - -(defvar org-lparse-char-styles - `(("*" bold) - ("/" emphasis) - ("_" underline) - ("=" code) - ("~" verbatim) - ("+" strike)) - "Map Org emphasis markers to char styles. -This is an alist where each element is of the -form (ORG-EMPHASIS-CHAR . CHAR-STYLE).") - -(defun org-lparse-apply-char-styles (string) - "Apply char styles to STRING. -The variable `org-lparse-char-styles' controls how the Org -emphasis markers are interpreted." - (let ((s 0) rpl) - (while (string-match org-emph-re string s) - (if (not (equal - (substring string (match-beginning 3) (1+ (match-beginning 3))) - (substring string (match-beginning 4) (1+ (match-beginning 4))))) - (setq s (match-beginning 0) - rpl - (concat - (match-string 1 string) - (org-lparse-format - 'FONTIFY (match-string 4 string) - (nth 1 (assoc (match-string 3 string) - org-lparse-char-styles))) - (match-string 5 string)) - string (replace-match rpl t t string) - s (+ s (- (length rpl) 2))) - (setq s (1+ s)))) - string)) - -(defun org-lparse-export-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. - -POS is the item position or line position the line had before -modifications to buffer. STRUCT is the list structure. PREVS is -the alist of previous items." - (let* ((get-type - (function - ;; Translate type of list containing POS to "d", "o" or - ;; "u". - (lambda (pos struct prevs) - (let ((type (org-list-get-list-type pos struct prevs))) - (cond - ((eq 'ordered type) "o") - ((eq 'descriptive type) "d") - (t "u")))))) - (get-closings - (function - ;; Return list of all items and sublists ending at POS, in - ;; reverse order. - (lambda (pos) - (let (out) - (catch 'exit - (mapc (lambda (e) - (let ((end (nth 6 e)) - (item (car e))) - (cond - ((= end pos) (push item out)) - ((>= item pos) (throw 'exit nil))))) - struct)) - out))))) - ;; First close any previous item, or list, ending at POS. - (mapc (lambda (e) - (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) - (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item struct prevs))) - (org-lparse-end-paragraph) - ;; Ending for every item - (org-lparse-end-list-item-1 type) - ;; We're ending last item of the list: end list. - (when lastp - (org-lparse-end-list type) - (org-lparse-begin-paragraph)))) - (funcall get-closings pos)) - (cond - ;; At an item: insert appropriate tags in export buffer. - ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\S-+[ \t]*\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (or (match-string 5 line) "")) - (list-beg (org-list-get-list-begin pos struct prevs)) - (firstp (= list-beg pos)) - ;; Always refer to first item to determine list type, in - ;; case list is ill-formed. - (type (funcall get-type list-beg struct prevs)) - (counter (let ((count-tmp (org-list-get-counter pos struct))) - (cond - ((not count-tmp) nil) - ((string-match "[A-Za-z]" count-tmp) - (- (string-to-char (upcase count-tmp)) 64)) - ((string-match "[0-9]+" count-tmp) - count-tmp))))) - (when firstp - (org-lparse-end-paragraph) - (org-lparse-begin-list type)) - - (let ((arg (cond ((equal type "d") desc-tag) - ((equal type "o") counter)))) - (org-lparse-begin-list-item type arg)) - - ;; If line had a checkbox, some additional modification is required. - (when checkbox - (setq body - (concat - (org-lparse-format - 'FONTIFY (concat - "[" - (cond - ((string-match "X" checkbox) "X") - ((string-match " " checkbox) - (org-lparse-format 'SPACES 1)) - (t "-")) - "]") - 'code) - " " - body))) - ;; Return modified line - body)) - ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) - ;; Not at an item: return line unchanged (side-effects only). - (t line)))) - -(defun org-lparse-bind-local-variables (opt-plist) - (mapc (lambda (x) - (set (make-local-variable (nth 2 x)) - (plist-get opt-plist (car x)))) - org-export-plist-vars)) - -(defvar org-lparse-table-rowgrp-open) -(defvar org-lparse-table-cur-rowgrp-is-hdr) -(defvar org-lparse-footnote-number) -(defvar org-lparse-footnote-definitions) -(defvar org-lparse-output-buffer nil - "Buffer to which `org-do-lparse' writes to. -This buffer contains the contents of the to-be-created exported -document.") - -(defcustom org-lparse-debug nil - "Enable or Disable logging of `org-lparse' callbacks. -The parameters passed to the backend-registered ENTITY-CONTROL -and ENTITY-FORMAT callbacks are logged as comment strings in the -exported buffer. (org-lparse-format 'COMMENT fmt args) is used -for logging. Customize this variable only if you are an expert -user. Valid values of this variable are: -nil : Disable logging -control : Log all invocations of `org-lparse-begin' and - `org-lparse-end' callbacks. -format : Log invocations of `org-lparse-format' callbacks. -t : Log all invocations of `org-lparse-begin', `org-lparse-end' - and `org-lparse-format' callbacks," - :group 'org-lparse - :type '(choice - (const :tag "Disable" nil) - (const :tag "Format callbacks" format) - (const :tag "Control callbacks" control) - (const :tag "Format and Control callbacks" t))) - -(defun org-lparse-begin (entity &rest args) - "Begin ENTITY in current buffer. ARGS is entity specific. -ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM etc. - -Use (org-lparse-begin 'LIST \"o\") to begin a list in current -buffer. - -See `org-xhtml-entity-control-callbacks-alist' for more -information." - (when (and (member org-lparse-debug '(t control)) - (not (eq entity 'DOCUMENT-CONTENT))) - (insert (org-lparse-format 'COMMENT "%s BEGIN %S" entity args))) - - (let ((f (cadr (assoc entity org-lparse-entity-control-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))) - -(defun org-lparse-end (entity &rest args) - "Close ENTITY in current buffer. ARGS is entity specific. -ENTITY can be one of PARAGRAPH, LIST, LIST-ITEM -etc. - -Use (org-lparse-end 'LIST \"o\") to close a list in current -buffer. - -See `org-xhtml-entity-control-callbacks-alist' for more -information." - (when (and (member org-lparse-debug '(t control)) - (not (eq entity 'DOCUMENT-CONTENT))) - (insert (org-lparse-format 'COMMENT "%s END %S" entity args))) - - (let ((f (caddr (assoc entity org-lparse-entity-control-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))) - -(defun org-lparse-begin-paragraph (&optional style) - "Insert <p>, but first close previous paragraph if any." - (org-lparse-end-paragraph) - (org-lparse-begin 'PARAGRAPH style) - (setq org-lparse-par-open t)) - -(defun org-lparse-end-paragraph () - "Close paragraph if there is one open." - (when org-lparse-par-open - (org-lparse-end 'PARAGRAPH) - (setq org-lparse-par-open nil))) - -(defun org-lparse-end-list-item-1 (&optional type) - "Close <li> if necessary." - (org-lparse-end-paragraph) - (org-lparse-end-list-item (or type "u"))) - -(define-obsolete-function-alias - 'org-lparse-preprocess-after-blockquote-hook - 'org-lparse-preprocess-after-blockquote - "24.3") - -(defun org-lparse-preprocess-after-blockquote () - "Treat `org-lparse-special-blocks' specially." - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(begin\\|end\\)_\\(\\S-+\\)[ \t]*\\(.*\\)$" nil t) - (when (member (downcase (match-string 2)) org-lparse-special-blocks) - (replace-match - (if (equal (downcase (match-string 1)) "begin") - (format "ORG-%s-START %s" (upcase (match-string 2)) - (match-string 3)) - (format "ORG-%s-END %s" (upcase (match-string 2)) - (match-string 3))) t t)))) - -(define-obsolete-function-alias - 'org-lparse-strip-experimental-blocks-maybe-hook - 'org-lparse-strip-experimental-blocks-maybe - "24.3") - -(defun org-lparse-strip-experimental-blocks-maybe () - "Strip \"list-table\" and \"annotation\" blocks. -Stripping happens only when the exported backend is not one of -\"odt\" or \"xhtml\"." - (when (not org-lparse-backend) - (message "Stripping following blocks - %S" org-lparse-special-blocks) - (goto-char (point-min)) - (let ((case-fold-search t)) - (while - (re-search-forward - "^[ \t]*#\\+begin_\\(\\S-+\\)\\([ \t]+.*\\)?\n\\([^\000]*?\\)\n[ \t]*#\\+end_\\1\\>.*" - nil t) - (when (member (match-string 1) org-lparse-special-blocks) - (replace-match "" t t)))))) - -(defvar org-lparse-list-table-p nil - "Non-nil if `org-do-lparse' is within a list-table.") - -(defvar org-lparse-dyn-current-environment nil) -(defun org-lparse-begin-environment (style &optional env-options-plist) - (case style - (list-table - (setq org-lparse-list-table-p t)) - (t (setq org-lparse-dyn-current-environment style) - (org-lparse-begin 'ENVIRONMENT style env-options-plist)))) - -(defun org-lparse-end-environment (style &optional env-options-plist) - (case style - (list-table - (setq org-lparse-list-table-p nil)) - (t (org-lparse-end 'ENVIRONMENT style env-options-plist) - (setq org-lparse-dyn-current-environment nil)))) - -(defun org-lparse-current-environment-p (style) - (eq org-lparse-dyn-current-environment style)) - -(defun org-lparse-begin-footnote-definition (n) - (org-lparse-begin-collect) - (setq org-lparse-insert-tag-with-newlines nil) - (org-lparse-begin 'FOOTNOTE-DEFINITION n)) - -(defun org-lparse-end-footnote-definition (n) - (org-lparse-end 'FOOTNOTE-DEFINITION n) - (setq org-lparse-insert-tag-with-newlines 'both) - (let ((footnote-def (org-lparse-end-collect))) - ;; Cleanup newlines in footnote definition. This ensures that a - ;; transcoded line is never (wrongly) broken in to multiple lines. - (let ((pos 0)) - (while (string-match "[\r\n]+" footnote-def pos) - (setq pos (1+ (match-beginning 0))) - (setq footnote-def (replace-match " " t t footnote-def)))) - (push (cons n footnote-def) org-lparse-footnote-definitions))) - -(defvar org-lparse-collect-buffer nil - "An auxiliary buffer named \"*Org Lparse Collect*\". -`org-do-lparse' uses this as output buffer while collecting -footnote definitions and table-cell contents of list-tables. See -`org-lparse-begin-collect' and `org-lparse-end-collect'.") - -(defvar org-lparse-collect-count nil - "Count number of calls to `org-lparse-begin-collect'. -Use this counter to catch chained collections if they ever -happen.") - -(defun org-lparse-begin-collect () - "Temporarily switch to `org-lparse-collect-buffer'. -Also erase it's contents." - (unless (zerop org-lparse-collect-count) - (error "FIXME (org-lparse.el): Encountered chained collections")) - (incf org-lparse-collect-count) - (unless org-lparse-collect-buffer - (setq org-lparse-collect-buffer - (get-buffer-create "*Org Lparse Collect*"))) - (set-buffer org-lparse-collect-buffer) - (erase-buffer)) - -(defun org-lparse-end-collect () - "Switch to `org-lparse-output-buffer'. -Return contents of `org-lparse-collect-buffer' as a `string'." - (assert (> org-lparse-collect-count 0)) - (decf org-lparse-collect-count) - (prog1 (buffer-string) - (erase-buffer) - (set-buffer org-lparse-output-buffer))) - -(defun org-lparse-format (entity &rest args) - "Format ENTITY in backend-specific way and return it. -ARGS is specific to entity being formatted. - -Use (org-lparse-format 'HEADING \"text\" 1) to format text as -level 1 heading. - -See `org-xhtml-entity-format-callbacks-alist' for more information." - (when (and (member org-lparse-debug '(t format)) - (not (equal entity 'COMMENT))) - (insert (org-lparse-format 'COMMENT "%s: %S" entity args))) - (cond - ((consp entity) - (let ((text (pop args))) - (apply 'org-lparse-format 'TAGS entity text args))) - (t - (let ((f (cdr (assoc entity org-lparse-entity-format-callbacks-alist)))) - (unless f (error "Unknown entity: %s" entity)) - (apply f args))))) - -(defun org-lparse-insert (entity &rest args) - (insert (apply 'org-lparse-format entity args))) - -(defun org-lparse-prepare-toc (lines level-offset opt-plist umax-toc) - (let* ((quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) - (org-min-level (org-get-min-level lines level-offset)) - (org-last-level org-min-level) - level) - (with-temp-buffer - (org-lparse-bind-local-variables opt-plist) - (erase-buffer) - (org-lparse-begin 'TOC (nth 3 (plist-get opt-plist :lang-words)) umax-toc) - (setq - lines - (mapcar - #'(lambda (line) - (when (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line)) - (<= (setq level (org-tr-level - (- (match-end 1) (match-beginning 1) - level-offset))) - umax-toc)) - (let ((txt (save-match-data - (org-xml-encode-org-text-skip-links - (org-export-cleanup-toc-line - (match-string 3 line))))) - (todo (and - org-export-mark-todo-in-toc - (or (and (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) - (and (= level umax-toc) - (org-search-todo-below - line lines level))))) - tags) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line - (replace-match - (let ((org-lparse-encode-pending t)) - (org-lparse-format 'FONTIFY - (match-string 1 line) "target")) - t t line))) - (when (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) - (setq tags (match-string 1 txt) - txt (replace-match "" t nil txt))) - (when (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (org-lparse-format - 'TOC-ITEM - (let* ((snumber (org-section-number level)) - (href (replace-regexp-in-string - "\\." "-" (format "sec-%s" snumber))) - (href - (or - (cdr (assoc - href org-export-preferred-target-alist)) - href)) - (href (org-solidify-link-text href))) - (org-lparse-format 'TOC-ENTRY snumber todo txt tags href)) - level org-last-level) - (setq org-last-level level))) - line) - lines)) - (org-lparse-end 'TOC) - (setq org-lparse-toc (buffer-string)))) - lines) - -(defun org-lparse-format-table-row (fields &optional text-for-empty-fields) - (if org-lparse-table-ncols - ;; second and subsequent rows of the table - (when (and org-lparse-list-table-p - (> (length fields) org-lparse-table-ncols)) - (error "Table row has %d columns but header row claims %d columns" - (length fields) org-lparse-table-ncols)) - ;; first row of the table - (setq org-lparse-table-ncols (length fields)) - (when org-lparse-table-is-styled - (setq org-lparse-table-num-numeric-items-per-column - (make-vector org-lparse-table-ncols 0)) - (setq org-lparse-table-colalign-vector - (make-vector org-lparse-table-ncols nil)) - (let ((c -1)) - (while (< (incf c) org-lparse-table-ncols) - (let* ((col-cookie (cdr (assoc (1+ c) org-lparse-table-colalign-info))) - (align (nth 0 col-cookie))) - (setf (aref org-lparse-table-colalign-vector c) - (cond - ((string= align "l") "left") - ((string= align "r") "right") - ((string= align "c") "center")))))))) - (incf org-lparse-table-rownum) - (let ((i -1)) - (org-lparse-format - 'TABLE-ROW - (mapconcat - (lambda (x) - (when (and (string= x "") text-for-empty-fields) - (setq x text-for-empty-fields)) - (incf i) - (let (col-cookie horiz-span) - (when org-lparse-table-is-styled - (when (and (< i org-lparse-table-ncols) - (string-match org-table-number-regexp x)) - (incf (aref org-lparse-table-num-numeric-items-per-column i))) - (setq col-cookie (cdr (assoc (1+ i) org-lparse-table-colalign-info)) - horiz-span (nth 1 col-cookie))) - (org-lparse-format - 'TABLE-CELL x org-lparse-table-rownum i (or horiz-span 0)))) - fields "\n")))) - -(defun org-lparse-get (what &optional opt-plist) - "Query for value of WHAT for the current backend `org-lparse-backend'. -See also `org-lparse-backend-get'." - (if (boundp 'org-lparse-backend) - (org-lparse-backend-get (symbol-name org-lparse-backend) what opt-plist) - (error "org-lparse-backend is not bound yet"))) - -(defun org-lparse-backend-get (backend what &optional opt-plist) - "Query BACKEND for value of WHAT. -Dispatch the call to `org-<backend>-user-get'. If that throws an -error, dispatch the call to `org-<backend>-get'. See -`org-xhtml-get' for all known settings queried for by -`org-lparse' during the course of export." - (assert (stringp backend) t) - (unless (org-lparse-backend-is-native-p backend) - (error "Unknown native backend %s" backend)) - (let ((backend-get-method (intern (format "org-%s-get" backend))) - (backend-user-get-method (intern (format "org-%s-user-get" backend)))) - (cond - ((functionp backend-get-method) - (condition-case nil - (funcall backend-user-get-method what opt-plist) - (error (funcall backend-get-method what opt-plist)))) - (t - (error "Native backend %s doesn't define %s" backend backend-get-method))))) - -(defun org-lparse-insert-tag (tag &rest args) - (when (member org-lparse-insert-tag-with-newlines '(lead both)) - (insert "\n")) - (insert (apply 'format tag args)) - (when (member org-lparse-insert-tag-with-newlines '(trail both)) - (insert "\n"))) - -(defun org-lparse-get-targets-from-title (title) - (let* ((target (org-get-text-property-any 0 'target title)) - (extra-targets (assoc target org-export-target-aliases)) - (target (or (cdr (assoc target org-export-preferred-target-alist)) - target))) - (cons target (remove target extra-targets)))) - -(defun org-lparse-suffix-from-snumber (snumber) - (let* ((snu (replace-regexp-in-string "\\." "-" snumber)) - (href (cdr (assoc (concat "sec-" snu) - org-export-preferred-target-alist)))) - (org-solidify-link-text (or href snu)))) - -(defun org-lparse-begin-level (level title umax head-count) - "Insert a new LEVEL in HTML export. -When TITLE is nil, just close all open levels." - (org-lparse-end-level level umax) - (unless title (error "Why is heading nil")) - (let* ((targets (org-lparse-get-targets-from-title title)) - (target (car targets)) (extra-targets (cdr targets)) - (target (and target (org-solidify-link-text target))) - (extra-class (org-get-text-property-any 0 'html-container-class title)) - snumber tags level1 class) - (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) - (setq tags (and org-export-with-tags (match-string 1 title))) - (setq title (replace-match "" t t title))) - (if (> level umax) - (progn - (if (aref org-levels-open (1- level)) - (org-lparse-end-list-item-1) - (aset org-levels-open (1- level) t) - (org-lparse-end-paragraph) - (org-lparse-begin-list 'unordered)) - (org-lparse-begin-list-item - 'unordered target (org-lparse-format - 'HEADLINE title extra-targets tags))) - (aset org-levels-open (1- level) t) - (setq snumber (org-section-number level)) - (setq level1 (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)) - (unless (= head-count 1) - (org-lparse-end-outline-text-or-outline)) - (org-lparse-begin-outline-and-outline-text - level1 snumber title tags target extra-targets extra-class) - (org-lparse-begin-paragraph)))) - -(defun org-lparse-end-level (level umax) - (org-lparse-end-paragraph) - (loop for l from org-level-max downto level - do (when (aref org-levels-open (1- l)) - ;; Terminate one level in HTML export - (if (<= l umax) - (org-lparse-end-outline-text-or-outline) - (org-lparse-end-list-item-1) - (org-lparse-end-list 'unordered)) - (aset org-levels-open (1- l) nil)))) - -(defvar org-lparse-outline-text-open) -(defun org-lparse-begin-outline-and-outline-text (level1 snumber title tags - target extra-targets - extra-class) - (org-lparse-begin - 'OUTLINE level1 snumber title tags target extra-targets extra-class) - (org-lparse-begin-outline-text level1 snumber extra-class)) - -(defun org-lparse-end-outline-text-or-outline () - (cond - (org-lparse-outline-text-open - (org-lparse-end 'OUTLINE-TEXT) - (setq org-lparse-outline-text-open nil)) - (t (org-lparse-end 'OUTLINE)))) - -(defun org-lparse-begin-outline-text (level1 snumber extra-class) - (assert (not org-lparse-outline-text-open) t) - (setq org-lparse-outline-text-open t) - (org-lparse-begin 'OUTLINE-TEXT level1 snumber extra-class)) - -(defun org-lparse-html-list-type-to-canonical-list-type (ltype) - (cdr (assoc ltype '(("o" . ordered) - ("u" . unordered) - ("d" . description))))) - -;; following vars are bound during `org-do-lparse' -(defvar org-lparse-list-stack) -(defvar org-lparse-list-table:table-row) -(defvar org-lparse-list-table:lines) - -;; Notes on LIST-TABLES -;; ==================== -;; Lists withing "list-table" blocks (as shown below) -;; -;; #+begin_list-table -;; - Row 1 -;; - 1.1 -;; - 1.2 -;; - 1.3 -;; - Row 2 -;; - 2.1 -;; - 2.2 -;; - 2.3 -;; #+end_list-table -;; -;; will be exported as though it were a table as shown below. -;; -;; | Row 1 | 1.1 | 1.2 | 1.3 | -;; | Row 2 | 2.1 | 2.2 | 2.3 | -;; -;; Note that org-tables are NOT multi-line and each line is mapped to -;; a unique row in the exported document. So if an exported table -;; needs to contain a single paragraph (with copious text) it needs to -;; be typed up in a single line. Editing such long lines using the -;; table editor will be a cumbersome task. Furthermore inclusion of -;; multi-paragraph text in a table cell is well-nigh impossible. -;; -;; LIST-TABLEs are meant to circumvent the above problems with -;; org-tables. -;; -;; Note that in the example above the list items could be paragraphs -;; themselves and the list can be arbitrarily deep. -;; -;; Inspired by following thread: -;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html - -(defun org-lparse-begin-list (ltype) - (push ltype org-lparse-list-stack) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-begin 'LIST ltype)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; begin LIST-TABLE - (setq org-lparse-list-table:lines nil) - (setq org-lparse-list-table:table-row nil)) - ((= 2 list-level) - (ignore)) - (t - (org-lparse-begin 'LIST ltype))))) - -(defun org-lparse-end-list (ltype) - (pop org-lparse-list-stack) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-end 'LIST ltype)) - ;; process LIST-TABLE - ((= 0 list-level) - ;; end LIST-TABLE - (insert (org-lparse-format-list-table - (nreverse org-lparse-list-table:lines)))) - ((= 1 list-level) - (ignore)) - (t - (org-lparse-end 'LIST ltype))))) - -(defun org-lparse-begin-list-item (ltype &optional arg headline) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-begin 'LIST-ITEM ltype arg headline)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; begin TABLE-ROW for LIST-TABLE - (setq org-lparse-list-table:table-row nil) - (org-lparse-begin-list-table:table-cell)) - ((= 2 list-level) - ;; begin TABLE-CELL for LIST-TABLE - (org-lparse-begin-list-table:table-cell)) - (t - (org-lparse-begin 'LIST-ITEM ltype arg headline))))) - -(defun org-lparse-end-list-item (ltype) - (let ((list-level (length org-lparse-list-stack))) - (cond - ((not org-lparse-list-table-p) - (org-lparse-end 'LIST-ITEM ltype)) - ;; process LIST-TABLE - ((= 1 list-level) - ;; end TABLE-ROW for LIST-TABLE - (org-lparse-end-list-table:table-cell) - (push (nreverse org-lparse-list-table:table-row) - org-lparse-list-table:lines)) - ((= 2 list-level) - ;; end TABLE-CELL for LIST-TABLE - (org-lparse-end-list-table:table-cell)) - (t - (org-lparse-end 'LIST-ITEM ltype))))) - -(defvar org-lparse-list-table:table-cell-open) -(defun org-lparse-begin-list-table:table-cell () - (org-lparse-end-list-table:table-cell) - (setq org-lparse-list-table:table-cell-open t) - (org-lparse-begin-collect) - (org-lparse-begin-paragraph)) - -(defun org-lparse-end-list-table:table-cell () - (when org-lparse-list-table:table-cell-open - (setq org-lparse-list-table:table-cell-open nil) - (org-lparse-end-paragraph) - (push (org-lparse-end-collect) - org-lparse-list-table:table-row))) - -(defvar org-lparse-table-rowgrp-info) -(defun org-lparse-begin-table-rowgroup (&optional is-header-row) - (push (cons (1+ org-lparse-table-rownum) :start) org-lparse-table-rowgrp-info) - (org-lparse-begin 'TABLE-ROWGROUP is-header-row)) - -(defun org-lparse-end-table () - (when org-lparse-table-is-styled - ;; column groups - (unless (car org-table-colgroup-info) - (setq org-table-colgroup-info - (cons :start (cdr org-table-colgroup-info)))) - - ;; column alignment - (let ((c -1)) - (mapc - (lambda (x) - (incf c) - (setf (aref org-lparse-table-colalign-vector c) - (or (aref org-lparse-table-colalign-vector c) - (if (> (/ (float x) (1+ org-lparse-table-rownum)) - org-table-number-fraction) - "right" "left")))) - org-lparse-table-num-numeric-items-per-column))) - (org-lparse-end 'TABLE)) - -(defvar org-lparse-encode-pending nil) - -(defun org-lparse-format-tags (tag text prefix suffix &rest args) - (cond - ((consp tag) - (concat prefix (apply 'format (car tag) args) text suffix - (format (cdr tag)))) - ((stringp tag) ; singleton tag - (concat prefix (apply 'format tag args) text)))) - -(defun org-xml-fix-class-name (kwd) ; audit callers of this function - "Turn todo keyword into a valid class name. -Replaces invalid characters with \"_\"." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - kwd) - -(defun org-lparse-format-todo (todo) - (org-lparse-format 'FONTIFY - (concat - (ignore-errors (org-lparse-get 'TODO-KWD-CLASS-PREFIX)) - (org-xml-fix-class-name todo)) - (list (if (member todo org-done-keywords) "done" "todo") - todo))) - -(defun org-lparse-format-extra-targets (extra-targets) - (if (not extra-targets) "" - (mapconcat (lambda (x) - (setq x (org-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-lparse-format 'ANCHOR "" x)) - extra-targets ""))) - -(defun org-lparse-format-org-tags (tags) - (if (not tags) "" - (org-lparse-format - 'FONTIFY (mapconcat - (lambda (x) - (org-lparse-format - 'FONTIFY x - (concat - (ignore-errors (org-lparse-get 'TAG-CLASS-PREFIX)) - (org-xml-fix-class-name x)))) - (org-split-string tags ":") - (org-lparse-format 'SPACES 1)) "tag"))) - -(defun org-lparse-format-section-number (&optional snumber level) - (and org-export-with-section-numbers - (not org-lparse-body-only) snumber level - (org-lparse-format 'FONTIFY snumber (format "section-number-%d" level)))) - -(defun org-lparse-warn (msg) - (if (not org-lparse-use-flashy-warning) - (message msg) - (put-text-property 0 (length msg) 'face 'font-lock-warning-face msg) - (message msg) - (sleep-for 3))) - -(defun org-xml-format-href (s) - "Make sure the S is valid as a href reference in an XHTML document." - (save-match-data - (let ((start 0)) - (while (string-match "&" s start) - (setq start (+ (match-beginning 0) 3) - s (replace-match "&" t t s))))) - s) - -(defun org-xml-format-desc (s) - "Make sure the S is valid as a description in a link." - (if (and s (not (get-text-property 1 'org-protected s))) - (save-match-data - (org-xml-encode-org-text s)) - s)) - -(provide 'org-lparse) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-lparse.el ends here diff --git a/lisp/org/org-mac-message.el b/lisp/org/org-mac-message.el deleted file mode 100644 index 5df68f56a0..0000000000 --- a/lisp/org/org-mac-message.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Authors: John Wiegley <[email protected]> -;; Christopher Suckling <suckling at gmail dot com> - -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 implements links to Apple Mail.app messages from within Org-mode. -;; Org-mode does not load this module by default - if you would actually like -;; this to happen then configure the variable `org-modules'. - -;; If you would like to create links to all flagged messages in an -;; Apple Mail.app account, please customize the variable -;; `org-mac-mail-account' and then call one of the following functions: - -;; (org-mac-message-insert-selected) copies a formatted list of links to -;; the kill ring. - -;; (org-mac-message-insert-selected) inserts at point links to any -;; messages selected in Mail.app. - -;; (org-mac-message-insert-flagged) searches within an org-mode buffer -;; for a specific heading, creating it if it doesn't exist. Any -;; message:// links within the first level of the heading are deleted -;; and replaced with links to flagged messages. - -;;; Code: - -(require 'org) - -(defgroup org-mac-flagged-mail nil - "Options concerning linking to flagged Mail.app messages." - :tag "Org Mail.app" - :group 'org-link) - -(defcustom org-mac-mail-account "customize" - "The Mail.app account in which to search for flagged messages." - :group 'org-mac-flagged-mail - :type 'string) - -(org-add-link-type "message" 'org-mac-message-open) - -;; In mac.c, removed in Emacs 23. -(declare-function do-applescript "org-mac-message" (script)) -(unless (fboundp 'do-applescript) - ;; Need to fake this using shell-command-to-string - (defun do-applescript (script) - (let (start cmd return) - (while (string-match "\n" script) - (setq script (replace-match "\r" t t script))) - (while (string-match "'" script start) - (setq start (+ 2 (match-beginning 0)) - script (replace-match "\\'" t t script))) - (setq cmd (concat "osascript -e '" script "'")) - (setq return (shell-command-to-string cmd)) - (concat "\"" (org-trim return) "\"")))) - -(defun org-mac-message-open (message-id) - "Visit the message with the given MESSAGE-ID. -This will use the command `open' with the message URL." - (start-process (concat "open message:" message-id) nil - "open" (concat "message://<" (substring message-id 2) ">"))) - -(defun as-get-selected-mail () - "AppleScript to create links to selected messages in Mail.app." - (do-applescript - (concat - "tell application \"Mail\"\n" - "set theLinkList to {}\n" - "set theSelection to selection\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -(defun as-get-flagged-mail () - "AppleScript to create links to flagged messages in Mail.app." - (do-applescript - (concat - ;; Is Growl installed? - "tell application \"System Events\"\n" - "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n" - "if (count of growlHelpers) > 0 then\n" - "set growlHelperApp to item 1 of growlHelpers\n" - "else\n" - "set growlHelperApp to \"\"\n" - "end if\n" - "end tell\n" - - ;; Get links - "tell application \"Mail\"\n" - "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n" - "set theLinkList to {}\n" - "repeat with aMailbox in theMailboxes\n" - "set theSelection to (every message in aMailbox whose flagged status = true)\n" - "repeat with theMessage in theSelection\n" - "set theID to message id of theMessage\n" - "set theSubject to subject of theMessage\n" - "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n" - "copy theLink to end of theLinkList\n" - - ;; Report progress through Growl - ;; This "double tell" idiom is described in detail at - ;; http://macscripter.net/viewtopic.php?id=24570 The - ;; script compiler needs static knowledge of the - ;; growlHelperApp. Hmm, since we're compiling - ;; on-the-fly here, this is likely to be way less - ;; portable than I'd hoped. It'll work when the name - ;; is still "GrowlHelperApp", though. - "if growlHelperApp is not \"\" then\n" - "tell application \"GrowlHelperApp\"\n" - "tell application growlHelperApp\n" - "set the allNotificationsList to {\"FlaggedMail\"}\n" - "set the enabledNotificationsList to allNotificationsList\n" - "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n" - "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n" - "end tell\n" - "end tell\n" - "end if\n" - "end repeat\n" - "end repeat\n" - "return theLinkList as string\n" - "end tell"))) - -(defun org-mac-message-get-links (&optional select-or-flag) - "Create links to the messages currently selected or flagged in Mail.app. -This will use AppleScript to get the message-id and the subject of the -messages in Mail.app and make a link out of it. -When SELECT-OR-FLAG is \"s\", get the selected messages (this is also -the default). When SELECT-OR-FLAG is \"f\", get the flagged messages. -The Org-syntax text will be pushed to the kill ring, and also returned." - (interactive "sLink to (s)elected or (f)lagged messages: ") - (setq select-or-flag (or select-or-flag "s")) - (message "AppleScript: searching mailboxes...") - (let* ((as-link-list - (if (string= select-or-flag "s") - (as-get-selected-mail) - (if (string= select-or-flag "f") - (as-get-flagged-mail) - (error "Please select \"s\" or \"f\"")))) - (link-list - (mapcar - (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x) - (split-string as-link-list "[\r\n]+"))) - split-link URL description orglink orglink-insert rtn orglink-list) - (while link-list - (setq split-link (split-string (pop link-list) "::split::")) - (setq URL (car split-link)) - (setq description (cadr split-link)) - (when (not (string= URL "")) - (setq orglink (org-make-link-string URL description)) - (push orglink orglink-list))) - (setq rtn (mapconcat 'identity orglink-list "\n")) - (kill-new rtn) - rtn)) - -(defun org-mac-message-insert-selected () - "Insert a link to the messages currently selected in Mail.app. -This will use AppleScript to get the message-id and the subject of the -active mail in Mail.app and make a link out of it." - (interactive) - (insert (org-mac-message-get-links "s"))) - -;; The following line is for backward compatibility -(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected) - -(defun org-mac-message-insert-flagged (org-buffer org-heading) - "Asks for an org buffer and a heading within it, and replace message links. -If heading exists, delete all message:// links within heading's first -level. If heading doesn't exist, create it at point-max. Insert -list of message:// links to flagged mail after heading." - (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ") - (with-current-buffer org-buffer - (goto-char (point-min)) - (let ((isearch-forward t) - (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]")) - (if (org-goto-local-search-headings org-heading nil t) - (if (not (eobp)) - (progn - (save-excursion - (while (re-search-forward - message-re (save-excursion (outline-next-heading)) t) - (delete-region (match-beginning 0) (match-end 0))) - (insert "\n" (org-mac-message-get-links "f"))) - (flush-lines "^$" (point) (outline-next-heading))) - (insert "\n" (org-mac-message-get-links "f"))) - (goto-char (point-max)) - (insert "\n") - (org-insert-heading nil t) - (insert org-heading "\n" (org-mac-message-get-links "f")))))) - -(provide 'org-mac-message) - -;;; org-mac-message.el ends here diff --git a/lisp/org/org-mew.el b/lisp/org/org-mew.el deleted file mode 100644 index 820988bdbb..0000000000 --- a/lisp/org/org-mew.el +++ /dev/null @@ -1,136 +0,0 @@ -;;; org-mew.el --- Support for links to Mew messages from within Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; 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 implements links to Mew messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -(defgroup org-mew nil - "Options concerning the Mew link." - :tag "Org Startup" - :group 'org-link) - -(defcustom org-mew-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-mew - :type 'boolean) - -;; Declare external functions and variables -(declare-function mew-cache-hit "ext:mew-cache" (fld msg &optional must-hit)) -(declare-function mew-case-folder "ext:mew-func" (case folder)) -(declare-function mew-header-get-value "ext:mew-header" - (field &optional as-list)) -(declare-function mew-init "ext:mew" ()) -(declare-function mew-refile-get "ext:mew-refile" (msg)) -(declare-function mew-sinfo-get-case "ext:mew-summary" ()) -(declare-function mew-summary-display "ext:mew-summary2" (&optional redisplay)) -(declare-function mew-summary-folder-name "ext:mew-syntax" (&optional ext)) -(declare-function mew-summary-get-mark "ext:mew-mark" ()) -(declare-function mew-summary-message-number2 "ext:mew-syntax" ()) -(declare-function mew-summary-pick-with-mewl "ext:mew-pick" - (pattern folder src-msgs)) -(declare-function mew-summary-search-msg "ext:mew-const" (msg)) -(declare-function mew-summary-set-message-buffer "ext:mew-summary3" (fld msg)) -(declare-function mew-summary-visit-folder "ext:mew-summary4" - (folder &optional goend no-ls)) -(declare-function mew-window-push "ext:mew" ()) -(defvar mew-init-p) -(defvar mew-summary-goto-line-then-display) - -;; Install the link type -(org-add-link-type "mew" 'org-mew-open) -(add-hook 'org-store-link-functions 'org-mew-store-link) - -;; Implementation -(defun org-mew-store-link () - "Store a link to a Mew folder or message." - (when (memq major-mode '(mew-summary-mode mew-virtual-mode)) - (let* ((msgnum (mew-summary-message-number2)) - (mark-info (mew-summary-get-mark)) - (folder-name - (if (and org-mew-link-to-refile-destination - (eq mark-info ?o)) ; marked as refile - (mew-case-folder (mew-sinfo-get-case) - (nth 1 (mew-refile-get msgnum))) - (mew-summary-folder-name))) - message-id from to subject desc link date date-ts date-ts-ia) - (save-window-excursion - (if (fboundp 'mew-summary-set-message-buffer) - (mew-summary-set-message-buffer folder-name msgnum) - (set-buffer (mew-cache-hit folder-name msgnum t))) - (setq message-id (mew-header-get-value "Message-Id:")) - (setq from (mew-header-get-value "From:")) - (setq to (mew-header-get-value "To:")) - (setq date (mew-header-get-value "Date:")) - (setq date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (setq date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - (setq subject (mew-header-get-value "Subject:"))) - (org-store-link-props :type "mew" :from from :to to - :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (concat "mew:" folder-name "#" message-id)) - (org-add-link-props :link link :description desc) - link))) - -(defun org-mew-open (path) - "Follow the Mew message link specified by PATH." - (let (folder msgnum) - (cond ((string-match "\\`\\(+.*\\)+\\+\\([0-9]+\\)\\'" path) ; for Bastien's - (setq folder (match-string 1 path)) - (setq msgnum (match-string 2 path))) - ((string-match "\\`\\(\\(%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path) - (setq folder (match-string 1 path)) - (setq msgnum (match-string 4 path))) - (t (error "Error in Mew link"))) - (require 'mew) - (mew-window-push) - (unless mew-init-p (mew-init)) - (mew-summary-visit-folder folder) - (when msgnum - (if (not (string-match "\\`[0-9]+\\'" msgnum)) - (let* ((pattern (concat "message-id=" msgnum)) - (msgs (mew-summary-pick-with-mewl pattern folder nil))) - (setq msgnum (car msgs)))) - (if (mew-summary-search-msg msgnum) - (if mew-summary-goto-line-then-display - (mew-summary-display)) - (error "Message not found"))))) - -(provide 'org-mew) - -;;; org-mew.el ends here diff --git a/lisp/org/org-mks.el b/lisp/org/org-mks.el deleted file mode 100644 index c614799db8..0000000000 --- a/lisp/org/org-mks.el +++ /dev/null @@ -1,134 +0,0 @@ -;;; org-mks.el --- Multi-key-selection for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: -;; - -;;; Code: - -(require 'org) -(eval-when-compile - (require 'cl)) - -(defun org-mks (table title &optional prompt specials) - "Select a member of an alist with multiple keys. -TABLE is the alist which should contain entries where the car is a string. -There should be two types of entries. - -1. prefix descriptions like (\"a\" \"Description\") - This indicates that `a' is a prefix key for multi-letter selection, and - that there are entries following with keys like \"ab\", \"ax\"... - -2. Selectable members must have more than two elements, with the first - being the string of keys that lead to selecting it, and the second a - short description string of the item. - -The command will then make a temporary buffer listing all entries -that can be selected with a single key, and all the single key -prefixes. When you press the key for a single-letter entry, it is selected. -When you press a prefix key, the commands (and maybe further prefixes) -under this key will be shown and offered for selection. - -TITLE will be placed over the selection in the temporary buffer, -PROMPT will be used when prompting for a key. SPECIAL is an alist with -also (\"key\" \"description\") entries. When one of these is selection, -only the bare key is returned." - (setq prompt (or prompt "Select: ")) - (let (tbl orig-table dkey ddesc des-keys allowed-keys - current prefix rtn re pressed buffer (inhibit-quit t)) - (save-window-excursion - (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) - (setq orig-table table) - (catch 'exit - (while t - (erase-buffer) - (insert title "\n\n") - (setq tbl table - des-keys nil - allowed-keys nil) - (setq prefix (if current (concat current " ") "")) - (while tbl - (cond - ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) - ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cadar tbl)) - (pop tbl) - (push dkey des-keys) - (push dkey allowed-keys) - (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") - ;; Skip keys which are below this prefix - (setq re (concat "\\`" (regexp-quote dkey))) - (while (and tbl (string-match re (caar tbl))) (pop tbl))) - ((= 2 (length (car tbl))) - ;; Not yet a usable description, skip it - ) - (t - ;; usable entry on this level - (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") - (push (caar tbl) allowed-keys) - (pop tbl)))) - (when specials - (insert "-------------------------------------------------------------------------------\n") - (let ((sp specials)) - (while sp - (insert (format "[%s] %s\n" - (caar sp) (nth 1 (car sp)))) - (push (caar sp) allowed-keys) - (pop sp)))) - (push "\C-g" allowed-keys) - (goto-char (point-min)) - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive))) - (while (not (member pressed allowed-keys)) - (message "Invalid key `%s'" pressed) (sit-for 1) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive)))) - (when (equal pressed "\C-g") - (kill-buffer buffer) - (error "Abort")) - (when (and (not (assoc pressed table)) - (not (member pressed des-keys)) - (assoc pressed specials)) - (throw 'exit (setq rtn pressed))) - (unless (member pressed des-keys) - (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) - orig-table)))) - (setq current (concat current pressed)) - (setq table (mapcar - (lambda (x) - (if (and (> (length (car x)) 1) - (equal (substring (car x) 0 1) pressed)) - (cons (substring (car x) 1) (cdr x)) - nil)) - table)) - (setq table (remove nil table))))) - (when buffer (kill-buffer buffer)) - rtn)) - -(provide 'org-mks) - -;;; org-mks.el ends here diff --git a/lisp/org/org-odt.el b/lisp/org/org-odt.el deleted file mode 100644 index 92228f37eb..0000000000 --- a/lisp/org/org-odt.el +++ /dev/null @@ -1,2859 +0,0 @@ -;;; org-odt.el --- OpenDocument Text exporter for Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K <kjambunathan at gmail dot com> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; 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: - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'org-lparse) - -(defgroup org-export-odt nil - "Options specific for ODT export of Org-mode files." - :tag "Org Export ODT" - :group 'org-export - :version "24.1") - -(defvar org-lparse-dyn-first-heading-pos) ; let bound during org-do-lparse -(defun org-odt-insert-toc () - (goto-char (point-min)) - (cond - ((re-search-forward - "\\(<text:p [^>]*>\\)?\\s-*\\[TABLE-OF-CONTENTS\\]\\s-*\\(</text:p>\\)?" - nil t) - (replace-match "")) - (t - (goto-char org-lparse-dyn-first-heading-pos))) - (insert (org-odt-format-toc))) - -(defun org-odt-end-export () - (org-odt-insert-toc) - (org-odt-fixup-label-references) - - ;; remove empty paragraphs - (goto-char (point-min)) - (while (re-search-forward - "<text:p\\( text:style-name=\"Text_20_body\"\\)?>[ \r\n\t]*</text:p>" - nil t) - (replace-match "")) - (goto-char (point-min)) - - ;; Convert whitespace place holders - (goto-char (point-min)) - (let (beg end n) - (while (setq beg (next-single-property-change (point) 'org-whitespace)) - (setq n (get-text-property beg 'org-whitespace) - end (next-single-property-change beg 'org-whitespace)) - (goto-char beg) - (delete-region beg end) - (insert (format "<span style=\"visibility:hidden;\">%s</span>" - (make-string n ?x))))) - - ;; Remove empty lines at the beginning of the file. - (goto-char (point-min)) - (when (looking-at "\\s-+\n") (replace-match "")) - - ;; Remove display properties - (remove-text-properties (point-min) (point-max) '(display t))) - -(defvar org-odt-suppress-xref nil) -(defconst org-export-odt-special-string-regexps - '(("\\\\-" . "­\\1") ; shy - ("---\\([^-]\\)" . "—\\1") ; mdash - ("--\\([^-]\\)" . "–\\1") ; ndash - ("\\.\\.\\." . "…")) ; hellip - "Regular expressions for special string conversion.") - -(defconst org-odt-lib-dir (file-name-directory load-file-name) - "Location of ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-export-odt-schema-dir'.") - -(defvar org-odt-data-dir nil - "Data directory for ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-export-odt-schema-dir'.") - -(defconst org-odt-schema-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./schema/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./schema/" org-odt-data-dir)))) - "List of directories to search for OpenDocument schema files. -Use this list to set the default value of -`org-export-odt-schema-dir'. The entries in this list are -populated heuristically based on the values of `org-odt-lib-dir' -and `org-odt-data-dir'.") - -(defcustom org-export-odt-schema-dir - (let* ((schema-dir - (catch 'schema-dir - (message "Debug (org-odt): Searching for OpenDocument schema files...") - (mapc - (lambda (schema-dir) - (when schema-dir - (message "Debug (org-odt): Trying %s..." schema-dir) - (when (and (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - (message "Debug (org-odt): Using schema files under %s" - schema-dir) - (throw 'schema-dir schema-dir)))) - org-odt-schema-dir-list) - (message "Debug (org-odt): No OpenDocument schema files installed") - nil))) - schema-dir) - "Directory that contains OpenDocument schema files. - -This directory contains: -1. rnc files for OpenDocument schema -2. a \"schemas.xml\" file that specifies locating rules needed - for auto validation of OpenDocument XML files. - -Use the customize interface to set this variable. This ensures -that `rng-schema-locating-files' is updated and auto-validation -of OpenDocument XML takes place based on the value -`rng-nxml-auto-validate-flag'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-schema-dir-list'. The OASIS schema files are available -only in the org's private git repository. It is *not* bundled -with GNU ELPA tar or standard Emacs distribution." - :type '(choice - (const :tag "Not set" nil) - (directory :tag "Schema directory")) - :group 'org-export-odt - :version "24.1" - :set - (lambda (var value) - "Set `org-export-odt-schema-dir'. -Also add it to `rng-schema-locating-files'." - (let ((schema-dir value)) - (set var - (if (and - (file-readable-p - (expand-file-name "od-manifest-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "od-schema-v1.2-cs01.rnc" schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - schema-dir - (when value - (message "Error (org-odt): %s has no OpenDocument schema files" - value)) - nil))) - (when org-export-odt-schema-dir - (eval-after-load 'rng-loc - '(add-to-list 'rng-schema-locating-files - (expand-file-name "schemas.xml" - org-export-odt-schema-dir)))))) - -(defconst org-odt-styles-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./styles/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./styles/" org-odt-data-dir))) - (expand-file-name "../etc/styles/" org-odt-lib-dir) ; git - (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa - (expand-file-name "./org/" data-directory) ; system - ) - "List of directories to search for OpenDocument styles files. -See `org-odt-styles-dir'. The entries in this list are populated -heuristically based on the values of `org-odt-lib-dir' and -`org-odt-data-dir'.") - -(defconst org-odt-styles-dir - (let* ((styles-dir - (catch 'styles-dir - (message "Debug (org-odt): Searching for OpenDocument styles files...") - (mapc (lambda (styles-dir) - (when styles-dir - (message "Debug (org-odt): Trying %s..." styles-dir) - (when (and (file-readable-p - (expand-file-name - "OrgOdtContentTemplate.xml" styles-dir)) - (file-readable-p - (expand-file-name - "OrgOdtStyles.xml" styles-dir))) - (message "Debug (org-odt): Using styles under %s" - styles-dir) - (throw 'styles-dir styles-dir)))) - org-odt-styles-dir-list) - nil))) - (unless styles-dir - (error "Error (org-odt): Cannot find factory styles files, aborting")) - styles-dir) - "Directory that holds auxiliary XML files used by the ODT exporter. - -This directory contains the following XML files - - \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These - XML files are used as the default values of - `org-export-odt-styles-file' and - `org-export-odt-content-template-file'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-styles-dir-list'. Note that the user could be using org -from one of: org's own private git repository, GNU ELPA tar or -standard Emacs.") - -(defvar org-odt-file-extensions - '(("odt" . "OpenDocument Text") - ("ott" . "OpenDocument Text Template") - ("odm" . "OpenDocument Master Document") - ("ods" . "OpenDocument Spreadsheet") - ("ots" . "OpenDocument Spreadsheet Template") - ("odg" . "OpenDocument Drawing (Graphics)") - ("otg" . "OpenDocument Drawing Template") - ("odp" . "OpenDocument Presentation") - ("otp" . "OpenDocument Presentation Template") - ("odi" . "OpenDocument Image") - ("odf" . "OpenDocument Formula") - ("odc" . "OpenDocument Chart"))) - -(mapc - (lambda (desc) - ;; Let Emacs open all OpenDocument files in archive mode - (add-to-list 'auto-mode-alist - (cons (concat "\\." (car desc) "\\'") 'archive-mode))) - org-odt-file-extensions) - -;; register the odt exporter with the pre-processor -(add-to-list 'org-export-backends 'odt) - -;; register the odt exporter with org-lparse library -(org-lparse-register-backend 'odt) - -(defun org-odt-unload-function () - (org-lparse-unregister-backend 'odt) - (remove-hook 'org-export-preprocess-after-blockquote-hook - 'org-export-odt-preprocess-latex-fragments) - nil) - -(defcustom org-export-odt-content-template-file nil - "Template file for \"content.xml\". -The exporter embeds the exported content just before -\"</office:text>\" element. - -If unspecified, the file named \"OrgOdtContentTemplate.xml\" -under `org-odt-styles-dir' is used." - :type 'file - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-styles-file nil - "Default styles file for use with ODT export. -Valid values are one of: -1. nil -2. path to a styles.xml file -3. path to a *.odt or a *.ott file -4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 -...)) - -In case of option 1, an in-built styles.xml is used. See -`org-odt-styles-dir' for more information. - -In case of option 3, the specified file is unzipped and the -styles.xml embedded therein is used. - -In case of option 4, the specified ODT-OR-OTT-FILE is unzipped -and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the -generated odt file. Use relative path for specifying the -FILE-MEMBERS. styles.xml must be specified as one of the -FILE-MEMBERS. - -Use options 1, 2 or 3 only if styles.xml alone suffices for -achieving the desired formatting. Use option 4, if the styles.xml -references additional files like header and footer images for -achieving the desired formatting. - -Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on -a per-file basis. For example, - -#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or -#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "Factory settings" nil) - (file :must-match t :tag "styles.xml") - (file :must-match t :tag "ODT or OTT file") - (list :tag "ODT or OTT file + Members" - (file :must-match t :tag "ODF Text or Text Template file") - (cons :tag "Members" - (file :tag " Member" "styles.xml") - (repeat (file :tag "Member")))))) - -(eval-after-load 'org-exp - '(add-to-list 'org-export-inbuffer-options-extra - '("ODT_STYLES_FILE" :odt-styles-file))) - -(defconst org-export-odt-tmpdir-prefix "%s-") -(defconst org-export-odt-bookmark-prefix "OrgXref.") -(defvar org-odt-zip-dir nil - "Temporary directory that holds XML files during export.") - -(defvar org-export-odt-embed-images t - "Should the images be copied in to the odt file or just linked?") - -(defvar org-export-odt-inline-images 'maybe) -(defcustom org-export-odt-inline-image-extensions - '("png" "jpeg" "jpg" "gif") - "Extensions of image files that can be inlined into HTML." - :type '(repeat (string :tag "Extension")) - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-pixels-per-inch display-pixels-per-inch - "Scaling factor for converting images pixels to inches. -Use this for sizing of embedded images. See Info node `(org) -Images in ODT export' for more information." - :type 'float - :group 'org-export-odt - :version "24.1") - -(defcustom org-export-odt-create-custom-styles-for-srcblocks t - "Whether custom styles for colorized source blocks be automatically created. -When this option is turned on, the exporter creates custom styles -for source blocks based on the advice of `htmlfontify'. Creation -of custom styles happen as part of `org-odt-hfy-face-to-css'. - -When this option is turned off exporter does not create such -styles. - -Use the latter option if you do not want the custom styles to be -based on your current display settings. It is necessary that the -styles.xml already contains needed styles for colorizing to work. - -This variable is effective only if -`org-export-odt-fontify-srcblocks' is turned on." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defvar org-export-odt-default-org-styles-alist - '((paragraph . ((default . "Text_20_body") - (fixedwidth . "OrgFixedWidthBlock") - (verse . "OrgVerse") - (quote . "Quotations") - (blockquote . "Quotations") - (center . "OrgCenter") - (left . "OrgLeft") - (right . "OrgRight") - (title . "OrgTitle") - (subtitle . "OrgSubtitle") - (footnote . "Footnote") - (src . "OrgSrcBlock") - (illustration . "Illustration") - (table . "Table") - (definition-term . "Text_20_body_20_bold") - (horizontal-line . "Horizontal_20_Line"))) - (character . ((default . "Default") - (bold . "Bold") - (emphasis . "Emphasis") - (code . "OrgCode") - (verbatim . "OrgCode") - (strike . "Strikethrough") - (underline . "Underline") - (subscript . "OrgSubscript") - (superscript . "OrgSuperscript"))) - (list . ((ordered . "OrgNumberedList") - (unordered . "OrgBulletedList") - (description . "OrgDescriptionList")))) - "Default styles for various entities.") - -(defvar org-export-odt-org-styles-alist org-export-odt-default-org-styles-alist) -(defun org-odt-get-style-name-for-entity (category &optional entity) - (let ((entity (or entity 'default))) - (or - (cdr (assoc entity (cdr (assoc category - org-export-odt-org-styles-alist)))) - (cdr (assoc entity (cdr (assoc category - org-export-odt-default-org-styles-alist)))) - (error "Cannot determine style name for entity %s of type %s" - entity category)))) - -(defcustom org-export-odt-preferred-output-format nil - "Automatically post-process to this format after exporting to \"odt\". -Interactive commands `org-export-as-odt' and -`org-export-as-odt-and-open' export first to \"odt\" format and -then use `org-export-odt-convert-process' to convert the -resulting document to this format. During customization of this -variable, the list of valid values are populated based on -`org-export-odt-convert-capabilities'. - -You can set this option on per-file basis using file local -values. See Info node `(emacs) File Variables'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,c ,c)) - (org-lparse-reachable-formats "odt"))))) -;;;###autoload -(put 'org-export-odt-preferred-output-format 'safe-local-variable 'stringp) - -(defmacro org-odt-cleanup-xml-buffers (&rest body) - `(let ((org-odt-zip-dir - (make-temp-file - (format org-export-odt-tmpdir-prefix "odf") t)) - (--cleanup-xml-buffers - (function - (lambda nil - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml" "styles.xml"))) - ;; kill all xml buffers - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect - (expand-file-name file org-odt-zip-dir) t) - (set-buffer-modified-p nil) - (kill-buffer))) - xml-files)) - ;; delete temporary directory. - (org-delete-directory org-odt-zip-dir t))))) - (condition-case err - (prog1 (progn ,@body) - (funcall --cleanup-xml-buffers)) - ((quit error) - (funcall --cleanup-xml-buffers) - (message "OpenDocument export failed: %s" - (error-message-string err)))))) - -;;;###autoload -(defun org-export-as-odt-and-open (arg) - "Export the outline as ODT and immediately open it with a browser. -If there is an active region, export only the region. -The prefix ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted lists." - (interactive "P") - (org-odt-cleanup-xml-buffers - (org-lparse-and-open - (or org-export-odt-preferred-output-format "odt") "odt" arg))) - -;;;###autoload -(defun org-export-as-odt-batch () - "Call the function `org-lparse-batch'. -This function can be used in batch processing as: -emacs --batch - --load=$HOME/lib/emacs/org.el - --eval \"(setq org-export-headline-levels 2)\" - --visit=MyFile --funcall org-export-as-odt-batch" - (org-odt-cleanup-xml-buffers (org-lparse-batch "odt"))) - -;;; org-export-as-odt -;;;###autoload -(defun org-export-as-odt (arg &optional hidden ext-plist - to-buffer body-only pub-dir) - "Export the outline as a OpenDocumentText file. -If there is an active region, export only the region. The prefix -ARG specifies how many levels of the outline should become -headlines. The default is 3. Lower levels will become bulleted -lists. HIDDEN is obsolete and does nothing. -EXT-PLIST is a property list with external parameters overriding -org-mode's default settings, but still inferior to file-local -settings. When TO-BUFFER is non-nil, create a buffer with that -name and export to that buffer. If TO-BUFFER is the symbol -`string', don't leave any buffer behind but just return the -resulting XML as a string. When BODY-ONLY is set, don't produce -the file header and footer, simply return the content of -<body>...</body>, without even the body tags themselves. When -PUB-DIR is set, use this as the publishing directory." - (interactive "P") - (org-odt-cleanup-xml-buffers - (org-lparse (or org-export-odt-preferred-output-format "odt") - "odt" arg hidden ext-plist to-buffer body-only pub-dir))) - -(defvar org-odt-entity-control-callbacks-alist - `((EXPORT - . (org-odt-begin-export org-odt-end-export)) - (DOCUMENT-CONTENT - . (org-odt-begin-document-content org-odt-end-document-content)) - (DOCUMENT-BODY - . (org-odt-begin-document-body org-odt-end-document-body)) - (TOC - . (org-odt-begin-toc org-odt-end-toc)) - (ENVIRONMENT - . (org-odt-begin-environment org-odt-end-environment)) - (FOOTNOTE-DEFINITION - . (org-odt-begin-footnote-definition org-odt-end-footnote-definition)) - (TABLE - . (org-odt-begin-table org-odt-end-table)) - (TABLE-ROWGROUP - . (org-odt-begin-table-rowgroup org-odt-end-table-rowgroup)) - (LIST - . (org-odt-begin-list org-odt-end-list)) - (LIST-ITEM - . (org-odt-begin-list-item org-odt-end-list-item)) - (OUTLINE - . (org-odt-begin-outline org-odt-end-outline)) - (OUTLINE-TEXT - . (org-odt-begin-outline-text org-odt-end-outline-text)) - (PARAGRAPH - . (org-odt-begin-paragraph org-odt-end-paragraph))) - "") - -(defvar org-odt-entity-format-callbacks-alist - `((EXTRA-TARGETS . org-lparse-format-extra-targets) - (ORG-TAGS . org-lparse-format-org-tags) - (SECTION-NUMBER . org-lparse-format-section-number) - (HEADLINE . org-odt-format-headline) - (TOC-ENTRY . org-odt-format-toc-entry) - (TOC-ITEM . org-odt-format-toc-item) - (TAGS . org-odt-format-tags) - (SPACES . org-odt-format-spaces) - (TABS . org-odt-format-tabs) - (LINE-BREAK . org-odt-format-line-break) - (FONTIFY . org-odt-format-fontify) - (TODO . org-lparse-format-todo) - (LINK . org-odt-format-link) - (INLINE-IMAGE . org-odt-format-inline-image) - (ORG-LINK . org-odt-format-org-link) - (HEADING . org-odt-format-heading) - (ANCHOR . org-odt-format-anchor) - (TABLE . org-lparse-format-table) - (TABLE-ROW . org-odt-format-table-row) - (TABLE-CELL . org-odt-format-table-cell) - (FOOTNOTES-SECTION . ignore) - (FOOTNOTE-REFERENCE . org-odt-format-footnote-reference) - (HORIZONTAL-LINE . org-odt-format-horizontal-line) - (COMMENT . org-odt-format-comment) - (LINE . org-odt-format-line) - (ORG-ENTITY . org-odt-format-org-entity)) - "") - -;;;_. callbacks -;;;_. control callbacks -;;;_ , document body -(defun org-odt-begin-office-body () - ;; automatic styles - (insert-file-contents - (or org-export-odt-content-template-file - (expand-file-name "OrgOdtContentTemplate.xml" - org-odt-styles-dir))) - (goto-char (point-min)) - (re-search-forward "</office:text>" nil nil) - (delete-region (match-beginning 0) (point-max))) - -;; Following variable is let bound when `org-do-lparse' is in -;; progress. See org-html.el. -(defvar org-lparse-toc) -(defun org-odt-format-toc () - (if (not org-lparse-toc) "" (concat "\n" org-lparse-toc "\n"))) - -(defun org-odt-format-preamble (opt-plist) - (let* ((title (plist-get opt-plist :title)) - (author (plist-get opt-plist :author)) - (date (plist-get opt-plist :date)) - (iso-date (org-odt-format-date date)) - (date (org-odt-format-date date "%d %b %Y")) - (email (plist-get opt-plist :email)) - ;; switch on or off above vars based on user settings - (author (and (plist-get opt-plist :author-info) (or author email))) - (email (and (plist-get opt-plist :email-info) email)) - (date (and (plist-get opt-plist :time-stamp-file) date))) - (concat - ;; title - (when title - (concat - (org-odt-format-stylized-paragraph - 'title (org-odt-format-tags - '("<text:title>" . "</text:title>") title)) - ;; separator - "<text:p text:style-name=\"OrgTitle\"/>")) - (cond - ((and author (not email)) - ;; author only - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-tags - '("<text:initial-creator>" . "</text:initial-creator>") - author)) - ;; separator - "<text:p text:style-name=\"OrgSubtitle\"/>")) - ((and author email) - ;; author and email - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-link - (org-odt-format-tags - '("<text:initial-creator>" . "</text:initial-creator>") - author) (concat "mailto:" email))) - ;; separator - "<text:p text:style-name=\"OrgSubtitle\"/>"))) - ;; date - (when date - (concat - (org-odt-format-stylized-paragraph - 'subtitle - (org-odt-format-tags - '("<text:date style:data-style-name=\"%s\" text:date-value=\"%s\">" - . "</text:date>") date "N75" iso-date)) - ;; separator - "<text:p text:style-name=\"OrgSubtitle\"/>"))))) - -(defun org-odt-begin-document-body (opt-plist) - (org-odt-begin-office-body) - (insert (org-odt-format-preamble opt-plist)) - (setq org-lparse-dyn-first-heading-pos (point))) - -(defvar org-lparse-body-only) ; let bound during org-do-lparse -(defvar org-lparse-to-buffer) ; let bound during org-do-lparse -(defun org-odt-end-document-body (opt-plist) - (unless org-lparse-body-only - (org-lparse-insert-tag "</office:text>") - (org-lparse-insert-tag "</office:body>"))) - -(defun org-odt-begin-document-content (opt-plist) - (ignore)) - -(defun org-odt-end-document-content () - (org-lparse-insert-tag "</office:document-content>")) - -(defun org-odt-begin-outline (level1 snumber title tags - target extra-targets class) - (org-lparse-insert - 'HEADING (org-lparse-format - 'HEADLINE title extra-targets tags snumber level1) - level1 target)) - -(defun org-odt-end-outline () - (ignore)) - -(defun org-odt-begin-outline-text (level1 snumber class) - (ignore)) - -(defun org-odt-end-outline-text () - (ignore)) - -(defun org-odt-begin-section (style &optional name) - (let ((default-name (car (org-odt-add-automatic-style "Section")))) - (org-lparse-insert-tag - "<text:section text:style-name=\"%s\" text:name=\"%s\">" - style (or name default-name)))) - -(defun org-odt-end-section () - (org-lparse-insert-tag "</text:section>")) - -(defun org-odt-begin-paragraph (&optional style) - (org-lparse-insert-tag - "<text:p%s>" (org-odt-get-extra-attrs-for-paragraph-style style))) - -(defun org-odt-end-paragraph () - (org-lparse-insert-tag "</text:p>")) - -(defun org-odt-get-extra-attrs-for-paragraph-style (style) - (let (style-name) - (setq style-name - (cond - ((stringp style) style) - ((symbolp style) (org-odt-get-style-name-for-entity - 'paragraph style)))) - (unless style-name - (error "Don't know how to handle paragraph style %s" style)) - (format " text:style-name=\"%s\"" style-name))) - -(defun org-odt-format-stylized-paragraph (style text) - (org-odt-format-tags - '("<text:p%s>" . "</text:p>") text - (org-odt-get-extra-attrs-for-paragraph-style style))) - -(defvar org-lparse-opt-plist) ; bound during org-do-lparse -(defun org-odt-format-author (&optional author) - (when (setq author (or author (plist-get org-lparse-opt-plist :author))) - (org-odt-format-tags '("<dc:creator>" . "</dc:creator>") author))) - -(defun org-odt-format-date (&optional org-ts fmt) - (save-match-data - (let* ((time - (and (stringp org-ts) - (string-match org-ts-regexp0 org-ts) - (apply 'encode-time - (org-fix-decoded-time - (org-parse-time-string (match-string 0 org-ts) t))))) - date) - (cond - (fmt (format-time-string fmt time)) - (t (setq date (format-time-string "%Y-%m-%dT%H:%M:%S%z" time)) - (format "%s:%s" (substring date 0 -2) (substring date -2))))))) - -(defun org-odt-begin-annotation (&optional author date) - (org-lparse-insert-tag "<office:annotation>") - (when (setq author (org-odt-format-author author)) - (insert author)) - (insert (org-odt-format-tags - '("<dc:date>" . "</dc:date>") - (org-odt-format-date - (or date (plist-get org-lparse-opt-plist :date))))) - (org-lparse-begin-paragraph)) - -(defun org-odt-end-annotation () - (org-lparse-insert-tag "</office:annotation>")) - -(defun org-odt-begin-environment (style env-options-plist) - (case style - (annotation - (org-lparse-stash-save-paragraph-state) - (org-odt-begin-annotation (plist-get env-options-plist 'author) - (plist-get env-options-plist 'date))) - ((blockquote verse center quote) - (org-lparse-begin-paragraph style) - (list)) - ((fixedwidth native) - (org-lparse-end-paragraph) - (list)) - (t (error "Unknown environment %s" style)))) - -(defun org-odt-end-environment (style env-options-plist) - (case style - (annotation - (org-lparse-end-paragraph) - (org-odt-end-annotation) - (org-lparse-stash-pop-paragraph-state)) - ((blockquote verse center quote) - (org-lparse-end-paragraph) - (list)) - ((fixedwidth native) - (org-lparse-begin-paragraph) - (list)) - (t (error "Unknown environment %s" style)))) - -(defvar org-lparse-list-stack) ; dynamically bound in org-do-lparse -(defvar org-odt-list-stack-stashed) -(defun org-odt-begin-list (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (let* ((style-name (org-odt-get-style-name-for-entity 'list ltype)) - (extra (concat (if (or org-lparse-list-table-p - (and (= 1 (length org-lparse-list-stack)) - (null org-odt-list-stack-stashed))) - " text:continue-numbering=\"false\"" - " text:continue-numbering=\"true\"") - (when style-name - (format " text:style-name=\"%s\"" style-name))))) - (case ltype - ((ordered unordered description) - (org-lparse-end-paragraph) - (org-lparse-insert-tag "<text:list%s>" extra)) - (t (error "Unknown list type: %s" ltype))))) - -(defun org-odt-end-list (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (if ltype - (org-lparse-insert-tag "</text:list>") - (error "Unknown list type: %s" ltype))) - -(defun org-odt-begin-list-item (ltype &optional arg headline) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (case ltype - (ordered - (assert (not headline) t) - (let* ((counter arg) (extra "")) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - "<text:list-header>" "<text:list-item>")) - (org-lparse-begin-paragraph))) - (unordered - (let* ((id arg) (extra "")) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - "<text:list-header>" "<text:list-item>")) - (org-lparse-begin-paragraph) - (insert (if headline (org-odt-format-target headline id) - (org-odt-format-bookmark "" id))))) - (description - (assert (not headline) t) - (let ((term (or arg "(no term)"))) - (insert - (org-odt-format-tags - '("<text:list-item>" . "</text:list-item>") - (org-odt-format-stylized-paragraph 'definition-term term))) - (org-lparse-begin-list-item 'unordered) - (org-lparse-begin-list 'description) - (org-lparse-begin-list-item 'unordered))) - (t (error "Unknown list type")))) - -(defun org-odt-end-list-item (ltype) - (setq ltype (or (org-lparse-html-list-type-to-canonical-list-type ltype) - ltype)) - (case ltype - ((ordered unordered) - (org-lparse-insert-tag (if (= (length org-lparse-list-stack) - (length org-odt-list-stack-stashed)) - (prog1 "</text:list-header>" - (setq org-odt-list-stack-stashed nil)) - "</text:list-item>"))) - (description - (org-lparse-end-list-item-1) - (org-lparse-end-list 'description) - (org-lparse-end-list-item-1)) - (t (error "Unknown list type")))) - -(defun org-odt-discontinue-list () - (let ((stashed-stack org-lparse-list-stack)) - (loop for list-type in stashed-stack - do (org-lparse-end-list-item-1 list-type) - (org-lparse-end-list list-type)) - (setq org-odt-list-stack-stashed stashed-stack))) - -(defun org-odt-continue-list () - (setq org-odt-list-stack-stashed (nreverse org-odt-list-stack-stashed)) - (loop for list-type in org-odt-list-stack-stashed - do (org-lparse-begin-list list-type) - (org-lparse-begin-list-item list-type))) - -;; Following variables are let bound when table emission is in -;; progress. See org-lparse.el. -(defvar org-lparse-table-begin-marker) -(defvar org-lparse-table-ncols) -(defvar org-lparse-table-rowgrp-open) -(defvar org-lparse-table-rownum) -(defvar org-lparse-table-cur-rowgrp-is-hdr) -(defvar org-lparse-table-is-styled) -(defvar org-lparse-table-rowgrp-info) -(defvar org-lparse-table-colalign-vector) - -(defvar org-odt-table-style nil - "Table style specified by \"#+ATTR_ODT: <style-name>\" line. -This is set during `org-odt-begin-table'.") - -(defvar org-odt-table-style-spec nil - "Entry for `org-odt-table-style' in `org-export-odt-table-styles'.") - -(defcustom org-export-odt-table-styles - '(("OrgEquation" "OrgEquation" - ((use-first-column-styles . t) - (use-last-column-styles . t)))) - "Specify how Table Styles should be derived from a Table Template. -This is a list where each element is of the -form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). - -TABLE-STYLE-NAME is the style associated with the table through -`org-odt-table-style'. - -TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic -TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined -below) that is included in -`org-export-odt-content-template-file'. - -TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableCell\" -PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableParagraph\" -TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | - \"FirstRow\" | \"LastRow\" | - \"EvenRow\" | \"OddRow\" | - \"EvenColumn\" | \"OddColumn\" | \"\" -where \"+\" above denotes string concatenation. - -TABLE-CELL-OPTIONS is an alist where each element is of the -form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). -TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | - `use-last-row-styles' | - `use-first-column-styles' | - `use-last-column-styles' | - `use-banding-rows-styles' | - `use-banding-columns-styles' | - `use-first-row-styles' -ON-OR-OFF := `t' | `nil' - -For example, with the following configuration - -\(setq org-export-odt-table-styles - '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" - \(\(use-first-row-styles . t\) - \(use-first-column-styles . t\)\)\) - \(\"TableWithHeaderColumns\" \"Custom\" - \(\(use-first-column-styles . t\)\)\)\)\) - -1. A table associated with \"TableWithHeaderRowsAndColumns\" - style will use the following table-cell styles - - \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", - \"CustomTableCell\" and the following paragraph styles - \"CustomFirstRowTableParagraph\", - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate. - -2. A table associated with \"TableWithHeaderColumns\" style will - use the following table-cell styles - - \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the - following paragraph styles - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate.. - -Note that TABLE-TEMPLATE-NAME corresponds to the -\"<table:table-template>\" elements contained within -\"<office:styles>\". The entries (TABLE-STYLE-NAME -TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to -\"table:template-name\" and \"table:use-first-row-styles\" etc -attributes of \"<table:table>\" element. Refer ODF-1.2 -specification for more information. Also consult the -implementation filed under `org-odt-get-table-cell-styles'. - -The TABLE-STYLE-NAME \"OrgEquation\" is used internally for -formatting of numbered display equations. Do not delete this -style from the list." - :group 'org-export-odt - :version "24.1" - :type '(choice - (const :tag "None" nil) - (repeat :tag "Table Styles" - (list :tag "Table Style Specification" - (string :tag "Table Style Name") - (string :tag "Table Template Name") - (alist :options (use-first-row-styles - use-last-row-styles - use-first-column-styles - use-last-column-styles - use-banding-rows-styles - use-banding-columns-styles) - :key-type symbol - :value-type (const :tag "True" t)))))) - -(defvar org-odt-table-style-format - " -<style:style style:name=\"%s\" style:family=\"table\"> - <style:table-properties style:rel-width=\"%d%%\" fo:margin-top=\"0cm\" fo:margin-bottom=\"0.20cm\" table:align=\"center\"/> -</style:style> -" - "Template for auto-generated Table styles.") - -(defvar org-odt-automatic-styles '() - "Registry of automatic styles for various OBJECT-TYPEs. -The variable has the following form: -\(\(OBJECT-TYPE-A - \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) - \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) - \(OBJECT-TYPE-B - \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) - \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) - ...\). - -OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option to `org-lparse-get-block-params'. - -Use `org-odt-add-automatic-style' to add update this variable.'") - -(defvar org-odt-object-counters nil - "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See -`org-odt-add-automatic-style'.") - -(defun org-odt-write-automatic-styles () - "Write automatic styles to \"content.xml\"." - (with-current-buffer - (find-file-noselect (expand-file-name "content.xml") t) - ;; position the cursor - (goto-char (point-min)) - (re-search-forward " </office:automatic-styles>" nil t) - (goto-char (match-beginning 0)) - ;; write automatic table styles - (loop for (style-name props) in - (plist-get org-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) 96)) - (insert (format org-odt-table-style-format style-name props)))))) - -(defun org-odt-add-automatic-style (object-type &optional object-props) - "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option of the object in question to -`org-lparse-get-block-params'. - -Use `org-odt-object-counters' to generate an automatic -OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a -new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME -. STYLE-NAME)." - (assert (stringp object-type)) - (let* ((object (intern object-type)) - (seqvar object) - (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) - (object-name (format "%s%d" object-type seqno)) style-name) - (setq org-odt-object-counters - (plist-put org-odt-object-counters seqvar seqno)) - (when object-props - (setq style-name (format "Org%s" object-name)) - (setq org-odt-automatic-styles - (plist-put org-odt-automatic-styles object - (append (list (list style-name object-props)) - (plist-get org-odt-automatic-styles object))))) - (cons object-name style-name))) - -(defvar org-odt-table-indentedp nil) -(defun org-odt-begin-table (caption label attributes short-caption) - (setq org-odt-table-indentedp (not (null org-lparse-list-stack))) - (when org-odt-table-indentedp - ;; Within the Org file, the table is appearing within a list item. - ;; OpenDocument doesn't allow table to appear within list items. - ;; Temporarily terminate the list, emit the table and then - ;; re-continue the list. - (org-odt-discontinue-list) - ;; Put the Table in an indented section. - (let ((level (length org-odt-list-stack-stashed))) - (org-odt-begin-section (format "OrgIndentedSection-Level-%d" level)))) - (setq attributes (org-lparse-get-block-params attributes)) - (setq org-odt-table-style (plist-get attributes :style)) - (setq org-odt-table-style-spec - (assoc org-odt-table-style org-export-odt-table-styles)) - (when (or label caption) - (insert - (org-odt-format-stylized-paragraph - 'table (org-odt-format-entity-caption label caption "__Table__")))) - (let ((automatic-name (org-odt-add-automatic-style "Table" attributes))) - (org-lparse-insert-tag - "<table:table table:name=\"%s\" table:style-name=\"%s\">" - (or short-caption (car automatic-name)) - (or (nth 1 org-odt-table-style-spec) - (cdr automatic-name) "OrgTable"))) - (setq org-lparse-table-begin-marker (point))) - -(defvar org-lparse-table-colalign-info) -(defun org-odt-end-table () - (goto-char org-lparse-table-begin-marker) - (loop for level from 0 below org-lparse-table-ncols - do (let* ((col-cookie (and org-lparse-table-is-styled - (cdr (assoc (1+ level) - org-lparse-table-colalign-info)))) - (extra-columns (or (nth 1 col-cookie) 0))) - (dotimes (i (1+ extra-columns)) - (insert - (org-odt-format-tags - "<table:table-column table:style-name=\"%sColumn\"/>" - "" (or (nth 1 org-odt-table-style-spec) "OrgTable")))) - (insert "\n"))) - ;; fill style attributes for table cells - (when org-lparse-table-is-styled - (while (re-search-forward "@@\\(table-cell:p\\|table-cell:style-name\\)@@\\([0-9]+\\)@@\\([0-9]+\\)@@" nil t) - (let* ((spec (match-string 1)) - (r (string-to-number (match-string 2))) - (c (string-to-number (match-string 3))) - (cell-styles (org-odt-get-table-cell-styles - r c org-odt-table-style-spec)) - (table-cell-style (car cell-styles)) - (table-cell-paragraph-style (cdr cell-styles))) - (cond - ((equal spec "table-cell:p") - (replace-match table-cell-paragraph-style t t)) - ((equal spec "table-cell:style-name") - (replace-match table-cell-style t t)))))) - (goto-char (point-max)) - (org-lparse-insert-tag "</table:table>") - (when org-odt-table-indentedp - (org-odt-end-section) - (org-odt-continue-list))) - -(defun org-odt-begin-table-rowgroup (&optional is-header-row) - (when org-lparse-table-rowgrp-open - (org-lparse-end 'TABLE-ROWGROUP)) - (org-lparse-insert-tag (if is-header-row - "<table:table-header-rows>" - "<table:table-rows>")) - (setq org-lparse-table-rowgrp-open t) - (setq org-lparse-table-cur-rowgrp-is-hdr is-header-row)) - -(defun org-odt-end-table-rowgroup () - (when org-lparse-table-rowgrp-open - (setq org-lparse-table-rowgrp-open nil) - (org-lparse-insert-tag - (if org-lparse-table-cur-rowgrp-is-hdr - "</table:table-header-rows>" "</table:table-rows>")))) - -(defun org-odt-format-table-row (row) - (org-odt-format-tags - '("<table:table-row>" . "</table:table-row>") row)) - -(defun org-odt-get-table-cell-styles (r c &optional style-spec) - "Retrieve styles applicable to a table cell. -R and C are (zero-based) row and column numbers of the table -cell. STYLE-SPEC is an entry in `org-export-odt-table-styles' -applicable to the current table. It is `nil' if the table is not -associated with any style attributes. - -Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). - -When STYLE-SPEC is nil, style the table cell the conventional way -- choose cell borders based on row and column groupings and -choose paragraph alignment based on `org-col-cookies' text -property. See also -`org-odt-get-paragraph-style-cookie-for-table-cell'. - -When STYLE-SPEC is non-nil, ignore the above cookie and return -styles congruent with the ODF-1.2 specification." - (cond - (style-spec - - ;; LibreOffice - particularly the Writer - honors neither table - ;; templates nor custom table-cell styles. Inorder to retain - ;; inter-operability with LibreOffice, only automatic styles are - ;; used for styling of table-cells. The current implementation is - ;; congruent with ODF-1.2 specification and hence is - ;; future-compatible. - - ;; Additional Note: LibreOffice's AutoFormat facility for tables - - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration - ;; by hand. - - (let* ((template-name (nth 1 style-spec)) - (cell-style-selectors (nth 2 style-spec)) - (cell-type - (cond - ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) - (= c 0)) "FirstColumn") - ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) - (= c (1- org-lparse-table-ncols))) "LastColumn") - ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) - (= r 0)) "FirstRow") - ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) - (= r org-lparse-table-rownum)) - "LastRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 1)) "EvenRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 0)) "OddRow") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 1)) "EvenColumn") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 0)) "OddColumn") - (t "")))) - (cons - (concat template-name cell-type "TableCell") - (concat template-name cell-type "TableParagraph")))) - (t - (cons - (concat - "OrgTblCell" - (cond - ((= r 0) "T") - ((eq (cdr (assoc r org-lparse-table-rowgrp-info)) :start) "T") - (t "")) - (when (= r org-lparse-table-rownum) "B") - (cond - ((= c 0) "") - ((or (memq (nth c org-table-colgroup-info) '(:start :startend)) - (memq (nth (1- c) org-table-colgroup-info) '(:end :startend))) "L") - (t ""))) - (capitalize (aref org-lparse-table-colalign-vector c)))))) - -(defun org-odt-get-paragraph-style-cookie-for-table-cell (r c) - (concat - (and (not org-odt-table-style-spec) - (cond - (org-lparse-table-cur-rowgrp-is-hdr "OrgTableHeading") - ((and (= c 0) (org-lparse-get 'TABLE-FIRST-COLUMN-AS-LABELS)) - "OrgTableHeading") - (t "OrgTableContents"))) - (and org-lparse-table-is-styled - (format "@@table-cell:p@@%03d@@%03d@@" r c)))) - -(defun org-odt-get-style-name-cookie-for-table-cell (r c) - (when org-lparse-table-is-styled - (format "@@table-cell:style-name@@%03d@@%03d@@" r c))) - -(defun org-odt-format-table-cell (data r c horiz-span) - (concat - (let* ((paragraph-style-cookie - (org-odt-get-paragraph-style-cookie-for-table-cell r c)) - (style-name-cookie - (org-odt-get-style-name-cookie-for-table-cell r c)) - (extra (and style-name-cookie - (format " table:style-name=\"%s\"" style-name-cookie))) - (extra (concat extra - (and (> horiz-span 0) - (format " table:number-columns-spanned=\"%d\"" - (1+ horiz-span)))))) - (org-odt-format-tags - '("<table:table-cell%s>" . "</table:table-cell>") - (if org-lparse-list-table-p data - (org-odt-format-stylized-paragraph paragraph-style-cookie data)) extra)) - (let (s) - (dotimes (i horiz-span) - (setq s (concat s "\n<table:covered-table-cell/>"))) s) - "\n")) - -(defun org-odt-begin-footnote-definition (n) - (org-lparse-begin-paragraph 'footnote)) - -(defun org-odt-end-footnote-definition (n) - (org-lparse-end-paragraph)) - -(defun org-odt-begin-toc (lang-specific-heading max-level) - ;; Strings in `org-export-language-setup' can contain named html - ;; entities. Replace those with utf-8 equivalents. - (let ((i 0) entity rpl) - (while (string-match "&\\([^#].*?\\);" lang-specific-heading i) - (setq entity (match-string 1 lang-specific-heading)) - (if (not (setq rpl (org-entity-get-representation entity 'utf8))) - (setq i (match-end 0)) - (setq i (+ (match-beginning 0) (length rpl))) - (setq lang-specific-heading - (replace-match rpl t t lang-specific-heading))))) - (insert - (format " - <text:table-of-content text:style-name=\"Sect2\" text:protected=\"true\" text:name=\"Table of Contents1\"> - <text:table-of-content-source text:outline-level=\"%d\"> - <text:index-title-template text:style-name=\"Contents_20_Heading\">%s</text:index-title-template> -" max-level lang-specific-heading)) - (loop for level from 1 upto 10 - do (insert (format - " - <text:table-of-content-entry-template text:outline-level=\"%d\" text:style-name=\"Contents_20_%d\"> - <text:index-entry-link-start text:style-name=\"Internet_20_link\"/> - <text:index-entry-chapter/> - <text:index-entry-text/> - <text:index-entry-link-end/> - </text:table-of-content-entry-template> -" level level))) - - (insert - (format " - </text:table-of-content-source> - - <text:index-body> - <text:index-title text:style-name=\"Sect1\" text:name=\"Table of Contents1_Head\"> - <text:p text:style-name=\"Contents_20_Heading\">%s</text:p> - </text:index-title> -" lang-specific-heading))) - -(defun org-odt-end-toc () - (insert " - </text:index-body> - </text:table-of-content> -")) - -(defun org-odt-format-toc-entry (snumber todo headline tags href) - (setq headline (concat - (and org-export-with-section-numbers - (concat snumber ". ")) - headline - (and tags - (concat - (org-lparse-format 'SPACES 3) - (org-lparse-format 'FONTIFY tags "tag"))))) - (when todo - (setq headline (org-lparse-format 'FONTIFY headline "todo"))) - - (let ((org-odt-suppress-xref t)) - (org-odt-format-link headline (concat "#" href)))) - -(defun org-odt-format-toc-item (toc-entry level org-last-level) - (let ((style (format "Contents_20_%d" - (+ level (or (org-lparse-get 'TOPLEVEL-HLEVEL) 1) -1)))) - (insert "\n" (org-odt-format-stylized-paragraph style toc-entry) "\n"))) - -;; Following variable is let bound during 'ORG-LINK callback. See -;; org-html.el -(defvar org-lparse-link-description-is-image nil) -(defun org-odt-format-link (desc href &optional attr) - (cond - ((and (= (string-to-char href) ?#) (not org-odt-suppress-xref)) - (setq href (substring href 1)) - (let ((xref-format "text")) - (when (numberp desc) - (setq desc (format "%d" desc) xref-format "number")) - (when (listp desc) - (setq desc (mapconcat 'identity desc ".") xref-format "chapter")) - (setq href (concat org-export-odt-bookmark-prefix href)) - (org-odt-format-tags - '("<text:bookmark-ref text:reference-format=\"%s\" text:ref-name=\"%s\">" . - "</text:bookmark-ref>") - desc xref-format href))) - (org-lparse-link-description-is-image - (org-odt-format-tags - '("<draw:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</draw:a>") - desc href (or attr ""))) - (t - (org-odt-format-tags - '("<text:a xlink:type=\"simple\" xlink:href=\"%s\" %s>" . "</text:a>") - desc href (or attr ""))))) - -(defun org-odt-format-spaces (n) - (cond - ((= n 1) " ") - ((> n 1) (concat - " " (org-odt-format-tags "<text:s text:c=\"%d\"/>" "" (1- n)))) - (t ""))) - -(defun org-odt-format-tabs (&optional n) - (let ((tab "<text:tab/>") - (n (or n 1))) - (insert tab))) - -(defun org-odt-format-line-break () - (org-odt-format-tags "<text:line-break/>" "")) - -(defun org-odt-format-horizontal-line () - (org-odt-format-stylized-paragraph 'horizontal-line "")) - -(defun org-odt-encode-plain-text (line &optional no-whitespace-filling) - (setq line (org-xml-encode-plain-text line)) - (if no-whitespace-filling line - (org-odt-fill-tabs-and-spaces line))) - -(defun org-odt-format-line (line) - (case org-lparse-dyn-current-environment - (fixedwidth (concat - (org-odt-format-stylized-paragraph - 'fixedwidth (org-odt-encode-plain-text line)) "\n")) - (t (concat line "\n")))) - -(defun org-odt-format-comment (fmt &rest args) - (let ((comment (apply 'format fmt args))) - (format "\n<!-- %s -->\n" comment))) - -(defun org-odt-format-org-entity (wd) - (org-entity-get-representation wd 'utf8)) - -(defun org-odt-fill-tabs-and-spaces (line) - (replace-regexp-in-string - "\\([\t]\\|\\([ ]+\\)\\)" (lambda (s) - (cond - ((string= s "\t") (org-odt-format-tabs)) - (t (org-odt-format-spaces (length s))))) line)) - -(defcustom org-export-odt-fontify-srcblocks t - "Specify whether or not source blocks need to be fontified. -Turn this option on if you want to colorize the source code -blocks in the exported file. For colorization to work, you need -to make available an enhanced version of `htmlfontify' library." - :type 'boolean - :group 'org-export-odt - :version "24.1") - -(defun org-odt-format-source-line-with-line-number-and-label - (line rpllbl num fontifier par-style) - - (let ((keep-label (not (numberp rpllbl))) - (ref (org-find-text-property-in-string 'org-coderef line))) - (setq line (concat line (and keep-label ref (format "(%s)" ref)))) - (setq line (funcall fontifier line)) - (when ref - (setq line (org-odt-format-target line (concat "coderef-" ref)))) - (setq line (org-odt-format-stylized-paragraph par-style line)) - (if (not num) line - (org-odt-format-tags '("<text:list-item>" . "</text:list-item>") line)))) - -(defun org-odt-format-source-code-or-example-plain - (lines lang caption textareap cols rows num cont rpllbl fmt) - "Format source or example blocks much like fixedwidth blocks. -Use this when `org-export-odt-fontify-srcblocks' option is turned -off." - (let* ((lines (org-split-string lines "[\r\n]")) - (line-count (length lines)) - (i 0)) - (mapconcat - (lambda (line) - (incf i) - (org-odt-format-source-line-with-line-number-and-label - line rpllbl num 'org-odt-encode-plain-text - (if (= i line-count) "OrgFixedWidthBlockLastLine" - "OrgFixedWidthBlock"))) - lines "\n"))) - -(defvar org-src-block-paragraph-format - "<style:style style:name=\"OrgSrcBlock\" style:family=\"paragraph\" style:parent-style-name=\"Preformatted_20_Text\"> - <style:paragraph-properties fo:background-color=\"%s\" fo:padding=\"0.049cm\" fo:border=\"0.51pt solid #000000\" style:shadow=\"none\"> - <style:background-image/> - </style:paragraph-properties> - <style:text-properties fo:color=\"%s\"/> - </style:style>" - "Custom paragraph style for colorized source and example blocks. -This style is much the same as that of \"OrgFixedWidthBlock\" -except that the foreground and background colors are set -according to the default face identified by the `htmlfontify'.") - -(defvar hfy-optimisations) -(declare-function hfy-face-to-style "htmlfontify" (fn)) -(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) - -(defun org-odt-hfy-face-to-css (fn) - "Create custom style for face FN. -When FN is the default face, use it's foreground and background -properties to create \"OrgSrcBlock\" paragraph style. Otherwise -use it's color attribute to create a character style whose name -is obtained from FN. Currently all attributes of FN other than -color are ignored. - -The style name for a face FN is derived using the following -operations on the face name in that order - de-dash, CamelCase -and prefix with \"OrgSrc\". For example, -`font-lock-function-name-face' is associated with -\"OrgSrcFontLockFunctionNameFace\"." - (let* ((css-list (hfy-face-to-style fn)) - (style-name ((lambda (fn) - (concat "OrgSrc" - (mapconcat - 'capitalize (split-string - (hfy-face-or-def-to-name fn) "-") - ""))) fn)) - (color-val (cdr (assoc "color" css-list))) - (background-color-val (cdr (assoc "background" css-list))) - (style (and org-export-odt-create-custom-styles-for-srcblocks - (cond - ((eq fn 'default) - (format org-src-block-paragraph-format - background-color-val color-val)) - (t - (format - " -<style:style style:name=\"%s\" style:family=\"text\"> - <style:text-properties fo:color=\"%s\"/> - </style:style>" style-name color-val)))))) - (cons style-name style))) - -(defun org-odt-insert-custom-styles-for-srcblocks (styles) - "Save STYLES used for colorizing of source blocks. -Update styles.xml with styles that were collected as part of -`org-odt-hfy-face-to-css' callbacks." - (when styles - (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) - (goto-char (point-min)) - (when (re-search-forward "</office:styles>" nil t) - (goto-char (match-beginning 0)) - (insert "\n<!-- Org Htmlfontify Styles -->\n" styles "\n"))))) - -(defun org-odt-format-source-code-or-example-colored - (lines lang caption textareap cols rows num cont rpllbl fmt) - "Format source or example blocks using `htmlfontify-string'. -Use this routine when `org-export-odt-fontify-srcblocks' option -is turned on." - (let* ((lang-m (and lang (or (cdr (assoc lang org-src-lang-modes)) lang))) - (mode (and lang-m (intern (concat (if (symbolp lang-m) - (symbol-name lang-m) - lang-m) "-mode")))) - (org-inhibit-startup t) - (org-startup-folded nil) - (lines (with-temp-buffer - (insert lines) - (if (functionp mode) (funcall mode) (fundamental-mode)) - (font-lock-fontify-buffer) - (buffer-string))) - (hfy-html-quote-regex "\\([<\"&> ]\\)") - (hfy-html-quote-map '(("\"" """) - ("<" "<") - ("&" "&") - (">" ">") - (" " "<text:s/>") - (" " "<text:tab/>"))) - (hfy-face-to-css 'org-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-sequence hfy-optimisations)) - (hfy-optimisations (add-to-list 'hfy-optimisations-1 - 'body-text-only)) - (hfy-begin-span-handler - (lambda (style text-block text-id text-begins-block-p) - (insert (format "<text:span text:style-name=\"%s\">" style)))) - (hfy-end-span-handler (lambda nil (insert "</text:span>")))) - (when (fboundp 'htmlfontify-string) - (let* ((lines (org-split-string lines "[\r\n]")) - (line-count (length lines)) - (i 0)) - (mapconcat - (lambda (line) - (incf i) - (org-odt-format-source-line-with-line-number-and-label - line rpllbl num 'htmlfontify-string - (if (= i line-count) "OrgSrcBlockLastLine" "OrgSrcBlock"))) - lines "\n"))))) - -(defun org-odt-format-source-code-or-example (lines lang caption textareap - cols rows num cont - rpllbl fmt) - "Format source or example blocks for export. -Use `org-odt-format-source-code-or-example-plain' or -`org-odt-format-source-code-or-example-colored' depending on the -value of `org-export-odt-fontify-srcblocks." - (setq lines (org-export-number-lines - lines 0 0 num cont rpllbl fmt 'preprocess) - lines (funcall - (or (and org-export-odt-fontify-srcblocks - (or (featurep 'htmlfontify) - ;; htmlfontify.el was introduced in Emacs 23.2 - ;; So load it with some caution - (require 'htmlfontify nil t)) - (fboundp 'htmlfontify-string) - 'org-odt-format-source-code-or-example-colored) - 'org-odt-format-source-code-or-example-plain) - lines lang caption textareap cols rows num cont rpllbl fmt)) - (if (not num) lines - (let ((extra (format " text:continue-numbering=\"%s\"" - (if cont "true" "false")))) - (org-odt-format-tags - '("<text:list text:style-name=\"OrgSrcBlockNumberedLine\"%s>" - . "</text:list>") lines extra)))) - -(defun org-odt-remap-stylenames (style-name) - (or - (cdr (assoc style-name '(("timestamp-wrapper" . "OrgTimestampWrapper") - ("timestamp" . "OrgTimestamp") - ("timestamp-kwd" . "OrgTimestampKeyword") - ("tag" . "OrgTag") - ("todo" . "OrgTodo") - ("done" . "OrgDone") - ("target" . "OrgTarget")))) - style-name)) - -(defun org-odt-format-fontify (text style &optional id) - (let* ((style-name - (cond - ((stringp style) - (org-odt-remap-stylenames style)) - ((symbolp style) - (org-odt-get-style-name-for-entity 'character style)) - ((listp style) - (assert (< 1 (length style))) - (let ((parent-style (pop style))) - (mapconcat (lambda (s) - ;; (assert (stringp s) t) - (org-odt-remap-stylenames s)) style "") - (org-odt-remap-stylenames parent-style))) - (t (error "Don't how to handle style %s" style))))) - (org-odt-format-tags - '("<text:span text:style-name=\"%s\">" . "</text:span>") - text style-name))) - -(defun org-odt-relocate-relative-path (path dir) - (if (file-name-absolute-p path) path - (file-relative-name (expand-file-name path dir) - (expand-file-name "eyecandy" dir)))) - -(defun org-odt-format-inline-image (thefile) - (let* ((thelink (if (file-name-absolute-p thefile) thefile - (org-xml-format-href - (org-odt-relocate-relative-path - thefile org-current-export-file)))) - (href - (org-odt-format-tags - "<draw:image xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" "" - (if org-export-odt-embed-images - (org-odt-copy-image-file thefile) thelink)))) - (org-export-odt-format-image thefile href))) - -(defvar org-odt-entity-labels-alist nil - "Associate Labels with the Labeled entities. -Each element of the alist is of the form (LABEL-NAME -CATEGORY-NAME SEQNO LABEL-STYLE-NAME). LABEL-NAME is same as -that specified by \"#+LABEL: ...\" line. CATEGORY-NAME is the -type of the entity that LABEL-NAME is attached to. CATEGORY-NAME -can be one of \"Table\", \"Figure\" or \"Equation\". SEQNO is -the unique number assigned to the referenced entity on a -per-CATEGORY basis. It is generated sequentially and is 1-based. -LABEL-STYLE-NAME is a key `org-odt-label-styles'. - -See `org-odt-add-label-definition' and -`org-odt-fixup-label-references'.") - -(defun org-export-odt-format-formula (src href) - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (short-caption - (or (org-find-text-property-in-string 'org-caption-shortn src) - caption)) - (caption (and caption (org-xml-format-desc caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (label (org-find-text-property-in-string 'org-label src)) - (latex-frag (org-find-text-property-in-string 'org-latex-src src)) - (embed-as (or (and latex-frag - (org-find-text-property-in-string - 'org-latex-src-embed-type src)) - (if (or caption label) 'paragraph 'character))) - width height) - (when latex-frag - (setq href (org-propertize href :title "LaTeX Fragment" - :description latex-frag))) - (cond - ((eq embed-as 'character) - (org-odt-format-entity "InlineFormula" href width height)) - (t - (org-lparse-end-paragraph) - (org-lparse-insert-list-table - `((,(org-odt-format-entity - (if (not (or caption label)) "DisplayFormula" - "CaptionedDisplayFormula") - href width height :caption caption :label label - :short-caption short-caption) - ,(if (not (or caption label)) "" - (let* ((label-props (car org-odt-entity-labels-alist))) - (setcar (last label-props) "math-label") - (apply 'org-odt-format-label-definition - caption label-props))))) - nil nil nil ":style \"OrgEquation\"" nil '((1 "c" 8) (2 "c" 1))) - (throw 'nextline nil)))))) - -(defvar org-odt-embedded-formulas-count 0) -(defun org-odt-copy-formula-file (path) - "Returns the internal name of the file" - (let* ((src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir (format "Formula-%04d/" - (incf org-odt-embedded-formulas-count))) - (target-file (concat target-dir "content.xml"))) - (when (not org-lparse-to-buffer) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (make-directory target-dir) - (org-odt-create-manifest-file-entry - "application/vnd.oasis.opendocument.formula" target-dir "1.2") - - (case (org-odt-is-formula-link-p src-file) - (mathml - (copy-file src-file target-file 'overwrite)) - (odf - (org-odt-zip-extract-one src-file "content.xml" target-dir)) - (t - (error "%s is not a formula file" src-file))) - - (org-odt-create-manifest-file-entry "text/xml" target-file)) - target-file)) - -(defun org-odt-format-inline-formula (thefile) - (let* ((thelink (if (file-name-absolute-p thefile) thefile - (org-xml-format-href - (org-odt-relocate-relative-path - thefile org-current-export-file)))) - (href - (org-odt-format-tags - "<draw:object xlink:href=\"%s\" xlink:type=\"simple\" xlink:show=\"embed\" xlink:actuate=\"onLoad\"/>" "" - (file-name-directory (org-odt-copy-formula-file thefile))))) - (org-export-odt-format-formula thefile href))) - -(defun org-odt-is-formula-link-p (file) - (let ((case-fold-search nil)) - (cond - ((string-match "\\.\\(mathml\\|mml\\)\\'" file) - 'mathml) - ((string-match "\\.odf\\'" file) - 'odf)))) - -(defun org-odt-format-org-link (opt-plist type-1 path fragment desc attr - descp) - "Make a OpenDocument link. -OPT-PLIST is an options list. -TYPE-1 is the device-type of the link (THIS://foo.html). -PATH is the path of the link (http://THIS#location). -FRAGMENT is the fragment part of the link, if any (foo.html#THIS). -DESC is the link description, if any. -ATTR is a string of other attributes of the a element." - (declare (special org-lparse-par-open)) - (save-match-data - (let* ((may-inline-p - (and (member type-1 '("http" "https" "file")) - (org-lparse-should-inline-p path descp) - (not fragment))) - (type (if (equal type-1 "id") "file" type-1)) - (filename path) - (thefile path) - sec-frag sec-nos) - (cond - ;; check for inlined images - ((and (member type '("file")) - (not fragment) - (org-file-image-p - filename org-export-odt-inline-image-extensions) - (or (eq t org-export-odt-inline-images) - (and org-export-odt-inline-images (not descp)))) - (org-odt-format-inline-image thefile)) - ;; check for embedded formulas - ((and (member type '("file")) - (not fragment) - (org-odt-is-formula-link-p filename) - (or (not descp))) - (org-odt-format-inline-formula thefile)) - ;; code references - ((string= type "coderef") - (let* ((ref fragment) - (lineno-or-ref (cdr (assoc ref org-export-code-refs))) - (desc (and descp desc)) - (org-odt-suppress-xref nil) - (href (org-xml-format-href (concat "#coderef-" ref)))) - (cond - ((and (numberp lineno-or-ref) (not desc)) - (org-odt-format-link lineno-or-ref href)) - ((and (numberp lineno-or-ref) desc - (string-match (regexp-quote (concat "(" ref ")")) desc)) - (format (replace-match "%s" t t desc) - (org-odt-format-link lineno-or-ref href))) - (t - (setq desc (format - (if (and desc (string-match - (regexp-quote (concat "(" ref ")")) - desc)) - (replace-match "%s" t t desc) - (or desc "%s")) - lineno-or-ref)) - (org-odt-format-link (org-xml-format-desc desc) href))))) - ;; links to headlines - ((and (string= type "") - (or (not thefile) (string= thefile "")) - (plist-get org-lparse-opt-plist :section-numbers) - (get-text-property 0 'org-no-description fragment) - (setq sec-frag fragment) - (or (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag) - (and (setq sec-frag - (loop for alias in org-export-target-aliases do - (when (member fragment (cdr alias)) - (return (car alias))))) - (string-match "\\`sec\\(\\(-[0-9]+\\)+\\)" sec-frag))) - (setq sec-nos (org-split-string (match-string 1 sec-frag) "-")) - (<= (length sec-nos) (plist-get org-lparse-opt-plist - :headline-levels))) - (let ((org-odt-suppress-xref nil)) - (org-odt-format-link sec-nos (concat "#" sec-frag) attr))) - (t - (when (string= type "file") - (setq thefile - (cond - ((file-name-absolute-p path) - (concat "file://" (expand-file-name path))) - (t (org-odt-relocate-relative-path - thefile org-current-export-file))))) - - (when (and (member type '("" "http" "https" "file")) fragment) - (setq thefile (concat thefile "#" fragment))) - - (setq thefile (org-xml-format-href thefile)) - - (when (not (member type '("" "file"))) - (setq thefile (concat type ":" thefile))) - - (let ((org-odt-suppress-xref - ;; Typeset link to headlines with description, as a - ;; regular hyperlink. - (and (string= type "") - (not (get-text-property 0 'org-no-description fragment))))) - (org-odt-format-link - (org-xml-format-desc desc) thefile attr))))))) - -(defun org-odt-format-heading (text level &optional id) - (let* ((text (if id (org-odt-format-target text id) text))) - (org-odt-format-tags - '("<text:h text:style-name=\"Heading_20_%s\" text:outline-level=\"%s\">" . - "</text:h>") text level level))) - -(defun org-odt-format-headline (title extra-targets tags - &optional snumber level) - (concat - (org-lparse-format 'EXTRA-TARGETS extra-targets) - - ;; No need to generate section numbers. They are auto-generated by - ;; the application - - ;; (concat (org-lparse-format 'SECTION-NUMBER snumber level) " ") - title - (and tags (concat (org-lparse-format 'SPACES 3) - (org-lparse-format 'ORG-TAGS tags))))) - -(defun org-odt-format-anchor (text name &optional class) - (org-odt-format-target text name)) - -(defun org-odt-format-bookmark (text id) - (if id - (org-odt-format-tags "<text:bookmark text:name=\"%s\"/>" text id) - text)) - -(defun org-odt-format-target (text id) - (let ((name (concat org-export-odt-bookmark-prefix id))) - (concat - (and id (org-odt-format-tags - "<text:bookmark-start text:name=\"%s\"/>" "" name)) - (org-odt-format-bookmark text id) - (and id (org-odt-format-tags - "<text:bookmark-end text:name=\"%s\"/>" "" name))))) - -(defun org-odt-format-footnote (n def) - (let ((id (concat "fn" n)) - (note-class "footnote") - (par-style "Footnote")) - (org-odt-format-tags - '("<text:note text:id=\"%s\" text:note-class=\"%s\">" . - "</text:note>") - (concat - (org-odt-format-tags - '("<text:note-citation>" . "</text:note-citation>") - n) - (org-odt-format-tags - '("<text:note-body>" . "</text:note-body>") - def)) - id note-class))) - -(defun org-odt-format-footnote-reference (n def refcnt) - (if (= refcnt 1) - (org-odt-format-footnote n def) - (org-odt-format-footnote-ref n))) - -(defun org-odt-format-footnote-ref (n) - (let ((note-class "footnote") - (ref-format "text") - (ref-name (concat "fn" n))) - (org-odt-format-tags - '("<text:span text:style-name=\"%s\">" . "</text:span>") - (org-odt-format-tags - '("<text:note-ref text:note-class=\"%s\" text:reference-format=\"%s\" text:ref-name=\"%s\">" . "</text:note-ref>") - n note-class ref-format ref-name) - "OrgSuperscript"))) - -(defun org-odt-get-image-name (file-name) - (require 'sha1) - (file-relative-name - (expand-file-name - (concat (sha1 file-name) "." (file-name-extension file-name)) "Pictures"))) - -(defun org-export-odt-format-image (src href) - "Create image tag with source and attributes." - (save-match-data - (let* ((caption (org-find-text-property-in-string 'org-caption src)) - (short-caption - (or (org-find-text-property-in-string 'org-caption-shortn src) - caption)) - (caption (and caption (org-xml-format-desc caption))) - (short-caption (and short-caption - (org-xml-encode-plain-text short-caption))) - (attr (org-find-text-property-in-string 'org-attributes src)) - (label (org-find-text-property-in-string 'org-label src)) - (latex-frag (org-find-text-property-in-string - 'org-latex-src src)) - (category (and latex-frag "__DvipngImage__")) - (attr-plist (org-lparse-get-block-params attr)) - (user-frame-anchor - (car (assoc-string (plist-get attr-plist :anchor) - '(("as-char") ("paragraph") ("page")) t))) - (user-frame-style - (and user-frame-anchor (plist-get attr-plist :style))) - (user-frame-attrs - (and user-frame-anchor (plist-get attr-plist :attributes))) - (user-frame-params - (list user-frame-style user-frame-attrs user-frame-anchor)) - (embed-as (cond - (latex-frag - (symbol-name - (case (org-find-text-property-in-string - 'org-latex-src-embed-type src) - (paragraph 'paragraph) - (t 'as-char)))) - (user-frame-anchor) - (t "paragraph"))) - (size (org-odt-image-size-from-file - src (plist-get attr-plist :width) - (plist-get attr-plist :height) - (plist-get attr-plist :scale) nil embed-as)) - (width (car size)) (height (cdr size))) - (when latex-frag - (setq href (org-propertize href :title "LaTeX Fragment" - :description latex-frag))) - (let ((frame-style-handle (concat (and (or caption label) "Captioned") - embed-as "Image"))) - (org-odt-format-entity - frame-style-handle href width height - :caption caption :label label :category category - :short-caption short-caption - :user-frame-params user-frame-params))))) - -(defun org-odt-format-object-description (title description) - (concat (and title (org-odt-format-tags - '("<svg:title>" . "</svg:title>") - (org-odt-encode-plain-text title t))) - (and description (org-odt-format-tags - '("<svg:desc>" . "</svg:desc>") - (org-odt-encode-plain-text description t))))) - -(defun org-odt-format-frame (text width height style &optional - extra anchor-type) - (let ((frame-attrs - (concat - (if width (format " svg:width=\"%0.2fcm\"" width) "") - (if height (format " svg:height=\"%0.2fcm\"" height) "") - extra - (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))))) - (org-odt-format-tags - '("<draw:frame draw:style-name=\"%s\"%s>" . "</draw:frame>") - (concat text (org-odt-format-object-description - (get-text-property 0 :title text) - (get-text-property 0 :description text))) - style frame-attrs))) - -(defun org-odt-format-textbox (text width height style &optional - extra anchor-type) - (org-odt-format-frame - (org-odt-format-tags - '("<draw:text-box %s>" . "</draw:text-box>") - text (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) - (unless width - (format " fo:min-width=\"%0.2fcm\"" (or width .2))))) - width nil style extra anchor-type)) - -(defun org-odt-format-inlinetask (heading content - &optional todo priority tags) - (org-odt-format-stylized-paragraph - nil (org-odt-format-textbox - (concat (org-odt-format-stylized-paragraph - "OrgInlineTaskHeading" - (org-lparse-format - 'HEADLINE (concat (org-lparse-format-todo todo) " " heading) - nil tags)) - content) nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))) - -(defvar org-odt-entity-frame-styles - '(("As-CharImage" "__Figure__" ("OrgInlineImage" nil "as-char")) - ("ParagraphImage" "__Figure__" ("OrgDisplayImage" nil "paragraph")) - ("PageImage" "__Figure__" ("OrgPageImage" nil "page")) - ("CaptionedAs-CharImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgInlineImage" nil "as-char")) - ("CaptionedParagraphImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgImageCaptionFrame" nil "paragraph")) - ("CaptionedPageImage" "__Figure__" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgPageImageCaptionFrame" nil "page")) - ("InlineFormula" "__MathFormula__" ("OrgInlineFormula" nil "as-char")) - ("DisplayFormula" "__MathFormula__" ("OrgDisplayFormula" nil "as-char")) - ("CaptionedDisplayFormula" "__MathFormula__" - ("OrgCaptionedFormula" nil "paragraph") - ("OrgFormulaCaptionFrame" nil "as-char")))) - -(defun org-odt-merge-frame-params(default-frame-params user-frame-params) - (if (not user-frame-params) default-frame-params - (assert (= (length default-frame-params) 3)) - (assert (= (length user-frame-params) 3)) - (loop for user-frame-param in user-frame-params - for default-frame-param in default-frame-params - collect (or user-frame-param default-frame-param)))) - -(defun* org-odt-format-entity (entity href width height - &key caption label category - user-frame-params short-caption) - (let* ((entity-style (assoc-string entity org-odt-entity-frame-styles t)) - default-frame-params frame-params) - (cond - ((not (or caption label)) - (setq default-frame-params (nth 2 entity-style)) - (setq frame-params (org-odt-merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-odt-format-frame href width height frame-params)) - (t - (setq default-frame-params (nth 3 entity-style)) - (setq frame-params (org-odt-merge-frame-params - default-frame-params user-frame-params)) - (apply 'org-odt-format-textbox - (org-odt-format-stylized-paragraph - 'illustration - (concat - (apply 'org-odt-format-frame href width height - (let ((entity-style-1 (copy-sequence - (nth 2 entity-style)))) - (setcar (cdr entity-style-1) - (concat - (cadr entity-style-1) - (and short-caption - (format " draw:name=\"%s\" " - short-caption)))) - - entity-style-1)) - (org-odt-format-entity-caption - label caption (or category (nth 1 entity-style))))) - width height frame-params))))) - -(defvar org-odt-embedded-images-count 0) -(defun org-odt-copy-image-file (path) - "Returns the internal name of the file" - (let* ((image-type (file-name-extension path)) - (media-type (format "image/%s" image-type)) - (src-file (expand-file-name - path (file-name-directory org-current-export-file))) - (target-dir "Images/") - (target-file - (format "%s%04d.%s" target-dir - (incf org-odt-embedded-images-count) image-type))) - (when (not org-lparse-to-buffer) - (message "Embedding %s as %s ..." - (substring-no-properties path) target-file) - - (when (= 1 org-odt-embedded-images-count) - (make-directory target-dir) - (org-odt-create-manifest-file-entry "" target-dir)) - - (copy-file src-file target-file 'overwrite) - (org-odt-create-manifest-file-entry media-type target-file)) - target-file)) - -(defvar org-export-odt-image-size-probe-method - (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 - '(emacs fixed)) - "Ordered list of methods for determining image sizes.") - -(defvar org-export-odt-default-image-sizes-alist - '(("as-char" . (5 . 0.4)) - ("paragraph" . (5 . 5))) - "Hardcoded image dimensions one for each of the anchor - methods.") - -;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So -;; the effective text area is 17.0 by 25.7 cm -(defvar org-export-odt-max-image-size '(17.0 . 20.0) - "Limiting dimensions for an embedded image.") - -(defun org-odt-do-image-size (probe-method file &optional dpi anchor-type) - (let* ((dpi (or dpi org-export-odt-pixels-per-inch)) - (anchor-type (or anchor-type "paragraph")) - (--pixels-to-cms - (function - (lambda (pixels dpi) - (let* ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches))))) - (--size-in-cms - (function - (lambda (size-in-pixels dpi) - (and size-in-pixels - (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) - (funcall --pixels-to-cms (cdr size-in-pixels) dpi))))))) - (case probe-method - (emacs - (let ((size-in-pixels - (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) - (funcall --size-in-cms size-in-pixels dpi))) - (imagemagick - (let ((size-in-pixels - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (funcall --size-in-cms size-in-pixels dpi))) - (t (cdr (assoc-string anchor-type - org-export-odt-default-image-sizes-alist)))))) - -(defun org-odt-image-size-from-file (file &optional user-width - user-height scale dpi embed-as) - (unless (file-name-absolute-p file) - (setq file (expand-file-name - file (file-name-directory org-current-export-file)))) - (let* (size width height) - (unless (and user-height user-width) - (loop for probe-method in org-export-odt-image-size-probe-method - until size - do (setq size (org-odt-do-image-size - probe-method file dpi embed-as))) - (or size (error "Cannot determine image size, aborting")) - (setq width (car size) height (cdr size))) - (cond - (scale - (setq width (* width scale) height (* height scale))) - ((and user-height user-width) - (setq width user-width height user-height)) - (user-height - (setq width (* user-height (/ width height)) height user-height)) - (user-width - (setq height (* user-width (/ height width)) width user-width)) - (t (ignore))) - ;; ensure that an embedded image fits comfortably within a page - (let ((max-width (car org-export-odt-max-image-size)) - (max-height (cdr org-export-odt-max-image-size))) - (when (or (> width max-width) (> height max-height)) - (let* ((scale1 (/ max-width width)) - (scale2 (/ max-height height)) - (scale (min scale1 scale2))) - (setq width (* scale width) height (* scale height))))) - (cons width height))) - -(defvar org-odt-entity-counts-plist nil - "Plist of running counters of SEQNOs for each of the CATEGORY-NAMEs. -See `org-odt-entity-labels-alist' for known CATEGORY-NAMEs.") - -(defvar org-odt-label-styles - '(("math-formula" "%c" "text" "(%n)") - ("math-label" "(%n)" "text" "(%n)") - ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") - ("value" "%e %n: %c" "value" "%n")) - "Specify how labels are applied and referenced. -This is an alist where each element is of the -form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE -LABEL-REF-FMT). - -LABEL-ATTACH-FMT controls how labels and captions are attached to -an entity. It may contain following specifiers - %e, %n and %c. -%e is replaced with the CATEGORY-NAME. %n is replaced with -\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced -with CAPTION. See `org-odt-format-label-definition'. - -LABEL-REF-MODE and LABEL-REF-FMT controls how label references -are generated. The following XML is generated for a label -reference - \"<text:sequence-ref -text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT -</text:sequence-ref>\". LABEL-REF-FMT may contain following -specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. See -`org-odt-format-label-reference'.") - -(defcustom org-export-odt-category-strings - '(("en" "Table" "Figure" "Equation" "Equation")) - "Specify category strings for various captionable entities. -Captionable entity can be one of a Table, an Embedded Image, a -LaTeX fragment (generated with dvipng) or a Math Formula. - -For example, when `org-export-default-language' is \"en\", an -embedded image will be captioned as \"Figure 1: Orgmode Logo\". -If you want the images to be captioned instead as \"Illustration -1: Orgmode Logo\", then modify the entry for \"en\" as shown -below. - - \(setq org-export-odt-category-strings - '\(\(\"en\" \"Table\" \"Illustration\" - \"Equation\" \"Equation\"\)\)\)" - :group 'org-export-odt - :version "24.1" - :type '(repeat (list (string :tag "Language tag") - (choice :tag "Table" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Figure" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Math Formula" - (const :tag "Use Default" nil) - (string :tag "Category string")) - (choice :tag "Dvipng Image" - (const :tag "Use Default" nil) - (string :tag "Category string"))))) - -(defvar org-odt-category-map-alist - '(("__Table__" "Table" "value") - ("__Figure__" "Illustration" "value") - ("__MathFormula__" "Text" "math-formula") - ("__DvipngImage__" "Equation" "value") - ;; ("__Table__" "Table" "category-and-value") - ;; ("__Figure__" "Figure" "category-and-value") - ;; ("__DvipngImage__" "Equation" "category-and-value") - ) - "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. -This is a list where each entry is of the form \\(CATEGORY-HANDLE -OD-VARIABLE LABEL-STYLE\\). CATEGORY_HANDLE identifies the -captionable entity in question. OD-VARIABLE is the OpenDocument -sequence counter associated with the entity. These counters are -declared within -\"<text:sequence-decls>...</text:sequence-decls>\" block of -`org-export-odt-content-template-file'. LABEL-STYLE is a key -into `org-odt-label-styles' and specifies how a given entity -should be captioned and referenced. - -The position of a CATEGORY-HANDLE in this list is used as an -index in to per-language entry for -`org-export-odt-category-strings' to retrieve a CATEGORY-NAME. -This CATEGORY-NAME is then used for qualifying the user-specified -captions on export.") - -(defun org-odt-add-label-definition (label default-category) - "Create an entry in `org-odt-entity-labels-alist' and return it." - (let* ((label-props (assoc default-category org-odt-category-map-alist)) - ;; identify the sequence number - (counter (nth 1 label-props)) - (sequence-var (intern counter)) - (seqno (1+ (or (plist-get org-odt-entity-counts-plist sequence-var) - 0))) - ;; assign an internal label, if user has not provided one - (label (if label (substring-no-properties label) - (format "%s-%s" default-category seqno))) - ;; identify label style - (label-style (nth 2 label-props)) - ;; grok language setting - (en-strings (assoc-default "en" org-export-odt-category-strings)) - (lang (plist-get org-lparse-opt-plist :language)) - (lang-strings (assoc-default lang org-export-odt-category-strings)) - ;; retrieve localized category sting - (pos (- (length org-odt-category-map-alist) - (length (memq label-props org-odt-category-map-alist)))) - (category (or (nth pos lang-strings) (nth pos en-strings))) - (label-props (list label category counter seqno label-style))) - ;; synchronize internal counters - (setq org-odt-entity-counts-plist - (plist-put org-odt-entity-counts-plist sequence-var seqno)) - ;; stash label properties for later retrieval - (push label-props org-odt-entity-labels-alist) - label-props)) - -(defun org-odt-format-label-definition (caption label category counter - seqno label-style) - (assert label) - (format-spec - (cadr (assoc-string label-style org-odt-label-styles t)) - `((?e . ,category) - (?n . ,(org-odt-format-tags - '("<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">" . "</text:sequence>") - (format "%d" seqno) label counter counter)) - (?c . ,(or caption ""))))) - -(defun org-odt-format-label-reference (label category counter - seqno label-style) - (assert label) - (save-match-data - (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) - (fmt1 (car fmt)) - (fmt2 (cadr fmt))) - (org-odt-format-tags - '("<text:sequence-ref text:reference-format=\"%s\" text:ref-name=\"%s\">" - . "</text:sequence-ref>") - (format-spec fmt2 `((?e . ,category) - (?n . ,(format "%d" seqno)))) fmt1 label)))) - -(defun org-odt-fixup-label-references () - (goto-char (point-min)) - (while (re-search-forward - "<text:sequence-ref text:ref-name=\"\\([^\"]+\\)\">[ \t\n]*</text:sequence-ref>" - nil t) - (let* ((label (match-string 1)) - (label-def (assoc label org-odt-entity-labels-alist)) - (rpl (and label-def - (apply 'org-odt-format-label-reference label-def)))) - (if rpl (replace-match rpl t t) - (org-lparse-warn - (format "Unable to resolve reference to label \"%s\"" label)))))) - -(defun org-odt-format-entity-caption (label caption category) - (if (not (or label caption)) "" - (apply 'org-odt-format-label-definition caption - (org-odt-add-label-definition label category)))) - -(defun org-odt-format-tags (tag text &rest args) - (let ((prefix (when org-lparse-encode-pending "@")) - (suffix (when org-lparse-encode-pending "@"))) - (apply 'org-lparse-format-tags tag text prefix suffix args))) - -(defvar org-odt-manifest-file-entries nil) -(defun org-odt-init-outfile (filename) - (unless (executable-find "zip") - ;; Not at all OSes ship with zip by default - (error "Executable \"zip\" needed for creating OpenDocument files")) - - (let* ((content-file (expand-file-name "content.xml" org-odt-zip-dir))) - ;; init conten.xml - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect content-file t)) - - ;; reset variables - (setq org-odt-manifest-file-entries nil - org-odt-embedded-images-count 0 - org-odt-embedded-formulas-count 0 - org-odt-entity-labels-alist nil - org-odt-list-stack-stashed nil - org-odt-automatic-styles nil - org-odt-object-counters nil - org-odt-entity-counts-plist nil) - content-file)) - -(defcustom org-export-odt-prettify-xml nil - "Specify whether or not the xml output should be prettified. -When this option is turned on, `indent-region' is run on all -component xml buffers before they are saved. Turn this off for -regular use. Turn this on if you need to examine the xml -visually." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defvar hfy-user-sheet-assoc) ; bound during org-do-lparse -(defun org-odt-save-as-outfile (target opt-plist) - ;; write automatic styles - (org-odt-write-automatic-styles) - - ;; write meta file - (org-odt-update-meta-file opt-plist) - - ;; write styles file - (when (equal org-lparse-backend 'odt) - (org-odt-update-styles-file opt-plist)) - - ;; create mimetype file - (let ((mimetype (org-odt-write-mimetype-file org-lparse-backend))) - (org-odt-create-manifest-file-entry mimetype "/" "1.2")) - - ;; create a manifest entry for content.xml - (org-odt-create-manifest-file-entry "text/xml" "content.xml") - - ;; write out the manifest entries before zipping - (org-odt-write-manifest-file) - - (let ((xml-files '("mimetype" "META-INF/manifest.xml" "content.xml" - "meta.xml"))) - (when (equal org-lparse-backend 'odt) - (push "styles.xml" xml-files)) - - ;; save all xml files - (mapc (lambda (file) - (with-current-buffer - (find-file-noselect (expand-file-name file) t) - ;; prettify output if needed - (when org-export-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))) - xml-files) - - (let* ((target-name (file-name-nondirectory target)) - (target-dir (file-name-directory target)) - (cmds `(("zip" "-mX0" ,target-name "mimetype") - ("zip" "-rmTq" ,target-name ".")))) - (when (file-exists-p target) - ;; FIXME: If the file is locked this throws a cryptic error - (delete-file target)) - - (let ((coding-system-for-write 'no-conversion) exitcode err-string) - (message "Creating odt file...") - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (ignore (message "%s" err-string)) - (error "Unable to create odt file (%S)" exitcode))) - cmds)) - - ;; move the file from outdir to target-dir - (rename-file target-name target-dir))) - - (message "Created %s" target) - (set-buffer (find-file-noselect target t))) - -(defconst org-odt-manifest-file-entry-tag - " -<manifest:file-entry manifest:media-type=\"%s\" manifest:full-path=\"%s\"%s/>") - -(defun org-odt-create-manifest-file-entry (&rest args) - (push args org-odt-manifest-file-entries)) - -(defun org-odt-write-manifest-file () - (make-directory "META-INF") - (let ((manifest-file (expand-file-name "META-INF/manifest.xml"))) - (with-current-buffer - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect manifest-file t)) - (insert - "<?xml version=\"1.0\" encoding=\"UTF-8\"?> - <manifest:manifest xmlns:manifest=\"urn:oasis:names:tc:opendocument:xmlns:manifest:1.0\" manifest:version=\"1.2\">\n") - (mapc - (lambda (file-entry) - (let* ((version (nth 2 file-entry)) - (extra (if version - (format " manifest:version=\"%s\"" version) - ""))) - (insert - (format org-odt-manifest-file-entry-tag - (nth 0 file-entry) (nth 1 file-entry) extra)))) - org-odt-manifest-file-entries) - (insert "\n</manifest:manifest>")))) - -(defun org-odt-update-meta-file (opt-plist) - (let ((date (org-odt-format-date (plist-get opt-plist :date))) - (author (or (plist-get opt-plist :author) "")) - (email (plist-get opt-plist :email)) - (keywords (plist-get opt-plist :keywords)) - (description (plist-get opt-plist :description)) - (title (plist-get opt-plist :title))) - (write-region - (concat - "<?xml version=\"1.0\" encoding=\"UTF-8\"?> - <office:document-meta - xmlns:office=\"urn:oasis:names:tc:opendocument:xmlns:office:1.0\" - xmlns:xlink=\"http://www.w3.org/1999/xlink\" - xmlns:dc=\"http://purl.org/dc/elements/1.1/\" - xmlns:meta=\"urn:oasis:names:tc:opendocument:xmlns:meta:1.0\" - xmlns:ooo=\"http://openoffice.org/2004/office\" - office:version=\"1.2\"> - <office:meta>" "\n" - (org-odt-format-author) - (org-odt-format-tags - '("\n<meta:initial-creator>" . "</meta:initial-creator>") author) - (org-odt-format-tags '("\n<dc:date>" . "</dc:date>") date) - (org-odt-format-tags - '("\n<meta:creation-date>" . "</meta:creation-date>") date) - (org-odt-format-tags '("\n<meta:generator>" . "</meta:generator>") - (when org-export-creator-info - (format "Org-%s/Emacs-%s" - (org-version) - emacs-version))) - (org-odt-format-tags '("\n<meta:keyword>" . "</meta:keyword>") keywords) - (org-odt-format-tags '("\n<dc:subject>" . "</dc:subject>") description) - (org-odt-format-tags '("\n<dc:title>" . "</dc:title>") title) - "\n" - " </office:meta>" "</office:document-meta>") - nil (expand-file-name "meta.xml"))) - - ;; create a manifest entry for meta.xml - (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) - -(defun org-odt-update-styles-file (opt-plist) - ;; write styles file - (let ((styles-file (plist-get opt-plist :odt-styles-file))) - (org-odt-copy-styles-file (and styles-file - (read (org-trim styles-file))))) - - ;; Update styles.xml - take care of outline numbering - (with-current-buffer - (find-file-noselect (expand-file-name "styles.xml") t) - ;; Don't make automatic backup of styles.xml file. This setting - ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative - ;; would be to fix the zip command so that the output odt file - ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that - ;; currently the zip command zips up the entire temp directory so - ;; that any auto-generated files created under the hood ends up in - ;; the resulting odt file. - (set (make-local-variable 'backup-inhibited) t) - - ;; Import local setting of `org-export-with-section-numbers' - (org-lparse-bind-local-variables opt-plist) - (org-odt-configure-outline-numbering - (if org-export-with-section-numbers org-export-headline-levels 0))) - - ;; Write custom styles for source blocks - (org-odt-insert-custom-styles-for-srcblocks - (mapconcat - (lambda (style) - (format " %s\n" (cddr style))) - hfy-user-sheet-assoc ""))) - -(defun org-odt-write-mimetype-file (format) - ;; create mimetype file - (let ((mimetype - (case format - (odt "application/vnd.oasis.opendocument.text") - (odf "application/vnd.oasis.opendocument.formula") - (t (error "Unknown OpenDocument backend %S" org-lparse-backend))))) - (write-region mimetype nil (expand-file-name "mimetype")) - mimetype)) - -(defun org-odt-finalize-outfile () - (org-odt-delete-empty-paragraphs)) - -(defun org-odt-delete-empty-paragraphs () - (goto-char (point-min)) - (let ((open "<text:p[^>]*>") - (close "</text:p>")) - (while (re-search-forward (format "%s[ \r\n\t]*%s" open close) nil t) - (replace-match "")))) - -(defcustom org-export-odt-convert-processes - '(("LibreOffice" - "soffice --headless --convert-to %f%x --outdir %d %i") - ("unoconv" - "unoconv -f %f -o %d %i")) - "Specify a list of document converters and their usage. -The converters in this list are offered as choices while -customizing `org-export-odt-convert-process'. - -This variable is a list where each element is of the -form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name -of the converter. CONVERTER-CMD is the shell command for the -converter and can contain format specifiers. These format -specifiers are interpreted as below: - -%i input file name in full -%I input file name as a URL -%f format of the output file -%o output file name in full -%O output file name as a URL -%d output dir in full -%D output dir as a URL. -%x extra options as set in `org-export-odt-convert-capabilities'." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Converters" - :key-type (string :tag "Converter Name") - :value-type (group (string :tag "Command line"))))) - -(defcustom org-export-odt-convert-process "LibreOffice" - "Use this converter to convert from \"odt\" format to other formats. -During customization, the list of converter names are populated -from `org-export-odt-convert-processes'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,(car c) ,(car c))) - org-export-odt-convert-processes)))) - -(defcustom org-export-odt-convert-capabilities - '(("Text" - ("odt" "ott" "doc" "rtf" "docx") - (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") - ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) - ("Web" - ("html") - (("pdf" "pdf") ("odt" "odt") ("html" "html"))) - ("Spreadsheet" - ("ods" "ots" "xls" "csv" "xlsx") - (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") - ("xls" "xls") ("xlsx" "xlsx"))) - ("Presentation" - ("odp" "otp" "ppt" "pptx") - (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") - ("pptx" "pptx") ("odg" "odg")))) - "Specify input and output formats of `org-export-odt-convert-process'. -More correctly, specify the set of input and output formats that -the user is actually interested in. - -This variable is an alist where each element is of the -form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). -INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an -alist where each element is of the form (OUTPUT-FMT -OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). - -The variable is interpreted as follows: -`org-export-odt-convert-process' can take any document that is in -INPUT-FMT-LIST and produce any document that is in the -OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have -OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT -serves dual purposes: -- It is used for populating completion candidates during - `org-export-odt-convert' commands. -- It is used as the value of \"%f\" specifier in - `org-export-odt-convert-process'. - -EXTRA-OPTIONS is used as the value of \"%x\" specifier in -`org-export-odt-convert-process'. - -DOCUMENT-CLASS is used to group a set of file formats in -INPUT-FMT-LIST in to a single class. - -Note that this variable inherently captures how LibreOffice based -converters work. LibreOffice maps documents of various formats -to classes like Text, Web, Spreadsheet, Presentation etc and -allow document of a given class (irrespective of it's source -format) to be converted to any of the export formats associated -with that class. - -See default setting of this variable for an typical -configuration." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Capabilities" - :key-type (string :tag "Document Class") - :value-type - (group (repeat :tag "Input formats" (string :tag "Input format")) - (alist :tag "Output formats" - :key-type (string :tag "Output format") - :value-type - (group (string :tag "Output file extension") - (choice - (const :tag "None" nil) - (string :tag "Extra options")))))))) - -(declare-function org-create-math-formula "org" - (latex-frag &optional mathml-file)) - -;;;###autoload -(defun org-export-odt-convert (&optional in-file out-fmt prefix-arg) - "Convert IN-FILE to format OUT-FMT using a command line converter. -IN-FILE is the file to be converted. If unspecified, it defaults -to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-export-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'." - (interactive - (append (org-lparse-convert-read-params) current-prefix-arg)) - (org-lparse-do-convert in-file out-fmt prefix-arg)) - -(defun org-odt-get (what &optional opt-plist) - (case what - (BACKEND 'odt) - (EXPORT-DIR (org-export-directory :html opt-plist)) - (FILE-NAME-EXTENSION "odt") - (EXPORT-BUFFER-NAME "*Org ODT Export*") - (ENTITY-CONTROL org-odt-entity-control-callbacks-alist) - (ENTITY-FORMAT org-odt-entity-format-callbacks-alist) - (INIT-METHOD 'org-odt-init-outfile) - (FINAL-METHOD 'org-odt-finalize-outfile) - (SAVE-METHOD 'org-odt-save-as-outfile) - (CONVERT-METHOD - (and org-export-odt-convert-process - (cadr (assoc-string org-export-odt-convert-process - org-export-odt-convert-processes t)))) - (CONVERT-CAPABILITIES - (and org-export-odt-convert-process - (cadr (assoc-string org-export-odt-convert-process - org-export-odt-convert-processes t)) - org-export-odt-convert-capabilities)) - (TOPLEVEL-HLEVEL 1) - (SPECIAL-STRING-REGEXPS org-export-odt-special-string-regexps) - (INLINE-IMAGES 'maybe) - (INLINE-IMAGE-EXTENSIONS '("png" "jpeg" "jpg" "gif" "svg")) - (PLAIN-TEXT-MAP '(("&" . "&") ("<" . "<") (">" . ">"))) - (TABLE-FIRST-COLUMN-AS-LABELS nil) - (FOOTNOTE-SEPARATOR (org-lparse-format 'FONTIFY "," 'superscript)) - (CODING-SYSTEM-FOR-WRITE 'utf-8) - (CODING-SYSTEM-FOR-SAVE 'utf-8) - (t (error "Unknown property: %s" what)))) - -(defvar org-lparse-latex-fragment-fallback) ; set by org-do-lparse -(defun org-export-odt-do-preprocess-latex-fragments () - "Convert LaTeX fragments to images." - (let* ((latex-frag-opt (plist-get org-lparse-opt-plist :LaTeX-fragments)) - (latex-frag-opt ; massage the options - (or (and (member latex-frag-opt '(mathjax t)) - (not (and (fboundp 'org-format-latex-mathml-available-p) - (org-format-latex-mathml-available-p))) - (prog1 org-lparse-latex-fragment-fallback - (org-lparse-warn - (concat - "LaTeX to MathML converter not available. " - (format "Using %S instead." - org-lparse-latex-fragment-fallback))))) - latex-frag-opt)) - cache-dir display-msg) - (cond - ((eq latex-frag-opt 'dvipng) - (setq cache-dir org-latex-preview-ltxpng-directory) - (setq display-msg "Creating LaTeX image %s")) - ((member latex-frag-opt '(mathjax t)) - (setq latex-frag-opt 'mathml) - (setq cache-dir "ltxmathml/") - (setq display-msg "Creating MathML formula %s"))) - (when (and org-current-export-file) - (org-format-latex - (concat cache-dir (file-name-sans-extension - (file-name-nondirectory org-current-export-file))) - org-current-export-dir nil display-msg - nil nil latex-frag-opt)))) - -(defadvice org-format-latex-as-mathml - (after org-odt-protect-latex-fragment activate) - "Encode LaTeX fragment as XML. -Do this when translation to MathML fails." - (when (or (not (> (length ad-return-value) 0)) - (get-text-property 0 'org-protected ad-return-value)) - (setq ad-return-value - (org-propertize (org-odt-encode-plain-text (ad-get-arg 0)) - 'org-protected t)))) - -(defun org-export-odt-preprocess-latex-fragments () - (when (equal org-export-current-backend 'odt) - (org-export-odt-do-preprocess-latex-fragments))) - -(defun org-export-odt-preprocess-label-references () - (goto-char (point-min)) - (let (label label-components category value pretty-label) - (while (re-search-forward "\\\\ref{\\([^{}\n]+\\)}" nil t) - (org-if-unprotected-at (match-beginning 1) - (replace-match - (let ((org-lparse-encode-pending t) - (label (match-string 1))) - ;; markup generated below is mostly an eye-candy. At - ;; pre-processing stage, there is no information on which - ;; entity a label reference points to. The actual markup - ;; is generated as part of `org-odt-fixup-label-references' - ;; which gets called at the fag end of export. By this - ;; time we would have seen and collected all the label - ;; definitions in `org-odt-entity-labels-alist'. - (org-odt-format-tags - '("<text:sequence-ref text:ref-name=\"%s\">" . - "</text:sequence-ref>") - "" (org-add-props label '(org-protected t)))) t t))))) - -;; process latex fragments as part of -;; `org-export-preprocess-after-blockquote-hook'. Note that this hook -;; is the one that is closest and well before the call to -;; `org-export-attach-captions-and-attributes' in -;; `org-export-preprocess-string'. The above arrangement permits -;; captions, labels and attributes to be attached to png images -;; generated out of latex equations. -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-export-odt-preprocess-latex-fragments) - -(defun org-export-odt-preprocess (parameters) - (org-export-odt-preprocess-label-references)) - -(declare-function archive-zip-extract "arc-mode" (archive name)) -(defun org-odt-zip-extract-one (archive member &optional target) - (require 'arc-mode) - (let* ((target (or target default-directory)) - (archive (expand-file-name archive)) - (archive-zip-extract - (list "unzip" "-qq" "-o" "-d" target)) - exit-code command-output) - (setq command-output - (with-temp-buffer - (setq exit-code (archive-zip-extract archive member)) - (buffer-string))) - (unless (zerop exit-code) - (message command-output) - (error "Extraction failed")))) - -(defun org-odt-zip-extract (archive members &optional target) - (when (atom members) (setq members (list members))) - (mapc (lambda (member) - (org-odt-zip-extract-one archive member target)) - members)) - -(defun org-odt-copy-styles-file (&optional styles-file) - ;; Non-availability of styles.xml is not a critical error. For now - ;; throw an error purely for aesthetic reasons. - (setq styles-file (or styles-file - org-export-odt-styles-file - (expand-file-name "OrgOdtStyles.xml" - org-odt-styles-dir) - (error "org-odt: Missing styles file?"))) - (cond - ((listp styles-file) - (let ((archive (nth 0 styles-file)) - (members (nth 1 styles-file))) - (org-odt-zip-extract archive members) - (mapc - (lambda (member) - (when (org-file-image-p member) - (let* ((image-type (file-name-extension member)) - (media-type (format "image/%s" image-type))) - (org-odt-create-manifest-file-entry media-type member)))) - members))) - ((and (stringp styles-file) (file-exists-p styles-file)) - (let ((styles-file-type (file-name-extension styles-file))) - (cond - ((string= styles-file-type "xml") - (copy-file styles-file "styles.xml" t)) - ((member styles-file-type '("odt" "ott")) - (org-odt-zip-extract styles-file "styles.xml"))))) - (t - (error (format "Invalid specification of styles.xml file: %S" - org-export-odt-styles-file)))) - - ;; create a manifest entry for styles.xml - (org-odt-create-manifest-file-entry "text/xml" "styles.xml")) - -(defun org-odt-configure-outline-numbering (level) - "Outline numbering is retained only upto LEVEL. -To disable outline numbering pass a LEVEL of 0." - (goto-char (point-min)) - (let ((regex - "<text:outline-level-style\\([^>]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") - (replacement - "<text:outline-level-style\\1text:level=\"\\2\" style:num-format=\"\">")) - (while (re-search-forward regex nil t) - (when (> (string-to-number (match-string 2)) level) - (replace-match replacement t nil)))) - (save-buffer 0)) - -;;;###autoload -(defun org-export-as-odf (latex-frag &optional odf-file) - "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. -Use `org-create-math-formula' to convert LATEX-FRAG first to -MathML. When invoked as an interactive command, use -`org-latex-regexps' to infer LATEX-FRAG from currently active -region. If no LaTeX fragments are found, prompt for it. Push -MathML source to kill ring, if `org-export-copy-to-kill-ring' is -non-nil." - (interactive - `(,(let (frag) - (setq frag (and (setq frag (and (org-region-active-p) - (buffer-substring (region-beginning) - (region-end)))) - (loop for e in org-latex-regexps - thereis (when (string-match (nth 1 e) frag) - (match-string (nth 2 e) frag))))) - (read-string "LaTeX Fragment: " frag nil frag)) - ,(let ((odf-filename (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (read-file-name "ODF filename: " nil odf-filename nil - (file-name-nondirectory odf-filename))))) - (org-odt-cleanup-xml-buffers - (let* ((org-lparse-backend 'odf) - org-lparse-opt-plist - (filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (buffer (find-file-noselect (org-odt-init-outfile filename))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - (or (org-export-push-to-kill-ring - (upcase (symbol-name org-lparse-backend))) - (message "Exporting... done"))) - (org-odt-save-as-outfile filename nil)))) - -;;;###autoload -(defun org-export-as-odf-and-open () - "Export LaTeX fragment as OpenDocument formula and immediately open it. -Use `org-export-as-odf' to read LaTeX fragment and OpenDocument -formula file." - (interactive) - (org-lparse-and-open - nil nil nil (call-interactively 'org-export-as-odf))) - -(provide 'org-odt) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-odt.el ends here diff --git a/lisp/org/org-publish.el b/lisp/org/org-publish.el deleted file mode 100644 index 20c6a6860a..0000000000 --- a/lisp/org/org-publish.el +++ /dev/null @@ -1,1198 +0,0 @@ -;;; org-publish.el --- publish related org-mode files as a website -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. - -;; Author: David O'Toole <[email protected]> -;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> -;; Keywords: hypermedia, outlines, wp - -;; 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 program allow configurable publishing of related sets of -;; Org-mode files as a complete website. -;; -;; org-publish.el can do the following: -;; -;; + Publish all one's org-files to HTML or PDF -;; + Upload HTML, images, attachments and other files to a web server -;; + Exclude selected private pages from publishing -;; + Publish a clickable sitemap of pages -;; + Manage local timestamps for publishing only changed files -;; + Accept plugin functions to extend range of publishable content -;; -;; Documentation for publishing is in the manual. - -;;; Code: - - -(eval-when-compile - (require 'cl)) -(require 'org) -(require 'org-exp) -(require 'format-spec) - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) - -(defvar org-publish-initial-buffer nil - "The buffer `org-publish' has been called from.") - -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - -;; Here, so you find the variable right before it's used the first time: -(defvar org-publish-cache nil - "This will cache timestamps and titles for files in publishing projects. -Blocks could hash sha1 values here.") - -(defgroup org-publish nil - "Options for publishing a set of Org-mode and related files." - :tag "Org Publishing" - :group 'org) - -(defcustom org-publish-project-alist nil - "Association list to control publishing behavior. -Each element of the alist is a publishing 'project.' The CAR of -each element is a string, uniquely identifying the project. The -CDR of each element is in one of the following forms: - -1. A well-formed property list with an even number of elements, alternating - keys and values, specifying parameters for the publishing process. - - (:property value :property value ... ) - -2. A meta-project definition, specifying of a list of sub-projects: - - (:components (\"project-1\" \"project-2\" ...)) - -When the CDR of an element of org-publish-project-alist is in -this second form, the elements of the list after :components are -taken to be components of the project, which group together files -requiring different publishing options. When you publish such a -project with \\[org-publish], the components all publish. - -When a property is given a value in org-publish-project-alist, its -setting overrides the value of the corresponding user variable -\(if any) during publishing. However, options set within a file -override everything. - -Most properties are optional, but some should always be set: - - :base-directory Directory containing publishing source files - :base-extension Extension (without the dot!) of source files. - This can be a regular expression. If not given, - \"org\" will be used as default extension. - :publishing-directory Directory (possibly remote) where output - files will be published - -The :exclude property may be used to prevent certain files from -being published. Its value may be a string or regexp matching -file names you don't want to be published. - -The :include property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are -considered relative to the base directory. - -When both :include and :exclude properties are given values, the -exclusion step happens first. - -One special property controls which back-end function to use for -publishing files in the project. This can be used to extend the -set of file types publishable by org-publish, as well as the set -of output formats. - - :publishing-function Function to publish file. The default is - `org-publish-org-to-html', but other - values are possible. May also be a - list of functions, in which case - each function in the list is invoked - in turn. - -Another property allows you to insert code that prepares a -project for publishing. For example, you could call GNU Make on a -certain makefile, to ensure published files are built up to date. - - :preparation-function Function to be called before publishing - this project. This may also be a list - of functions. - :completion-function Function to be called after publishing - this project. This may also be a list - of functions. - -Some properties control details of the Org publishing process, -and are equivalent to the corresponding user variables listed in -the right column. See the documentation for those variables to -learn more about their use and default values. - - :language `org-export-default-language' - :headline-levels `org-export-headline-levels' - :section-numbers `org-export-with-section-numbers' - :table-of-contents `org-export-with-toc' - :emphasize `org-export-with-emphasize' - :sub-superscript `org-export-with-sub-superscripts' - :TeX-macros `org-export-with-TeX-macros' - :fixed-width `org-export-with-fixed-width' - :tables `org-export-with-tables' - :table-auto-headline `org-export-highlight-first-table-line' - :style `org-export-html-style' - :convert-org-links `org-export-html-link-org-files-as-html' - :inline-images `org-export-html-inline-images' - :expand-quoted-html `org-export-html-expand' - :timestamp `org-export-html-with-timestamp' - :publishing-directory `org-export-publishing-directory' - :html-preamble `org-export-html-preamble' - :html-postamble `org-export-html-postamble' - :author `user-full-name' - :email `user-mail-address' - -The following properties may be used to control publishing of a -sitemap of files or summary page for a given project. - - :auto-sitemap Whether to publish a sitemap during - `org-publish-current-project' or `org-publish-all'. - :sitemap-filename Filename for output of sitemap. Defaults - to 'sitemap.org' (which becomes 'sitemap.html'). - :sitemap-title Title of sitemap page. Defaults to name of file. - :sitemap-function Plugin function to use for generation of sitemap. - Defaults to `org-publish-org-sitemap', which - generates a plain list of links to all files - in the project. - :sitemap-style Can be `list' (sitemap is just an itemized list - of the titles of the files involved) or - `tree' (the directory structure of the source - files is reflected in the sitemap). Defaults to - `tree'. - :sitemap-sans-extension Remove extension from sitemap's - filenames. Useful to have cool - URIs (see - http://www.w3.org/Provider/Style/URI). - Defaults to nil. - - If you create a sitemap file, adjust the sorting like this: - - :sitemap-sort-folders Where folders should appear in the sitemap. - Set this to `first' (default) or `last' to - display folders first or last, respectively. - Any other value will mix files and folders. - :sitemap-sort-files The site map is normally sorted alphabetically. - You can change this behaviour setting this to - `chronologically', `anti-chronologically' or nil. - :sitemap-ignore-case Should sorting be case-sensitive? Default nil. - -The following properties control the creation of a concept index. - - :makeindex Create a concept index. - -Other properties affecting publication. - - :body-only Set this to 't' to publish only the body of the - documents, excluding everything outside and - including the <body> tags in HTML, or - \begin{document}..\end{document} in LaTeX." - :group 'org-publish - :type 'alist) - -(defcustom org-publish-use-timestamps-flag t - "Non-nil means use timestamp checking to publish only changed files. -When nil, do no timestamp checking and always publish all files." - :group 'org-publish - :type 'boolean) - -(defcustom org-publish-timestamp-directory (convert-standard-filename - "~/.org-timestamps/") - "Name of directory in which to store publishing timestamps." - :group 'org-publish - :type 'directory) - -(defcustom org-publish-list-skipped-files t - "Non-nil means show message about files *not* published." - :group 'org-publish - :type 'boolean) - -(defcustom org-publish-before-export-hook nil - "Hook run before export on the Org file. -The hook may modify the file in arbitrary ways before publishing happens. -The original version of the buffer will be restored after publishing." - :group 'org-publish - :type 'hook) - -(defcustom org-publish-after-export-hook nil - "Hook run after export on the exported buffer. -Any changes made by this hook will be saved." - :group 'org-publish - :type 'hook) - -(defcustom org-publish-sitemap-sort-files 'alphabetically - "How sitemaps files should be sorted by default? -Possible values are `alphabetically', `chronologically', `anti-chronologically' and nil. -If `alphabetically', files will be sorted alphabetically. -If `chronologically', files will be sorted with older modification time first. -If `anti-chronologically', files will be sorted with newer modification time first. -nil won't sort files. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-files'." - :group 'org-publish - :version "24.1" - :type 'symbol) - -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. -If `first', folders will be sorted before files. -If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." - :group 'org-publish - :version "24.1" - :type 'symbol) - -(defcustom org-publish-sitemap-sort-ignore-case nil - "Sort sitemaps case insensitively by default? - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-ignore-case'." - :group 'org-publish - :version "24.1" - :type 'boolean) - -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for `format-time-string' which is used to print a date -in the sitemap." - :group 'org-publish - :version "24.1" - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "How a sitemap file entry is formatted. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-publish - :version "24.1" - :type 'string) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Sanitize-plist (FIXME why?) - -(defun org-publish-sanitize-plist (plist) - ;; FIXME document - (mapcar (lambda (x) - (or (cdr (assq x '((:index-filename . :sitemap-filename) - (:index-title . :sitemap-title) - (:index-function . :sitemap-function) - (:index-style . :sitemap-style) - (:auto-index . :auto-sitemap)))) - x)) - plist)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Timestamp-related functions - -(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) - "Return path to timestamp file for filename FILENAME." - (setq filename (concat filename "::" (or pub-dir "") "::" - (format "%s" (or pub-func "")))) - (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) - -(defun org-publish-needed-p (filename &optional pub-dir pub-func true-pub-dir base-dir) - "Return t if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is where the file will truly end up. Currently we are not using -this - maybe it can eventually be used to check if the file is present at -the target location, and how old it is. Right now we cannot do this, because -we do not know under what file name the file will be stored - the publishing -function can still decide about that independently." - (let ((rtn - (if org-publish-use-timestamps-flag - (org-publish-cache-file-needs-publishing - filename pub-dir pub-func base-dir) - ;; don't use timestamps, always return t - t))) - (if rtn - (message "Publishing file %s using `%s'" filename pub-func) - (when org-publish-list-skipped-files - (message "Skipping unmodified file %s" filename))) - rtn)) - -(defun org-publish-update-timestamp (filename &optional pub-dir pub-func base-dir) - "Update publishing timestamp for file FILENAME. -If there is no timestamp, create one." - (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (stamp (org-publish-cache-ctime-of-src filename))) - (org-publish-cache-set key stamp))) - -(defun org-publish-remove-all-timestamps () - "Remove all files in the timestamp directory." - (let ((dir org-publish-timestamp-directory) - files) - (when (and (file-exists-p dir) - (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) - (org-publish-reset-cache)))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Compatibility aliases - -;; Delete-dups is not in Emacs <22 -(if (fboundp 'delete-dups) - (defalias 'org-publish-delete-dups 'delete-dups) - (defun org-publish-delete-dups (list) - "Destructively remove `equal' duplicates from LIST. -Store the result in LIST and return it. LIST must be a proper list. -Of several `equal' occurrences of an element in LIST, the first -one is kept. - -This is a compatibility function for Emacsen without `delete-dups'." - ;; Code from `subr.el' in Emacs 22: - (let ((tail list)) - (while tail - (setcdr tail (delete (car tail) (cdr tail))) - (setq tail (cdr tail)))) - list)) - -(declare-function org-publish-delete-dups "org-publish" (list)) -(declare-function find-lisp-find-files "find-lisp" (directory regexp)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Getting project information out of org-publish-project-alist - -(defun org-publish-expand-projects (projects-alist) - "Expand projects in PROJECTS-ALIST. -This splices all the components into the list." - (let ((rest projects-alist) rtn p components) - (while (setq p (pop rest)) - (if (setq components (plist-get (cdr p) :components)) - (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) - rest)) - (push p rtn))) - (nreverse (org-publish-delete-dups (delq nil rtn))))) - -(defvar org-sitemap-sort-files) -(defvar org-sitemap-sort-folders) -(defvar org-sitemap-ignore-case) -(defvar org-sitemap-requested) -(defvar org-sitemap-date-format) -(defvar org-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (when (or org-sitemap-sort-files org-sitemap-sort-folders) - ;; First we sort files: - (when org-sitemap-sort-files - (cond ((equal org-sitemap-sort-files 'alphabetically) - (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) - (A (if aorg - (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg - (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if org-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((or (equal org-sitemap-sort-files 'chronologically) - (equal org-sitemap-sort-files 'anti-chronologically)) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval (if (equal org-sitemap-sort-files 'chronologically) - (<= A B) - (>= A B))))))) - ;; Directory-wise wins: - (when org-sitemap-sort-folders - ;; a is directory, b not: - (cond - ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: - ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-sitemap-sort-folders 'last)))))) - retval)) - -(defun org-publish-get-base-files-1 (base-dir &optional recurse match skip-file skip-dir) - "Set `org-publish-temp-files' with files from BASE-DIR directory. -If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is -non-nil, restrict this list to the files matching the regexp -MATCH. If SKIP-FILE is non-nil, skip file matching the regexp -SKIP-FILE. If SKIP-DIR is non-nil, don't check directories -matching the regexp SKIP-DIR when recursing through BASE-DIR." - (mapc (lambda (f) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 f recurse match skip-file skip-dir) - (unless (or fd-p ;; this is a directory - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - - (pushnew f org-publish-temp-files))))) - (if org-sitemap-requested - (sort (directory-files base-dir t (unless recurse match)) - 'org-publish-compare-directory-files) - (directory-files base-dir t (unless recurse match))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (org-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) - "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-sitemap-sort-folders' has an accepted value - (unless (memq org-sitemap-sort-folders '(first last)) - (setq org-sitemap-sort-folders nil)) - - (setq org-publish-temp-files nil) - (if org-sitemap-requested - (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) - (org-publish-get-base-files-1 base-dir recurse match - ;; FIXME distinguish exclude regexp - ;; for skip-file and skip-dir? - exclude-regexp exclude-regexp) - (mapc (lambda (f) - (pushnew - (expand-file-name (concat base-dir f)) - org-publish-temp-files)) - include-list) - org-publish-temp-files)) - -(defun org-publish-get-project-from-filename (filename &optional up) - "Return the project that FILENAME belongs to." - (let* ((filename (expand-file-name filename)) - project-name) - - (catch 'p-found - (dolist (prj org-publish-project-alist) - (unless (plist-get (cdr prj) :components) - ;; [[info:org:Selecting%20files]] shows how this is supposed to work: - (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (file-name-as-directory - (plist-get (cdr prj) :base-directory)))) - (x (or (plist-get (cdr prj) :base-extension) "org")) - (e (plist-get (cdr prj) :exclude)) - (i (plist-get (cdr prj) :include)) - (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when - (or - (and - i (member filename - (mapcar - (lambda (file) (expand-file-name file b)) - i))) - (and - (not (and e (string-match e filename))) - (string-match xm filename))) - (setq project-name (car prj)) - (throw 'p-found project-name)))))) - (when up - (dolist (prj org-publish-project-alist) - (if (member project-name (plist-get (cdr prj) :components)) - (setq project-name (car prj))))) - (assoc project-name org-publish-project-alist))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Pluggable publishing back-end functions - -(defun org-publish-org-to (format plist filename pub-dir) - "Publish an org file to FORMAT. -PLIST is the property list for the given project. -FILENAME is the filename of the org file to be published. -PUB-DIR is the publishing directory." - (require 'org) - (unless (file-exists-p pub-dir) - (make-directory pub-dir t)) - (let ((visiting (find-buffer-visiting filename))) - (save-excursion - (org-pop-to-buffer-same-window (or visiting (find-file filename))) - (let* ((plist (cons :buffer-will-be-killed (cons t plist))) - (init-buf (current-buffer)) - (init-point (point)) - (init-buf-string (buffer-string)) - export-buf-or-file) - ;; run hooks before exporting - (run-hooks 'org-publish-before-export-hook) - ;; export the possibly modified buffer - (setq export-buf-or-file - (funcall (intern (concat "org-export-as-" format)) - (plist-get plist :headline-levels) - plist nil - (plist-get plist :body-only) - pub-dir)) - (when (and (bufferp export-buf-or-file) - (buffer-live-p export-buf-or-file)) - (set-buffer export-buf-or-file) - ;; run hooks after export and save export - (progn (run-hooks 'org-publish-after-export-hook) - (if (buffer-modified-p) (save-buffer))) - (kill-buffer export-buf-or-file)) - ;; maybe restore buffer's content - (set-buffer init-buf) - (when (buffer-modified-p init-buf) - (erase-buffer) - (insert init-buf-string) - (save-buffer) - (goto-char init-point)) - (unless visiting - (kill-buffer init-buf)))))) - -(defmacro org-publish-with-aux-preprocess-maybe (&rest body) - "Execute BODY with a modified hook to preprocess for index." - `(let ((org-export-preprocess-after-headline-targets-hook - (if (plist-get project-plist :makeindex) - (cons 'org-publish-aux-preprocess - org-export-preprocess-after-headline-targets-hook) - org-export-preprocess-after-headline-targets-hook))) - ,@body)) -(def-edebug-spec org-publish-with-aux-preprocess-maybe (body)) - -(defvar project-plist) -(defun org-publish-org-to-latex (plist filename pub-dir) - "Publish an org file to LaTeX. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latex" plist filename pub-dir))) - -(defun org-publish-org-to-pdf (plist filename pub-dir) - "Publish an org file to PDF (via LaTeX). -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "pdf" plist filename pub-dir))) - -(defun org-publish-org-to-html (plist filename pub-dir) - "Publish an org file to HTML. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "html" plist filename pub-dir))) - -(defun org-publish-org-to-org (plist filename pub-dir) - "Publish an org file to HTML. -See `org-publish-org-to' to the list of arguments." - (org-publish-org-to "org" plist filename pub-dir)) - -(defun org-publish-org-to-ascii (plist filename pub-dir) - "Publish an org file to ASCII. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "ascii" plist filename pub-dir))) - -(defun org-publish-org-to-latin1 (plist filename pub-dir) - "Publish an org file to Latin-1. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "latin1" plist filename pub-dir))) - -(defun org-publish-org-to-utf8 (plist filename pub-dir) - "Publish an org file to UTF-8. -See `org-publish-org-to' to the list of arguments." - (org-publish-with-aux-preprocess-maybe - (org-publish-org-to "utf8" plist filename pub-dir))) - -(defun org-publish-attachment (plist filename pub-dir) - "Publish a file with no transformation of any kind. -See `org-publish-org-to' to the list of arguments." - ;; make sure eshell/cp code is loaded - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) - (copy-file filename - (expand-file-name (file-name-nondirectory filename) pub-dir) - t))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices - -(defun org-publish-file (filename &optional project no-cache) - "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-publish-cache and -write it to disk. This is needed, since this function is used to -publish single files, when entire projects are published. -See `org-publish-projects'." - (let* ((project - (or project - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename))))) - (project-plist (cdr project)) - (ftname (expand-file-name filename)) - (publishing-function - (or (plist-get project-plist :publishing-function) - 'org-publish-org-to-html)) - (base-dir - (file-name-as-directory - (expand-file-name - (or (plist-get project-plist :base-directory) - (error "Project %s does not have :base-directory defined" - (car project)))))) - (pub-dir - (file-name-as-directory - (file-truename - (or (eval (plist-get project-plist :publishing-directory)) - (error "Project %s does not have :publishing-directory defined" - (car project)))))) - tmp-pub-dir) - - (unless no-cache - (org-publish-initialize-cache (car project))) - - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) - (if (listp publishing-function) - ;; allow chain of publishing functions - (mapc (lambda (f) - (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) - (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f base-dir))) - publishing-function) - (when (org-publish-needed-p filename pub-dir publishing-function tmp-pub-dir base-dir) - (funcall publishing-function project-plist filename tmp-pub-dir) - (org-publish-update-timestamp - filename pub-dir publishing-function base-dir))) - (unless no-cache (org-publish-write-cache-file)))) - -(defun org-publish-projects (projects) - "Publish all files belonging to the PROJECTS alist. -If :auto-sitemap is set, publish the sitemap too. -If :makeindex is set, also produce a file theindex.org." - (mapc - (lambda (project) - ;; Each project uses its own cache file: - (org-publish-initialize-cache (car project)) - (let* - ((project-plist (cdr project)) - (exclude-regexp (plist-get project-plist :exclude)) - (sitemap-p (plist-get project-plist :auto-sitemap)) - (sitemap-filename (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-publish-org-sitemap)) - (org-sitemap-date-format (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-sitemap-file-entry-format (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) - (preparation-function (plist-get project-plist :preparation-function)) - (completion-function (plist-get project-plist :completion-function)) - (files (org-publish-get-base-files project exclude-regexp)) file) - (when preparation-function (run-hooks 'preparation-function)) - (if sitemap-p (funcall sitemap-function project sitemap-filename)) - (while (setq file (pop files)) - (org-publish-file file project t)) - (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex - (plist-get project-plist :base-directory)) - (org-publish-file (expand-file-name - "theindex.org" - (plist-get project-plist :base-directory)) - project t)) - (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) - (org-publish-expand-projects projects))) - -(defun org-publish-org-sitemap (project &optional sitemap-filename) - "Create a sitemap of pages in set defined by PROJECT. -Optionally set the filename of the sitemap with SITEMAP-FILENAME. -Default for SITEMAP-FILENAME is 'sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) - (exclude-regexp (plist-get project-plist :exclude)) - (files (nreverse (org-publish-get-base-files project exclude-regexp))) - (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) - (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) - (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) - (sitemap-sans-extension (plist-get project-plist :sitemap-sans-extension)) - (visiting (find-buffer-visiting sitemap-filename)) - (ifn (file-name-nondirectory sitemap-filename)) - file sitemap-buffer) - (with-current-buffer (setq sitemap-buffer - (or visiting (find-file sitemap-filename))) - (erase-buffer) - (insert (concat "#+TITLE: " sitemap-title "\n\n")) - (while (setq file (pop files)) - (let ((fn (file-name-nondirectory file)) - (link (file-relative-name file dir)) - (oldlocal localdir)) - (when sitemap-sans-extension - (setq link (file-name-sans-extension link))) - ;; sitemap shouldn't list itself - (unless (equal (file-truename sitemap-filename) - (file-truename file)) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry org-sitemap-file-entry-format - file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file))) - title) - (with-current-buffer buffer - (let* ((opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist)))) - (setq title - (or (plist-get opt-plist :title) - (and (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting - (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. -If FILE provides a #+date keyword use it else use the file -system's modification time. - -It returns time in `current-time' format." - (let ((visiting (find-buffer-visiting file))) - (save-excursion - (org-pop-to-buffer-same-window (or visiting (find-file-noselect file nil t))) - (let* ((plist (org-infile-export-plist)) - (date (plist-get plist :date))) - (unless visiting - (kill-buffer (current-buffer))) - (if date - (org-time-string-to-time date) - (when (file-exists-p file) - (nth 5 (file-attributes file)))))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Interactive publishing functions - -;;;###autoload -(defalias 'org-publish-project 'org-publish) - -;;;###autoload -(defun org-publish (project &optional force) - "Publish PROJECT." - (interactive - (list - (assoc (org-icompleting-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist) - current-prefix-arg)) - (setq org-publish-initial-buffer (current-buffer)) - (save-window-excursion - (let* ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects - (if (stringp project) - ;; If this function is called in batch mode, - ;; project is still a string here. - (list (assoc project org-publish-project-alist)) - (list project)))))) - -;;;###autoload -(defun org-publish-all (&optional force) - "Publish all projects. -With prefix argument, remove all files in the timestamp -directory and force publishing all files." - (interactive "P") - (when force - (org-publish-remove-all-timestamps)) - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects org-publish-project-alist)))) - -;;;###autoload -(defun org-publish-current-file (&optional force) - "Publish the current file. -With prefix argument, force publish the file." - (interactive "P") - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-file (buffer-file-name))))) - -;;;###autoload -(defun org-publish-current-project (&optional force) - "Publish the project associated with the current file. -With a prefix argument, force publishing of all files in -the project." - (interactive "P") - (save-window-excursion - (let ((project (org-publish-get-project-from-filename (buffer-file-name) 'up)) - (org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (if (not project) - (error "File %s is not part of any known project" (buffer-file-name))) - ;; FIXME: force is not used here? - (org-publish project)))) - - -;;; Index generation - -(defun org-publish-aux-preprocess () - "Find index entries and write them to an .orgx file." - (let ((case-fold-search t) - entry index target) - (goto-char (point-min)) - (while - (and - (re-search-forward "^[ \t]*#\\+index:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (> (match-end 1) (match-beginning 1))) - (setq entry (match-string 1)) - (when (eq org-export-current-backend 'latex) - (replace-match (format "\\index{%s}" entry) t t)) - (save-excursion - (ignore-errors (org-back-to-heading t)) - (setq target (get-text-property (point) 'target)) - (setq target (or (cdr (assoc target org-export-preferred-target-alist)) - (cdr (assoc target org-export-id-target-alist)) - target "")) - (push (cons entry target) index))) - (with-temp-file - (concat - (file-name-directory org-current-export-file) "." - (file-name-sans-extension - (file-name-nondirectory org-current-export-file)) ".orgx") - (dolist (entry (nreverse index)) - (insert (format "INDEX: (%s) %s\n" (cdr entry) (car entry))))))) - -(defun org-publish-index-generate-theindex (directory) - "Generate the index from all .orgx files in DIRECTORY." - (require 'find-lisp) - (let* ((fulldir (file-name-as-directory - (expand-file-name directory))) - (full-files (find-lisp-find-files directory "\\.orgx\\'")) - (re (concat "\\`" fulldir)) - (files (mapcar (lambda (f) (if (string-match re f) - (substring f (match-end 0)) - f)) - full-files)) - (default-directory directory) - index origfile buf target entry ibuffer - main last-main letter last-letter file sub link tgext) - ;; `files' contains the list of relative file names - (dolist (file files) - (setq origfile - (concat (file-name-directory file) - (substring (file-name-nondirectory file) 1 -1))) - (setq buf (find-file-noselect file)) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^INDEX: (\\(.*?\\)) \\(.*\\)" nil t) - (setq target (match-string 1) - entry (match-string 2)) - (push (list entry origfile target) index))) - (kill-buffer buf)) - (setq index (sort index (lambda (a b) (string< (downcase (car a)) - (downcase (car b)))))) - (setq ibuffer (find-file-noselect (expand-file-name "theindex.inc" directory))) - (with-current-buffer ibuffer - (erase-buffer) - (insert "* Index\n") - (setq last-letter nil) - (dolist (idx index) - (setq entry (car idx) file (nth 1 idx) target (nth 2 idx)) - (if (and (stringp target) (string-match "\\S-" target)) - (setq tgext (concat "::#" target)) - (setq tgext "")) - (setq letter (upcase (substring entry 0 1))) - (when (not (equal letter last-letter)) - (insert "** " letter "\n") - (setq last-letter letter)) - (if (string-match "!" entry) - (setq main (substring entry 0 (match-beginning 0)) - sub (substring entry (match-end 0))) - (setq main nil sub nil last-main nil)) - (when (and main (not (equal main last-main))) - (insert " - " main "\n") - (setq last-main main)) - (setq link (concat "[[file:" file tgext "]" - "[" (or sub entry) "]]")) - (if (and main sub) - (insert " - " link "\n") - (insert " - " link "\n"))) - (save-buffer)) - (kill-buffer ibuffer) - ;; Create theindex.org if it doesn't exist already - (let ((index-file (expand-file-name "theindex.org" directory))) - (unless (file-exists-p index-file) - (setq ibuffer (find-file-noselect index-file)) - (with-current-buffer ibuffer - (erase-buffer) - (insert "\n\n#+INCLUDE: \"theindex.inc\"\n\n") - (save-buffer)) - (kill-buffer ibuffer))))) - -;; Caching functions: - -(defun org-publish-write-cache-file (&optional free-cache) - "Write `org-publish-cache' to file. -If FREE-CACHE, empty the cache." - (or org-publish-cache - (error "`org-publish-write-cache-file' called, but no cache present")) - - (let ((cache-file (org-publish-cache-get ":cache-file:"))) - (or cache-file - (error "Cannot find cache-file name in `org-publish-write-cache-file'")) - (with-temp-file cache-file - (let ((print-level nil) - (print-length nil)) - (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") - (maphash (lambda (k v) - (insert - (format (concat "(puthash %S " - (if (or (listp v) (symbolp v)) - "'" "") - "%S org-publish-cache)\n") k v))) - org-publish-cache))) - (when free-cache (org-publish-reset-cache)))) - -(defun org-publish-initialize-cache (project-name) - "Initialize the projects cache if not initialized yet and return it." - - (or project-name - (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) - - (unless (file-exists-p org-publish-timestamp-directory) - (make-directory org-publish-timestamp-directory t)) - (if (not (file-directory-p org-publish-timestamp-directory)) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory)) - - (unless (and org-publish-cache - (string= (org-publish-cache-get ":project:") project-name)) - (let* ((cache-file (concat - (expand-file-name org-publish-timestamp-directory) - project-name - ".cache")) - (cexists (file-exists-p cache-file))) - - (when org-publish-cache - (org-publish-reset-cache)) - - (if cexists - (load-file cache-file) - (setq org-publish-cache - (make-hash-table :test 'equal :weakness nil :size 100)) - (org-publish-cache-set ":project:" project-name) - (org-publish-cache-set ":cache-file:" cache-file)) - (unless cexists (org-publish-write-cache-file nil)))) - org-publish-cache) - -(defun org-publish-reset-cache () - "Empty org-publish-cache and reset it nil." - (message "%s" "Resetting org-publish-cache") - (if (hash-table-p org-publish-cache) - (clrhash org-publish-cache)) - (setq org-publish-cache nil)) - -(defun org-publish-cache-file-needs-publishing (filename &optional pub-dir pub-func base-dir) - "Check the timestamp of the last publishing of FILENAME. -Return `t', if the file needs publishing. The function also -checks if any included files have been more recently published, -so that the file including them will be republished as well." - (or org-publish-cache - (error "`org-publish-cache-file-needs-publishing' called, but no cache present")) - (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (pstamp (org-publish-cache-get key)) - (visiting (find-buffer-visiting filename)) - (case-fold-search t) - included-files-ctime buf) - - (when (equal (file-name-extension filename) "org") - (setq buf (find-file (expand-file-name filename))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward "^#\\+include:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src included-file) t)))) - ;; FIXME don't kill current buffer - (unless visiting (kill-buffer buf))) - (if (null pstamp) - t - (let ((ctime (org-publish-cache-ctime-of-src filename))) - (or (< pstamp ctime) - (when included-files-ctime - (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) - included-files-ctime)))))))))) - -(defun org-publish-cache-set-file-property (filename property value &optional project-name) - "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. -Use cache file of PROJECT-NAME. If the entry does not exist, it will be -created. Return VALUE." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename))) - (if pl - (progn - (plist-put pl property value) - value) - (org-publish-cache-get-file-property - filename property value nil project-name)))) - -(defun org-publish-cache-get-file-property - (filename property &optional default no-create project-name) - "Return the value for a PROPERTY of file FILENAME in publishing cache. -Use cache file of PROJECT-NAME. Return the value of that PROPERTY or -DEFAULT, if the value does not yet exist. -If the entry will be created, unless NO-CREATE is not nil." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename)) - (retval nil)) - (if pl - (if (plist-member pl property) - (setq retval (plist-get pl property)) - (setq retval default)) - ;; no pl yet: - (unless no-create - (org-publish-cache-set filename (list property default))) - (setq retval default)) - retval)) - -(defun org-publish-cache-get (key) - "Return the value stored in `org-publish-cache' for key KEY. -Returns nil, if no value or nil is found, or the cache does not -exist." - (or org-publish-cache - (error "`org-publish-cache-get' called, but no cache present")) - (gethash key org-publish-cache)) - -(defun org-publish-cache-set (key value) - "Store KEY VALUE pair in `org-publish-cache'. -Returns value on success, else nil." - (or org-publish-cache - (error "`org-publish-cache-set' called, but no cache present")) - (puthash key value org-publish-cache)) - -(defun org-publish-cache-ctime-of-src (file) - "Get the ctime of filename F as an integer." - (let ((attr (file-attributes - (expand-file-name (or (file-symlink-p file) file) - (file-name-directory file))))) - (+ (lsh (car (nth 5 attr)) 16) - (cadr (nth 5 attr))))) - -(provide 'org-publish) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-publish.el ends here diff --git a/lisp/org/org-remember.el b/lisp/org/org-remember.el deleted file mode 100644 index cb1fdbbb93..0000000000 --- a/lisp/org/org-remember.el +++ /dev/null @@ -1,1156 +0,0 @@ -;;; org-remember.el --- Fast note taking in Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 system to take fast notes with Org-mode. -;; This system is used together with John Wiegley's `remember.el'. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org) -(require 'org-compat) -(require 'org-datetree) - -(declare-function remember-mode "remember" ()) -(declare-function remember "remember" (&optional initial)) -(declare-function remember-buffer-desc "remember" ()) -(declare-function remember-finalize "remember" ()) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defvar remember-save-after-remembering) -(defvar remember-register) -(defvar remember-buffer) -(defvar remember-handler-functions) -(defvar remember-annotation-functions) -(defvar org-clock-heading) -(defvar org-clock-heading-for-remember) - -(defgroup org-remember nil - "Options concerning interaction with remember.el." - :tag "Org Remember" - :group 'org) - -(defcustom org-remember-store-without-prompt t - "Non-nil means \\<org-remember-mode-map>\\[org-remember-finalize] \ -stores the remember note without further prompts. -It then uses the file and headline specified by the template or (if the -template does not specify them) by the variables `org-default-notes-file' -and `org-remember-default-headline'. To force prompting anyway, use -\\[universal-argument] \\[org-remember-finalize] to file the note. - -When this variable is nil, \\[org-remember-finalize] gives you the prompts, and -\\[universal-argument] \\[org-remember-finalize] triggers the fast track." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-interactive-interface 'refile - "The interface to be used for interactive filing of remember notes. -This is only used when the interactive mode for selecting a filing -location is used (see the variable `org-remember-store-without-prompt'). -Allowed values are: -outline The interface shows an outline of the relevant file - and the correct heading is found by moving through - the outline or by searching with incremental search. -outline-path-completion Headlines in the current buffer are offered via - completion. -refile Use the refile interface, and offer headlines, - possibly from different buffers." - :group 'org-remember - :type '(choice - (const :tag "Refile" refile) - (const :tag "Outline" outline) - (const :tag "Outline-path-completion" outline-path-completion))) - -(defcustom org-remember-default-headline "" - "The headline that should be the default location in the notes file. -When filing remember notes, the cursor will start at that position. -You can set this on a per-template basis with the variable -`org-remember-templates'." - :group 'org-remember - :type 'string) - -(defcustom org-remember-templates nil - "Templates for the creation of remember buffers. -When nil, just let remember make the buffer. -When non-nil, this is a list of (up to) 6-element lists. In each entry, -the first element is the name of the template, which should be a single -short word. The second element is a character, a unique key to select -this template. The third element is the template. - -The fourth element is optional and can specify a destination file for -remember items created with this template. The default file is given -by `org-default-notes-file'. If the file name is not an absolute path, -it will be interpreted relative to `org-directory'. - -An optional fifth element can specify the headline in that file that should -be offered first when the user is asked to file the entry. The default -headline is given in the variable `org-remember-default-headline'. When -this element is `top' or `bottom', the note will be placed as a level-1 -entry at the beginning or end of the file, respectively. - -An optional sixth element specifies the contexts in which the template -will be offered to the user. This element can be a list of major modes -or a function, and the template will only be offered if `org-remember' -is called from a mode in the list, or if the function returns t. -Templates that specify t or nil for the context will always be added -to the list of selectable templates. - -The template specifies the structure of the remember buffer. It should have -a first line starting with a star, to act as the org-mode headline. -Furthermore, the following %-escapes will be replaced with content: - - %^{PROMPT} prompt the user for a string and replace this sequence with it. - A default value and a completion table can be specified like this: - %^{prompt|default|completion2|completion3|...} - The arrow keys access a prompt-specific history. - %a annotation, normally the link created with `org-store-link' - %A like %a, but prompt for the description part - %i initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. - %t time stamp, date only - %T time stamp with date and time - %u, %U like the above, but inactive time stamps - %^t like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like %^{Please specify birthday}t - %n user name (taken from `user-full-name') - %c current kill ring head - %x content of the X clipboard - %:keyword specific information for certain link types, see below - %^C interactive selection of which kill or clip to use - %^L like %^C, but insert as link - %k title of the currently clocked task - %K link to the currently clocked task - %^g prompt for tags, completing tags in the target file - %^G prompt for tags, completing all tags in all agenda files - %^{PROP}p Prompt the user for a value for property PROP - %[PATHNAME] insert the contents of the file given by PATHNAME - %(SEXP) evaluate elisp `(SEXP)' and replace with the result - %! store this note immediately after completing the template\ - \\<org-remember-mode-map> - (skipping the \\[org-remember-finalize] that normally triggers storing) - %& jump to target location immediately after storing note - %? after completing the template, position cursor here. - -Apart from these general escapes, you can access information specific to the -link type that is created. For example, calling `remember' in emails or gnus -will record the author and the subject of the message, which you can access -with %:fromname and %:subject, respectively. Here is a complete list of what -is recorded for each link type. - -Link type | Available information --------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, rmail | %:type %:subject %:message-id - | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") -gnus | %:group, for messages also all email fields and - | %:org-date (the Date: header in Org format) -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-remember - :get (lambda (var) ; Make sure all entries have at least 5 elements - (mapcar (lambda (x) - (if (not (stringp (car x))) (setq x (cons "" x))) - (cond ((= (length x) 4) (append x '(nil))) - ((= (length x) 3) (append x '(nil nil))) - (t x))) - (default-value var))) - :type '(repeat - :tag "enabled" - (list :value ("" ?a "\n" nil nil nil) - (string :tag "Name") - (character :tag "Selection Key") - (string :tag "Template") - (choice :tag "Destination file" - (file :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-default-notes-file'" nil)) - (choice :tag "Destin. headline" - (string :tag "Specify") - (function :tag "Function") - (const :tag "Use `org-remember-default-headline'" nil) - (const :tag "At beginning of file" top) - (const :tag "At end of file" bottom) - (const :tag "In a date tree" date-tree)) - (choice :tag "Context" - (const :tag "Use in all contexts" nil) - (const :tag "Use in all contexts" t) - (repeat :tag "Use only if in major mode" - (symbol :tag "Major mode")) - (function :tag "Perform a check against function"))))) - -(defcustom org-remember-delete-empty-lines-at-end t - "Non-nil means clean up final empty lines in remember buffer." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-before-finalize-hook nil - "Hook that is run right before a remember process is finalized. -The remember buffer is still current when this hook runs." - :group 'org-remember - :type 'hook) - -(defvar org-remember-mode-map (make-sparse-keymap) - "Keymap for `org-remember-mode', a minor mode. -Use this map to set additional keybindings for when Org-mode is used -for a Remember buffer.") -(defvar org-remember-mode-hook nil - "Hook for the minor `org-remember-mode'.") - -(define-minor-mode org-remember-mode - "Minor mode for special key bindings in a remember buffer." - nil " Rem" org-remember-mode-map - (run-hooks 'org-remember-mode-hook)) -(define-key org-remember-mode-map "\C-c\C-c" 'org-remember-finalize) -(define-key org-remember-mode-map "\C-c\C-k" 'org-remember-kill) - -(defcustom org-remember-clock-out-on-exit 'query - "Non-nil means stop the clock when exiting a clocking remember buffer. -This only applies if the clock is running in the remember buffer. If the -clock is not stopped, it continues to run in the storage location. -Instead of nil or t, this may also be the symbol `query' to prompt the -user each time a remember buffer with a running clock is filed away." - :group 'org-remember - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Query user" query))) - -(defcustom org-remember-backup-directory nil - "Directory where to store all remember buffers, for backup purposes. -After a remember buffer has been stored successfully, the backup file -will be removed. However, if you forget to finish the remember process, -the file will remain there. -See also `org-remember-auto-remove-backup-files'." - :group 'org-remember - :type '(choice - (const :tag "No backups" nil) - (directory :tag "Directory"))) - -(defcustom org-remember-auto-remove-backup-files t - "Non-nil means remove remember backup files after successfully storage. -When remember is finished successfully, with storing the note at the -desired target, remove the backup files related to this remember process -and show a message about remaining backup files, from previous, unfinished -remember sessions. -Backup files will only be made at all, when `org-remember-backup-directory' -is set." - :group 'org-remember - :type 'boolean) - -(defcustom org-remember-warn-about-backups t - "Non-nil means warn about backup files in `org-remember-backup-directory'. - -Set this to nil if you find that you don't need the warning. - -If you cancel remember calls frequently and know when they -contain useful information (because you know that you made an -error or Emacs crashed, for example) nil is more useful. In the -opposite case, the default, t, is more useful." - :group 'org-remember - :type 'boolean) - -;;;###autoload -(defun org-remember-insinuate () - "Setup remember.el for use with Org-mode." - (org-require-remember) - (setq remember-annotation-functions '(org-remember-annotation)) - (setq remember-handler-functions '(org-remember-handler)) - (add-hook 'remember-mode-hook 'org-remember-apply-template)) - -;;;###autoload -(defun org-remember-annotation () - "Return a link to the current location as an annotation for remember.el. -If you are using Org-mode files as target for data storage with -remember.el, then the annotations should include a link compatible with the -conventions in Org-mode. This function returns such a link." - (org-store-link nil)) - -(defconst org-remember-help - "Select a destination location for the note. -UP/DOWN=headline TAB=cycle visibility [Q]uit RET/<left>/<right>=Store -RET on headline -> Store as sublevel entry to current headline -RET at beg-of-buf -> Append to file as level 2 headline -<left>/<right> -> before/after current headline, same headings level") - -(defvar org-jump-to-target-location nil) -(defvar org-remember-previous-location nil) -(defvar org-remember-reference-date nil) -(defvar org-force-remember-template-char) ;; dynamically scoped - -;; Save the major mode of the buffer we called remember from -(defvar org-select-template-temp-major-mode nil) - -;; Temporary store the buffer where remember was called from -(defvar org-select-template-original-buffer nil) - -(defun org-select-remember-template (&optional use-char) - (when org-remember-templates - (let* ((pre-selected-templates - (mapcar - (lambda (tpl) - (let ((ctxt (nth 5 tpl)) - (mode org-select-template-temp-major-mode) - (buf org-select-template-original-buffer)) - (and (or (not ctxt) (eq ctxt t) - (and (listp ctxt) (memq mode ctxt)) - (and (functionp ctxt) - (with-current-buffer buf - ;; Protect the user-defined function from error - (condition-case nil (funcall ctxt) (error nil))))) - tpl))) - org-remember-templates)) - ;; If no template at this point, add the default templates: - (pre-selected-templates1 - (if (not (delq nil pre-selected-templates)) - (mapcar (lambda(x) (if (not (nth 5 x)) x)) - org-remember-templates) - pre-selected-templates)) - ;; Then unconditionally add template for any contexts - (pre-selected-templates2 - (append (mapcar (lambda(x) (if (eq (nth 5 x) t) x)) - org-remember-templates) - (delq nil pre-selected-templates1))) - (templates (mapcar (lambda (x) - (if (stringp (car x)) - (append (list (nth 1 x) (car x)) (cddr x)) - (append (list (car x) "") (cdr x)))) - (delq nil pre-selected-templates2))) - msg - (char (or use-char - (cond - ((= (length templates) 1) - (caar templates)) - ((and (boundp 'org-force-remember-template-char) - org-force-remember-template-char) - (if (stringp org-force-remember-template-char) - (string-to-char org-force-remember-template-char) - org-force-remember-template-char)) - (t - (setq msg (format - "Select template: %s%s" - (mapconcat - (lambda (x) - (cond - ((not (string-match "\\S-" (nth 1 x))) - (format "[%c]" (car x))) - ((equal (downcase (car x)) - (downcase (aref (nth 1 x) 0))) - (format "[%c]%s" (car x) - (substring (nth 1 x) 1))) - (t (format "[%c]%s" (car x) (nth 1 x))))) - templates " ") - (if (assoc ?C templates) - "" - " [C]customize templates"))) - (let ((inhibit-quit t) char0) - (while (not char0) - (message msg) - (setq char0 (read-char-exclusive)) - (when (and (not (assoc char0 templates)) - (not (equal char0 ?\C-g)) - (not (equal char0 ?C))) - (message "No such template \"%c\"" char0) - (ding) (sit-for 1) - (setq char0 nil))) - (when (equal char0 ?\C-g) - (jump-to-register remember-register) - (kill-buffer remember-buffer) - (error "Abort")) - (when (not (assoc char0 templates)) - (jump-to-register remember-register) - (kill-buffer remember-buffer) - (customize-variable 'org-remember-templates) - (error "Customize templates")) - char0)))))) - (cddr (assoc char templates))))) - -;;;###autoload -(defun org-remember-apply-template (&optional use-char skip-interactive) - "Initialize *remember* buffer with template, invoke `org-mode'. -This function should be placed into `remember-mode-hook' and in fact requires -to be run from that hook to function properly." - (when (and (boundp 'initial) (stringp initial)) - (setq initial (org-no-properties initial))) - (if org-remember-templates - (let* ((entry (org-select-remember-template use-char)) - (ct (or org-overriding-default-time (org-current-time))) - (dct (decode-time ct)) - (ct1 - (if (< (nth 2 dct) org-extend-today-until) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct)) - (tpl (car entry)) - (plist-p (if org-store-link-plist t nil)) - (file (if (and (nth 1 entry) - (or (and (stringp (nth 1 entry)) - (string-match "\\S-" (nth 1 entry))) - (functionp (nth 1 entry)))) - (nth 1 entry) - org-default-notes-file)) - (headline (nth 2 entry)) - (v-c (and (> (length kill-ring) 0) (current-kill 0))) - (v-x (or (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY))) - (v-t (format-time-string (car org-time-stamp-formats) ct)) - (v-T (format-time-string (cdr org-time-stamp-formats) ct)) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' are bound in `remember'. - ;; But if the property list has them, we prefer those values - (v-i (or (plist-get org-store-link-plist :initial) - (and (boundp 'initial) (symbol-value 'initial)) - "")) - (v-a (or (plist-get org-store-link-plist :annotation) - (and (boundp 'annotation) (symbol-value 'annotation)) - "")) - ;; Is the link empty? Then we do not want it... - (v-a (if (equal v-a "[[]]") "" v-a)) - (clipboards (remove nil (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c))) - (v-A (if (and v-a - (string-match "\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a)) - (replace-match "[\\1[%^{Link description}]]" nil nil v-a) - v-a)) - (v-n user-full-name) - (v-k (if (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) - (v-K (if (marker-buffer org-clock-marker) - (org-make-link-string - (buffer-file-name (marker-buffer org-clock-marker)) - org-clock-heading))) - v-I - (org-startup-folded nil) - (org-inhibit-startup t) - org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar) - - (when (functionp file) - (setq file (funcall file))) - (when (functionp headline) - (setq headline (funcall headline))) - (when (and file (not (file-name-absolute-p file))) - (setq file (expand-file-name file org-directory))) - - (setq org-store-link-plist - (plist-put org-store-link-plist :annotation v-a) - org-store-link-plist - (plist-put org-store-link-plist :initial v-i)) - - (unless tpl (setq tpl "") (message "No template") (ding) (sit-for 1)) - (erase-buffer) - (insert (substitute-command-keys - (format - "# %s \"%s\" -> \"* %s\" -# C-u C-c C-c like C-c C-c, and immediately visit note at target location -# C-0 C-c C-c \"%s\" -> \"* %s\" -# %s to select file and header location interactively. -# C-2 C-c C-c as child (C-3: as sibling) of the currently clocked item -# To switch templates, use `\\[org-remember]'. To abort use `C-c C-k'.\n\n" - (if org-remember-store-without-prompt " C-c C-c" " C-1 C-c C-c") - (abbreviate-file-name (or file org-default-notes-file)) - (or headline "") - (or (car org-remember-previous-location) "???") - (or (cdr org-remember-previous-location) "???") - (if org-remember-store-without-prompt "C-1 C-c C-c" " C-c C-c")))) - (insert tpl) - - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-remember-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Couldn't insert %s: %s]" - filename error))))))) - ;; Simple %-escapes - (goto-char (point-min)) - (let ((init (and (boundp 'initial) - (symbol-value 'initial)))) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (unless (org-remember-escaped-%) - (when (and init (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string init "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t)))) - - ;; %() embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\((.+)\\)" nil t) - (unless (org-remember-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let ((result - (condition-case error - (eval (read (current-buffer))) - (error (format "%%![Error: %s]" error))))) - (delete-region template-start (point)) - (insert result))))) - - ;; From the property list - (when plist-p - (goto-char (point-min)) - (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-remember-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) - - ;; Turn on org-mode in the remember buffer, set local variables - (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) - (if (and file (string-match "\\S-" file) (not (file-directory-p file))) - (org-set-local 'org-default-notes-file file)) - (if headline - (org-set-local 'org-remember-default-headline headline)) - (org-set-local 'org-remember-reference-date - (list (nth 4 dct) (nth 3 dct) (nth 5 dct))) - ;; Interactive template entries - (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (unless (org-remember-escaped-%) - (setq char (if (match-end 3) (match-string 3)) - prompt (if (match-end 2) (match-string 2))) - (goto-char (match-beginning 0)) - (replace-match "") - (setq completions nil default nil) - (when prompt - (setq completions (org-split-string prompt "|") - prompt (pop completions) - default (car completions) - histvar (intern (concat - "org-remember-template-prompt-history::" - (or prompt ""))) - completions (mapcar 'list completions))) - (cond - ((member char '("G" "g")) - (let* ((org-last-tags-completion-table - (org-global-tags-completion-table - (if (equal char "G") (org-agenda-files) (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-icompleting-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":"))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (let* - ((prop (org-no-properties prompt)) - (pall (concat prop "_ALL")) - (allowed - (with-current-buffer - (or (find-buffer-visiting file) - (find-file-noselect file)) - (or (cdr (assoc pall org-file-properties)) - (cdr (assoc pall org-global-properties)) - (cdr (assoc pall org-global-properties-fixed))))) - (existing (with-current-buffer - (or (find-buffer-visiting file) - (find-file-noselect file)) - (mapcar 'list (org-property-values prop)))) - (propprompt (concat "Value for " prop ": ")) - (val (if allowed - (org-completing-read - propprompt - (mapcar 'list (org-split-string allowed "[ \t]+")) - nil 'req-match) - (org-completing-read-no-i propprompt existing nil nil - "" nil "")))) - (org-set-property prop val))) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) "U") t nil - prompt)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (insert (org-without-partial-completion - (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default)))))))) - - (goto-char (point-min)) - (if (re-search-forward "%\\?" nil t) - (replace-match "") - (and (re-search-forward "^[^#\n]" nil t) (backward-char 1)))) - (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1))) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward "%&" nil t)) - (replace-match "") - (org-set-local 'org-jump-to-target-location t)) - (when org-remember-backup-directory - (unless (file-directory-p org-remember-backup-directory) - (make-directory org-remember-backup-directory)) - (org-set-local 'auto-save-file-name-transforms nil) - (setq buffer-file-name - (expand-file-name - (format-time-string "remember-%Y-%m-%d-%H-%M-%S") - org-remember-backup-directory)) - (save-buffer) - (org-set-local 'auto-save-visited-file-name t) - (auto-save-mode 1)) - (when (save-excursion - (goto-char (point-min)) - (re-search-forward "%!" nil t)) - (replace-match "") - (add-hook 'post-command-hook 'org-remember-finish-immediately 'append))) - -(defun org-remember-escaped-% () - (if (equal (char-before (match-beginning 0)) ?\\) - (progn - (delete-region (1- (match-beginning 0)) (match-beginning 0)) - t) - nil)) - - -(defun org-remember-finish-immediately () - "File remember note immediately. -This should be run in `post-command-hook' and will remove itself -from that hook." - (remove-hook 'post-command-hook 'org-remember-finish-immediately) - (org-remember-finalize)) - -(defun org-remember-visit-immediately () - "File remember note immediately. -This should be run in `post-command-hook' and will remove itself -from that hook." - (org-remember '(16)) - (goto-char (or (text-property-any - (point) (save-excursion (org-end-of-subtree t t)) - 'org-position-cursor t) - (point))) - (message "%s" - (format - (substitute-command-keys - "Restore window configuration with \\[jump-to-register] %c") - remember-register))) - -(defvar org-clock-marker) ; Defined in org.el -(defun org-remember-finalize () - "Finalize the remember process." - (interactive) - (unless org-remember-mode - (error "This does not seem to be a remember buffer for Org-mode")) - (run-hooks 'org-remember-before-finalize-hook) - (unless (fboundp 'remember-finalize) - (defalias 'remember-finalize 'remember-buffer)) - (when (and org-clock-marker - (equal (marker-buffer org-clock-marker) (current-buffer))) - ;; the clock is running in this buffer. - (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) - (or (eq org-remember-clock-out-on-exit t) - (and org-remember-clock-out-on-exit - (y-or-n-p "The clock is running in this buffer. Clock out now? ")))) - (let (org-log-note-clock-out) (org-clock-out)))) - (when buffer-file-name - (do-auto-save)) - (remember-finalize)) - -(defun org-remember-kill () - "Abort the current remember process." - (interactive) - (let ((org-note-abort t)) - (org-remember-finalize))) - -;;;###autoload -(defun org-remember (&optional goto org-force-remember-template-char) - "Call `remember'. If this is already a remember buffer, re-apply template. -If there is an active region, make sure remember uses it as initial content -of the remember buffer. - -When called interactively with a \\[universal-argument] \ -prefix argument GOTO, don't remember -anything, just go to the file/headline where the selected template usually -stores its notes. With a double prefix argument \ -\\[universal-argument] \\[universal-argument], go to the last -note stored by remember. - -Lisp programs can set ORG-FORCE-REMEMBER-TEMPLATE-CHAR to a character -associated with a template in `org-remember-templates'." - (interactive "P") - (org-require-remember) - (cond - ((equal goto '(4)) (org-go-to-remember-target)) - ((equal goto '(16)) (org-remember-goto-last-stored)) - (t - ;; set temporary variables that will be needed in - ;; `org-select-remember-template' - (setq org-select-template-temp-major-mode major-mode) - (setq org-select-template-original-buffer (current-buffer)) - (if org-remember-mode - (progn - (when (< (length org-remember-templates) 2) - (error "No other template available")) - (erase-buffer) - (let ((annotation (plist-get org-store-link-plist :annotation)) - (initial (plist-get org-store-link-plist :initial))) - (org-remember-apply-template)) - (message "Press C-c C-c to remember data")) - (if (org-region-active-p) - (org-do-remember (buffer-substring (point) (mark))) - (org-do-remember)))))) - -(defvar org-remember-last-stored-marker (make-marker) - "Marker pointing to the entry most recently stored with `org-remember'.") - -(defun org-remember-goto-last-stored () - "Go to the location where the last remember note was stored." - (interactive) - (org-goto-marker-or-bmk org-remember-last-stored-marker - "org-remember-last-stored") - (message "This is the last note stored by remember")) - -(defun org-go-to-remember-target (&optional template-key) - "Go to the target location of a remember template. -The user is queried for the template." - (interactive) - (let* (org-select-template-temp-major-mode - (entry (org-select-remember-template template-key)) - (file (nth 1 entry)) - (heading (nth 2 entry)) - visiting) - (unless (and file (stringp file) (string-match "\\S-" file)) - (setq file org-default-notes-file)) - (when (and file (not (file-name-absolute-p file))) - (setq file (expand-file-name file org-directory))) - (unless (and heading (stringp heading) (string-match "\\S-" heading)) - (setq heading org-remember-default-headline)) - (setq visiting (org-find-base-buffer-visiting file)) - (if (not visiting) (find-file-noselect file)) - (org-pop-to-buffer-same-window (or visiting (get-file-buffer file))) - (widen) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format (regexp-quote heading)) - nil t) - (goto-char (match-beginning 0)) - (error "Target headline not found: %s" heading)))) - -;; FIXME (bzg): let's clean up of final empty lines happen only once -;; (see the org-remember-delete-empty-lines-at-end option below) -;;;###autoload -(defun org-remember-handler () - "Store stuff from remember.el into an org file. -When the template has specified a file and a headline, the entry is filed -there, or in the location defined by `org-default-notes-file' and -`org-remember-default-headline'. -\\<org-remember-mode-map> -If no defaults have been defined, or if the current prefix argument -is 1 (using C-1 \\[org-remember-finalize] to exit remember), an interactive -process is used to select the target location. - -When the prefix is 0 (i.e. when remember is exited with \ -C-0 \\[org-remember-finalize]), -the entry is filed to the same location as the previous note. - -When the prefix is 2 (i.e. when remember is exited with \ -C-2 \\[org-remember-finalize]), -the entry is filed as a subentry of the entry where the clock is -currently running. - -When \\[universal-argument] has been used as prefix argument, the -note is stored and Emacs moves point to the new location of the -note, so that editing can be continued there (similar to -inserting \"%&\" into the template). - -Before storing the note, the function ensures that the text has an -org-mode-style headline, i.e. a first line that starts with -a \"*\". If not, a headline is constructed from the current date and -some additional data. - -If the variable `org-adapt-indentation' is non-nil, the entire text is -also indented so that it starts in the same column as the headline -\(i.e. after the stars). - -See also the variable `org-reverse-note-order'." - (when (and (equal current-prefix-arg 2) - (not (marker-buffer org-clock-marker))) - (error "No running clock")) - (when (org-bound-and-true-p org-jump-to-target-location) - (let* ((end (min (point-max) (1+ (point)))) - (beg (point))) - (if (= end beg) (setq beg (1- beg))) - (put-text-property beg end 'org-position-cursor t))) - (goto-char (point-min)) - (while (looking-at "^[ \t]*\n\\|^# .*\n") - (replace-match "")) - (when org-remember-delete-empty-lines-at-end - (goto-char (point-max)) - (beginning-of-line 1) - (while (and (looking-at "[ \t]*$\\|[ \t]*# .*") (> (point) 1)) - (delete-region (1- (point)) (point-max)) - (beginning-of-line 1))) - (catch 'quit - (if org-note-abort (throw 'quit t)) - (let* ((visitp (org-bound-and-true-p org-jump-to-target-location)) - (backup-file - (and buffer-file-name - (equal (file-name-directory buffer-file-name) - (file-name-as-directory - (expand-file-name org-remember-backup-directory))) - (string-match "^remember-[0-9]\\{4\\}" - (file-name-nondirectory buffer-file-name)) - buffer-file-name)) - - (dummy - (unless (string-match "\\S-" (buffer-string)) - (message "Nothing to remember") - (and backup-file - (ignore-errors - (delete-file backup-file) - (delete-file (concat backup-file "~")))) - (set-buffer-modified-p nil) - (throw 'quit t))) - (reference-date org-remember-reference-date) - (previousp (and (member current-prefix-arg '((16) 0)) - org-remember-previous-location)) - (clockp (equal current-prefix-arg 2)) - (clocksp (equal current-prefix-arg 3)) - (fastp (org-xor (equal current-prefix-arg 1) - org-remember-store-without-prompt)) - (file (cond - (fastp org-default-notes-file) - ((and (eq org-remember-interactive-interface 'refile) - org-refile-targets) - org-default-notes-file) - ((not previousp) - (org-get-org-file)))) - (heading org-remember-default-headline) - (visiting (and file (org-find-base-buffer-visiting file))) - (org-startup-folded nil) - (org-startup-align-all-tables nil) - (org-goto-start-pos 1) - spos exitcmd level reversed txt text-before-node-creation) - (when (equal current-prefix-arg '(4)) - (setq visitp t)) - (when previousp - (setq file (car org-remember-previous-location) - visiting (and file (org-find-base-buffer-visiting file)) - heading (cdr org-remember-previous-location) - fastp t)) - (when (or clockp clocksp) - (setq file (buffer-file-name (marker-buffer org-clock-marker)) - visiting (and file (org-find-base-buffer-visiting file)) - heading org-clock-heading-for-remember - fastp t)) - (setq current-prefix-arg nil) - ;; Modify text so that it becomes a nice subtree which can be inserted - ;; into an org tree. - (when org-remember-delete-empty-lines-at-end - (goto-char (point-min)) - (if (re-search-forward "[ \t\n]+\\'" nil t) - ;; remove empty lines at end - (replace-match ""))) - (goto-char (point-min)) - (setq text-before-node-creation (buffer-string)) - (unless (looking-at org-outline-regexp) - ;; add a headline - (insert (concat "* " (current-time-string) - " (" (remember-buffer-desc) ")\n")) - (backward-char 1) - (when org-adapt-indentation - (while (re-search-forward "^" nil t) - (insert " ")))) - ;; Delete final empty lines - (when org-remember-delete-empty-lines-at-end - (goto-char (point-min)) - (if (re-search-forward "\n[ \t]*\n[ \t\n]*\\'" nil t) - (replace-match "\n\n") - (if (re-search-forward "[ \t\n]*\\'") - (replace-match "\n")))) - (goto-char (point-min)) - (setq txt (buffer-string)) - (org-save-markers-in-region (point-min) (point-max)) - (set-buffer-modified-p nil) - (when (and (eq org-remember-interactive-interface 'refile) - (not fastp)) - (org-refile nil (or visiting (find-file-noselect file))) - (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately)) - (save-excursion - (bookmark-jump "org-refile-last-stored") - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - (throw 'quit t)) - ;; Find the file - (with-current-buffer (or visiting (find-file-noselect file)) - (unless (or (derived-mode-p 'org-mode) (member heading '(top bottom))) - (error "Target files for notes must be in Org-mode if not filing to top/bottom")) - (save-excursion - (save-restriction - (widen) - (setq reversed (org-notes-order-reversed-p)) - - ;; Find the default location - (when heading - (cond - ((not (derived-mode-p 'org-mode)) - (if (eq heading 'top) - (goto-char (point-min)) - (goto-char (point-max)) - (or (bolp) (newline))) - (insert text-before-node-creation) - (when remember-save-after-remembering - (save-buffer) - (if (not visiting) (kill-buffer (current-buffer)))) - (throw 'quit t)) - ((eq heading 'top) - (goto-char (point-min)) - (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp nil t)) - (setq org-goto-start-pos (or (match-beginning 0) (point-min)))) - ((eq heading 'bottom) - (goto-char (point-max)) - (or (bolp) (newline)) - (setq org-goto-start-pos (point))) - ((eq heading 'date-tree) - (org-datetree-find-date-create reference-date) - (setq reversed nil) - (setq org-goto-start-pos (point))) - ((and (stringp heading) (string-match "\\S-" heading)) - (goto-char (point-min)) - (if (re-search-forward - (format org-complex-heading-regexp-format - (regexp-quote heading)) - nil t) - (setq org-goto-start-pos (match-beginning 0)) - (when fastp - (goto-char (point-max)) - (unless (bolp) (newline)) - (insert "* " heading "\n") - (setq org-goto-start-pos (point-at-bol 0))))) - (t (goto-char (point-min)) (setq org-goto-start-pos (point) - heading 'top)))) - - ;; Ask the User for a location, using the appropriate interface - (cond - ((and fastp (memq heading '(top bottom))) - (setq spos org-goto-start-pos - exitcmd (if (eq heading 'top) 'left nil))) - (fastp (setq spos org-goto-start-pos - exitcmd 'return)) - ((eq org-remember-interactive-interface 'outline) - (setq spos (org-get-location (current-buffer) - org-remember-help) - exitcmd (cdr spos) - spos (car spos))) - ((eq org-remember-interactive-interface 'outline-path-completion) - (let ((org-refile-targets '((nil . (:maxlevel . 10)))) - (org-refile-use-outline-path t)) - (setq spos (org-refile-get-location "Heading") - exitcmd 'return - spos (nth 3 spos)))) - (t (error "This should not happen"))) - (if (not spos) (throw 'quit nil)) ; return nil to show we did - ; not handle this note - (and visitp (run-with-idle-timer 0.01 nil 'org-remember-visit-immediately)) - (goto-char spos) - (cond ((org-at-heading-p t) - (org-back-to-heading t) - (setq level (funcall outline-level)) - (cond - ((eq exitcmd 'return) - ;; sublevel of current - (setq org-remember-previous-location - (cons (abbreviate-file-name file) - (org-get-heading 'notags))) - (if reversed - (outline-next-heading) - (org-end-of-subtree t) - (if (not (bolp)) - (if (looking-at "[ \t]*\n") - (beginning-of-line 2) - (end-of-line 1) - (insert "\n")))) - (org-paste-subtree (if clocksp - level - (org-get-valid-level level 1)) txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - ((eq exitcmd 'left) - ;; before current - (org-paste-subtree level txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - ((eq exitcmd 'right) - ;; after current - (org-end-of-subtree t) - (org-paste-subtree level txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - (t (error "This should not happen")))) - - ((eq heading 'bottom) - (org-paste-subtree 1 txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point))) - - ((and (bobp) (not reversed)) - ;; Put it at the end, one level below level 1 - (save-restriction - (widen) - (goto-char (point-max)) - (if (not (bolp)) (newline)) - (org-paste-subtree (org-get-valid-level 1 1) txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - - ((and (bobp) reversed) - ;; Put it at the start, as level 1 - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward org-outline-regexp-bol nil t) - (beginning-of-line 1) - (org-paste-subtree 1 txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - (t - ;; Put it right there, with automatic level determined by - ;; org-paste-subtree or from prefix arg - (org-paste-subtree - (if (numberp current-prefix-arg) current-prefix-arg) - txt) - (and org-auto-align-tags (org-set-tags nil t)) - (bookmark-set "org-remember-last-stored") - (move-marker org-remember-last-stored-marker (point)))) - - (when remember-save-after-remembering - (save-buffer) - (if (and (not visiting) - (not (equal (marker-buffer org-clock-marker) - (current-buffer)))) - (kill-buffer (current-buffer)))) - (when org-remember-auto-remove-backup-files - (when backup-file - (ignore-errors - (delete-file backup-file) - (delete-file (concat backup-file "~")))) - (when org-remember-backup-directory - (let ((n (length - (directory-files - org-remember-backup-directory nil - "^remember-.*[0-9]$")))) - (when (and org-remember-warn-about-backups - (> n 0)) - (message - "%d backup files (unfinished remember calls) in %s" - n org-remember-backup-directory)))))))))) - - t) ;; return t to indicate that we took care of this note. - -(defun org-do-remember (&optional initial) - "Call remember." - (remember initial)) - -(defun org-require-remember () - "Make sure remember is loaded, or install our own emergency version of it." - (condition-case nil - (require 'remember) - (error - ;; Lets install our own micro version of remember - (defvar remember-register ?R) - (defvar remember-mode-hook nil) - (defvar remember-handler-functions nil) - (defvar remember-buffer "*Remember*") - (defvar remember-save-after-remembering t) - (defvar remember-annotation-functions '(buffer-file-name)) - (defun remember-finalize () - (run-hook-with-args-until-success 'remember-handler-functions) - (when (equal remember-buffer (buffer-name)) - (kill-buffer (current-buffer)) - (jump-to-register remember-register))) - (defun remember-mode () - (fundamental-mode) - (setq mode-name "Remember") - (run-hooks 'remember-mode-hook)) - (defun remember (&optional initial) - (window-configuration-to-register remember-register) - (let* ((annotation (run-hook-with-args-until-success - 'remember-annotation-functions))) - (switch-to-buffer-other-window (get-buffer-create remember-buffer)) - (remember-mode))) - (defun remember-buffer-desc () - (buffer-substring (point-min) (save-excursion (goto-char (point-min)) - (point-at-eol))))))) - -(provide 'org-remember) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-remember.el ends here diff --git a/lisp/org/org-special-blocks.el b/lisp/org/org-special-blocks.el deleted file mode 100644 index bbf5fef4bc..0000000000 --- a/lisp/org/org-special-blocks.el +++ /dev/null @@ -1,104 +0,0 @@ -;;; org-special-blocks.el --- handle Org special blocks -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Chris Gray <[email protected]> - -;; 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 package generalizes the #+begin_foo and #+end_foo tokens. - -;; To use, put the following in your init file: -;; -;; (require 'org-special-blocks) - -;; The tokens #+begin_center, #+begin_verse, etc. existed previously. -;; This package generalizes them (at least for the LaTeX and html -;; exporters). When a #+begin_foo token is encountered by the LaTeX -;; exporter, it is expanded into \begin{foo}. The text inside the -;; environment is not protected, as text inside environments generally -;; is. When #+begin_foo is encountered by the html exporter, a div -;; with class foo is inserted into the HTML file. It is up to the -;; user to add this class to his or her stylesheet if this div is to -;; mean anything. - -(require 'org-html) -(require 'org-compat) - -(declare-function org-open-par "org-html" ()) -(declare-function org-close-par-maybe "org-html" ()) - -(defvar org-special-blocks-ignore-regexp "^\\(LaTeX\\|HTML\\)$" - "A regexp indicating the names of blocks that should be ignored -by org-special-blocks. These blocks will presumably be -interpreted by other mechanisms.") - -(defvar org-export-current-backend) ; dynamically bound in org-exp.el -(defun org-special-blocks-make-special-cookies () - "Adds special cookies when #+begin_foo and #+end_foo tokens are -seen. This is run after a few special cases are taken care of." - (when (or (eq org-export-current-backend 'html) - (eq org-export-current-backend 'latex)) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) - (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2)) - (replace-match - (if (equal (downcase (match-string 1)) "begin") - (concat "ORG-" (match-string 2) "-START") - (concat "ORG-" (match-string 2) "-END")) - t t))))) - -(add-hook 'org-export-preprocess-after-blockquote-hook - 'org-special-blocks-make-special-cookies) - -(defun org-special-blocks-convert-latex-special-cookies () - "Converts the special cookies into LaTeX blocks." - (goto-char (point-min)) - (while (re-search-forward "^ORG-\\([^ \t\n]*\\)[ \t]*\\(.*\\)-\\(START\\|END\\)$" nil t) - (replace-match - (if (equal (match-string 3) "START") - (concat "\\begin{" (match-string 1) "}" (match-string 2)) - (concat "\\end{" (match-string 1) "}")) - t t))) - - -(add-hook 'org-export-latex-after-blockquotes-hook - 'org-special-blocks-convert-latex-special-cookies) - -(defvar org-line) -(defun org-special-blocks-convert-html-special-cookies () - "Converts the special cookies into div blocks." - ;; Uses the dynamically-bound variable `org-line'. - (when (and org-line (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line)) - (message "%s" (match-string 1)) - (when (equal (match-string 2 org-line) "START") - (org-close-par-maybe) - (insert "\n<div class=\"" (match-string 1 org-line) "\">") - (org-open-par)) - (when (equal (match-string 2 org-line) "END") - (org-close-par-maybe) - (insert "\n</div>") - (org-open-par)) - (throw 'nextline nil))) - -(add-hook 'org-export-html-after-blockquotes-hook - 'org-special-blocks-convert-html-special-cookies) - -(provide 'org-special-blocks) - -;;; org-special-blocks.el ends here diff --git a/lisp/org/org-vm.el b/lisp/org/org-vm.el deleted file mode 100644 index fc2a34b8fe..0000000000 --- a/lisp/org/org-vm.el +++ /dev/null @@ -1,180 +0,0 @@ -;;; org-vm.el --- Support for links to VM messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; Support for IMAP folders added -;; by Konrad Hinsen <konrad dot hinsen at fastmail dot net> -;; Requires VM 8.2.0a or later. -;; -;; 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 implements links to VM messages and folders from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -;; Declare external functions and variables -(declare-function vm-preview-current-message "ext:vm-page" ()) -(declare-function vm-follow-summary-cursor "ext:vm-motion" ()) -(declare-function vm-get-header-contents "ext:vm-summary" - (message header-name-regexp &optional clump-sep)) -(declare-function vm-isearch-narrow "ext:vm-search" ()) -(declare-function vm-isearch-update "ext:vm-search" ()) -(declare-function vm-select-folder-buffer "ext:vm-macro" ()) -(declare-function vm-su-message-id "ext:vm-summary" (m)) -(declare-function vm-su-subject "ext:vm-summary" (m)) -(declare-function vm-summarize "ext:vm-summary" (&optional display raise)) -(declare-function vm-imap-folder-p "ext:vm-save" ()) -(declare-function vm-imap-find-spec-for-buffer "ext:vm-imap" (buffer)) -(declare-function vm-imap-folder-for-spec "ext:vm-imap" (spec)) -(declare-function vm-imap-parse-spec-to-list "ext:vm-imap" (spec)) -(declare-function vm-imap-spec-for-account "ext:vm-imap" (account)) -(defvar vm-message-pointer) -(defvar vm-folder-directory) - -;; Install the link type -(org-add-link-type "vm" 'org-vm-open) -(org-add-link-type "vm-imap" 'org-vm-imap-open) -(add-hook 'org-store-link-functions 'org-vm-store-link) - -;; Implementation -(defun org-vm-store-link () - "Store a link to a VM folder or message." - (when (and (or (eq major-mode 'vm-summary-mode) - (eq major-mode 'vm-presentation-mode)) - (save-window-excursion - (vm-select-folder-buffer) buffer-file-name)) - (and (eq major-mode 'vm-presentation-mode) (vm-summarize)) - (vm-follow-summary-cursor) - (save-excursion - (vm-select-folder-buffer) - (let* ((message (car vm-message-pointer)) - (subject (vm-su-subject message)) - (to (vm-get-header-contents message "To")) - (from (vm-get-header-contents message "From")) - (message-id (vm-su-message-id message)) - (link-type (if (vm-imap-folder-p) "vm-imap" "vm")) - (date (vm-get-header-contents message "Date")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - folder desc link) - (if (vm-imap-folder-p) - (let ((spec (vm-imap-find-spec-for-buffer (current-buffer)))) - (setq folder (vm-imap-folder-for-spec spec))) - (progn - (setq folder (abbreviate-file-name buffer-file-name)) - (if (and vm-folder-directory - (string-match (concat "^" (regexp-quote vm-folder-directory)) - folder)) - (setq folder (replace-match "" t t folder))))) - (setq message-id (org-remove-angle-brackets message-id)) - (org-store-link-props :type link-type :from from :to to :subject subject - :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq desc (org-email-link-description)) - (setq link (concat (concat link-type ":") folder "#" message-id)) - (org-add-link-props :link link :description desc) - link)))) - -(defun org-vm-open (path) - "Follow a VM message link specified by PATH." - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in VM link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - ;; The prefix argument will be interpreted as read-only - (org-vm-follow-link folder article current-prefix-arg))) - -(defun org-vm-follow-link (&optional folder article readonly) - "Follow a VM link to FOLDER and ARTICLE." - (require 'vm) - (setq article (org-add-angle-brackets article)) - (if (string-match "^//\\([a-zA-Z]+@\\)?\\([^:]+\\):\\(.*\\)" folder) - ;; ange-ftp or efs or tramp access - (let ((user (or (match-string 1 folder) (user-login-name))) - (host (match-string 2 folder)) - (file (match-string 3 folder))) - (cond - ((featurep 'tramp) - ;; use tramp to access the file - (if (featurep 'xemacs) - (setq folder (format "[%s@%s]%s" user host file)) - (setq folder (format "/%s@%s:%s" user host file)))) - (t - ;; use ange-ftp or efs - (require (if (featurep 'xemacs) 'efs 'ange-ftp)) - (setq folder (format "/%s@%s:%s" user host file)))))) - (when folder - (funcall (cdr (assq 'vm org-link-frame-setup)) folder readonly) - (when article - (org-vm-select-message (org-add-angle-brackets article))))) - -(defun org-vm-imap-open (path) - "Follow a VM link to an IMAP folder." - (require 'vm-imap) - (when (string-match "\\([^:]+\\):\\([^#]+\\)#?\\(.+\\)?" path) - (let* ((account-name (match-string 1 path)) - (mailbox-name (match-string 2 path)) - (message-id (match-string 3 path)) - (account-spec (vm-imap-parse-spec-to-list - (vm-imap-spec-for-account account-name))) - (mailbox-spec (mapconcat 'identity - (append (butlast account-spec 4) - (cons mailbox-name - (last account-spec 3))) - ":"))) - (funcall (cdr (assq 'vm-imap org-link-frame-setup)) - mailbox-spec) - (when message-id - (org-vm-select-message (org-add-angle-brackets message-id)))))) - -(defun org-vm-select-message (message-id) - "Go to the message with message-id in the current folder." - (require 'vm-search) - (sit-for 0.1) - (vm-select-folder-buffer) - (widen) - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (not (re-search-forward - (concat "^" "message-id: *" (regexp-quote message-id)))) - (error "Could not find the specified message in this folder")) - (vm-isearch-update) - (vm-isearch-narrow) - (vm-preview-current-message) - (vm-summarize))) - -(provide 'org-vm) - - - -;;; org-vm.el ends here diff --git a/lisp/org/org-wl.el b/lisp/org/org-wl.el deleted file mode 100644 index b755c023e7..0000000000 --- a/lisp/org/org-wl.el +++ /dev/null @@ -1,316 +0,0 @@ -;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> -;; David Maus <dmaus at ictsoc dot de> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 implements links to Wanderlust messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -(defgroup org-wl nil - "Options concerning the Wanderlust link." - :tag "Org Startup" - :group 'org-link) - -(defcustom org-wl-link-to-refile-destination t - "Create a link to the refile destination if the message is marked as refile." - :group 'org-wl - :type 'boolean) - -(defcustom org-wl-link-remove-filter nil - "Remove filter condition if message is filter folder." - :group 'org-wl - :version "24.1" - :type 'boolean) - -(defcustom org-wl-shimbun-prefer-web-links nil - "If non-nil create web links for shimbun messages." - :group 'org-wl - :version "24.1" - :type 'boolean) - -(defcustom org-wl-nntp-prefer-web-links nil - "If non-nil create web links for nntp messages. -When folder name contains string \"gmane\" link to gmane, -googlegroups otherwise." - :type 'boolean - :version "24.1" - :group 'org-wl) - -(defcustom org-wl-disable-folder-check t - "Disable check for new messages when open a link." - :type 'boolean - :version "24.1" - :group 'org-wl) - -(defcustom org-wl-namazu-default-index nil - "Default namazu search index." - :type 'directory - :version "24.1" - :group 'org-wl) - -;; Declare external functions and variables -(declare-function elmo-folder-exists-p "ext:elmo" (folder) t) -(declare-function elmo-message-entity-field "ext:elmo-msgdb" - (entity field &optional type)) -(declare-function elmo-message-field "ext:elmo" - (folder number field &optional type) t) -(declare-function elmo-msgdb-overview-get-entity "ext:elmo" (id msgdb) t) -;; Backward compatibility to old version of wl -(declare-function wl "ext:wl" () t) -(declare-function wl-summary-buffer-msgdb "ext:wl-folder" () t) -(declare-function wl-summary-jump-to-msg-by-message-id "ext:wl-summary" - (&optional id)) -(declare-function wl-summary-jump-to-msg "ext:wl-summary" - (&optional number beg end)) -(declare-function wl-summary-line-from "ext:wl-summary" ()) -(declare-function wl-summary-line-subject "ext:wl-summary" ()) -(declare-function wl-summary-message-number "ext:wl-summary" ()) -(declare-function wl-summary-redisplay "ext:wl-summary" (&optional arg)) -(declare-function wl-summary-registered-temp-mark "ext:wl-action" (number)) -(declare-function wl-folder-goto-folder-subr "ext:wl-folder" - (&optional folder sticky)) -(declare-function wl-folder-get-petname "ext:wl-folder" (name)) -(declare-function wl-folder-get-entity-from-buffer "ext:wl-folder" - (&optional getid)) -(declare-function wl-folder-buffer-group-p "ext:wl-folder") -(defvar wl-init) -(defvar wl-summary-buffer-elmo-folder) -(defvar wl-summary-buffer-folder-name) -(defvar wl-folder-group-regexp) -(defvar wl-auto-check-folder-name) -(defvar elmo-nntp-default-server) - -(defconst org-wl-folder-types - '(("%" . imap) ("-" . nntp) ("+" . mh) ("=" . spool) - ("$" . archive) ("&" . pop) ("@" . shimbun) ("[" . search) - ("*" . multi) ("/" . filter) ("|" . pipe) ("'" . internal)) - "List of folder indicators. See Wanderlust manual, section 3.") - -;; Install the link type -(org-add-link-type "wl" 'org-wl-open) -(add-hook 'org-store-link-functions 'org-wl-store-link) - -;; Implementation - -(defun org-wl-folder-type (folder) - "Return symbol that indicates the type of FOLDER. -FOLDER is the wanderlust folder name. The first character of the -folder name determines the folder type." - (let* ((indicator (substring folder 0 1)) - (type (cdr (assoc indicator org-wl-folder-types)))) - ;; maybe access or file folder - (when (not type) - (setq type - (cond - ((and (>= (length folder) 5) - (string= (substring folder 0 5) "file:")) - 'file) - ((and (>= (length folder) 7) - (string= (substring folder 0 7) "access:")) - 'access) - (t - nil)))) - type)) - -(defun org-wl-message-field (field entity) - "Return content of FIELD in ENTITY. -FIELD is a symbol of a rfc822 message header field. -ENTITY is a message entity." - (let ((content (elmo-message-entity-field entity field 'string))) - (if (listp content) (car content) content))) - -(defun org-wl-store-link () - "Store a link to a WL message or folder." - (unless (eobp) - (cond - ((memq major-mode '(wl-summary-mode mime-view-mode)) - (org-wl-store-link-message)) - ((eq major-mode 'wl-folder-mode) - (org-wl-store-link-folder)) - (t - nil)))) - -(defun org-wl-store-link-folder () - "Store a link to a WL folder." - (let* ((folder (wl-folder-get-entity-from-buffer)) - (petname (wl-folder-get-petname folder)) - (link (concat "wl:" folder))) - (save-excursion - (beginning-of-line) - (unless (and (wl-folder-buffer-group-p) - (looking-at wl-folder-group-regexp)) - (org-store-link-props :type "wl" :description petname - :link link) - link)))) - -(defun org-wl-store-link-message () - "Store a link to a WL message." - (save-excursion - (let ((buf (if (eq major-mode 'wl-summary-mode) - (current-buffer) - (and (boundp 'wl-message-buffer-cur-summary-buffer) - wl-message-buffer-cur-summary-buffer)))) - (when buf - (with-current-buffer buf - (let* ((msgnum (wl-summary-message-number)) - (mark-info (wl-summary-registered-temp-mark msgnum)) - (folder-name - (if (and org-wl-link-to-refile-destination - mark-info - (equal (nth 1 mark-info) "o")) ; marked as refile - (nth 2 mark-info) - wl-summary-buffer-folder-name)) - (folder-type (org-wl-folder-type folder-name)) - (wl-message-entity - (if (fboundp 'elmo-message-entity) - (elmo-message-entity - wl-summary-buffer-elmo-folder msgnum) - (elmo-msgdb-overview-get-entity - msgnum (wl-summary-buffer-msgdb)))) - (message-id - (org-wl-message-field 'message-id wl-message-entity)) - (message-id-no-brackets - (org-remove-angle-brackets message-id)) - (from (org-wl-message-field 'from wl-message-entity)) - (to (org-wl-message-field 'to wl-message-entity)) - (xref (org-wl-message-field 'xref wl-message-entity)) - (subject (org-wl-message-field 'subject wl-message-entity)) - (date (org-wl-message-field 'date wl-message-entity)) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - desc link) - - ;; remove text properties of subject string to avoid possible bug - ;; when formatting the subject - ;; (Emacs bug #5306, fixed) - (set-text-properties 0 (length subject) nil subject) - - ;; maybe remove filter condition - (when (and (eq folder-type 'filter) org-wl-link-remove-filter) - (while (eq (org-wl-folder-type folder-name) 'filter) - (setq folder-name - (replace-regexp-in-string "^/[^/]+/" "" folder-name)))) - - ;; maybe create http link - (cond - ((and (eq folder-type 'shimbun) - org-wl-shimbun-prefer-web-links xref) - (org-store-link-props :type "http" :link xref :description subject - :from from :to to :message-id message-id - :message-id-no-brackets message-id-no-brackets - :subject subject)) - ((and (eq folder-type 'nntp) org-wl-nntp-prefer-web-links) - (setq link - (format - (if (string-match "gmane\\." folder-name) - "http://mid.gmane.org/%s" - "http://groups.google.com/groups/search?as_umsgid=%s") - (org-fixup-message-id-for-http message-id))) - (org-store-link-props :type "http" :link link :description subject - :from from :to to :message-id message-id - :message-id-no-brackets message-id-no-brackets - :subject subject)) - (t - (org-store-link-props :type "wl" :from from :to to - :subject subject :message-id message-id - :message-id-no-brackets message-id-no-brackets) - (setq desc (org-email-link-description)) - (setq link (concat "wl:" folder-name "#" message-id-no-brackets)) - (org-add-link-props :link link :description desc))) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (or link xref))))))) - -(defun org-wl-open-nntp (path) - "Follow the nntp: link specified by PATH." - (let* ((spec (split-string path "/")) - (server (split-string (nth 2 spec) "@")) - (group (nth 3 spec)) - (article (nth 4 spec))) - (org-wl-open - (concat "-" group ":" (if (cdr server) - (car (split-string (car server) ":")) - "") - (if (string= elmo-nntp-default-server (nth 2 spec)) - "" - (concat "@" (or (cdr server) (car server)))) - (if article (concat "#" article) ""))))) - -(defun org-wl-open (path) - "Follow the WL message link specified by PATH. -When called with one prefix, open message in namazu search folder -with `org-wl-namazu-default-index' as search index. When called -with two prefixes or `org-wl-namazu-default-index' is nil, ask -for namazu index." - (require 'wl) - (let ((wl-auto-check-folder-name - (if org-wl-disable-folder-check - 'none - wl-auto-check-folder-name))) - (unless wl-init (wl)) - ;; XXX: The imap-uw's MH folder names start with "%#". - (if (not (string-match "\\`\\(\\(?:%#\\)?[^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Wanderlust link")) - (let ((folder (match-string 1 path)) - (article (match-string 3 path))) - ;; maybe open message in namazu search folder - (when current-prefix-arg - (setq folder (concat "[" article "]" - (if (and (equal current-prefix-arg '(4)) - org-wl-namazu-default-index) - org-wl-namazu-default-index - (read-directory-name "Namazu index: "))))) - (if (not (elmo-folder-exists-p (org-no-warnings - (wl-folder-get-elmo-folder folder)))) - (error "No such folder: %s" folder)) - (let ((old-buf (current-buffer)) - (old-point (point-marker))) - (wl-folder-goto-folder-subr folder) - (with-current-buffer old-buf - ;; XXX: `wl-folder-goto-folder-subr' moves point to the - ;; beginning of the current line. So, restore the point - ;; in the old buffer. - (goto-char old-point)) - (when article - (if (org-string-match-p "@" article) - (wl-summary-jump-to-msg-by-message-id (org-add-angle-brackets - article)) - (or (wl-summary-jump-to-msg (string-to-number article)) - (error "No such message: %s" article))) - (wl-summary-redisplay)))))) - -(provide 'org-wl) - -;;; org-wl.el ends here diff --git a/lisp/org/org-xoxo.el b/lisp/org/org-xoxo.el deleted file mode 100644 index 1083fe16c5..0000000000 --- a/lisp/org/org-xoxo.el +++ /dev/null @@ -1,129 +0,0 @@ -;;; org-xoxo.el --- XOXO export for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: -;; XOXO export - -;;; Code: - -(require 'org-exp) - -(defvar org-export-xoxo-final-hook nil - "Hook run after XOXO export, in the new buffer.") - -(defun org-export-as-xoxo-insert-into (buffer &rest output) - (with-current-buffer buffer - (apply 'insert output))) -(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1) - -;;;###autoload -(defun org-export-as-xoxo (&optional buffer) - "Export the org buffer as XOXO. -The XOXO buffer is named *xoxo-<source buffer name>*" - (interactive (list (current-buffer))) - (run-hooks 'org-export-first-hook) - ;; A quickie abstraction - - ;; Output everything as XOXO - (with-current-buffer (get-buffer buffer) - (let* ((pos (point)) - (opt-plist (org-combine-plists (org-default-export-plist) - (org-infile-export-plist))) - (filename (concat (file-name-as-directory - (org-export-directory :xoxo opt-plist)) - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ".html")) - (out (find-file-noselect filename)) - (last-level 1) - (hanging-li nil)) - (goto-char (point-min)) ;; CD: beginning-of-buffer is not allowed. - ;; Check the output buffer is empty. - (with-current-buffer out (erase-buffer)) - ;; Kick off the output - (org-export-as-xoxo-insert-into out "<ol class='xoxo'>\n") - (while (re-search-forward "^\\(\\*+\\)[ \t]+\\(.+\\)" (point-max) 't) - (let* ((hd (match-string-no-properties 1)) - (level (length hd)) - (text (concat - (match-string-no-properties 2) - (save-excursion - (goto-char (match-end 0)) - (let ((str "")) - (catch 'loop - (while 't - (forward-line) - (if (looking-at "^[ \t]\\(.*\\)") - (setq str (concat str (match-string-no-properties 1))) - (throw 'loop str))))))))) - - ;; Handle level rendering - (cond - ((> level last-level) - (org-export-as-xoxo-insert-into out "\n<ol>\n")) - - ((< level last-level) - (dotimes (- (- last-level level) 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n")) - (org-export-as-xoxo-insert-into out "</ol>\n")) - (when hanging-li - (org-export-as-xoxo-insert-into out "</li>\n") - (setq hanging-li nil))) - - ((equal level last-level) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n"))) - ) - - (setq last-level level) - - ;; And output the new li - (setq hanging-li 't) - (if (equal ?+ (elt text 0)) - (org-export-as-xoxo-insert-into out "<li class='" (substring text 1) "'>") - (org-export-as-xoxo-insert-into out "<li>" text)))) - - ;; Finally finish off the ol - (dotimes (- last-level 1) - (if hanging-li - (org-export-as-xoxo-insert-into out "</li>\n")) - (org-export-as-xoxo-insert-into out "</ol>\n")) - - (goto-char pos) - ;; Finish the buffer off and clean it up. - (switch-to-buffer-other-window out) - (indent-region (point-min) (point-max) nil) - (run-hooks 'org-export-xoxo-final-hook) - (save-buffer) - (goto-char (point-min)) - ))) - -(provide 'org-xoxo) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-xoxo.el ends here |