+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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 <johnw@gnu.org>
-;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; org-publish.el --- publish related org-mode files as a website
-;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
-
-;; Author: David O'Toole <dto@gnu.org>
-;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; org-special-blocks.el --- handle Org special blocks
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
-
-;; Author: Chris Gray <chrismgray@gmail.com>
-
-;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
+++ /dev/null
-;;; 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
projects / emacs.git / commitdiff