[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: |
Thu, 24 Jul 2008 13:59:59 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Carsten Dominik <cdominik> 08/07/24 13:59:57
Index: org-exp.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/org/org-exp.el,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -b -r1.5 -r1.6
--- org-exp.el 17 Jun 2008 15:21:57 -0000 1.5
+++ org-exp.el 24 Jul 2008 13:59:53 -0000 1.6
@@ -5,7 +5,7 @@
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;; Homepage: http://orgmode.org
-;; Version: 6.05a
+;; Version: 6.06a
;;
;; This file is part of GNU Emacs.
;;
@@ -209,6 +209,12 @@
:group 'org-export-general
:type 'boolean)
+(defcustom org-export-creator-info t
+ "Non-nil means, the postamle 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.
@@ -466,57 +472,69 @@
:group 'org-export-html
:type '(string :tag "File or URL"))
-(defcustom org-export-html-style
+(defconst org-export-html-style-default
"<style type=\"text/css\">
- html {
- font-family: Times, serif;
- font-size: 12pt;
- }
+ html { font-family: Times, serif; font-size: 12pt; }
.title { text-align: center; }
.todo { color: red; }
.done { color: green; }
- .timestamp { color: grey }
- .timestamp-kwd { color: CadetBlue }
.tag { background-color:lightblue; font-weight:normal }
.target { }
+ .timestamp { color: grey }
+ .timestamp-kwd { color: CadetBlue }
+ 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;
- <!--border: 1pt solid #ADB9CC;-->
- }
+ td, th { vertical-align: top; }
dt { font-weight: bold; }
</style>"
"The default style specification for exported HTML files.
-Since there are different ways of setting style information, this variable
-needs to contain the full HTML structure to provide a style, including the
-surrounding HTML tags. The style specifications should include definitions
-for new classes todo, done, title, and deadline. For example, valid values
-would be:
+Please use the variables `org-export-html-style' and
+`org-export-html-style-extra' to add to this style.")
+
+(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\">
p { font-weight: normal; color: gray; }
h1 { color: black; }
.title { text-align: center; }
- .todo, .deadline { color: red; }
+ .todo, .timestamp-kwd { color: red; }
.done { color: green; }
</style>
-or, if you want to keep the style in a file,
+If you'd like to refer to en 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."
+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)
+(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)
(defcustom org-export-html-title-format "<h1 class=\"title\">%s</h1>\n"
"Format for typesetting the document title in HTML export."
@@ -625,6 +643,46 @@
:group 'org-export-icalendar
:type 'file)
+(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-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-include-todo nil
"Non-nil means, export to iCalendar files should also cover TODO items."
:group 'org-export-icalendar
@@ -650,11 +708,6 @@
(const :tag "Everything" t)
(integer :tag "Max characters")))
-(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-store-UID nil
"Non-nil means, store any created UIDs in properties.
The iCalendar standard requires that all entries have a unique identifyer.
@@ -709,10 +762,12 @@
(:fixed-width . org-export-with-fixed-width)
(:timestamps . org-export-with-timestamps)
(:author-info . org-export-author-info)
+ (:creator-info . org-export-creator-info)
(:time-stamp-file . org-export-time-stamp-file)
(:tables . org-export-with-tables)
(:table-auto-headline . org-export-highlight-first-table-line)
(:style . org-export-html-style)
+ (:style-extra . org-export-html-style-extra)
(:agenda-style . org-agenda-export-html-style)
(:convert-org-links . org-export-html-link-org-files-as-html)
(:inline-images . org-export-html-inline-images)
@@ -1361,15 +1416,15 @@
;; 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
+ (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)
- ;; 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))
@@ -1380,10 +1435,12 @@
(defun org-export-kill-licensed-text ()
"Remove all text that is marked with a :org-license-to-kill property."
- (let (p)
+ (let (p q)
(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)))))
+ (delete-region
+ p (or (next-single-property-change p :org-license-to-kill)
+ (point-max))))))
(defun org-export-define-heading-targets (target-alist)
"Find all headings and define the targets for them.
@@ -1437,9 +1494,14 @@
(slink (org-solidify-link-text link))
found props pos
(target
- (or (cdr (assoc slink target-alist))
+ (cond
+ ((cdr (assoc slink target-alist)))
+ ((string-match org-link-types-re link) nil)
+ ((or (file-name-absolute-p link)
+ (string-match "^\\." link))
+ nil)
+ (t
(save-excursion
- (unless (string-match org-link-types-re link)
(setq found (condition-case nil (org-link-search link)
(error nil)))
(when (and found
@@ -1577,7 +1639,8 @@
(defun org-export-remove-comment-blocks-and-subtrees ()
"Remove the comment environment, and also commented subtrees."
- (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>")))
+ (let ((re-commented (concat "^\\*+[ \t]+" org-comment-string "\\>"))
+ (case-fold-search nil))
;; Remove comment environment
(goto-char (point-min))
(while (re-search-forward
@@ -1653,6 +1716,7 @@
(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)))
(org-if-unprotected
(let* ((xx (save-match-data
(org-link-expand-abbrev (match-string 1))))
@@ -1835,10 +1899,12 @@
(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)
+ params file markup lang start end prefix prefix1)
(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)
file (org-symname-or-string (pop params))
markup (org-symname-or-string (pop params))
lang (org-symname-or-string (pop params)))
@@ -1854,17 +1920,45 @@
(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))))
+ (insert (org-get-file-contents (expand-file-name file) prefix prefix1))
(or (bolp) (newline))
(insert (or end ""))))))
+(defun org-get-file-contents (file &optional prefix prefix1)
+ "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."
+ (with-temp-buffer
+ (insert-file-contents file)
+ (when (or prefix prefix1)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert (or prefix1 prefix))
+ (setq prefix1 nil)
+ (beginning-of-line 2)))
+ (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 of code
-;; Currently only for th HTML backend, but who knows....
+;; Currently only for the 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)
@@ -1915,7 +2009,8 @@
(org-export-htmlize-region-for-paste
(point-min) (point-max)))))
(if (string-match "<pre\\([^>]*\\)>\n?" htmltext)
- (setq htmltext (replace-match "<pre class=\"src\">"
+ (setq htmltext (replace-match
+ (format "<pre class=\"src src-%s\">" lang)
t t htmltext)))
(concat "#+BEGIN_HTML\n" htmltext "\n#+END_HTML\n"))))
(t
@@ -2053,7 +2148,7 @@
((and date (string-match "%" date))
(setq date (format-time-string date)))
(date)
- (t (setq date (format-time-string "%Y/%m/%d %X"))))
+ (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")))
@@ -2516,12 +2611,13 @@
(when (interactive-p)
(setq buffer "*Org HTML Export*"))
(let ((transient-mark-mode t) (zmacs-regions t)
- rtn)
+ ext-plist rtn)
+ (setq ext-plist (plist-put ext-plist :ignore-subree-p t))
(goto-char end)
(set-mark (point)) ;; to activate the region
(goto-char beg)
(setq rtn (org-export-as-html
- nil nil nil
+ nil nil ext-plist
buffer body-only))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(if (and (interactive-p) (bufferp rtn))
@@ -2568,7 +2664,9 @@
ext-plist
(org-infile-export-plist))))
- (style (plist-get opt-plist :style))
+ (style (concat org-export-html-style-default
+ (plist-get opt-plist :style)
+ (plist-get opt-plist :style-extra)))
(html-extension (plist-get opt-plist :html-extension))
(link-validate (plist-get opt-plist :link-validation-function))
valid thetoc have-headings first-heading-pos
@@ -2577,11 +2675,13 @@
(rbeg (and region-p (region-beginning)))
(rend (and region-p (region-end)))
(subtree-p
+ (if (plist-get opt-plist :ignore-subree-p)
+ nil
(when region-p
(save-excursion
(goto-char rbeg)
(and (org-at-heading-p)
- (>= (org-end-of-subtree t t) rend)))))
+ (>= (org-end-of-subtree t t) rend))))))
(opt-plist (if subtree-p
(org-export-add-subtree-options opt-plist rbeg)
opt-plist))
@@ -2629,6 +2729,7 @@
(quote-re (concat "^\\(\\*+\\)\\([ \t]+" org-quote-string "\\>\\)"))
(inquote nil)
(infixed nil)
+ (inverse nil)
(in-local-list nil)
(local-list-type nil)
(local-list-indent nil)
@@ -2671,7 +2772,7 @@
table-open type
table-buffer table-orig-buffer
ind item-type starter didclose
- rpl path desc descp desc1 desc2 link
+ rpl path attr desc descp desc1 desc2 link
snumber fnc item-tag
)
@@ -2690,7 +2791,7 @@
((and date (string-match "%" date))
(setq date (format-time-string date)))
(date)
- (t (setq date (format-time-string "%Y/%m/%d %X"))))
+ (t (setq date (format-time-string "%Y-%m-%d %T %Z"))))
;; Get the language-dependent settings
(setq lang-words (or (assoc language org-export-language-setup)
@@ -2836,12 +2937,12 @@
(insert (org-html-protect line) "\n")
(throw 'nextline nil))
- ;; verbatim lines
+ ;; Fixed-width, verbatim lines (examples)
(when (and org-export-with-fixed-width
(string-match "^[ \t]*:\\(.*\\)" line))
(when (not infixed)
(setq infixed t)
- (insert "<pre>\n"))
+ (insert "<pre class=\"example\">\n"))
(insert (org-html-protect (match-string 1 line)) "\n")
(when (or (not lines)
(not (string-match "^[ \t]*\\(:.*\\)"
@@ -2879,11 +2980,20 @@
(insert "</p>\n</blockquote>\n")
(throw 'nextline nil))
(when (equal "ORG-VERSE-START" line)
- (insert "<verse>\n<p>\n")
+ (insert "\n<p class=\"verse\">\n")
+ (setq inverse t)
(throw 'nextline nil))
(when (equal "ORG-VERSE-END" line)
- (insert "</p>\n</verse>\n")
+ (insert "</p>\n")
+ (setq inverse nil)
(throw 'nextline nil))
+ (when inverse
+ (setq i (org-get-string-indentation line))
+ (if (> i 0)
+ (setq line (concat (mapconcat 'identity
+ (make-list (* 2 i) "\\nbsp") "")
+ " " (org-trim line))))
+ (setq line (concat line " \\\\")))
;; make targets to anchors
(while (string-match "<<<?\\([^<>]*\\)>>>?\\((INVISIBLE)\\)?[
\t]*\n?" line)
@@ -2919,8 +3029,18 @@
(setq start 0)
(while (string-match org-bracket-link-analytic-regexp line start)
(setq start (match-beginning 0))
- (setq type (if (match-end 2) (match-string 2 line) "internal"))
- (setq path (match-string 3 line))
+ (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 (org-attributes-to-string
+ (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)))
@@ -2939,19 +3059,27 @@
"<a href=\"#"
(org-solidify-link-text
(save-match-data (org-link-unescape path)) nil)
- "\">" desc "</a>")))
+ "\"" attr ">" desc "</a>")))
((member type '("http" "https"))
;; standard URL, just check if we need to inline an image
(if (and (or (eq t org-export-html-inline-images)
(and org-export-html-inline-images (not descp)))
(org-file-image-p path))
- (setq rpl (concat "<img src=\"" type ":" path "\"/>"))
+ (setq rpl (concat "<img src=\"" type ":" path "\"" attr "/>"))
(setq link (concat type ":" path))
- (setq rpl (concat "<a href=\"" link "\">" desc "</a>"))))
+ (setq rpl (concat "<a href=\"" link "\"" attr ">"
+ desc "</a>"))))
((member type '("ftp" "mailto" "news"))
;; standard URL
(setq link (concat type ":" path))
(setq rpl (concat "<a href=\"" link "\">" desc "</a>")))
+
+ ((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
(let* ((filename path)
@@ -2988,15 +3116,11 @@
(or (eq t org-export-html-inline-images)
(and org-export-html-inline-images
(not descp))))
- (concat "<img src=\"" thefile "\"/>")
- (concat "<a href=\"" thefile "\">" desc "</a>")))
+ (concat "<img src=\"" thefile "\"" attr "/>")
+ (concat "<a href=\"" thefile "\"" attr ">"
+ desc "</a>")))
(if (not valid) (setq rpl desc))))
- ((functionp (setq fnc (nth 2 (assoc type org-link-protocols))))
- (setq rpl
- (save-match-data
- (funcall fnc (org-link-unescape path) desc1 'html))))
-
(t
;; just publish the path, as default
(setq rpl (concat "<i><" type ":"
@@ -3199,8 +3323,9 @@
(insert "<p class=\"date\"> "
(nth 2 lang-words) ": "
date "</p>\n"))
+ (when org-export-creator-info
(insert (format "<p>HTML generated by org-mode %s in emacs %s<\p>\n"
- org-version emacs-major-version))
+ org-version emacs-major-version)))
(insert "</div>"))
(if org-export-html-with-timestamp
@@ -3256,6 +3381,7 @@
(kill-buffer (current-buffer)))
(current-buffer)))))
+
(defvar org-table-colgroup-info nil)
(defun org-format-table-ascii (lines)
"Format a table for ascii export."
@@ -3516,6 +3642,16 @@
(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
@@ -3932,7 +4068,7 @@
(format-time-string (cdr org-time-stamp-formats) (current-time))
"DTSTART"))
hd ts ts2 state status (inc t) pos b sexp rrule
- scheduledp deadlinep prefix
+ scheduledp deadlinep todo prefix due start
tmp pri category entry location summary desc uid
(sexp-buffer (get-buffer-create "*ical-tmp*")))
(org-refresh-category-properties)
@@ -3981,8 +4117,21 @@
ts)
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)
))
+ (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))
@@ -4070,9 +4219,16 @@
t org-icalendar-include-body)
location (org-icalendar-cleanup-string
(org-entry-get nil "LOCATION"))
+ 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"))
uid (if org-icalendar-store-UID
(org-id-get-create)
(or (org-id-get) (org-id-new))))
+ (and due (setq due (org-ical-ts-to-string due "DUE")))
+ (and start (setq start (org-ical-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))
@@ -4088,19 +4244,20 @@
(princ (format "BEGIN:VTODO
UID: %s
%s
-SUMMARY:%s%s%s
+SUMMARY:%s%s%s%s
CATEGORIES:%s
SEQUENCE:1
PRIORITY:%d
STATUS:%s
END:VTODO\n"
(concat prefix uid)
- dts
+ (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) "")
category
pri status)))))))))
@@ -4269,4 +4426,3 @@
;; arch-tag: 65985fe9-095c-49c7-a7b6-cb4ee15c0a95
;;; org-exp.el ends here
-
- [Emacs-diffs] Changes to emacs/lisp/org/org-exp.el,v,
Carsten Dominik <=