[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/org/org-exp.el,v
From: |
Carsten Dominik |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/org/org-exp.el,v |
Date: |
Tue, 17 Jun 2008 15:22:07 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Carsten Dominik <cdominik> 08/06/17 15:22:01
Index: lisp/org/org-exp.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/org/org-exp.el,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -b -r1.4 -r1.5
--- lisp/org/org-exp.el 15 May 2008 03:31:34 -0000 1.4
+++ lisp/org/org-exp.el 17 Jun 2008 15:21:57 -0000 1.5
@@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.02b
+;; Version: 6.05a
;;
;; This file is part of GNU Emacs.
;;
@@ -33,6 +33,8 @@
(declare-function org-export-latex-preprocess "org-export-latex" ())
(declare-function org-agenda-skip "org-agenda" ())
(declare-function org-infojs-options-inbuffer-template "org-jsinfo" ())
+(declare-function htmlize-region "ext:htmlize" (beg end))
+(defvar htmlize-buffer-places) ; from htmlize.el
(defgroup org-export nil
"Options for exporting org-listings."
@@ -86,7 +88,9 @@
("fr" "Auteur" "Date" "Table des mati\xe8res")
("it" "Autore" "Data" "Indice")
("nl" "Auteur" "Datum" "Inhoudsopgave")
- ("nn" "Forfattar" "Dato" "Innhold") ;; nn = Norsk (nynorsk)
+ ("no" "Forfatter" "Dato" "Innhold")
+ ("nb" "Forfatter" "Dato" "Innhold") ;; nb = Norsk (bokm.l)
+ ("nn" "Forfattar" "Dato" "Innhald") ;; nn = Norsk (nynorsk)
("sv" "F\xf6rfattarens" "Datum" "Inneh\xe5ll"))
"Terms used in export text, translated to different languages.
Use the variable `org-export-default-language' to set the language,
@@ -105,7 +109,7 @@
:group 'org-export-general
:type 'string)
-(defcustom org-export-skip-text-before-1st-heading t
+(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
@@ -128,6 +132,26 @@
: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 \"a\".
+ 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'.
@@ -227,6 +251,10 @@
(repeat :tag "Selected drawers"
(string :tag "Drawer name"))))
+(defvar org-export-preprocess-hook nil
+ "Hook for preprocessing an export buffer.
+Pretty much the first thing when exporting is running this hook.")
+
(defgroup org-export-translation nil
"Options for translating special ascii sequences for the export backends."
:tag "Org Export Translation"
@@ -456,12 +484,14 @@
background-color: #F3F5F7;
padding: 5pt;
font-family: courier, monospace;
+ font-size: 90%;
}
table { border-collapse: collapse; }
td, th {
vertical-align: top;
<!--border: 1pt solid #ADB9CC;-->
}
+ dt { font-weight: bold; }
</style>"
"The default style specification for exported HTML files.
Since there are different ways of setting style information, this variable
@@ -564,6 +594,25 @@
:group 'org-export-html
:type 'string)
+(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.
+Normally this is `inline-css', but if you have defined to appropriate
+classes in your css style file, setting this to `css' means that the
+fontification will use the class names.
+See also the function `org-export-htmlize-generate-css'."
+ :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)
+
(defgroup org-export-icalendar nil
"Options specific for iCalendar export of Org-mode files."
:tag "Org Export iCalendar"
@@ -606,6 +655,20 @@
:group 'org-export-icalendar
:type 'string)
+(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 identifyer.
+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,
+superceeding 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)
+
;;;; Exporting
;;; Variables, constants, and parameter plists
@@ -630,6 +693,7 @@
(:customtime . org-display-custom-times)
(:headline-levels . org-export-headline-levels)
(:section-numbers . org-export-with-section-numbers)
+ (:section-number-format . org-export-section-number-format)
(:table-of-contents . org-export-with-toc)
(:preserve-breaks . org-export-preserve-breaks)
(:archived-trees . org-export-with-archived-trees)
@@ -694,16 +758,21 @@
(save-excursion
(save-restriction
(widen)
- (goto-char 0)
+ (goto-char (point-min))
(let ((re (org-make-options-regexp
(append
'("TITLE" "AUTHOR" "DATE" "EMAIL" "TEXT" "OPTIONS" "LANGUAGE"
- "LINK_UP" "LINK_HOME")
+ "LINK_UP" "LINK_HOME" "SETUPFILE")
(mapcar 'car org-export-inbuffer-options-extra))))
- p key val text options js-up js-main js-css js-opt a pr)
- (while (re-search-forward re nil t)
- (setq key (org-match-string-no-properties 1)
- val (org-match-string-no-properties 2))
+ p key val text options js-up js-main js-css js-opt a pr
+ ext-setup-or-nil 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))
@@ -716,13 +785,32 @@
((string-equal key "TEXT")
(setq text (if text (concat text "\n" val) val)))
((string-equal key "OPTIONS")
- (setq options (concat options " " val)))
+ (setq options (concat val " " options)))
((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)))))
+ (setq p (plist-put p :link-home val)))
+ ((equal key "SETUPFILE")
+ (setq setup-contents (org-file-contents
+ (expand-file-name
+ (org-remove-double-quotes
+ (org-trim val)))
+ '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 options
+ (setq p (org-export-add-options-to-plist p options)))
+ p))))
+
+(defun org-export-add-options-to-plist (p options)
+ "Parse an OPTONS line and set values in the property list P."
+ (let (o)
+ (when options
(let ((op '(("H" . :headline-levels)
("num" . :section-numbers)
("toc" . :table-of-contents)
@@ -748,8 +836,23 @@
options)
(setq p (plist-put p (cdr o)
(car (read-from-string
- (match-string 1 options)))))))))
- p))))
+ (match-string 1 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_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))
@@ -758,6 +861,12 @@
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.
@@ -1151,50 +1260,40 @@
The result is then again returned as a string, and the exporter works
on this string to produce the exported version."
(interactive)
- (let* ((re-radio (and org-target-link-regexp
- (concat "\\([^<]\\)\\(" org-target-link-regexp "\\)")))
- (re-plain-link (concat "\\([^[<]\\)" org-plain-link-re))
- (re-angle-link (concat "\\([^[]\\)" org-angle-link-re))
- (re-archive (concat ":" org-archive-tag ":"))
- (re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>"))
- (re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>"))
- (htmlp (plist-get parameters :for-html))
+ (let* ((htmlp (plist-get parameters :for-html))
(asciip (plist-get parameters :for-ascii))
(latexp (plist-get parameters :for-LaTeX))
- (commentsp (plist-get parameters :comments))
(archived-trees (plist-get parameters :archived-trees))
(inhibit-read-only t)
(drawers org-drawers)
- (exp-drawers (plist-get parameters :drawers))
(outline-regexp "\\*+ ")
- target-alist tmp target level
- a b xx rtn p)
+ target-alist rtn)
(with-current-buffer (get-buffer-create " org-mode-tmp")
(erase-buffer)
(insert string)
+ (setq case-fold-search t)
+ ;; Call the hook
+ (run-hooks 'org-export-preprocess-hook)
+
;; Remove license-to-kill stuff
;; The caller markes some stuff fo killing, stuff that has been
;; used to create the page title, for example.
- (while (setq p (text-property-any (point-min) (point-max)
- :org-license-to-kill t))
- (delete-region p (next-single-property-change p :org-license-to-kill)))
+ (org-export-kill-licensed-text)
(let ((org-inhibit-startup t)) (org-mode))
+ (setq case-fold-search t)
(untabify (point-min) (point-max))
+ ;; Handle incude files
+ (org-export-handle-include-files)
+
+ ;; Handle source code snippets
+ (org-export-replace-src-segments)
+
;; Get rid of drawers
- (unless (eq t exp-drawers)
- (goto-char (point-min))
- (let ((re (concat "^[ \t]*:\\("
- (mapconcat
- 'identity
- (org-delete-all exp-drawers
- (copy-sequence drawers))
- "\\|")
- "\\):[ \t]*\n\\(address@hidden)?[ \t]*:END:[
\t]*\n")))
- (while (re-search-forward re nil t)
- (replace-match ""))))
+ (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)
@@ -1208,21 +1307,91 @@
(insert (plist-get parameters :add-text) "\n"))
;; Get rid of archived trees
- (when (not (eq archived-trees t))
- (goto-char (point-min))
- (while (re-search-forward re-archive nil t)
- (if (not (org-on-heading-p t))
- (org-end-of-subtree t)
- (beginning-of-line 1)
- (setq a (if archived-trees
- (1+ (point-at-eol)) (point))
- b (org-end-of-subtree t))
- (if (> b a) (delete-region a b)))))
+ (org-export-remove-archived-trees archived-trees)
;; Find all headings and compute the targets for them
+ (setq target-alist (org-export-define-heading-targets target-alist))
+
+ ;; 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))
+
+ ;; Protect examples
+ (org-export-protect-examples)
+
+ ;; Protect backend specific stuff, throw away the others.
+ (org-export-select-backend-specific-text
+ (cond (htmlp 'html) (latexp 'latex) (asciip 'ascii)))
+
+ ;; Protect quoted subtrees
+ (org-export-protect-quoted-subtrees)
+
+ ;; Protect verbatim elements
+ (org-export-protect-verbatim)
+
+ ;; Blockquotes and verse
+ (org-export-mark-blockquote-and-verse)
+
+ ;; Remove comment environment and comment subtrees
+ (org-export-remove-comment-blocks-and-subtrees)
+
+ ;; Remove special table lines
+ (when org-export-table-remove-special-lines
+ (org-export-remove-special-table-lines))
+
+ ;; Specific LaTeX stuff
+ (when latexp
+ (require 'org-export-latex nil)
+ (org-export-latex-preprocess))
+
+ ;; Specific ASCII stuff
+ (when asciip
+ (org-export-ascii-preprocess))
+
+ ;; Specific HTML stuff
+ (when htmlp
+ (org-export-html-preprocess parameters))
+
+ ;; Remove or replace comments
+ (org-export-handle-comments (plist-get parameters :comments))
+
+ ;; Find matches for radio targets and turn them into internal links
+ (org-export-mark-radio-links)
+
+ ;; Find all links that contain a newline and put them into a single line
+ (org-export-concatenate-multiline-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)
+
+ ;; Normalize links: Convert angle and plain links into bracket links
+ ;; and expand link abbreviations
+ (org-export-normalize-links)
+
+ ;; Find multiline emphasis and put them into single line
+ (when (plist-get parameters :emph-multiline)
+ (org-export-concatenate-multiline-emphasis))
+
+ (setq rtn (buffer-string)))
+ (kill-buffer " org-mode-tmp")
+ 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 (next-single-property-change p :org-license-to-kill)))))
+
+(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."
(goto-char (point-min))
(org-init-section-numbers)
- (let ((re (concat "^" org-outline-regexp)))
+ (let ((re (concat "^" org-outline-regexp))
+ level target)
(while (re-search-forward re nil t)
(setq level (org-reduced-level
(save-excursion (goto-char (point-at-bol))
@@ -1233,9 +1402,12 @@
(add-text-properties
(point-at-bol) (point-at-eol)
(list 'target target))))
+ target-alist)
- ;; Find targets in comments and move them out of comments,
- ;; but mark them as targets that should be invisible
+(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)
(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
@@ -1249,27 +1421,124 @@
(push (cons (org-solidify-link-text tmp) target)
target-alist))
;; Make an invisible target
- (replace-match "\\1(INVISIBLE)")))
+ (replace-match "\\1(INVISIBLE)"))))
+ target-alist)
- ;; Protect backend specific stuff, throw away the others.
- (let ((formatters
- `((,htmlp "HTML" "BEGIN_HTML" "END_HTML")
- (,asciip "ASCII" "BEGIN_ASCII" "END_ASCII")
- (,latexp "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
- fmt)
+(defun org-export-target-internal-links (target-alist)
+ "Find all internal links and assign target to them.
+If a link has a fuzzy match (i.e. not a *dedicated* target match),
+let the link point to the corresponding section."
+ (goto-char (point-min))
+ (while (re-search-forward org-bracket-link-regexp nil t)
+ (org-if-unprotected
+ (let* ((md (match-data))
+ (desc (match-end 2))
+ (link (org-link-unescape (match-string 1)))
+ (slink (org-solidify-link-text link))
+ found props pos
+ (target
+ (or (cdr (assoc slink target-alist))
+ (save-excursion
+ (unless (string-match org-link-types-re link)
+ (setq found (condition-case nil (org-link-search link)
+ (error nil)))
+ (when (and found
+ (or (org-on-heading-p)
+ (not (eq found 'dedicated))))
+ (or (get-text-property (point) 'target)
+ (get-text-property
+ (max (point-min)
+ (1- (previous-single-property-change
+ (point) 'target)))
+ '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-remove-or-extract-drawers (all-drawers exp-drawers)
+ "Remove drawers, or extract 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."
+ (unless (eq t exp-drawers)
+ (goto-char (point-min))
+ (let ((re (concat "^[ \t]*:\\("
+ (mapconcat
+ 'identity
+ (org-delete-all exp-drawers
+ (copy-sequence all-drawers))
+ "\\|")
+ "\\):[ \t]*\n\\(address@hidden)?[ \t]*:END:[ \t]*\n")))
+ (while (re-search-forward re nil t)
+ (replace-match "")))))
+
+(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-on-heading-p t))
+ (org-end-of-subtree t)
+ (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-protect-quoted-subtrees ()
+ "Mark quoted subtrees with the protection property."
+ (let ((re-quote (concat "^\\*+[ \t]+" org-quote-string "\\>")))
+ (goto-char (point-min))
+ (while (re-search-forward 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-protect-verbatim ()
+ "Mark verbatim snippets with the protection property."
+ (goto-char (point-min))
+ (while (re-search-forward org-verbatim-re nil t)
+ (add-text-properties (match-beginning 4) (match-end 4)
+ '(org-protected t))
+ (goto-char (1+ (match-end 4)))))
+
+(defun org-export-protect-examples ()
+ "Protect code that should be exported as monospaced examples."
(goto-char (point-min))
(while (re-search-forward "^#\\+BEGIN_EXAMPLE[ \t]*\n" nil t)
(goto-char (match-end 0))
- (while (not (looking-at "#\\+END_EXAMPLE"))
+ (while (and (not (looking-at "#\\+END_EXAMPLE")) (not (eobp)))
(insert ": ")
(beginning-of-line 2)))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:.*\\(\n[ \t]*:.*\\)*" nil t)
(add-text-properties (match-beginning 0) (match-end 0)
- '(org-protected t)))
+ '(org-protected t))))
+
+(defun org-export-select-backend-specific-text (backend)
+ (let ((formatters
+ '((html "HTML" "BEGIN_HTML" "END_HTML")
+ (ascii "ASCII" "BEGIN_ASCII" "END_ASCII")
+ (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX")))
+ fmt)
+
(while formatters
(setq fmt (pop formatters))
- (when (car fmt)
+ (when (eq (car fmt) backend)
+ ;; This is selected code, put it into the file for real
(goto-char (point-min))
(while (re-search-forward (concat "^#\\+" (cadr fmt)
":[ \t]*\\(.*\\)") nil t)
@@ -1282,125 +1551,89 @@
(concat "^#\\+"
(caddr fmt) "\\>.*\\(\\(\n.*\\)*?\n\\)#\\+"
(cadddr fmt) "\\>.*\n?") nil t)
- (if (car fmt)
+ (if (eq (car fmt) backend)
+ ;; yes, keep this
(add-text-properties (match-beginning 1) (1+ (match-end 1))
'(org-protected t))
- (delete-region (match-beginning 0) (match-end 0))))))
+ ;; No, this is for a different backend, kill it
+ (delete-region (match-beginning 0) (match-end 0)))))))
- ;; Protect quoted subtrees
- (goto-char (point-min))
- (while (re-search-forward 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)))
-
- ;; Protect verbatim elements
+(defun org-export-mark-blockquote-and-verse ()
+ "Mark block quote and verse environments with special cookies.
+These special cookies will later be interpreted by the backend."
+ ;; Blockquotes
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+\\(begin\\|end\\)_\\(block\\)?quote\\>.*"
+ nil t)
+ (replace-match (if (equal (downcase (match-string 1)) "end")
+ "ORG-BLOCKQUOTE-END" "ORG-BLOCKQUOTE-START")
+ t t))
+ ;; Verse
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+\\(begin\\|end\\)_verse\\>.*" nil t)
+ (replace-match (if (equal (downcase (match-string 1)) "end")
+ "ORG-VERSE-END" "ORG-VERSE-START")
+ t t)))
+
+(defun org-export-remove-comment-blocks-and-subtrees ()
+ "Remove the comment environment, and also commented subtrees."
+ (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>")))
+ ;; Remove comment environment
(goto-char (point-min))
- (while (re-search-forward org-verbatim-re nil t)
- (add-text-properties (match-beginning 4) (match-end 4)
- '(org-protected t))
- (goto-char (1+ (match-end 4))))
-
+ (while (re-search-forward
+ "^#\\+BEGIN_COMMENT[ \t]*\n[^\000]*?^#\\+END_COMMENT\\>.*" nil t)
+ (replace-match "" t t))
;; Remove subtrees that are commented
(goto-char (point-min))
(while (re-search-forward re-commented nil t)
(goto-char (match-beginning 0))
- (delete-region (point) (org-end-of-subtree t)))
+ (delete-region (point) (org-end-of-subtree t)))))
- ;; Remove special table lines
- (when org-export-table-remove-special-lines
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]*|" nil t)
- (beginning-of-line 1)
- (if (or (looking-at "[ \t]*| *[!_^] *|")
- (and (looking-at ".*?| *<[0-9]+> *|")
- (not (looking-at ".*?| *[^ <|]"))))
- (delete-region (max (point-min) (1- (point-at-bol)))
- (point-at-eol))
- (end-of-line 1))))
-
- ;; Specific LaTeX stuff
- (when latexp
- (require 'org-export-latex nil)
- (org-export-latex-preprocess))
-
- (when asciip
- (org-export-ascii-clean-string))
-
- ;; Specific HTML stuff
- (when htmlp
- ;; Convert LaTeX fragments to images
- (when (plist-get parameters :LaTeX-fragments)
- (org-format-latex
- (concat "ltxpng/" (file-name-sans-extension
- (file-name-nondirectory
- org-current-export-file)))
- org-current-export-dir nil "Creating LaTeX image %s"))
- (message "Exporting..."))
-
- ;; Remove or replace comments
+(defun org-export-handle-comments (commentsp)
+ "Remove comments, or convert to backend-specific format.
+COMMENTSP can be a format string for publishing comments.
+When it is nil, all comments will be removed."
+ (let ((re "^#\\(.*\n?\\)")
+ pos)
(goto-char (point-min))
- (while (re-search-forward "^#\\(.*\n?\\)" nil t)
+ (while (or (looking-at re)
+ (re-search-forward re nil t))
+ (setq pos (match-beginning 0))
(if commentsp
(progn (add-text-properties
(match-beginning 0) (match-end 0) '(org-protected t))
(replace-match (format commentsp (match-string 1)) t t))
- (replace-match "")))
+ (goto-char (1+ pos))
+ (org-if-unprotected
+ (replace-match "")
+ (goto-char (max (point-min) (1- pos))))))))
- ;; Find matches for radio targets and turn them into internal links
+(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)
(org-if-unprotected
- (replace-match "\\1[[\\2]]"))))
-
- ;; Find all links that contain a newline and put them into a single line
- (goto-char (point-min))
- (while (re-search-forward "\\(\\(\\[\\|\\]\\)\\[[^]]*?\\)[ \t]*\n[
\t]*\\([^]]*\\]\\(\\[\\|\\]\\)\\)" nil t)
- (org-if-unprotected
- (replace-match "\\1 \\3")
- (goto-char (match-beginning 0))))
-
- ;; Find all internal links. If they have a fuzzy match (i.e. not
- ;; a *dedicated* target match, let the link point to the
- ;; correspinding section.
+ (replace-match "\\1[[\\2]]"))))))
+(defun org-export-remove-special-table-lines ()
+ "Remove tables lines that are used for internal purposes."
(goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp nil t)
- (org-if-unprotected
- (let* ((md (match-data))
- (desc (match-end 2))
- (link (org-link-unescape (match-string 1)))
- (slink (org-solidify-link-text link))
- found props pos
- (target
- (or (cdr (assoc slink target-alist))
- (save-excursion
- (unless (string-match org-link-types-re link)
- (setq found (condition-case nil (org-link-search link)
- (error nil)))
- (when (and found
- (or (org-on-heading-p)
- (not (eq found 'dedicated))))
- (or (get-text-property (point) 'target)
- (get-text-property
- (max (point-min)
- (1- (previous-single-property-change
- (point) 'target)))
- '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)))))
+ (while (re-search-forward "^[ \t]*|" nil t)
+ (beginning-of-line 1)
+ (if (or (looking-at "[ \t]*| *[!_^] *|")
+ (and (looking-at ".*?| *<[0-9]+> *|")
+ (not (looking-at ".*?| *[^ <|]"))))
+ (delete-region (max (point-min) (1- (point-at-bol)))
+ (point-at-eol))
+ (end-of-line 1))))
- ;; Normalize links: Convert angle and plain links into bracket links
- ;; Expand link abbreviations
+(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)))
(goto-char (point-min))
(while (re-search-forward re-plain-link nil t)
(goto-char (1- (match-end 0)))
@@ -1421,18 +1654,31 @@
(goto-char (point-min))
(while (re-search-forward org-bracket-link-regexp nil t)
(org-if-unprotected
- (let* ((s (concat "[[" (setq xx (save-match-data
+ (let* ((xx (save-match-data
(org-link-expand-abbrev
(match-string 1))))
- "]"
+ (s (concat
+ "[[" xx "]"
(if (match-end 3)
(match-string 2)
(concat "[" xx "]"))
"]")))
(put-text-property 0 (length s) 'face 'org-link s)
- (replace-match s t t))))
+ (replace-match s t t))))))
- ;; Find multiline emphasis and put them into single line
- (when (plist-get parameters :emph-multiline)
+(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
+ (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 (not (= (char-after (match-beginning 3))
@@ -1443,10 +1689,6 @@
(goto-char (1- (match-end 0))))
(goto-char (1+ (match-beginning 0))))))
- (setq rtn (buffer-string)))
- (kill-buffer " org-mode-tmp")
- rtn))
-
(defun org-export-grab-title-from-buffer ()
"Get a title for the current document, from looking at the buffer."
(let ((inhibit-read-only t))
@@ -1463,18 +1705,19 @@
(defun org-export-get-title-from-subtree ()
"Return subtree title and exclude it from export."
- (let (title (m (mark)))
+ (let (title (m (mark)) (rbeg (region-beginning)) (rend (region-end)))
(save-excursion
- (goto-char (region-beginning))
+ (goto-char rbeg)
(when (and (org-at-heading-p)
- (>= (org-end-of-subtree t t) (region-end)))
+ (>= (org-end-of-subtree t t) rend))
;; This is a subtree, we take the title from the first heading
- (goto-char (region-beginning))
+ (goto-char rbeg)
(looking-at org-todo-line-regexp)
(setq title (match-string 3))
(org-unmodified
(add-text-properties (point) (1+ (point-at-eol))
- (list :org-license-to-kill t)))))
+ (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)
@@ -1519,7 +1762,12 @@
(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))) idx n (string ""))
+ (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
@@ -1531,16 +1779,153 @@
(setq idx (1+ idx))))
(setq idx 0)
(while (<= idx depth)
- (setq n (aref org-section-numbers idx))
- (setq string (concat string (if (not (string= string "")) "." "")
- (int-to-string n)))
+ (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 "\\`\\(address@hidden)+" string)
(setq string (replace-match "" t nil string)))
(if (string-match "\\(\\.0\\)+\\'" string)
(setq string (replace-match "" t nil string))))
- 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 uppper 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)))
+
+(org-number-to-roman 1961)
+
+
+;;; 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)
+ (goto-char (point-min))
+ (while (re-search-forward "^#\\+INCLUDE:?[ \t]+\\(.*\\)" nil t)
+ (setq params (read (concat "(" (match-string 1) ")"))
+ file (org-symname-or-string (pop params))
+ markup (org-symname-or-string (pop params))
+ lang (org-symname-or-string (pop params)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (if (or (not file)
+ (not (file-exists-p file))
+ (not (file-readable-p file)))
+ (insert (format "CANNOT INCLUDE FILE %s" file))
+ (when markup
+ (if (equal (downcase markup) "src")
+ (setq start (format "#+begin_src %s\n" (or lang "fundamental"))
+ end "#+end_src")
+ (setq start (format "#+begin_%s\n" markup)
+ end (format "#+end_%s" markup))))
+ (insert (or start ""))
+ (forward-char (nth 1 (insert-file-contents (expand-file-name file))))
+ (or (bolp) (newline))
+ (insert (or end ""))))))
+
+(defun org-symname-or-string (s)
+ (if (symbolp s)
+ (if s (symbol-name s) s)
+ s))
+
+;;; Fontification of code
+;; Currently only for th HTML backend, but who knows....
+(defun org-export-replace-src-segments ()
+ "Replace source code segments with special code for export."
+ (let ((case-fold-search t)
+ lang code trans)
+ (goto-char (point-min))
+ (while (re-search-forward
+ "^#\\+BEGIN_SRC:?[ \t]+\\([^ \t\n]+\\)[
\t]*\n\\([^\000]+?\n\\)#\\+END_SRC.*"
+ nil t)
+ (setq lang (match-string 1) code (match-string 2)
+ trans (org-export-format-source-code lang code))
+ (replace-match trans t t))))
+
+(defvar htmlp) ;; dynamically scoped from org-exp.el
+
+(defun org-export-format-source-code (lang code)
+ "Format CODE from language LANG and return it formatted for export.
+Currently, this only does something for HTML export, for all other
+backends, it converts the segment into an EXAMPLE segment."
+ (save-match-data
+ (cond
+ (htmlp
+ ;; We are exporting to HTML
+ (condition-case nil (require 'htmlize) (nil t))
+ (if (not (fboundp 'htmlize-region-for-paste))
+ (progn
+ ;; we do not have htmlize.el, or an old version of it
+ (message
+ "htmlize.el 1.34 or later is needed for source code formatting")
+ (concat "#+BEGIN_EXAMPLE\n" code
+ (if (string-match "\n\\'" code) "" "\n")
+ "#+END_EXAMPLE\n"))
+ ;; ok, we are good to go
+ (let* ((mode (and lang (intern (concat lang "-mode"))))
+ (org-inhibit-startup t)
+ (org-startup-folded nil)
+ (htmltext
+ (with-temp-buffer
+ (insert code)
+ ;; Free up the protected stuff
+ (goto-char (point-min))
+ (while (re-search-forward "^," nil t)
+ (replace-match "")
+ (end-of-line 1))
+ (if (functionp mode)
+ (funcall mode)
+ (fundamental-mode))
+ (font-lock-fontify-buffer)
+ (org-export-htmlize-region-for-paste
+ (point-min) (point-max)))))
+ (if (string-match "<pre\\([^>]*\\)>\n?" htmltext)
+ (setq htmltext (replace-match "<pre class=\"src\">"
+ t t htmltext)))
+ (concat "#+BEGIN_HTML\n" htmltext "\n#+END_HTML\n"))))
+ (t
+ ;; This is not HTML, so just make it an example.
+ (when (equal lang "org")
+ (while (string-match "^," code)
+ (setq code (replace-match "" t t code))))
+ (concat "#+BEGIN_EXAMPLE\n" code
+ (if (string-match "\n\\'" code) "" "\n")
+ "#+END_EXAMPLE\n")))))
;;; ASCII export
@@ -1560,12 +1945,17 @@
(let* ((opt-plist (org-combine-plists (org-default-export-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
(when region-p
(save-excursion
- (goto-char (region-beginning))
+ (goto-char rbeg)
(and (org-at-heading-p)
- (>= (org-end-of-subtree t t) (region-end))))))
+ (>= (org-end-of-subtree t t) rend)))))
+ (opt-plist (if subtree-p
+ (org-export-add-subtree-options opt-plist rbeg)
+ opt-plist))
(custom-times org-display-custom-times)
(org-ascii-current-indentation '(0 . 0))
(level 0) line txt
@@ -1673,7 +2063,8 @@
(if org-export-with-toc
(progn
(push (concat (nth 3 lang-words) "\n") thetoc)
- (push (concat (make-string (length (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)
@@ -1810,7 +2201,7 @@
(goto-char beg)))
(goto-char (point-min))))
-(defun org-export-ascii-clean-string ()
+(defun org-export-ascii-preprocess ()
"Do extra work for ASCII export"
(goto-char (point-min))
(while (re-search-forward org-verbatim-re nil t)
@@ -1847,7 +2238,7 @@
(defun org-insert-centered (s &optional underline)
"Insert the string S centered and underline it with character UNDERLINE."
- (let ((ind (max (/ (- 80 (string-width s)) 2) 0)))
+ (let ((ind (max (/ (- fill-column (string-width s)) 2) 0)))
(insert (make-string ind ?\ ) s "\n")
(if underline
(insert (make-string ind ?\ )
@@ -1984,6 +2375,7 @@
#+DRAWERS: %s
#+STARTUP: %s %s %s %s %s
#+TAGS: %s
+#+FILETAGS: %s
#+ARCHIVE: %s
#+LINK: %s
"
@@ -2006,7 +2398,7 @@
org-export-skip-text-before-1st-heading
org-export-with-drawers
org-export-with-tags
- (if (featurep 'org-infojs) (org-infojs-options-inbuffer-template) "")
+ (if (featurep 'org-jsinfo) (org-infojs-options-inbuffer-template) "")
org-export-html-link-up
org-export-html-link-home
(file-name-nondirectory buffer-file-name)
@@ -2029,10 +2421,21 @@
((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-export-html-preprocess (parameters)
+ ;; Convert LaTeX fragments to images
+ (when (plist-get parameters :LaTeX-fragments)
+ (org-format-latex
+ (concat "ltxpng/" (file-name-sans-extension
+ (file-name-nondirectory
+ org-current-export-file)))
+ org-current-export-dir nil "Creating LaTeX image %s"))
+ (message "Exporting..."))
+
;;;###autoload
(defun org-insert-export-options-template ()
"Insert into the buffer a template with information for exporting."
@@ -2171,12 +2574,17 @@
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
(when region-p
(save-excursion
- (goto-char (region-beginning))
+ (goto-char rbeg)
(and (org-at-heading-p)
- (>= (org-end-of-subtree t t) (region-end))))))
+ (>= (org-end-of-subtree t t) rend)))))
+ (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
@@ -2222,7 +2630,7 @@
(inquote nil)
(infixed nil)
(in-local-list nil)
- (local-list-num nil)
+ (local-list-type nil)
(local-list-indent nil)
(llt org-plain-list-ordered-item-terminator)
(email (plist-get opt-plist :email))
@@ -2262,9 +2670,9 @@
"[\r\n]"))
table-open type
table-buffer table-orig-buffer
- ind start-is-num starter didclose
+ ind item-type starter didclose
rpl path desc descp desc1 desc2 link
- snumber fnc
+ snumber fnc item-tag
)
(let ((inhibit-read-only t))
@@ -2435,7 +2843,7 @@
(setq infixed t)
(insert "<pre>\n"))
(insert (org-html-protect (match-string 1 line)) "\n")
- (when (and lines
+ (when (or (not lines)
(not (string-match "^[ \t]*\\(:.*\\)"
(car lines))))
(setq infixed nil)
@@ -2451,6 +2859,7 @@
(replace-match "\\2\n"))
(insert line "\n")
(while (and lines
+ (not (string-match "^[ \t]*:" (car lines)))
(or (= (length (car lines)) 0)
(get-text-property 0 'org-protected (car lines))))
(insert (pop lines) "\n"))
@@ -2462,6 +2871,20 @@
(insert "\n<hr/>\n")
(throw 'nextline nil))
+ ;; Blockquotes and verse
+ (when (equal "ORG-BLOCKQUOTE-START" line)
+ (insert "<blockquote>\n<p>\n")
+ (throw 'nextline nil))
+ (when (equal "ORG-BLOCKQUOTE-END" line)
+ (insert "</p>\n</blockquote>\n")
+ (throw 'nextline nil))
+ (when (equal "ORG-VERSE-START" line)
+ (insert "<verse>\n<p>\n")
+ (throw 'nextline nil))
+ (when (equal "ORG-VERSE-END" line)
+ (insert "</p>\n</verse>\n")
+ (throw 'nextline nil))
+
;; make targets to anchors
(while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[
\t]*\n?" line)
(cond
@@ -2620,10 +3043,10 @@
(setq head-count (+ head-count 1)))
(when in-local-list
;; Close any local lists before inserting a new header line
- (while local-list-num
- (org-close-li)
- (insert (if (car local-list-num) "</ol>\n" "</ul>"))
- (pop local-list-num))
+ (while local-list-type
+ (org-close-li (car local-list-type))
+ (insert (format "</%sl>\n" (car local-list-type)))
+ (pop local-list-type))
(setq local-list-indent nil
in-local-list nil))
(setq first-heading-pos (or first-heading-pos (point)))
@@ -2661,11 +3084,17 @@
(t (error "Invalid value of
`org-plain-list-ordered-item-terminator'")))
line)
(setq ind (org-get-string-indentation line)
- start-is-num (match-beginning 4)
+ item-type (if (match-beginning 4) "o" "u")
starter (if (match-beginning 2)
(substring (match-string 2 line) 0 -1))
- line (substring line (match-beginning 5)))
- (unless (string-match "[^ \t]" line)
+ line (substring line (match-beginning 5))
+ item-tag nil)
+ (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line))
+ (setq item-type "d"
+ item-tag (match-string 1 line)
+ line (substring line (match-end 0))))
+ (when (and (not (equal item-type "d"))
+ (not (string-match "[^ \t]" line)))
;; empty line. Pretend indentation is large.
(setq ind (if org-empty-line-terminates-plain-lists
0
@@ -2676,9 +3105,9 @@
(not starter))
(< ind (car local-list-indent))))
(setq didclose t)
- (org-close-li)
- (insert (if (car local-list-num) "</ol>\n" "</ul>"))
- (pop local-list-num) (pop local-list-indent)
+ (org-close-li (car local-list-type))
+ (insert (format "</%sl>\n" (car local-list-type)))
+ (pop local-list-type) (pop local-list-indent)
(setq in-local-list local-list-indent))
(cond
((and starter
@@ -2686,14 +3115,21 @@
(> ind (car local-list-indent))))
;; Start new (level of) list
(org-close-par-maybe)
- (insert (if start-is-num "<ol>\n<li>\n" "<ul>\n<li>\n"))
- (push start-is-num local-list-num)
+ (insert (cond
+ ((equal item-type "u") "<ul>\n<li>\n")
+ ((equal item-type "o") "<ol>\n<li>\n")
+ ((equal item-type "d")
+ (format "<dl>\n<dt>%s</dt><dd>\n" item-tag))))
+ (push item-type local-list-type)
(push ind local-list-indent)
(setq in-local-list t))
(starter
;; continue current list
- (org-close-li)
- (insert "<li>\n"))
+ (org-close-li (car local-list-type))
+ (insert (cond
+ ((equal (car local-list-type) "d")
+ (format "<dt>%s</dt><dd>\n" (or item-tag "???")))
+ (t "<li>\n"))))
(didclose
;; we did close a list, normal text follows: need <p>
(org-open-par)))
@@ -2716,7 +3152,8 @@
(org-close-par-maybe)
(let ((n (match-string 1 line)))
(setq line (replace-match
- (format "<p class=\"footnote\"><sup><a
class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t
line)))))
+ (format "<p class=\"footnote\"><sup><a
class=\"footnum\" name=\"fn.%s\" href=\"#fnr.%s\">%s</a></sup>" n n n) t t
line))
+ (setq line (concat line "</p>")))))
;; Check if the line break needs to be conserved
(cond
@@ -2731,10 +3168,10 @@
(when inquote (insert "</pre>\n"))
(when in-local-list
;; Close any local lists before inserting a new header line
- (while local-list-num
- (org-close-li)
- (insert (if (car local-list-num) "</ol>\n" "</ul>\n"))
- (pop local-list-num))
+ (while local-list-type
+ (org-close-li (car local-list-type))
+ (insert (format "</%sl>\n" (car local-list-type)))
+ (pop local-list-type))
(setq local-list-indent nil
in-local-list nil))
(org-html-level-start 1 nil umax
@@ -2762,6 +3199,8 @@
(insert "<p class=\"date\"> "
(nth 2 lang-words) ": "
date "</p>\n"))
+ (insert (format "<p>HTML generated by org-mode %s in emacs %s<\p>\n"
+ org-version emacs-major-version))
(insert "</div>"))
(if org-export-html-with-timestamp
@@ -3106,6 +3545,54 @@
(setq r (concat r "@<br/>")))
r))))
+(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))))
+
+;;;###autoload
+(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))))
+ (switch-to-buffer "*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 & to &, < to < and > to >
(let ((start 0))
@@ -3280,10 +3767,10 @@
(when org-par-open
(insert "</p>")
(setq org-par-open nil)))
-(defun org-close-li ()
+(defun org-close-li (&optional type)
"Close <li> if necessary."
(org-close-par-maybe)
- (insert "</li>\n"))
+ (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)
@@ -3417,12 +3904,17 @@
(when (or (and combine (not files)) (not combine))
(org-finish-icalendar-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.
@@ -3440,7 +3932,8 @@
(format-time-string (cdr org-time-stamp-formats) (current-time))
"DTSTART"))
hd ts ts2 state status (inc t) pos b sexp rrule
- scheduledp deadlinep tmp pri category entry location summary desc
+ scheduledp deadlinep prefix
+ tmp pri category entry location summary desc uid
(sexp-buffer (get-buffer-create "*ical-tmp*")))
(org-refresh-category-properties)
(save-excursion
@@ -3456,7 +3949,9 @@
(setq pos (match-beginning 0)
ts (match-string 0)
inc t
- hd (condition-case nil (org-get-heading)
+ hd (condition-case nil
+ (org-icalendar-cleanup-string
+ (org-get-heading))
(error (throw :skip nil)))
summary (org-icalendar-cleanup-string
(org-entry-get nil "SUMMARY"))
@@ -3466,11 +3961,16 @@
t org-icalendar-include-body)
location (org-icalendar-cleanup-string
(org-entry-get nil "LOCATION"))
- category (org-get-category))
+ uid (if org-icalendar-store-UID
+ (org-id-get-create)
+ (or (org-id-get) (org-id-new)))
+ category (org-get-category)
+ deadlinep nil scheduledp nil)
(if (looking-at re2)
(progn
(goto-char (match-end 0))
- (setq ts2 (match-string 1) inc nil))
+ (setq ts2 (match-string 1)
+ inc (not (string-match "[0-9]\\{1,2\\}:[0-9][0-9]" ts2))))
(setq tmp (buffer-substring (max (point-min)
(- pos org-ds-keyword-length))
pos)
@@ -3483,6 +3983,7 @@
scheduledp (string-match org-scheduled-regexp tmp)
;; donep (org-entry-is-done-p)
))
+ (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)))
@@ -3508,11 +4009,13 @@
(with-current-buffer sexp-buffer
(insert (substring ts 1 -1) " " summary "\n"))
(princ (format "BEGIN:VEVENT
+UID: %s
%s
%s%s
SUMMARY:%s%s%s
CATEGORIES:%s
END:VEVENT\n"
+ (concat prefix uid)
(org-ical-ts-to-string ts "DTSTART")
(org-ical-ts-to-string ts2 "DTEND" inc)
rrule summary
@@ -3521,7 +4024,6 @@
(if (and location (string-match "\\S-" location))
(concat "\nLOCATION: " location) "")
category)))))
-
(when (and org-icalendar-include-sexps
(condition-case nil (require 'icalendar) (error nil))
(fboundp 'icalendar-export-region))
@@ -3536,10 +4038,12 @@
(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)))))
+ (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-todo-line-regexp nil t)
(catch :skip
@@ -3565,7 +4069,10 @@
(and org-icalendar-include-body (org-get-entry)))
t org-icalendar-include-body)
location (org-icalendar-cleanup-string
- (org-entry-get nil "LOCATION")))
+ (org-entry-get nil "LOCATION"))
+ uid (if org-icalendar-store-UID
+ (org-id-get-create)
+ (or (org-id-get) (org-id-new))))
(if (string-match org-bracket-link-regexp hd)
(setq hd (replace-match (if (match-end 3) (match-string 3 hd)
(match-string 1 hd))
@@ -3579,6 +4086,7 @@
(- org-lowest-priority
org-highest-priority))))))
(princ (format "BEGIN:VTODO
+UID: %s
%s
SUMMARY:%s%s%s
CATEGORIES:%s
@@ -3586,13 +4094,15 @@
PRIORITY:%d
STATUS:%s
END:VTODO\n"
+ (concat prefix uid)
dts
(or summary hd)
(if (and location (string-match "\\S-" location))
(concat "\nLOCATION: " location) "")
(if (and desc (string-match "\\S-" desc))
(concat "\nDESCRIPTION: " desc) "")
- category pri status)))))))))
+ category
+ pri status)))))))))
(defun org-icalendar-cleanup-string (s &optional is-body maxlength)
"Take out stuff and quote what needs to be quoted.
@@ -3607,7 +4117,7 @@
(while (string-match re s) (setq s (replace-match "" t t s)))
(while (string-match re2 s) (setq s (replace-match "" t t s)))))
(let ((start 0))
- (while (string-match "\\([,;\\]\\)" s start)
+ (while (string-match "\\([,;]\\)" s start)
(setq start (+ (match-beginning 0) 2)
s (replace-match "\\\\\\1" nil nil s))))
(when is-body
@@ -3756,12 +4266,7 @@
(provide 'org-exp)
-;;; org-exp.el ends here
+;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
+;;; org-exp.el ends here
-(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)
-;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/org/org-exp.el,v,
Carsten Dominik <=