Merge branch 'master-fixes-8'
This commit is contained in:
Bastien Guerry
commit
66d6a6c450
|
|
@ -1,9 +0,0 @@
|
|||
This directory contains the obsolete libraries for exporting .org
|
||||
files to various formats.
|
||||
|
||||
It is kept here for archiving purpose and to ease the reading of the
|
||||
source code, in case it helps with users migrating to the new export
|
||||
engine.
|
||||
|
||||
If you want to use the old exporters, you should checkout the maint
|
||||
branch of Org's repository and reload Org.
|
||||
|
|
@ -1,720 +0,0 @@
|
|||
;;; org-ascii.el --- ASCII export for Org-mode
|
||||
|
||||
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;;
|
||||
;; This file is part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org-exp)
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org-export-ascii nil
|
||||
"Options specific for ASCII export of Org-mode files."
|
||||
:tag "Org Export ASCII"
|
||||
:group 'org-export)
|
||||
|
||||
(defcustom org-export-ascii-underline '(?\= ?\- ?\~ ?\^ ?\. ?\# ?\$)
|
||||
"Characters for underlining headings in ASCII export.
|
||||
In the given sequence, these characters will be used for level 1, 2, ..."
|
||||
:group 'org-export-ascii
|
||||
:type '(repeat character))
|
||||
|
||||
(defcustom org-export-ascii-bullets '(?* ?+ ?-)
|
||||
"Bullet characters for headlines converted to lists in ASCII export.
|
||||
The first character is used for the first lest level generated in this
|
||||
way, and so on. If there are more levels than characters given here,
|
||||
the list will be repeated.
|
||||
Note that plain lists will keep the same bullets as the have in the
|
||||
Org-mode file."
|
||||
:group 'org-export-ascii
|
||||
:type '(repeat character))
|
||||
|
||||
(defcustom org-export-ascii-links-to-notes t
|
||||
"Non-nil means convert links to notes before the next headline.
|
||||
When nil, the link will be exported in place. If the line becomes long
|
||||
in this way, it will be wrapped."
|
||||
:group 'org-export-ascii
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-export-ascii-table-keep-all-vertical-lines nil
|
||||
"Non-nil means keep all vertical lines in ASCII tables.
|
||||
When nil, vertical lines will be removed except for those needed
|
||||
for column grouping."
|
||||
:group 'org-export-ascii
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-export-ascii-table-widen-columns t
|
||||
"Non-nil means widen narrowed columns for export.
|
||||
When nil, narrowed columns will look in ASCII export just like in org-mode,
|
||||
i.e. with \"=>\" as ellipsis."
|
||||
:group 'org-export-ascii
|
||||
:type 'boolean)
|
||||
|
||||
(defvar org-export-ascii-entities 'ascii
|
||||
"The ascii representation to be used during ascii export.
|
||||
Possible values are:
|
||||
|
||||
ascii Only use plain ASCII characters
|
||||
latin1 Include Latin-1 character
|
||||
utf8 Use all UTF-8 characters")
|
||||
|
||||
;;; Hooks
|
||||
|
||||
(defvar org-export-ascii-final-hook nil
|
||||
"Hook run at the end of ASCII export, in the new buffer.")
|
||||
|
||||
;;; ASCII export
|
||||
|
||||
(defvar org-ascii-current-indentation nil) ; For communication
|
||||
|
||||
(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))
|
||||
|
||||
(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))
|
||||
|
||||
(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))
|
||||
|
||||
(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))))
|
||||
|
||||
|
||||
(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*")))
|
||||
|
||||
(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)))
|
||||
|
||||
(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)))
|
||||
|
||||
(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))))
|
||||
|
||||
(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:
|
||||
;; End:
|
||||
|
||||
;;; org-ascii.el ends here
|
||||
|
|
@ -1,655 +0,0 @@
|
|||
;;; org-beamer.el --- Beamer-specific LaTeX export for org-mode
|
||||
;;
|
||||
;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com>
|
||||
;; Maintainer: Carsten Dominik <carsten.dominik AT gmail DOT com>
|
||||
;; Keywords: org, wp, tex
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This library implement the special treatment needed by using the
|
||||
;; beamer class during LaTeX export.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org)
|
||||
(require 'org-exp)
|
||||
|
||||
(defvar org-export-latex-header)
|
||||
(defvar org-export-latex-options-plist)
|
||||
(defvar org-export-opt-plist)
|
||||
|
||||
(defgroup org-beamer nil
|
||||
"Options specific for using the beamer class in LaTeX export."
|
||||
:tag "Org Beamer"
|
||||
:group 'org-export-latex)
|
||||
|
||||
(defcustom org-beamer-use-parts nil
|
||||
""
|
||||
:group 'org-beamer
|
||||
:version "24.1"
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-beamer-frame-level 1
|
||||
"The level that should be interpreted as a frame.
|
||||
The levels above this one will be translated into a sectioning structure.
|
||||
Setting this to 2 will allow sections, 3 will allow subsections as well.
|
||||
You can set this to 4 as well, if you at the same time set
|
||||
`org-beamer-use-parts' to make the top levels `\part'."
|
||||
:group 'org-beamer
|
||||
:version "24.1"
|
||||
:type '(choice
|
||||
(const :tag "Frames need a BEAMER_env property" nil)
|
||||
(integer :tag "Specific level makes a frame")))
|
||||
|
||||
(defcustom org-beamer-frame-default-options ""
|
||||
"Default options string to use for frames, should contains the [brackets].
|
||||
And example for this is \"[allowframebreaks]\"."
|
||||
:group 'org-beamer
|
||||
:version "24.1"
|
||||
:type '(string :tag "[options]"))
|
||||
|
||||
(defcustom org-beamer-column-view-format
|
||||
"%45ITEM %10BEAMER_env(Env) %10BEAMER_envargs(Env Args) %4BEAMER_col(Col) %8BEAMER_extra(Extra)"
|
||||
"Default column view format that should be used to fill the template."
|
||||
:group 'org-beamer
|
||||
:version "24.1"
|
||||
:type '(choice
|
||||
(const :tag "Do not insert Beamer column view format" nil)
|
||||
(string :tag "Beamer column view format")))
|
||||
|
||||
(defcustom org-beamer-themes
|
||||
"\\usetheme{default}\\usecolortheme{default}"
|
||||
"Default string to be used for extra heading stuff in beamer presentations.
|
||||
When a beamer template is filled, this will be the default for
|
||||
BEAMER_HEADER_EXTRA, which will be inserted just before \\begin{document}."
|
||||
:group 'org-beamer
|
||||
:version "24.1"
|
||||
:type '(choice
|
||||
(const :tag "Do not insert Beamer themes" nil)
|
||||
(string :tag "Beamer themes")))
|
||||
|
||||
(defconst org-beamer-column-widths
|
||||
"0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC"
|
||||
"The column widths that should be installed as allowed property values.")
|
||||
|
||||
(defconst org-beamer-transitions
|
||||
"\transblindsvertical \transblindshorizontal \transboxin \transboxout \transdissolve \transduration \transglitter \transsplithorizontalin \transsplithorizontalout \transsplitverticalin \transsplitverticalout \transwipe :ETC"
|
||||
"Transitions available for beamer.
|
||||
These are just a completion help.")
|
||||
|
||||
(defconst org-beamer-environments-default
|
||||
'(("frame" "f" "dummy- special handling hard coded" "dummy")
|
||||
("columns" "C" "\\begin{columns}%o %% %h%x" "\\end{columns}")
|
||||
("column" "c" "\\begin{column}%o{%h\\textwidth}%x" "\\end{column}")
|
||||
("block" "b" "\\begin{block}%a{%h}%x" "\\end{block}")
|
||||
("alertblock" "a" "\\begin{alertblock}%a{%h}%x" "\\end{alertblock}")
|
||||
("verse" "v" "\\begin{verse}%a %% %h%x" "\\end{verse}")
|
||||
("quotation" "q" "\\begin{quotation}%a %% %h%x" "\\end{quotation}")
|
||||
("quote" "Q" "\\begin{quote}%a %% %h%x" "\\end{quote}")
|
||||
("structureenv" "s" "\\begin{structureenv}%a %% %h%x" "\\end{structureenv}")
|
||||
("theorem" "t" "\\begin{theorem}%a%U%x" "\\end{theorem}")
|
||||
("definition" "d" "\\begin{definition}%a%U%x" "\\end{definition}")
|
||||
("example" "e" "\\begin{example}%a%U%x" "\\end{example}")
|
||||
("exampleblock" "E" "\\begin{exampleblock}%a{%h}%x" "\\end{exampleblock}")
|
||||
("proof" "p" "\\begin{proof}%a%U%x" "\\end{proof}")
|
||||
("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}%x" "\\end{beamercolorbox}")
|
||||
("normal" "h" "%h" "") ; Emit the heading as normal text
|
||||
("note" "n" "\\note%o%a{%h" "}")
|
||||
("noteNH" "N" "\\note%o%a{" "}") ; note, ignore heading
|
||||
("ignoreheading" "i" "%%%% %h" ""))
|
||||
"Environments triggered by properties in Beamer export.
|
||||
These are the defaults - for user definitions, see
|
||||
`org-beamer-environments-extra'.
|
||||
\"normal\" is a special fake environment, which emit the heading as
|
||||
normal text. It is needed when an environment should be surrounded
|
||||
by normal text. Since beamer export converts nodes into environments,
|
||||
you need to have a node to end the environment.
|
||||
For example
|
||||
|
||||
** a frame
|
||||
some text
|
||||
*** Blocktitle :B_block:
|
||||
inside the block
|
||||
*** After the block :B_normal:
|
||||
continuing here
|
||||
** next frame")
|
||||
|
||||
(defcustom org-beamer-environments-extra nil
|
||||
"Environments triggered by tags in Beamer export.
|
||||
Each entry has 4 elements:
|
||||
|
||||
name Name of the environment
|
||||
key Selection key for `org-beamer-select-environment'
|
||||
open The opening template for the environment, with the following escapes
|
||||
%a the action/overlay specification
|
||||
%A the default action/overlay specification
|
||||
%o the options argument of the template
|
||||
%h the headline text
|
||||
%H if there is headline text, that text in {} braces
|
||||
%U if there is headline text, that text in [] brackets
|
||||
%x the content of the BEAMER_extra property
|
||||
close The closing string of the environment."
|
||||
|
||||
:group 'org-beamer
|
||||
:version "24.1"
|
||||
:type '(repeat
|
||||
(list
|
||||
(string :tag "Environment")
|
||||
(string :tag "Selection key")
|
||||
(string :tag "Begin")
|
||||
(string :tag "End"))))
|
||||
|
||||
(defcustom org-beamer-inherited-properties nil
|
||||
"Properties that should be inherited during beamer export."
|
||||
:group 'org-beamer
|
||||
:type '(repeat
|
||||
(string :tag "Property")))
|
||||
|
||||
(defvar org-beamer-frame-level-now nil)
|
||||
(defvar org-beamer-header-extra nil)
|
||||
(defvar org-beamer-export-is-beamer-p nil)
|
||||
(defvar org-beamer-inside-frame-at-level nil)
|
||||
(defvar org-beamer-columns-open nil)
|
||||
(defvar org-beamer-column-open nil)
|
||||
|
||||
(defun org-beamer-cleanup-column-width (width)
|
||||
"Make sure the width is not empty, and that it has a unit."
|
||||
(setq width (org-trim (or width "")))
|
||||
(unless (string-match "\\S-" width) (setq width "0.5"))
|
||||
(if (string-match "\\`[.0-9]+\\'" width)
|
||||
(setq width (concat width "\\textwidth")))
|
||||
width)
|
||||
|
||||
(defun org-beamer-open-column (&optional width opt)
|
||||
(org-beamer-close-column-maybe)
|
||||
(setq org-beamer-column-open t)
|
||||
(setq width (org-beamer-cleanup-column-width width))
|
||||
(insert (format "\\begin{column}%s{%s}\n" (or opt "") width)))
|
||||
(defun org-beamer-close-column-maybe ()
|
||||
(when org-beamer-column-open
|
||||
(setq org-beamer-column-open nil)
|
||||
(insert "\\end{column}\n")))
|
||||
(defun org-beamer-open-columns-maybe (&optional opts)
|
||||
(unless org-beamer-columns-open
|
||||
(setq org-beamer-columns-open t)
|
||||
(insert (format "\\begin{columns}%s\n" (or opts "")))))
|
||||
(defun org-beamer-close-columns-maybe ()
|
||||
(org-beamer-close-column-maybe)
|
||||
(when org-beamer-columns-open
|
||||
(setq org-beamer-columns-open nil)
|
||||
(insert "\\end{columns}\n")))
|
||||
|
||||
(defun org-beamer-select-environment ()
|
||||
"Select the environment to be used by beamer for this entry.
|
||||
While this uses (for convenience) a tag selection interface, the result
|
||||
of this command will be that the BEAMER_env *property* of the entry is set.
|
||||
|
||||
In addition to this, the command will also set a tag as a visual aid, but
|
||||
the tag does not have any semantic meaning."
|
||||
(interactive)
|
||||
(let* ((envs (append org-beamer-environments-extra
|
||||
org-beamer-environments-default))
|
||||
(org-tag-alist
|
||||
(append '((:startgroup))
|
||||
(mapcar (lambda (e) (cons (concat "B_" (car e))
|
||||
(string-to-char (nth 1 e))))
|
||||
envs)
|
||||
'((:endgroup))
|
||||
'(("BMCOL" . ?|))))
|
||||
(org-fast-tag-selection-single-key t))
|
||||
(org-set-tags)
|
||||
(let ((tags (or (ignore-errors (org-get-tags-string)) "")))
|
||||
(cond
|
||||
((equal org-last-tag-selection-key ?|)
|
||||
(if (string-match ":BMCOL:" tags)
|
||||
(org-set-property "BEAMER_col" (read-string "Column width: "))
|
||||
(org-delete-property "BEAMER_col")))
|
||||
((string-match (concat ":B_\\("
|
||||
(mapconcat 'car envs "\\|")
|
||||
"\\):")
|
||||
tags)
|
||||
(org-entry-put nil "BEAMER_env" (match-string 1 tags)))
|
||||
(t (org-entry-delete nil "BEAMER_env"))))))
|
||||
|
||||
(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)
|
||||
|
||||
(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
|
||||
File diff suppressed because it is too large
Load Diff
|
|
@ -1,148 +0,0 @@
|
|||
;;; org-exp-bibtex.el --- Export bibtex fragments
|
||||
|
||||
;; Copyright (C) 2009-2013 Taru Karttunen
|
||||
|
||||
;; Author: Taru Karttunen <taruti@taruti.net>
|
||||
|
||||
;; This file is not currently part of GNU Emacs.
|
||||
|
||||
;; This program 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 2, or (at
|
||||
;; your option) any later version.
|
||||
|
||||
;; This program 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 this program ; see the file COPYING. If not, write to
|
||||
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
;; Boston, MA 02111-1307, USA.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is an utility to handle BibTeX export to both LaTeX and html
|
||||
;; exports. It uses the bibtex2html software from
|
||||
;; http://www.lri.fr/~filliatr/bibtex2html/
|
||||
;;
|
||||
;; The usage is as follows:
|
||||
;; #+BIBLIOGRAPHY: bibfilebasename stylename optional-options
|
||||
;; e.g. given foo.bib and using style plain:
|
||||
;; #+BIBLIOGRAPHY: foo plain option:-d
|
||||
;;
|
||||
;; Optional options are of the form:
|
||||
;;
|
||||
;; option:-foobar pass '-foobar' to bibtex2html
|
||||
;; e.g.
|
||||
;; option:-d sort by date.
|
||||
;; option:-a sort as BibTeX (usually by author) *default*
|
||||
;; option:-u unsorted i.e. same order as in .bib file
|
||||
;; option:-r reverse the sort.
|
||||
;; see the bibtex2html man page for more. Multiple options can be combined like:
|
||||
;; option:-d option:-r
|
||||
;;
|
||||
;; Limiting to only the entries cited in the document:
|
||||
;; limit:t
|
||||
|
||||
;; For LaTeX export this simply inserts the lines
|
||||
;; \bibliographystyle{plain}
|
||||
;; \bibliography{foo}
|
||||
;; into the tex-file when exporting.
|
||||
|
||||
;; For Html export it:
|
||||
;; 1) converts all \cite{foo} to links to the bibliography
|
||||
;; 2) creates a foo.html and foo_bib.html
|
||||
;; 3) includes the contents of foo.html in the exported html file
|
||||
|
||||
(require 'org)
|
||||
(require 'org-exp)
|
||||
|
||||
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
|
||||
(defun org-export-bibtex-preprocess ()
|
||||
"Export all BibTeX."
|
||||
(interactive)
|
||||
(save-window-excursion
|
||||
(setq oebp-cite-plist '())
|
||||
|
||||
;; Convert #+BIBLIOGRAPHY: name style
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^#\\+BIBLIOGRAPHY:[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\([^\r\n]*\\)" nil t)
|
||||
(let ((file (match-string 1))
|
||||
(style (match-string 2))
|
||||
(opt (org-exp-bibtex-options-to-plist (match-string 3))))
|
||||
(replace-match
|
||||
(cond
|
||||
((eq org-export-current-backend 'html) ;; We are exporting to HTML
|
||||
(let (extra-args cite-list end-hook tmp-files)
|
||||
(dolist (elt opt)
|
||||
(when (equal "option" (car elt))
|
||||
(setq extra-args (cons (cdr elt) extra-args))))
|
||||
|
||||
(when (assoc "limit" opt) ;; Limit is true - collect references
|
||||
(org-exp-bibtex-docites (lambda ()
|
||||
(dolist (c (org-split-string (match-string 1) ","))
|
||||
(add-to-list 'cite-list c))))
|
||||
;; (message "cites: %s" cite-list)
|
||||
(let ((tmp (make-temp-file "org-exp-bibtex")))
|
||||
(with-temp-file tmp (dolist (i cite-list) (insert (concat i "\n"))))
|
||||
(setq tmp-files (cons tmp tmp-files))
|
||||
(setq extra-args (append extra-args `("-citefile" ,tmp)))))
|
||||
|
||||
(when (not (eq 0 (apply 'call-process (append '("bibtex2html" nil nil nil)
|
||||
`("-a" "--nodoc" "--style" ,style "--no-header")
|
||||
extra-args
|
||||
(list (concat file ".bib"))))))
|
||||
(error "Executing bibtex2html failed"))
|
||||
|
||||
(dolist (f tmp-files) (delete-file f)))
|
||||
|
||||
(with-temp-buffer
|
||||
(save-match-data
|
||||
(insert-file-contents (concat file ".html"))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward (org-re "a name=\"\\([-_[:word:]]+\\)\">\\([[:word:]]+\\)") nil t)
|
||||
(setq oebp-cite-plist (cons (cons (match-string 1) (match-string 2)) oebp-cite-plist)))
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "<hr>" nil t)
|
||||
(replace-match "<hr/>" t t))
|
||||
(concat "\n#+BEGIN_HTML\n<div id=\"bibliography\">\n<h2>References</h2>\n" (buffer-string) "\n</div>\n#+END_HTML\n"))))
|
||||
((eq org-export-current-backend 'latex) ;; Latex export
|
||||
(concat "\n#+LATEX: \\bibliographystyle{" style "}"
|
||||
"\n#+LATEX: \\bibliography{" file "}\n"))) t t)))
|
||||
|
||||
;; Convert cites to links in html
|
||||
(when (eq org-export-current-backend 'html)
|
||||
;; Split citation commands with multiple keys
|
||||
(org-exp-bibtex-docites
|
||||
(lambda ()
|
||||
(let ((keys (save-match-data (org-split-string (match-string 1) ","))))
|
||||
(when (> (length keys) 1)
|
||||
(replace-match (mapconcat (lambda (k) (format "\\cite{%s}" k)) keys "")
|
||||
t t)))))
|
||||
;; Replace the citation commands with links
|
||||
(org-exp-bibtex-docites
|
||||
(lambda () (let* ((cn (match-string 1))
|
||||
(cv (assoc cn oebp-cite-plist)))
|
||||
;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]"))
|
||||
(replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t))))))
|
||||
|
||||
(defun org-exp-bibtex-docites (fun)
|
||||
(save-excursion
|
||||
(save-match-data
|
||||
(goto-char (point-min))
|
||||
(when (eq org-export-current-backend 'html)
|
||||
(while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t)
|
||||
(apply fun nil))))))
|
||||
|
||||
(defun org-exp-bibtex-options-to-plist (options)
|
||||
(save-match-data
|
||||
(flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s)))))
|
||||
(mapcar 'f (split-string options nil t)))))
|
||||
|
||||
(add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess)
|
||||
|
||||
(provide 'org-exp-bibtex)
|
||||
|
||||
;;; org-exp-bibtex.el ends here
|
||||
|
|
@ -1,402 +0,0 @@
|
|||
;;; org-exp-blocks.el --- pre-process blocks when exporting org files
|
||||
|
||||
;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Eric Schulte
|
||||
|
||||
;; This file is part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; This is a utility for pre-processing blocks in org files before
|
||||
;; export using the `org-export-preprocess-hook'. It can be used for
|
||||
;; exporting new types of blocks from org-mode files and also for
|
||||
;; changing the default export behavior of existing org-mode blocks.
|
||||
;; The `org-export-blocks' and `org-export-interblocks' variables can
|
||||
;; be used to control how blocks and the spaces between blocks
|
||||
;; respectively are processed upon export.
|
||||
;;
|
||||
;; The type of a block is defined as the string following =#+begin_=,
|
||||
;; so for example the following block would be of type ditaa. Note
|
||||
;; that both upper or lower case are allowed in =#+BEGIN_= and
|
||||
;; =#+END_=.
|
||||
;;
|
||||
;; #+begin_ditaa blue.png -r -S
|
||||
;; +---------+
|
||||
;; | cBLU |
|
||||
;; | |
|
||||
;; | +----+
|
||||
;; | |cPNK|
|
||||
;; | | |
|
||||
;; +----+----+
|
||||
;; #+end_ditaa
|
||||
;;
|
||||
;;; Currently Implemented Block Types
|
||||
;;
|
||||
;; ditaa :: (DEPRECATED--use "#+begin_src ditaa" code blocks) Convert
|
||||
;; ascii pictures to actual images using ditaa
|
||||
;; http://ditaa.sourceforge.net/. To use this set
|
||||
;; `org-ditaa-jar-path' to the path to ditaa.jar on your
|
||||
;; system (should be set automatically in most cases) .
|
||||
;;
|
||||
;; dot :: (DEPRECATED--use "#+begin_src dot" code blocks) Convert
|
||||
;; graphs defined using the dot graphing language to images
|
||||
;; using the dot utility. For information on dot see
|
||||
;; http://www.graphviz.org/
|
||||
;;
|
||||
;; export-comment :: Wrap comments with titles and author information,
|
||||
;; in their own divs with author-specific ids allowing for
|
||||
;; css coloring of comments based on the author.
|
||||
;;
|
||||
;;; Adding new blocks
|
||||
;;
|
||||
;; When adding a new block type first define a formatting function
|
||||
;; along the same lines as `org-export-blocks-format-dot' and then use
|
||||
;; `org-export-blocks-add-block' to add your block type to
|
||||
;; `org-export-blocks'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
(require 'find-func)
|
||||
(require 'org-compat)
|
||||
|
||||
(declare-function org-split-string "org" (string &optional separators))
|
||||
(declare-function org-remove-indentation "org" (code &optional n))
|
||||
|
||||
(defvar org-protecting-blocks nil) ; From org.el
|
||||
|
||||
(defun org-export-blocks-set (var value)
|
||||
"Set the value of `org-export-blocks' and install fontification."
|
||||
(set var value)
|
||||
(mapc (lambda (spec)
|
||||
(if (nth 2 spec)
|
||||
(setq org-protecting-blocks
|
||||
(delete (symbol-name (car spec))
|
||||
org-protecting-blocks))
|
||||
(add-to-list 'org-protecting-blocks
|
||||
(symbol-name (car spec)))))
|
||||
value))
|
||||
|
||||
(defcustom org-export-blocks
|
||||
'((export-comment org-export-blocks-format-comment t)
|
||||
(ditaa org-export-blocks-format-ditaa nil)
|
||||
(dot org-export-blocks-format-dot nil))
|
||||
"Use this alist to associate block types with block exporting functions.
|
||||
The type of a block is determined by the text immediately
|
||||
following the '#+BEGIN_' portion of the block header. Each block
|
||||
export function should accept three arguments."
|
||||
:group 'org-export-general
|
||||
:type '(repeat
|
||||
(list
|
||||
(symbol :tag "Block name")
|
||||
(function :tag "Block formatter")
|
||||
(boolean :tag "Fontify content as Org syntax")))
|
||||
:set 'org-export-blocks-set)
|
||||
|
||||
(defun org-export-blocks-add-block (block-spec)
|
||||
"Add a new block type to `org-export-blocks'.
|
||||
BLOCK-SPEC should be a three element list the first element of
|
||||
which should indicate the name of the block, the second element
|
||||
should be the formatting function called by
|
||||
`org-export-blocks-preprocess' and the third element a flag
|
||||
indicating whether these types of blocks should be fontified in
|
||||
org-mode buffers (see `org-protecting-blocks'). For example the
|
||||
BLOCK-SPEC for ditaa blocks is as follows.
|
||||
|
||||
(ditaa org-export-blocks-format-ditaa nil)"
|
||||
(unless (member block-spec org-export-blocks)
|
||||
(setq org-export-blocks (cons block-spec org-export-blocks))
|
||||
(org-export-blocks-set 'org-export-blocks org-export-blocks)))
|
||||
|
||||
(defcustom org-export-interblocks
|
||||
'()
|
||||
"Use this a-list to associate block types with block exporting functions.
|
||||
The type of a block is determined by the text immediately
|
||||
following the '#+BEGIN_' portion of the block header. Each block
|
||||
export function should accept three arguments."
|
||||
:group 'org-export-general
|
||||
:type 'alist)
|
||||
|
||||
(defcustom org-export-blocks-witheld
|
||||
'(hidden)
|
||||
"List of block types (see `org-export-blocks') which should not be exported."
|
||||
:group 'org-export-general
|
||||
:type 'list)
|
||||
|
||||
(defcustom org-export-blocks-postblock-hook nil
|
||||
"Run after blocks have been processed with `org-export-blocks-preprocess'."
|
||||
:group 'org-export-general
|
||||
:version "24.1"
|
||||
:type 'hook)
|
||||
|
||||
(defun org-export-blocks-html-quote (body &optional open close)
|
||||
"Protect BODY from org html export.
|
||||
The optional OPEN and CLOSE tags will be inserted around BODY."
|
||||
(concat
|
||||
"\n#+BEGIN_HTML\n"
|
||||
(or open "")
|
||||
body (if (string-match "\n$" body) "" "\n")
|
||||
(or close "")
|
||||
"#+END_HTML\n"))
|
||||
|
||||
(defun org-export-blocks-latex-quote (body &optional open close)
|
||||
"Protect BODY from org latex export.
|
||||
The optional OPEN and CLOSE tags will be inserted around BODY."
|
||||
(concat
|
||||
"\n#+BEGIN_LaTeX\n"
|
||||
(or open "")
|
||||
body (if (string-match "\n$" body) "" "\n")
|
||||
(or close "")
|
||||
"#+END_LaTeX\n"))
|
||||
|
||||
(defvar org-src-preserve-indentation) ; From org-src.el
|
||||
(defun org-export-blocks-preprocess ()
|
||||
"Export all blocks according to the `org-export-blocks' block export alist.
|
||||
Does not export block types specified in specified in BLOCKS
|
||||
which defaults to the value of `org-export-blocks-witheld'."
|
||||
(interactive)
|
||||
(save-window-excursion
|
||||
(let ((case-fold-search t)
|
||||
(interblock (lambda (start end)
|
||||
(mapcar (lambda (pair) (funcall (second pair) start end))
|
||||
org-export-interblocks)))
|
||||
matched indentation type types func
|
||||
start end body headers preserve-indent progress-marker)
|
||||
(goto-char (point-min))
|
||||
(setq start (point))
|
||||
(let ((beg-re "^\\([ \t]*\\)#\\+begin_\\(\\S-+\\)[ \t]*\\(.*\\)?[\r\n]"))
|
||||
(while (re-search-forward beg-re nil t)
|
||||
(let* ((match-start (copy-marker (match-beginning 0)))
|
||||
(body-start (copy-marker (match-end 0)))
|
||||
(indentation (length (match-string 1)))
|
||||
(inner-re (format "^[ \t]*#\\+\\(begin\\|end\\)_%s"
|
||||
(regexp-quote (downcase (match-string 2)))))
|
||||
(type (intern (downcase (match-string 2))))
|
||||
(headers (save-match-data
|
||||
(org-split-string (match-string 3) "[ \t]+")))
|
||||
(balanced 1)
|
||||
(preserve-indent (or org-src-preserve-indentation
|
||||
(member "-i" headers)))
|
||||
match-end)
|
||||
(while (and (not (zerop balanced))
|
||||
(re-search-forward inner-re nil t))
|
||||
(if (string= (downcase (match-string 1)) "end")
|
||||
(decf balanced)
|
||||
(incf balanced)))
|
||||
(when (not (zerop balanced))
|
||||
(error "Unbalanced begin/end_%s blocks with %S"
|
||||
type (buffer-substring match-start (point))))
|
||||
(setq match-end (copy-marker (match-end 0)))
|
||||
(unless preserve-indent
|
||||
(setq body (save-match-data (org-remove-indentation
|
||||
(buffer-substring
|
||||
body-start (match-beginning 0))))))
|
||||
(unless (memq type types) (setq types (cons type types)))
|
||||
(save-match-data (funcall interblock start match-start))
|
||||
(when (setq func (cadr (assoc type org-export-blocks)))
|
||||
(let ((replacement (save-match-data
|
||||
(if (memq type org-export-blocks-witheld) ""
|
||||
(apply func body headers)))))
|
||||
;; ;; un-comment this code after the org-element merge
|
||||
;; (save-match-data
|
||||
;; (when (and replacement (string= replacement ""))
|
||||
;; (delete-region
|
||||
;; (car (org-element-collect-affiliated-keyword))
|
||||
;; match-start)))
|
||||
(when replacement
|
||||
(delete-region match-start match-end)
|
||||
(goto-char match-start) (insert replacement)
|
||||
(if preserve-indent
|
||||
;; indent only the code block markers
|
||||
(save-excursion
|
||||
(indent-line-to indentation) ; indent end_block
|
||||
(goto-char match-start)
|
||||
(indent-line-to indentation)) ; indent begin_block
|
||||
;; indent everything
|
||||
(indent-code-rigidly match-start (point) indentation)))))
|
||||
;; cleanup markers
|
||||
(set-marker match-start nil)
|
||||
(set-marker body-start nil)
|
||||
(set-marker match-end nil))
|
||||
(setq start (point))))
|
||||
(funcall interblock start (point-max))
|
||||
(run-hooks 'org-export-blocks-postblock-hook))))
|
||||
|
||||
;;================================================================================
|
||||
;; type specific functions
|
||||
|
||||
;;--------------------------------------------------------------------------------
|
||||
;; ditaa: create images from ASCII art using the ditaa utility
|
||||
(defcustom org-ditaa-jar-path (expand-file-name
|
||||
"ditaa.jar"
|
||||
(file-name-as-directory
|
||||
(expand-file-name
|
||||
"scripts"
|
||||
(file-name-as-directory
|
||||
(expand-file-name
|
||||
"../contrib"
|
||||
(file-name-directory (org-find-library-dir "org")))))))
|
||||
"Path to the ditaa jar executable."
|
||||
:group 'org-babel
|
||||
:type 'string)
|
||||
|
||||
(defvar org-export-current-backend) ; dynamically bound in org-exp.el
|
||||
(defun org-export-blocks-format-ditaa (body &rest headers)
|
||||
"DEPRECATED: use begin_src ditaa code blocks
|
||||
|
||||
Pass block BODY to the ditaa utility creating an image.
|
||||
Specify the path at which the image should be saved as the first
|
||||
element of headers, any additional elements of headers will be
|
||||
passed to the ditaa utility as command line arguments."
|
||||
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks")
|
||||
(let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
|
||||
(data-file (make-temp-file "org-ditaa"))
|
||||
(hash (progn
|
||||
(set-text-properties 0 (length body) nil body)
|
||||
(sha1 (prin1-to-string (list body args)))))
|
||||
(raw-out-file (if headers (car headers)))
|
||||
(out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
|
||||
(cons (match-string 1 raw-out-file)
|
||||
(match-string 2 raw-out-file))
|
||||
(cons raw-out-file "png")))
|
||||
(out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
|
||||
(unless (file-exists-p org-ditaa-jar-path)
|
||||
(error (format "Could not find ditaa.jar at %s" org-ditaa-jar-path)))
|
||||
(setq body (if (string-match "^\\([^:\\|:[^ ]\\)" body)
|
||||
body
|
||||
(mapconcat (lambda (x) (substring x (if (> (length x) 1) 2 1)))
|
||||
(org-split-string body "\n")
|
||||
"\n")))
|
||||
(prog1
|
||||
(cond
|
||||
((member org-export-current-backend '(html latex docbook))
|
||||
(unless (file-exists-p out-file)
|
||||
(mapc ;; remove old hashed versions of this file
|
||||
(lambda (file)
|
||||
(when (and (string-match (concat (regexp-quote (car out-file-parts))
|
||||
"_\\([[:alnum:]]+\\)\\."
|
||||
(regexp-quote (cdr out-file-parts)))
|
||||
file)
|
||||
(= (length (match-string 1 out-file)) 40))
|
||||
(delete-file (expand-file-name file
|
||||
(file-name-directory out-file)))))
|
||||
(directory-files (or (file-name-directory out-file)
|
||||
default-directory)))
|
||||
(with-temp-file data-file (insert body))
|
||||
(message (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file))
|
||||
(shell-command (concat "java -jar " org-ditaa-jar-path " " args " " data-file " " out-file)))
|
||||
(format "\n[[file:%s]]\n" out-file))
|
||||
(t (concat
|
||||
"\n#+BEGIN_EXAMPLE\n"
|
||||
body (if (string-match "\n$" body) "" "\n")
|
||||
"#+END_EXAMPLE\n")))
|
||||
(message "begin_ditaa blocks are DEPRECATED, use begin_src blocks"))))
|
||||
|
||||
;;--------------------------------------------------------------------------------
|
||||
;; dot: create graphs using the dot graphing language
|
||||
;; (require the dot executable to be in your path)
|
||||
(defun org-export-blocks-format-dot (body &rest headers)
|
||||
"DEPRECATED: use \"#+begin_src dot\" code blocks
|
||||
|
||||
Pass block BODY to the dot graphing utility creating an image.
|
||||
Specify the path at which the image should be saved as the first
|
||||
element of headers, any additional elements of headers will be
|
||||
passed to the dot utility as command line arguments. Don't
|
||||
forget to specify the output type for the dot command, so if you
|
||||
are exporting to a file with a name like 'image.png' you should
|
||||
include a '-Tpng' argument, and your block should look like the
|
||||
following.
|
||||
|
||||
#+begin_dot models.png -Tpng
|
||||
digraph data_relationships {
|
||||
\"data_requirement\" [shape=Mrecord, label=\"{DataRequirement|description\lformat\l}\"]
|
||||
\"data_product\" [shape=Mrecord, label=\"{DataProduct|name\lversion\lpoc\lformat\l}\"]
|
||||
\"data_requirement\" -> \"data_product\"
|
||||
}
|
||||
#+end_dot"
|
||||
(message "begin_dot blocks are DEPRECATED, use begin_src blocks")
|
||||
(let* ((args (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))
|
||||
(data-file (make-temp-file "org-ditaa"))
|
||||
(hash (progn
|
||||
(set-text-properties 0 (length body) nil body)
|
||||
(sha1 (prin1-to-string (list body args)))))
|
||||
(raw-out-file (if headers (car headers)))
|
||||
(out-file-parts (if (string-match "\\(.+\\)\\.\\([^\\.]+\\)$" raw-out-file)
|
||||
(cons (match-string 1 raw-out-file)
|
||||
(match-string 2 raw-out-file))
|
||||
(cons raw-out-file "png")))
|
||||
(out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts))))
|
||||
(prog1
|
||||
(cond
|
||||
((member org-export-current-backend '(html latex docbook))
|
||||
(unless (file-exists-p out-file)
|
||||
(mapc ;; remove old hashed versions of this file
|
||||
(lambda (file)
|
||||
(when (and (string-match (concat (regexp-quote (car out-file-parts))
|
||||
"_\\([[:alnum:]]+\\)\\."
|
||||
(regexp-quote (cdr out-file-parts)))
|
||||
file)
|
||||
(= (length (match-string 1 out-file)) 40))
|
||||
(delete-file (expand-file-name file
|
||||
(file-name-directory out-file)))))
|
||||
(directory-files (or (file-name-directory out-file)
|
||||
default-directory)))
|
||||
(with-temp-file data-file (insert body))
|
||||
(message (concat "dot " data-file " " args " -o " out-file))
|
||||
(shell-command (concat "dot " data-file " " args " -o " out-file)))
|
||||
(format "\n[[file:%s]]\n" out-file))
|
||||
(t (concat
|
||||
"\n#+BEGIN_EXAMPLE\n"
|
||||
body (if (string-match "\n$" body) "" "\n")
|
||||
"#+END_EXAMPLE\n")))
|
||||
(message "begin_dot blocks are DEPRECATED, use begin_src blocks"))))
|
||||
|
||||
;;--------------------------------------------------------------------------------
|
||||
;; comment: export comments in author-specific css-stylable divs
|
||||
(defun org-export-blocks-format-comment (body &rest headers)
|
||||
"Format comment BODY by OWNER and return it formatted for export.
|
||||
Currently, this only does something for HTML export, for all
|
||||
other backends, it converts the comment into an EXAMPLE segment."
|
||||
(let ((owner (if headers (car headers)))
|
||||
(title (if (cdr headers) (mapconcat 'identity (cdr headers) " "))))
|
||||
(cond
|
||||
((eq org-export-current-backend 'html) ;; We are exporting to HTML
|
||||
(concat "#+BEGIN_HTML\n"
|
||||
"<div class=\"org-comment\""
|
||||
(if owner (format " id=\"org-comment-%s\" " owner))
|
||||
">\n"
|
||||
(if owner (concat "<b>" owner "</b> ") "")
|
||||
(if (and title (> (length title) 0)) (concat " -- " title "<br/>\n") "<br/>\n")
|
||||
"<p>\n"
|
||||
"#+END_HTML\n"
|
||||
body
|
||||
"\n#+BEGIN_HTML\n"
|
||||
"</p>\n"
|
||||
"</div>\n"
|
||||
"#+END_HTML\n"))
|
||||
(t ;; This is not HTML, so just make it an example.
|
||||
(concat "#+BEGIN_EXAMPLE\n"
|
||||
(if title (concat "Title:" title "\n") "")
|
||||
(if owner (concat "By:" owner "\n") "")
|
||||
body
|
||||
(if (string-match "\n\\'" body) "" "\n")
|
||||
"#+END_EXAMPLE\n")))))
|
||||
|
||||
(provide 'org-exp-blocks)
|
||||
|
||||
;;; org-exp-blocks.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -1,689 +0,0 @@
|
|||
;;; org-icalendar.el --- iCalendar export for Org-mode
|
||||
|
||||
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;;
|
||||
;; This file is part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org-exp)
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil)
|
||||
|
||||
(defgroup org-export-icalendar nil
|
||||
"Options specific for iCalendar export of Org-mode files."
|
||||
:tag "Org Export iCalendar"
|
||||
:group 'org-export)
|
||||
|
||||
(defcustom org-combined-agenda-icalendar-file "~/org.ics"
|
||||
"The file name for the iCalendar file covering all agenda files.
|
||||
This file is created with the command \\[org-export-icalendar-all-agenda-files].
|
||||
The file name should be absolute, the file will be overwritten without warning."
|
||||
:group 'org-export-icalendar
|
||||
:type 'file)
|
||||
|
||||
(defcustom org-icalendar-alarm-time 0
|
||||
"Number of minutes for triggering an alarm for exported timed events.
|
||||
A zero value (the default) turns off the definition of an alarm trigger
|
||||
for timed events. If non-zero, alarms are created.
|
||||
|
||||
- a single alarm per entry is defined
|
||||
- The alarm will go off N minutes before the event
|
||||
- only a DISPLAY action is defined."
|
||||
:group 'org-export-icalendar
|
||||
:version "24.1"
|
||||
:type 'integer)
|
||||
|
||||
(defcustom org-icalendar-combined-name "OrgMode"
|
||||
"Calendar name for the combined iCalendar representing all agenda files."
|
||||
:group 'org-export-icalendar
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-icalendar-combined-description nil
|
||||
"Calendar description for the combined iCalendar (all agenda files)."
|
||||
:group 'org-export-icalendar
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-icalendar-use-plain-timestamp t
|
||||
"Non-nil means make an event from every plain time stamp."
|
||||
:group 'org-export-icalendar
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-icalendar-honor-noexport-tag nil
|
||||
"Non-nil means don't export entries with a tag in `org-export-exclude-tags'."
|
||||
:group 'org-export-icalendar
|
||||
:version "24.1"
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due)
|
||||
"Contexts where iCalendar export should use a deadline time stamp.
|
||||
This is a list with several symbols in it. Valid symbol are:
|
||||
|
||||
event-if-todo Deadlines in TODO entries become calendar events.
|
||||
event-if-not-todo Deadlines in non-TODO entries become calendar events.
|
||||
todo-due Use deadlines in TODO entries as due-dates"
|
||||
:group 'org-export-icalendar
|
||||
:type '(set :greedy t
|
||||
(const :tag "Deadlines in non-TODO entries become events"
|
||||
event-if-not-todo)
|
||||
(const :tag "Deadline in TODO entries become events"
|
||||
event-if-todo)
|
||||
(const :tag "Deadlines in TODO entries become due-dates"
|
||||
todo-due)))
|
||||
|
||||
(defcustom org-icalendar-use-scheduled '(todo-start)
|
||||
"Contexts where iCalendar export should use a scheduling time stamp.
|
||||
This is a list with several symbols in it. Valid symbol are:
|
||||
|
||||
event-if-todo Scheduling time stamps in TODO entries become an event.
|
||||
event-if-not-todo Scheduling time stamps in non-TODO entries become an event.
|
||||
todo-start Scheduling time stamps in TODO entries become start date.
|
||||
Some calendar applications show TODO entries only after
|
||||
that date."
|
||||
:group 'org-export-icalendar
|
||||
:type '(set :greedy t
|
||||
(const :tag
|
||||
"SCHEDULED timestamps in non-TODO entries become events"
|
||||
event-if-not-todo)
|
||||
(const :tag "SCHEDULED timestamps in TODO entries become events"
|
||||
event-if-todo)
|
||||
(const :tag "SCHEDULED in TODO entries become start date"
|
||||
todo-start)))
|
||||
|
||||
(defcustom org-icalendar-categories '(local-tags category)
|
||||
"Items that should be entered into the categories field.
|
||||
This is a list of symbols, the following are valid:
|
||||
|
||||
category The Org-mode category of the current file or tree
|
||||
todo-state The todo state, if any
|
||||
local-tags The tags, defined in the current line
|
||||
all-tags All tags, including inherited ones."
|
||||
:group 'org-export-icalendar
|
||||
:type '(repeat
|
||||
(choice
|
||||
(const :tag "The file or tree category" category)
|
||||
(const :tag "The TODO state" todo-state)
|
||||
(const :tag "Tags defined in current line" local-tags)
|
||||
(const :tag "All tags, including inherited ones" all-tags))))
|
||||
|
||||
(defcustom org-icalendar-include-todo nil
|
||||
"Non-nil means export to iCalendar files should also cover TODO items.
|
||||
Valid values are:
|
||||
nil don't include any TODO items
|
||||
t include all TODO items that are not in a DONE state
|
||||
unblocked include all TODO items that are not blocked
|
||||
all include both done and not done items."
|
||||
:group 'org-export-icalendar
|
||||
:type '(choice
|
||||
(const :tag "None" nil)
|
||||
(const :tag "Unfinished" t)
|
||||
(const :tag "Unblocked" unblocked)
|
||||
(const :tag "All" all)))
|
||||
|
||||
(defvar org-icalendar-verify-function nil
|
||||
"Function to verify entries for iCalendar export.
|
||||
This can be set to a function that will be called at each entry that
|
||||
is considered for export to iCalendar. When the function returns nil,
|
||||
the entry will be skipped. When it returns a non-nil value, the entry
|
||||
will be considered for export.
|
||||
This is used internally when an agenda buffer is exported to an ics file,
|
||||
to make sure that only entries currently listed in the agenda will end
|
||||
up in the ics file. But for normal iCalendar export, you can use this
|
||||
for whatever you need.")
|
||||
|
||||
(defcustom org-icalendar-include-bbdb-anniversaries nil
|
||||
"Non-nil means a combined iCalendar files should include anniversaries.
|
||||
The anniversaries are define in the BBDB database."
|
||||
:group 'org-export-icalendar
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-icalendar-include-sexps t
|
||||
"Non-nil means export to iCalendar files should also cover sexp entries.
|
||||
These are entries like in the diary, but directly in an Org-mode file."
|
||||
:group 'org-export-icalendar
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-icalendar-include-body 100
|
||||
"Amount of text below headline to be included in iCalendar export.
|
||||
This is a number of characters that should maximally be included.
|
||||
Properties, scheduling and clocking lines will always be removed.
|
||||
The text will be inserted into the DESCRIPTION field."
|
||||
:group 'org-export-icalendar
|
||||
:type '(choice
|
||||
(const :tag "Nothing" nil)
|
||||
(const :tag "Everything" t)
|
||||
(integer :tag "Max characters")))
|
||||
|
||||
(defcustom org-icalendar-store-UID nil
|
||||
"Non-nil means store any created UIDs in properties.
|
||||
The iCalendar standard requires that all entries have a unique identifier.
|
||||
Org will create these identifiers as needed. When this variable is non-nil,
|
||||
the created UIDs will be stored in the ID property of the entry. Then the
|
||||
next time this entry is exported, it will be exported with the same UID,
|
||||
superseding the previous form of it. This is essential for
|
||||
synchronization services.
|
||||
This variable is not turned on by default because we want to avoid creating
|
||||
a property drawer in every entry if people are only playing with this feature,
|
||||
or if they are only using it locally."
|
||||
:group 'org-export-icalendar
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-icalendar-timezone (getenv "TZ")
|
||||
"The time zone string for iCalendar export.
|
||||
When nil or the empty string, use output from \(current-time-zone\)."
|
||||
:group 'org-export-icalendar
|
||||
:type '(choice
|
||||
(const :tag "Unspecified" nil)
|
||||
(string :tag "Time zone")))
|
||||
|
||||
;; Backward compatibility with previous variable
|
||||
(defvar org-icalendar-use-UTC-date-time nil)
|
||||
(defcustom org-icalendar-date-time-format
|
||||
(if org-icalendar-use-UTC-date-time
|
||||
":%Y%m%dT%H%M%SZ"
|
||||
":%Y%m%dT%H%M%S")
|
||||
"Format-string for exporting icalendar DATE-TIME.
|
||||
See `format-time-string' for a full documentation. The only
|
||||
difference is that `org-icalendar-timezone' is used for %Z.
|
||||
|
||||
Interesting value are:
|
||||
- \":%Y%m%dT%H%M%S\" for local time
|
||||
- \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone
|
||||
- \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time"
|
||||
|
||||
:group 'org-export-icalendar
|
||||
:version "24.1"
|
||||
:type '(choice
|
||||
(const :tag "Local time" ":%Y%m%dT%H%M%S")
|
||||
(const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S")
|
||||
(const :tag "Universal time" ":%Y%m%dT%H%M%SZ")
|
||||
(string :tag "Explicit format")))
|
||||
|
||||
(defun org-icalendar-use-UTC-date-timep ()
|
||||
(char-equal (elt org-icalendar-date-time-format
|
||||
(1- (length org-icalendar-date-time-format))) ?Z))
|
||||
|
||||
;;; iCalendar export
|
||||
|
||||
(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))
|
||||
|
||||
(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)))
|
||||
|
||||
(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
|
||||
|
|
@ -1,262 +0,0 @@
|
|||
;;; org-jsinfo.el --- Support for org-info.js Javascript in Org HTML export
|
||||
|
||||
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;;
|
||||
;; This file is part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
|
||||
;; This file implements the support for Sebastian Rose's JavaScript
|
||||
;; org-info.js to display an org-mode file exported to HTML in an
|
||||
;; Info-like way, or using folding similar to the outline structure
|
||||
;; org org-mode itself.
|
||||
|
||||
;; Documentation for using this module is in the Org manual. The script
|
||||
;; itself is documented by Sebastian Rose in a file distributed with
|
||||
;; the script. FIXME: Accurate pointers!
|
||||
|
||||
;; Org-mode loads this module by default - if this is not what you want,
|
||||
;; configure the variable `org-modules'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org-exp)
|
||||
(require 'org-html)
|
||||
|
||||
(add-to-list 'org-export-inbuffer-options-extra '("INFOJS_OPT" :infojs-opt))
|
||||
(add-hook 'org-export-options-filters 'org-infojs-handle-options)
|
||||
|
||||
(defgroup org-infojs nil
|
||||
"Options specific for using org-info.js in HTML export of Org-mode files."
|
||||
:tag "Org Export HTML INFOJS"
|
||||
:group 'org-export-html)
|
||||
|
||||
(defcustom org-export-html-use-infojs 'when-configured
|
||||
"Should Sebastian Rose's Java Script org-info.js be linked into HTML files?
|
||||
This option can be nil or t to never or always use the script. It can
|
||||
also be the symbol `when-configured', meaning that the script will be
|
||||
linked into the export file if and only if there is a \"#+INFOJS_OPT:\"
|
||||
line in the buffer. See also the variable `org-infojs-options'."
|
||||
:group 'org-export-html
|
||||
:group 'org-infojs
|
||||
:type '(choice
|
||||
(const :tag "Never" nil)
|
||||
(const :tag "When configured in buffer" when-configured)
|
||||
(const :tag "Always" t)))
|
||||
|
||||
(defconst org-infojs-opts-table
|
||||
'((path PATH "http://orgmode.org/org-info.js")
|
||||
(view VIEW "info")
|
||||
(toc TOC :table-of-contents)
|
||||
(ftoc FIXED_TOC "0")
|
||||
(tdepth TOC_DEPTH "max")
|
||||
(sdepth SECTION_DEPTH "max")
|
||||
(mouse MOUSE_HINT "underline")
|
||||
(buttons VIEW_BUTTONS "0")
|
||||
(ltoc LOCAL_TOC "1")
|
||||
(up LINK_UP :link-up)
|
||||
(home LINK_HOME :link-home))
|
||||
"JavaScript options, long form for script, default values.")
|
||||
|
||||
(defvar org-infojs-options)
|
||||
(when (and (boundp 'org-infojs-options)
|
||||
(assq 'runs org-infojs-options))
|
||||
(setq org-infojs-options (delq (assq 'runs org-infojs-options)
|
||||
org-infojs-options)))
|
||||
|
||||
(defcustom org-infojs-options
|
||||
(mapcar (lambda (x) (cons (car x) (nth 2 x)))
|
||||
org-infojs-opts-table)
|
||||
"Options settings for the INFOJS JavaScript.
|
||||
Each of the options must have an entry in `org-export-html/infojs-opts-table'.
|
||||
The value can either be a string that will be passed to the script, or
|
||||
a property. This property is then assumed to be a property that is defined
|
||||
by the Export/Publishing setup of Org.
|
||||
The `sdepth' and `tdepth' parameters can also be set to \"max\", which
|
||||
means to use the maximum value consistent with other options."
|
||||
:group 'org-infojs
|
||||
:type
|
||||
`(set :greedy t :inline t
|
||||
,@(mapcar
|
||||
(lambda (x)
|
||||
(list 'cons (list 'const (car x))
|
||||
'(choice
|
||||
(symbol :tag "Publishing/Export property")
|
||||
(string :tag "Value"))))
|
||||
org-infojs-opts-table)))
|
||||
|
||||
(defcustom org-infojs-template
|
||||
"<script type=\"text/javascript\" src=\"%SCRIPT_PATH\">
|
||||
/**
|
||||
*
|
||||
* @source: %SCRIPT_PATH
|
||||
*
|
||||
* @licstart The following is the entire license notice for the
|
||||
* JavaScript code in %SCRIPT_PATH.
|
||||
*
|
||||
* Copyright (C) 2012-2013 Sebastian Rose
|
||||
*
|
||||
*
|
||||
* The JavaScript code in this tag is free software: you can
|
||||
* redistribute it and/or modify it under the terms of the GNU
|
||||
* General Public License (GNU GPL) as published by the Free Software
|
||||
* Foundation, either version 3 of the License, or (at your option)
|
||||
* any later version. The code is distributed WITHOUT ANY WARRANTY;
|
||||
* without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
* FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
|
||||
*
|
||||
* As additional permission under GNU GPL version 3 section 7, you
|
||||
* may distribute non-source (e.g., minimized or compacted) forms of
|
||||
* that code without the copy of the GNU GPL normally required by
|
||||
* section 4, provided you include this license notice and a URL
|
||||
* through which recipients can access the Corresponding Source.
|
||||
*
|
||||
* @licend The above is the entire license notice
|
||||
* for the JavaScript code in %SCRIPT_PATH.
|
||||
*
|
||||
*/
|
||||
</script>
|
||||
|
||||
<script type=\"text/javascript\">
|
||||
|
||||
/*
|
||||
@licstart The following is the entire license notice for the
|
||||
JavaScript code in this tag.
|
||||
|
||||
Copyright (C) 2012-2013 Free Software Foundation, Inc.
|
||||
|
||||
The JavaScript code in this tag is free software: you can
|
||||
redistribute it and/or modify it under the terms of the GNU
|
||||
General Public License (GNU GPL) as published by the Free Software
|
||||
Foundation, either version 3 of the License, or (at your option)
|
||||
any later version. The code is distributed WITHOUT ANY WARRANTY;
|
||||
without even the implied warranty of MERCHANTABILITY or FITNESS
|
||||
FOR A PARTICULAR PURPOSE. See the GNU GPL for more details.
|
||||
|
||||
As additional permission under GNU GPL version 3 section 7, you
|
||||
may distribute non-source (e.g., minimized or compacted) forms of
|
||||
that code without the copy of the GNU GPL normally required by
|
||||
section 4, provided you include this license notice and a URL
|
||||
through which recipients can access the Corresponding Source.
|
||||
|
||||
|
||||
@licend The above is the entire license notice
|
||||
for the JavaScript code in this tag.
|
||||
*/
|
||||
|
||||
<!--/*--><![CDATA[/*><!--*/
|
||||
%MANAGER_OPTIONS
|
||||
org_html_manager.setup(); // activate after the parameters are set
|
||||
/*]]>*///-->
|
||||
</script>"
|
||||
"The template for the export style additions when org-info.js is used.
|
||||
Option settings will replace the %MANAGER-OPTIONS cookie."
|
||||
:group 'org-infojs
|
||||
:type 'string)
|
||||
|
||||
(defun org-infojs-handle-options (exp-plist)
|
||||
"Analyze JavaScript options in INFO-PLIST and modify EXP-PLIST accordingly."
|
||||
(if (or (not org-export-html-use-infojs)
|
||||
(and (eq org-export-html-use-infojs 'when-configured)
|
||||
(or (not (plist-get exp-plist :infojs-opt))
|
||||
(string-match "\\<view:nil\\>"
|
||||
(plist-get exp-plist :infojs-opt)))))
|
||||
;; We do not want to use the script
|
||||
exp-plist
|
||||
;; We do want to use the script, set it up
|
||||
(let ((template org-infojs-template)
|
||||
(ptoc (plist-get exp-plist :table-of-contents))
|
||||
(hlevels (plist-get exp-plist :headline-levels))
|
||||
tdepth sdepth s v e opt var val table default)
|
||||
(setq sdepth hlevels
|
||||
tdepth hlevels)
|
||||
(if (integerp ptoc) (setq tdepth (min ptoc tdepth)))
|
||||
(setq v (plist-get exp-plist :infojs-opt)
|
||||
table org-infojs-opts-table)
|
||||
(while (setq e (pop table))
|
||||
(setq opt (car e) var (nth 1 e)
|
||||
default (cdr (assoc opt org-infojs-options)))
|
||||
(and (symbolp default) (not (memq default '(t nil)))
|
||||
(setq default (plist-get exp-plist default)))
|
||||
(if (and v (string-match (format " %s:\\(\\S-+\\)" opt) v))
|
||||
(setq val (match-string 1 v))
|
||||
(setq val default))
|
||||
(cond
|
||||
((eq opt 'path)
|
||||
(setq template
|
||||
(replace-regexp-in-string "%SCRIPT_PATH" val template t t)))
|
||||
((eq opt 'sdepth)
|
||||
(if (integerp (read val))
|
||||
(setq sdepth (min (read val) hlevels))))
|
||||
((eq opt 'tdepth)
|
||||
(if (integerp (read val))
|
||||
(setq tdepth (min (read val) hlevels))))
|
||||
(t
|
||||
(setq val
|
||||
(cond
|
||||
((or (eq val t) (equal val "t")) "1")
|
||||
((or (eq val nil) (equal val "nil")) "0")
|
||||
((stringp val) val)
|
||||
(t (format "%s" val))))
|
||||
(push (cons var val) s))))
|
||||
|
||||
;; Now we set the depth of the *generated* TOC to SDEPTH, because the
|
||||
;; toc will actually determine the splitting. How much of the toc will
|
||||
;; actually be displayed is governed by the TDEPTH option.
|
||||
(setq exp-plist (plist-put exp-plist :table-of-contents sdepth))
|
||||
|
||||
;; The table of contents should not show more sections then we generate
|
||||
(setq tdepth (min tdepth sdepth))
|
||||
(push (cons "TOC_DEPTH" tdepth) s)
|
||||
|
||||
(setq s (mapconcat
|
||||
(lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");"
|
||||
(car x) (cdr x)))
|
||||
s "\n"))
|
||||
(when (and s (> (length s) 0))
|
||||
(and (string-match "%MANAGER_OPTIONS" template)
|
||||
(setq s (replace-match s t t template))
|
||||
(setq exp-plist
|
||||
(plist-put
|
||||
exp-plist :style-extra
|
||||
(concat (or (plist-get exp-plist :style-extra) "") "\n" s)))))
|
||||
;; This script absolutely needs the table of contents, to we change that
|
||||
;; setting
|
||||
(if (not (plist-get exp-plist :table-of-contents))
|
||||
(setq exp-plist (plist-put exp-plist :table-of-contents t)))
|
||||
;; Return the modified property list
|
||||
exp-plist)))
|
||||
|
||||
(defun org-infojs-options-inbuffer-template ()
|
||||
(format "#+INFOJS_OPT: view:%s toc:%s ltoc:%s mouse:%s buttons:%s path:%s"
|
||||
(if (eq t org-export-html-use-infojs) (cdr (assoc 'view org-infojs-options)) nil)
|
||||
(let ((a (cdr (assoc 'toc org-infojs-options))))
|
||||
(cond ((memq a '(nil t)) a)
|
||||
(t (plist-get (org-infile-export-plist) :table-of-contents))))
|
||||
(if (equal (cdr (assoc 'ltoc org-infojs-options)) "1") t nil)
|
||||
(cdr (assoc 'mouse org-infojs-options))
|
||||
(cdr (assoc 'buttons org-infojs-options))
|
||||
(cdr (assoc 'path org-infojs-options))))
|
||||
|
||||
(provide 'org-infojs)
|
||||
(provide 'org-jsinfo)
|
||||
|
||||
;;; org-jsinfo.el ends here
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -1,104 +0,0 @@
|
|||
;;; 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
|
||||
|
|
@ -1,805 +0,0 @@
|
|||
;;; org-taskjuggler.el --- TaskJuggler exporter for org-mode
|
||||
;;
|
||||
;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
|
||||
;;
|
||||
;; Emacs Lisp Archive Entry
|
||||
;; Filename: org-taskjuggler.el
|
||||
;; Author: Christian Egli
|
||||
;; Maintainer: Christian Egli
|
||||
;; Keywords: org, taskjuggler, project planning
|
||||
;; Description: Converts an org-mode buffer into a taskjuggler project plan
|
||||
;; URL:
|
||||
|
||||
;; 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 TaskJuggler exporter for org-mode.
|
||||
;; TaskJuggler uses a text format to define projects, tasks and
|
||||
;; resources, so it is a natural fit for org-mode. It can produce all
|
||||
;; sorts of reports for tasks or resources in either HTML, CSV or PDF.
|
||||
;; The current version of TaskJuggler requires KDE but the next
|
||||
;; version is implemented in Ruby and should therefore run on any
|
||||
;; platform.
|
||||
;;
|
||||
;; The exporter is a bit different from other exporters, such as the
|
||||
;; HTML and LaTeX exporters for example, in that it does not export
|
||||
;; all the nodes of a document or strictly follow the order of the
|
||||
;; nodes in the document.
|
||||
;;
|
||||
;; Instead the TaskJuggler exporter looks for a tree that defines the
|
||||
;; tasks and a optionally tree that defines the resources for this
|
||||
;; project. It then creates a TaskJuggler file based on these trees
|
||||
;; and the attributes defined in all the nodes.
|
||||
;;
|
||||
;; * Installation
|
||||
;;
|
||||
;; Put this file into your load-path and the following line into your
|
||||
;; ~/.emacs:
|
||||
;;
|
||||
;; (require 'org-taskjuggler)
|
||||
;;
|
||||
;; The interactive functions are similar to those of the HTML and LaTeX
|
||||
;; exporters:
|
||||
;;
|
||||
;; M-x `org-export-as-taskjuggler'
|
||||
;; M-x `org-export-as-taskjuggler-and-open'
|
||||
;;
|
||||
;; * Tasks
|
||||
;;
|
||||
;; Let's illustrate the usage with a small example. Create your tasks
|
||||
;; as you usually do with org-mode. Assign efforts to each task using
|
||||
;; properties (it's easiest to do this in the column view). You should
|
||||
;; end up with something similar to the example by Peter Jones in
|
||||
;; http://www.contextualdevelopment.com/static/artifacts/articles/2008/project-planning/project-planning.org.
|
||||
;; Now mark the top node of your tasks with a tag named
|
||||
;; "taskjuggler_project" (or whatever you customized
|
||||
;; `org-export-taskjuggler-project-tag' to). You are now ready to
|
||||
;; export the project plan with `org-export-as-taskjuggler-and-open'
|
||||
;; which will export the project plan and open a Gantt chart in
|
||||
;; TaskJugglerUI.
|
||||
;;
|
||||
;; * Resources
|
||||
;;
|
||||
;; Next you can define resources and assign those to work on specific
|
||||
;; tasks. You can group your resources hierarchically. Tag the top
|
||||
;; node of the resources with "taskjuggler_resource" (or whatever you
|
||||
;; customized `org-export-taskjuggler-resource-tag' to). You can
|
||||
;; optionally assign an identifier (named "resource_id") to the
|
||||
;; resources (using the standard org properties commands) or you can
|
||||
;; let the exporter generate identifiers automatically (the exporter
|
||||
;; picks the first word of the headline as the identifier as long as
|
||||
;; it is unique, see the documentation of
|
||||
;; `org-taskjuggler-get-unique-id'). Using that identifier you can
|
||||
;; then allocate resources to tasks. This is again done with the
|
||||
;; "allocate" property on the tasks. Do this in column view or when on
|
||||
;; the task type
|
||||
;;
|
||||
;; C-c C-x p allocate RET <resource_id> RET
|
||||
;;
|
||||
;; Once the allocations are done you can again export to TaskJuggler
|
||||
;; and check in the Resource Allocation Graph which person is working
|
||||
;; on what task at what time.
|
||||
;;
|
||||
;; * Export of properties
|
||||
;;
|
||||
;; The exporter also takes TODO state information into consideration,
|
||||
;; i.e. if a task is marked as done it will have the corresponding
|
||||
;; attribute in TaskJuggler ("complete 100"). Also it will export any
|
||||
;; property on a task resource or resource node which is known to
|
||||
;; TaskJuggler, such as limits, vacation, shift, booking, efficiency,
|
||||
;; journalentry, rate for resources or account, start, note, duration,
|
||||
;; end, journalentry, milestone, reference, responsible, scheduling,
|
||||
;; etc for tasks.
|
||||
;;
|
||||
;; * Dependencies
|
||||
;;
|
||||
;; The exporter will handle dependencies that are defined in the tasks
|
||||
;; either with the ORDERED attribute (see TODO dependencies in the Org
|
||||
;; mode manual) or with the BLOCKER attribute (see org-depend.el) or
|
||||
;; alternatively with a depends attribute. Both the BLOCKER and the
|
||||
;; depends attribute can be either "previous-sibling" or a reference
|
||||
;; to an identifier (named "task_id") which is defined for another
|
||||
;; task in the project. BLOCKER and the depends attribute can define
|
||||
;; multiple dependencies separated by either space or comma. You can
|
||||
;; also specify optional attributes on the dependency by simply
|
||||
;; appending it. The following examples should illustrate this:
|
||||
;;
|
||||
;; * Training material
|
||||
;; :PROPERTIES:
|
||||
;; :task_id: training_material
|
||||
;; :ORDERED: t
|
||||
;; :END:
|
||||
;; ** Markup Guidelines
|
||||
;; :PROPERTIES:
|
||||
;; :Effort: 2d
|
||||
;; :END:
|
||||
;; ** Workflow Guidelines
|
||||
;; :PROPERTIES:
|
||||
;; :Effort: 2d
|
||||
;; :END:
|
||||
;; * Presentation
|
||||
;; :PROPERTIES:
|
||||
;; :Effort: 2d
|
||||
;; :BLOCKER: training_material { gapduration 1d } some_other_task
|
||||
;; :END:
|
||||
;;
|
||||
;;;; * TODO
|
||||
;; - Look at org-file-properties, org-global-properties and
|
||||
;; org-global-properties-fixed
|
||||
;; - What about property inheritance and org-property-inherit-p?
|
||||
;; - Use TYPE_TODO as an way to assign resources
|
||||
;; - Make sure multiple dependency definitions (i.e. BLOCKER on
|
||||
;; previous-sibling and on a specific task_id) in multiple
|
||||
;; attributes are properly exported.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(eval-when-compile
|
||||
(require 'cl))
|
||||
|
||||
(require 'org)
|
||||
(require 'org-exp)
|
||||
|
||||
;;; User variables:
|
||||
|
||||
(defgroup org-export-taskjuggler nil
|
||||
"Options for exporting Org-mode files to TaskJuggler."
|
||||
:tag "Org Export TaskJuggler"
|
||||
:group 'org-export)
|
||||
|
||||
(defcustom org-export-taskjuggler-extension ".tjp"
|
||||
"Extension of TaskJuggler files."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-export-taskjuggler-project-tag "taskjuggler_project"
|
||||
"Tag, property or todo used to find the tree containing all
|
||||
the tasks for the project."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-export-taskjuggler-resource-tag "taskjuggler_resource"
|
||||
"Tag, property or todo used to find the tree containing all the
|
||||
resources for the project."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-export-taskjuggler-report-tag "taskjuggler_report"
|
||||
"Tag, property or todo used to find the tree containing all the
|
||||
reports for the project."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-export-taskjuggler-target-version 2.4
|
||||
"Which version of TaskJuggler the exporter is targeting."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'number)
|
||||
|
||||
(defcustom org-export-taskjuggler-default-project-version "1.0"
|
||||
"Default version string for the project."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-export-taskjuggler-default-project-duration 280
|
||||
"Default project duration if no start and end date have been defined
|
||||
in the root node of the task tree, i.e. the tree that has been marked
|
||||
with `org-export-taskjuggler-project-tag'"
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type 'integer)
|
||||
|
||||
(defcustom org-export-taskjuggler-default-reports
|
||||
'("taskreport \"Gantt Chart\" {
|
||||
headline \"Project Gantt Chart\"
|
||||
columns hierarchindex, name, start, end, effort, duration, completed, chart
|
||||
timeformat \"%Y-%m-%d\"
|
||||
hideresource 1
|
||||
loadunit shortauto
|
||||
}"
|
||||
"resourcereport \"Resource Graph\" {
|
||||
headline \"Resource Allocation Graph\"
|
||||
columns no, name, utilization, freeload, chart
|
||||
loadunit shortauto
|
||||
sorttasks startup
|
||||
hidetask ~isleaf()
|
||||
}")
|
||||
"Default reports for the project."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type '(repeat (string :tag "Report")))
|
||||
|
||||
(defcustom org-export-taskjuggler-default-global-header
|
||||
""
|
||||
"Default global header for the project. This goes before
|
||||
project declaration, and might be useful for early macros"
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type '(string :tag "Preamble"))
|
||||
|
||||
(defcustom org-export-taskjuggler-default-global-properties
|
||||
"shift s40 \"Part time shift\" {
|
||||
workinghours wed, thu, fri off
|
||||
}
|
||||
"
|
||||
"Default global properties for the project. Here you typically
|
||||
define global properties such as shifts, accounts, rates,
|
||||
vacation, macros and flags. Any property that is allowed within
|
||||
the TaskJuggler file can be inserted. You could for example
|
||||
include another TaskJuggler file.
|
||||
|
||||
The global properties are inserted after the project declaration
|
||||
but before any resource and task declarations."
|
||||
:group 'org-export-taskjuggler
|
||||
:version "24.1"
|
||||
:type '(string :tag "Preamble"))
|
||||
|
||||
(defcustom org-export-taskjuggler-valid-task-attributes
|
||||
'(account start note duration endbuffer endcredit end
|
||||
flags journalentry length limits maxend maxstart minend
|
||||
minstart period reference responsible scheduling
|
||||
startbuffer startcredit statusnote chargeset charge)
|
||||
"Valid attributes for Taskjuggler tasks. If one of these
|
||||
appears as a property for a headline, it will be exported with
|
||||
the corresponding task."
|
||||
:group 'org-export-taskjuggler)
|
||||
|
||||
(defcustom org-export-taskjuggler-valid-resource-attributes
|
||||
'(limits vacation shift booking efficiency journalentry rate
|
||||
workinghours flags)
|
||||
"Valid attributes for Taskjuggler resources. If one of these
|
||||
appears as a property for a headline, it will be exported with
|
||||
the corresponding resource."
|
||||
:group 'org-export-taskjuggler)
|
||||
|
||||
(defcustom org-export-taskjuggler-valid-report-attributes
|
||||
'(headline columns definitions timeformat hideresource hidetask
|
||||
loadunit sorttasks formats period)
|
||||
"Valid attributes for Taskjuggler reports. If one of these
|
||||
appears as a property for a headline, it will be exported with
|
||||
the corresponding report."
|
||||
:group 'org-export-taskjuggler)
|
||||
|
||||
(defcustom org-export-taskjuggler-keep-project-as-task t
|
||||
"Whether to keep the project headline as an umbrella task for
|
||||
all declared tasks. Setting this to nil will allow maintaining
|
||||
completely separated task buckets, while still sharing the same
|
||||
resources pool."
|
||||
:group 'org-export-taskjuggler
|
||||
:type 'boolean)
|
||||
|
||||
;;; Hooks
|
||||
|
||||
(defvar org-export-taskjuggler-final-hook nil
|
||||
"Hook run at the end of TaskJuggler export, in the new buffer.")
|
||||
|
||||
;;; Autoload functions:
|
||||
|
||||
;; avoid compiler warning about free variable
|
||||
(defvar org-export-taskjuggler-old-level)
|
||||
|
||||
(defun org-export-as-taskjuggler (&optional arg hidden ext-plist
|
||||
to-buffer body-only pub-dir)
|
||||
"Export parts of the current buffer as a TaskJuggler file.
|
||||
The exporter looks for a tree with tag, property or todo that
|
||||
matches `org-export-taskjuggler-project-tag' and takes this as
|
||||
the tasks for this project. The first node of this tree defines
|
||||
the project properties such as project name and project period.
|
||||
If there is a tree with tag, property or todo that matches
|
||||
`org-export-taskjuggler-resource-tag' this three is taken as
|
||||
resources for the project. If no resources are specified, a
|
||||
default resource is created and allocated to the project. Also
|
||||
the taskjuggler project will be created with default reports as
|
||||
defined in `org-export-taskjuggler-default-reports'."
|
||||
(interactive "P")
|
||||
|
||||
(message "Exporting...")
|
||||
(setq-default org-done-keywords org-done-keywords)
|
||||
(let* ((opt-plist (org-combine-plists (org-default-export-plist)
|
||||
ext-plist
|
||||
(org-infile-export-plist)))
|
||||
(org-export-opt-plist opt-plist)
|
||||
(tasks
|
||||
(org-taskjuggler-resolve-dependencies
|
||||
(org-taskjuggler-assign-task-ids
|
||||
(org-taskjuggler-compute-task-leafiness
|
||||
(org-map-entries
|
||||
'org-taskjuggler-components
|
||||
org-export-taskjuggler-project-tag nil 'archive 'comment)))))
|
||||
(resources
|
||||
(org-taskjuggler-assign-resource-ids
|
||||
(org-map-entries
|
||||
'org-taskjuggler-components
|
||||
org-export-taskjuggler-resource-tag nil 'archive 'comment)))
|
||||
(reports
|
||||
(org-map-entries
|
||||
'org-taskjuggler-components
|
||||
org-export-taskjuggler-report-tag nil 'archive 'comment))
|
||||
(filename (if to-buffer
|
||||
nil
|
||||
(concat (file-name-as-directory
|
||||
(or pub-dir
|
||||
(org-export-directory :tj opt-plist)))
|
||||
(file-name-sans-extension
|
||||
(file-name-nondirectory buffer-file-name))
|
||||
org-export-taskjuggler-extension)))
|
||||
(buffer (if to-buffer
|
||||
(cond
|
||||
((eq to-buffer 'string)
|
||||
(get-buffer-create "*Org Taskjuggler Export*"))
|
||||
(t (get-buffer-create to-buffer)))
|
||||
(find-file-noselect filename)))
|
||||
(old-buffer (current-buffer))
|
||||
(org-export-taskjuggler-old-level 0)
|
||||
task resource)
|
||||
(unless tasks
|
||||
(error "No tasks specified"))
|
||||
;; add a default resource
|
||||
(unless resources
|
||||
(setq resources
|
||||
`((("resource_id" . ,(user-login-name))
|
||||
("HEADLINE" . ,user-full-name)
|
||||
("level" . 1)))))
|
||||
;; add a default allocation to the first task if none was given
|
||||
(unless (assoc "allocate" (car tasks))
|
||||
(let ((task (car tasks))
|
||||
(resource-id (cdr (assoc "resource_id" (car resources)))))
|
||||
(setcar tasks (push (cons "allocate" resource-id) task))))
|
||||
;; add a default start date to the first task if none was given
|
||||
(unless (assoc "start" (car tasks))
|
||||
(let ((task (car tasks))
|
||||
(time-string (format-time-string "%Y-%m-%d")))
|
||||
(setcar tasks (push (cons "start" time-string) task))))
|
||||
;; add a default version if none was given
|
||||
(unless (assoc "version" (car tasks))
|
||||
(let ((task (car tasks))
|
||||
(version org-export-taskjuggler-default-project-version))
|
||||
(setcar tasks (push (cons "version" version) task))))
|
||||
(with-current-buffer buffer
|
||||
(erase-buffer)
|
||||
(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-clone-local-variables old-buffer "^org-")
|
||||
(insert org-export-taskjuggler-default-global-header)
|
||||
(org-taskjuggler-open-project
|
||||
(if org-export-taskjuggler-keep-project-as-task
|
||||
(car tasks)
|
||||
(pop tasks)))
|
||||
(insert org-export-taskjuggler-default-global-properties)
|
||||
(insert "\n")
|
||||
(dolist (resource resources)
|
||||
(let ((level (cdr (assoc "level" resource))))
|
||||
(org-taskjuggler-close-maybe level)
|
||||
(org-taskjuggler-open-resource resource)
|
||||
(setq org-export-taskjuggler-old-level level)))
|
||||
(org-taskjuggler-close-maybe 1)
|
||||
(setq org-export-taskjuggler-old-level 0)
|
||||
(dolist (task tasks)
|
||||
(let ((level (cdr (assoc "level" task))))
|
||||
(org-taskjuggler-close-maybe level)
|
||||
(org-taskjuggler-open-task task)
|
||||
(setq org-export-taskjuggler-old-level level)))
|
||||
(org-taskjuggler-close-maybe
|
||||
(if org-export-taskjuggler-keep-project-as-task
|
||||
1 2))
|
||||
(org-taskjuggler-insert-reports reports)
|
||||
(or to-buffer (save-buffer))
|
||||
(or (org-export-push-to-kill-ring "TaskJuggler")
|
||||
(message "Exporting... done"))
|
||||
(if (eq to-buffer 'string)
|
||||
(prog1 (buffer-substring (point-min) (point-max))
|
||||
(kill-buffer (current-buffer)))
|
||||
(current-buffer)))))
|
||||
|
||||
(defun org-export-as-taskjuggler-and-open ()
|
||||
"Export the current buffer as a TaskJuggler file and open it
|
||||
with the TaskJuggler GUI."
|
||||
(interactive)
|
||||
(let* ((file-name (buffer-file-name (org-export-as-taskjuggler)))
|
||||
(process-name "TaskJugglerUI")
|
||||
(command (concat process-name " " file-name)))
|
||||
(start-process-shell-command process-name nil command)))
|
||||
|
||||
(defun org-taskjuggler-targeting-tj3-p ()
|
||||
"Return true if we are targeting TaskJuggler III."
|
||||
(>= org-export-taskjuggler-target-version 3.0))
|
||||
|
||||
(defun org-taskjuggler-parent-is-ordered-p ()
|
||||
"Return true if the parent of the current node has a property
|
||||
\"ORDERED\". Return nil otherwise."
|
||||
(save-excursion
|
||||
(and (org-up-heading-safe) (org-entry-get (point) "ORDERED"))))
|
||||
|
||||
(defun org-taskjuggler-date (date)
|
||||
(let ((time (parse-time-string date)))
|
||||
(format "%d-%02d-%02d" (nth 5 time) (nth 4 time) (nth 3 time))))
|
||||
|
||||
(defun org-taskjuggler-components ()
|
||||
"Return an alist containing all the pertinent information for
|
||||
the current node such as the headline, the level, todo state
|
||||
information, all the properties, etc."
|
||||
(let* ((props (org-entry-properties))
|
||||
(components (org-heading-components))
|
||||
(level (nth 1 components))
|
||||
(headline
|
||||
(replace-regexp-in-string
|
||||
"\"" "\\\"" (nth 4 components) t t)) ; quote double quotes in headlines
|
||||
(parent-ordered (org-taskjuggler-parent-is-ordered-p)))
|
||||
(let ((scheduled (assoc "SCHEDULED" props))
|
||||
(deadline (assoc "DEADLINE" props)))
|
||||
(when scheduled
|
||||
(push (cons "start" (org-taskjuggler-date (cdr scheduled))) props))
|
||||
(when deadline
|
||||
(push (cons "end" (org-taskjuggler-date (cdr deadline))) props)))
|
||||
(push (cons "level" level) props)
|
||||
(push (cons "HEADLINE" headline) props)
|
||||
(push (cons "parent-ordered" parent-ordered) props)))
|
||||
|
||||
(defun org-taskjuggler-assign-task-ids (tasks)
|
||||
"Given a list of tasks return the same list assigning a unique id
|
||||
and the full path to each task. Taskjuggler takes hierarchical ids.
|
||||
For that reason we have to make ids locally unique and we have to keep
|
||||
a path to the current task."
|
||||
(let ((previous-level 0)
|
||||
unique-ids unique-id
|
||||
path
|
||||
task resolved-tasks tmp)
|
||||
(dolist (task tasks resolved-tasks)
|
||||
(let ((level (cdr (assoc "level" task))))
|
||||
(cond
|
||||
((< previous-level level)
|
||||
(setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
|
||||
(dotimes (tmp (- level previous-level))
|
||||
(push (list unique-id) unique-ids)
|
||||
(push unique-id path)))
|
||||
((= previous-level level)
|
||||
(setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
|
||||
(push unique-id (car unique-ids))
|
||||
(setcar path unique-id))
|
||||
((> previous-level level)
|
||||
(dotimes (tmp (- previous-level level))
|
||||
(pop unique-ids)
|
||||
(pop path))
|
||||
(setq unique-id (org-taskjuggler-get-unique-id task (car unique-ids)))
|
||||
(push unique-id (car unique-ids))
|
||||
(setcar path unique-id)))
|
||||
(push (cons "unique-id" unique-id) task)
|
||||
(push (cons "path"
|
||||
(mapconcat 'identity
|
||||
(if org-export-taskjuggler-keep-project-as-task
|
||||
(reverse path)
|
||||
(cdr (reverse path))) ".")) task)
|
||||
(setq previous-level level)
|
||||
(setq resolved-tasks (append resolved-tasks (list task)))))))
|
||||
|
||||
(defun org-taskjuggler-compute-task-leafiness (tasks)
|
||||
"Figure out if each task is a leaf by looking at it's level,
|
||||
and the level of its successor. If the successor is higher (ie
|
||||
deeper), then it's not a leaf."
|
||||
(let (new-list)
|
||||
(while (car tasks)
|
||||
(let ((task (car tasks))
|
||||
(successor (car (cdr tasks))))
|
||||
(cond
|
||||
;; if a task has no successors it is a leaf
|
||||
((null successor)
|
||||
(push (cons (cons "leaf-node" t) task) new-list))
|
||||
;; if the successor has a lower level than task it is a leaf
|
||||
((<= (cdr (assoc "level" successor)) (cdr (assoc "level" task)))
|
||||
(push (cons (cons "leaf-node" t) task) new-list))
|
||||
;; otherwise examine the rest of the tasks
|
||||
(t (push task new-list))))
|
||||
(setq tasks (cdr tasks)))
|
||||
(nreverse new-list)))
|
||||
|
||||
(defun org-taskjuggler-assign-resource-ids (resources)
|
||||
"Given a list of resources return the same list, assigning a
|
||||
unique id to each resource."
|
||||
(let (unique-ids new-list)
|
||||
(dolist (resource resources new-list)
|
||||
(let ((unique-id (org-taskjuggler-get-unique-id resource unique-ids)))
|
||||
(push (cons "unique-id" unique-id) resource)
|
||||
(push unique-id unique-ids)
|
||||
(push resource new-list)))
|
||||
(nreverse new-list)))
|
||||
|
||||
(defun org-taskjuggler-resolve-dependencies (tasks)
|
||||
(let ((previous-level 0)
|
||||
siblings
|
||||
task resolved-tasks)
|
||||
(dolist (task tasks resolved-tasks)
|
||||
(let* ((level (cdr (assoc "level" task)))
|
||||
(depends (cdr (assoc "depends" task)))
|
||||
(parent-ordered (cdr (assoc "parent-ordered" task)))
|
||||
(blocker (cdr (assoc "BLOCKER" task)))
|
||||
(blocked-on-previous
|
||||
(and blocker (string-match "previous-sibling" blocker)))
|
||||
(dependencies
|
||||
(org-taskjuggler-resolve-explicit-dependencies
|
||||
(append
|
||||
(and depends (org-taskjuggler-tokenize-dependencies depends))
|
||||
(and blocker (org-taskjuggler-tokenize-dependencies blocker)))
|
||||
tasks))
|
||||
previous-sibling)
|
||||
; update previous sibling info
|
||||
(cond
|
||||
((< previous-level level)
|
||||
(dotimes (tmp (- level previous-level))
|
||||
(push task siblings)))
|
||||
((= previous-level level)
|
||||
(setq previous-sibling (car siblings))
|
||||
(setcar siblings task))
|
||||
((> previous-level level)
|
||||
(dotimes (tmp (- previous-level level))
|
||||
(pop siblings))
|
||||
(setq previous-sibling (car siblings))
|
||||
(setcar siblings task)))
|
||||
; insert a dependency on previous sibling if the parent is
|
||||
; ordered or if the tasks has a BLOCKER attribute with value "previous-sibling"
|
||||
(when (or (and previous-sibling parent-ordered) blocked-on-previous)
|
||||
(push (format "!%s" (cdr (assoc "unique-id" previous-sibling))) dependencies))
|
||||
; store dependency information
|
||||
(when dependencies
|
||||
(push (cons "depends" (mapconcat 'identity dependencies ", ")) task))
|
||||
(setq previous-level level)
|
||||
(setq resolved-tasks (append resolved-tasks (list task)))))))
|
||||
|
||||
(defun org-taskjuggler-tokenize-dependencies (dependencies)
|
||||
"Split a dependency property value DEPENDENCIES into the
|
||||
individual dependencies and return them as a list while keeping
|
||||
the optional arguments (such as gapduration) for the
|
||||
dependencies. A dependency will have to match `[-a-zA-Z0-9_]+'."
|
||||
(cond
|
||||
((string-match "^ *$" dependencies) nil)
|
||||
((string-match "^[ \t]*\\([-a-zA-Z0-9_]+\\([ \t]*{[^}]+}\\)?\\)[ \t,]*" dependencies)
|
||||
(cons
|
||||
(substring dependencies (match-beginning 1) (match-end 1))
|
||||
(org-taskjuggler-tokenize-dependencies (substring dependencies (match-end 0)))))
|
||||
(t (error (format "invalid dependency id %s" dependencies)))))
|
||||
|
||||
(defun org-taskjuggler-resolve-explicit-dependencies (dependencies tasks)
|
||||
"For each dependency in DEPENDENCIES try to find a
|
||||
corresponding task with a matching property \"task_id\" in TASKS.
|
||||
Return a list containing the resolved links for all DEPENDENCIES
|
||||
where a matching tasks was found. If the dependency is
|
||||
\"previous-sibling\" it is ignored (as this is dealt with in
|
||||
`org-taskjuggler-resolve-dependencies'). If there is no matching
|
||||
task the dependency is ignored and a warning is displayed ."
|
||||
(unless (null dependencies)
|
||||
(let*
|
||||
;; the dependency might have optional attributes such as "{
|
||||
;; gapduration 5d }", so only use the first string as id for the
|
||||
;; dependency
|
||||
((dependency (car dependencies))
|
||||
(id (car (split-string dependency)))
|
||||
(optional-attributes
|
||||
(mapconcat 'identity (cdr (split-string dependency)) " "))
|
||||
(path (org-taskjuggler-find-task-with-id id tasks)))
|
||||
(cond
|
||||
;; ignore previous sibling dependencies
|
||||
((equal (car dependencies) "previous-sibling")
|
||||
(org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))
|
||||
;; if the id is found in another task use its path
|
||||
((not (null path))
|
||||
(cons (mapconcat 'identity (list path optional-attributes) " ")
|
||||
(org-taskjuggler-resolve-explicit-dependencies
|
||||
(cdr dependencies) tasks)))
|
||||
;; warn about dangling dependency but otherwise ignore it
|
||||
(t (display-warning
|
||||
'org-export-taskjuggler
|
||||
(format "No task with matching property \"task_id\" found for id %s" id))
|
||||
(org-taskjuggler-resolve-explicit-dependencies (cdr dependencies) tasks))))))
|
||||
|
||||
(defun org-taskjuggler-find-task-with-id (id tasks)
|
||||
"Find ID in tasks. If found return the path of task. Otherwise
|
||||
return nil."
|
||||
(let ((task-id (cdr (assoc "task_id" (car tasks))))
|
||||
(path (cdr (assoc "path" (car tasks)))))
|
||||
(cond
|
||||
((null tasks) nil)
|
||||
((equal task-id id) path)
|
||||
(t (org-taskjuggler-find-task-with-id id (cdr tasks))))))
|
||||
|
||||
(defun org-taskjuggler-get-unique-id (item unique-ids)
|
||||
"Return a unique id for an ITEM which can be a task or a resource.
|
||||
The id is derived from the headline and made unique against
|
||||
UNIQUE-IDS. If the (downcased) first token of the headline is not
|
||||
unique try to add more (downcased) tokens of the headline or
|
||||
finally add more underscore characters (\"_\")."
|
||||
(let* ((headline (cdr (assoc "HEADLINE" item)))
|
||||
(parts (split-string headline))
|
||||
(id (org-taskjuggler-clean-id (downcase (pop parts)))))
|
||||
; try to add more parts of the headline to make it unique
|
||||
(while (and (member id unique-ids) (car parts))
|
||||
(setq id (concat id "_" (org-taskjuggler-clean-id (downcase (pop parts))))))
|
||||
; if its still not unique add "_"
|
||||
(while (member id unique-ids)
|
||||
(setq id (concat id "_")))
|
||||
id))
|
||||
|
||||
(defun org-taskjuggler-clean-id (id)
|
||||
"Clean and return ID to make it acceptable for taskjuggler."
|
||||
(and id
|
||||
;; replace non-ascii by _
|
||||
(replace-regexp-in-string
|
||||
"[^a-zA-Z0-9_]" "_"
|
||||
;; make sure id doesn't start with a number
|
||||
(replace-regexp-in-string "^\\([0-9]\\)" "_\\1" id))))
|
||||
|
||||
(defun org-taskjuggler-open-project (project)
|
||||
"Insert the beginning of a project declaration. All valid
|
||||
attributes from the PROJECT alist are inserted. If no end date is
|
||||
specified it is calculated
|
||||
`org-export-taskjuggler-default-project-duration' days from now."
|
||||
(let* ((unique-id (cdr (assoc "unique-id" project)))
|
||||
(headline (cdr (assoc "HEADLINE" project)))
|
||||
(version (cdr (assoc "version" project)))
|
||||
(start (cdr (assoc "start" project)))
|
||||
(end (cdr (assoc "end" project))))
|
||||
(insert
|
||||
(format "project %s \"%s\" \"%s\" %s %s {\n }\n"
|
||||
unique-id headline version start
|
||||
(or (and end (format "- %s" end))
|
||||
(format "+%sd"
|
||||
org-export-taskjuggler-default-project-duration))))))
|
||||
|
||||
(defun org-taskjuggler-filter-and-join (items)
|
||||
"Filter all nil elements from ITEMS and join the remaining ones
|
||||
with separator \"\n\"."
|
||||
(let ((filtered-items (remq nil items)))
|
||||
(and filtered-items (mapconcat 'identity filtered-items "\n"))))
|
||||
|
||||
(defun org-taskjuggler-get-attributes (item attributes)
|
||||
"Return all attribute as a single formatted string. ITEM is an
|
||||
alist representing either a resource or a task. ATTRIBUTES is a
|
||||
list of symbols. Only entries from ITEM are considered that are
|
||||
listed in ATTRIBUTES."
|
||||
(org-taskjuggler-filter-and-join
|
||||
(mapcar
|
||||
(lambda (attribute)
|
||||
(org-taskjuggler-filter-and-join
|
||||
(org-taskjuggler-get-attribute item attribute)))
|
||||
attributes)))
|
||||
|
||||
(defun org-taskjuggler-get-attribute (item attribute)
|
||||
"Return a list of strings containing the properly formatted
|
||||
taskjuggler declaration for a given ATTRIBUTE in ITEM (an alist).
|
||||
If the ATTRIBUTE is not in ITEM return nil."
|
||||
(cond
|
||||
((null item) nil)
|
||||
((equal (symbol-name attribute) (car (car item)))
|
||||
(cons (format "%s %s" (symbol-name attribute) (cdr (car item)))
|
||||
(org-taskjuggler-get-attribute (cdr item) attribute)))
|
||||
(t (org-taskjuggler-get-attribute (cdr item) attribute))))
|
||||
|
||||
(defun org-taskjuggler-open-resource (resource)
|
||||
"Insert the beginning of a resource declaration. All valid
|
||||
attributes from the RESOURCE alist are inserted. If the RESOURCE
|
||||
defines a property \"resource_id\" it will be used as the id for
|
||||
this resource. Otherwise it will use the ID property. If neither
|
||||
is defined it will calculate a unique id for the resource using
|
||||
`org-taskjuggler-get-unique-id'."
|
||||
(let ((id (org-taskjuggler-clean-id
|
||||
(or (cdr (assoc "resource_id" resource))
|
||||
(cdr (assoc "ID" resource))
|
||||
(cdr (assoc "unique-id" resource)))))
|
||||
(headline (cdr (assoc "HEADLINE" resource)))
|
||||
(attributes org-export-taskjuggler-valid-resource-attributes))
|
||||
(insert
|
||||
(concat
|
||||
"resource " id " \"" headline "\" {\n "
|
||||
(org-taskjuggler-get-attributes resource attributes) "\n"))))
|
||||
|
||||
(defun org-taskjuggler-clean-effort (effort)
|
||||
"Translate effort strings into a format acceptable to taskjuggler,
|
||||
i.e. REAL UNIT. A valid effort string can be anything that is
|
||||
accepted by `org-duration-string-to-minutes´."
|
||||
(cond
|
||||
((null effort) effort)
|
||||
(t (let* ((minutes (org-duration-string-to-minutes effort))
|
||||
(hours (/ minutes 60.0)))
|
||||
(format "%.1fh" hours)))))
|
||||
|
||||
(defun org-taskjuggler-get-priority (priority)
|
||||
"Return a priority between 1 and 1000 based on PRIORITY, an
|
||||
org-mode priority string."
|
||||
(max 1 (/ (* 1000 (- org-lowest-priority (string-to-char priority)))
|
||||
(- org-lowest-priority org-highest-priority))))
|
||||
|
||||
(defun org-taskjuggler-open-task (task)
|
||||
(let* ((unique-id (cdr (assoc "unique-id" task)))
|
||||
(headline (cdr (assoc "HEADLINE" task)))
|
||||
(effort (org-taskjuggler-clean-effort (cdr (assoc org-effort-property task))))
|
||||
(depends (cdr (assoc "depends" task)))
|
||||
(allocate (cdr (assoc "allocate" task)))
|
||||
(priority-raw (cdr (assoc "PRIORITY" task)))
|
||||
(priority (and priority-raw (org-taskjuggler-get-priority priority-raw)))
|
||||
(state (cdr (assoc "TODO" task)))
|
||||
(complete (or (and (member state org-done-keywords) "100")
|
||||
(cdr (assoc "complete" task))))
|
||||
(parent-ordered (cdr (assoc "parent-ordered" task)))
|
||||
(previous-sibling (cdr (assoc "previous-sibling" task)))
|
||||
(milestone (or (cdr (assoc "milestone" task))
|
||||
(and (assoc "leaf-node" task)
|
||||
(not (or effort
|
||||
(cdr (assoc "length" task))
|
||||
(cdr (assoc "duration" task))
|
||||
(and (cdr (assoc "start" task))
|
||||
(cdr (assoc "end" task)))
|
||||
(cdr (assoc "period" task)))))))
|
||||
(attributes org-export-taskjuggler-valid-task-attributes))
|
||||
(insert
|
||||
(concat
|
||||
"task " unique-id " \"" headline "\" {\n"
|
||||
(if (and parent-ordered previous-sibling)
|
||||
(format " depends %s\n" previous-sibling)
|
||||
(and depends (format " depends %s\n" depends)))
|
||||
(and allocate (format " purge %s\n allocate %s\n"
|
||||
(or (and (org-taskjuggler-targeting-tj3-p) "allocate")
|
||||
"allocations")
|
||||
allocate))
|
||||
(and complete (format " complete %s\n" complete))
|
||||
(and effort (format " effort %s\n" effort))
|
||||
(and priority (format " priority %s\n" priority))
|
||||
(and milestone (format " milestone\n"))
|
||||
|
||||
(org-taskjuggler-get-attributes task attributes)
|
||||
"\n"))))
|
||||
|
||||
(defun org-taskjuggler-open-report (report)
|
||||
(let* ((kind (or (cdr (assoc "report-kind" report)) "taskreport"))
|
||||
(headline (cdr (assoc "HEADLINE" report)))
|
||||
(attributes org-export-taskjuggler-valid-report-attributes))
|
||||
(insert
|
||||
(concat
|
||||
kind " \"" headline "\" {\n"
|
||||
(org-taskjuggler-get-attributes report attributes)
|
||||
"\n}\n"))))
|
||||
|
||||
(defun org-taskjuggler-close-maybe (level)
|
||||
(while (> org-export-taskjuggler-old-level level)
|
||||
(insert "}\n")
|
||||
(setq org-export-taskjuggler-old-level (1- org-export-taskjuggler-old-level)))
|
||||
(when (= org-export-taskjuggler-old-level level)
|
||||
(insert "}\n")))
|
||||
|
||||
(defun org-taskjuggler-insert-reports (reports)
|
||||
(if reports
|
||||
(dolist (report (cdr reports))
|
||||
(org-taskjuggler-open-report report))
|
||||
(let (report)
|
||||
(dolist (report org-export-taskjuggler-default-reports)
|
||||
(insert report "\n")))))
|
||||
|
||||
(provide 'org-taskjuggler)
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
;; End:
|
||||
|
||||
;;; org-taskjuggler.el ends here
|
||||
|
|
@ -1,128 +0,0 @@
|
|||
;;; org-xoxo.el --- XOXO export for Org-mode
|
||||
|
||||
;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Carsten Dominik <carsten at orgmode dot org>
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;;
|
||||
;; This file is part of GNU Emacs.
|
||||
;;
|
||||
;; GNU Emacs is free software: you can redistribute it and/or modify
|
||||
;; it under the terms of the GNU General Public License as published by
|
||||
;; the Free Software Foundation, either version 3 of the License, or
|
||||
;; (at your option) any later version.
|
||||
|
||||
;; GNU Emacs is distributed in the hope that it will be useful,
|
||||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;; GNU General Public License for more details.
|
||||
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;;; Commentary:
|
||||
;; XOXO export
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'org-exp)
|
||||
|
||||
(defvar org-export-xoxo-final-hook nil
|
||||
"Hook run after XOXO export, in the new buffer.")
|
||||
|
||||
(defun org-export-as-xoxo-insert-into (buffer &rest output)
|
||||
(with-current-buffer buffer
|
||||
(apply 'insert output)))
|
||||
(put 'org-export-as-xoxo-insert-into 'lisp-indent-function 1)
|
||||
|
||||
(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
|
||||
|
|
@ -1,651 +0,0 @@
|
|||
;;; org2rem.el --- Convert org appointments into reminders
|
||||
|
||||
;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
|
||||
|
||||
;; Author: Bastien Guerry and Shatad Pratap
|
||||
;; Keywords: outlines, hypermedia, calendar, wp
|
||||
;; Homepage: http://orgmode.org
|
||||
;; Version: 6.09a
|
||||
;;
|
||||
;; This file is not 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:
|
||||
|
||||
;; (require 'org2rem)
|
||||
;; To export, do
|
||||
;;
|
||||
;; M-x org2rem-combine-agenda-files
|
||||
;;
|
||||
;; Then you can use reming like this:
|
||||
;;
|
||||
;; $ remind ~/org.rem
|
||||
;;
|
||||
;; If you want to use this regualrly, try in .emacs
|
||||
;;
|
||||
;; (add-hook 'org-mode-hook
|
||||
;; (lambda() (add-hook 'after-save-hook
|
||||
;; 'org-export-remind-all-agenda-files t t)))
|
||||
|
||||
(require 'org)
|
||||
(require 'org-agenda)
|
||||
(require 'org-exp)
|
||||
(eval-and-compile
|
||||
(require 'cl))
|
||||
|
||||
(defgroup org2rem nil
|
||||
"Options specific for Remind export of Org-mode files."
|
||||
:tag "Org Export Remind"
|
||||
:group 'org-export)
|
||||
|
||||
(defcustom org-combined-agenda-remind-file "~/org.rem"
|
||||
"The file name for the Remind file covering all agenda files.
|
||||
This file is created with the command \\[org2rem-all-agenda-files].
|
||||
The file name should be absolute, the file will be overwritten without warning."
|
||||
:group 'org2rem
|
||||
:type 'file)
|
||||
|
||||
(defcustom org-remind-combined-name "OrgMode"
|
||||
"Calendar name for the combined Remind representing all agenda files."
|
||||
:group 'org2rem
|
||||
:type 'string)
|
||||
|
||||
(defcustom org-remind-use-deadline '(event-if-not-todo todo-due)
|
||||
"Contexts where Remind 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 'org2rem
|
||||
: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-remind-use-scheduled '(todo-start)
|
||||
"Contexts where Remind 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 'org2rem
|
||||
: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-remind-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 'org2rem
|
||||
: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-remind-include-todo nil
|
||||
"Non-nil means export to remind files should also cover TODO items."
|
||||
:group 'org2rem
|
||||
:type '(choice
|
||||
(const :tag "None" nil)
|
||||
(const :tag "Unfinished" t)
|
||||
(const :tag "All" all)))
|
||||
|
||||
(defcustom org-remind-include-sexps t
|
||||
"Non-nil means export to Remind files should also cover sexp entries.
|
||||
These are entries like in the diary, but directly in an Org-mode file."
|
||||
:group 'org2rem
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-remind-deadline-over-scheduled t
|
||||
"Non-nil means use deadline as target when both deadline and
|
||||
scheduled present, vice-versa. Default is Non-nil."
|
||||
:group 'org2rem
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-remind-escape-percentage t
|
||||
"Non-nil means % will be escaped, vice-versa. Default is Non-nil."
|
||||
:group 'org2rem
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-remind-extra-warn-days 3
|
||||
"Extra days Remind keep reminding."
|
||||
:group 'org2rem
|
||||
:type 'number)
|
||||
|
||||
(defcustom org-remind-advanced-warn-days 3
|
||||
"Advanced days Remind start reminding."
|
||||
:group 'org2rem
|
||||
:type 'number)
|
||||
|
||||
(defcustom org-remind-suppress-last-newline nil
|
||||
"Non-nil means suppress last newline REM body. Default is nil."
|
||||
:group 'org2rem
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-remind-include-body 100
|
||||
"Amount of text below headline to be included in Remind 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 'org2rem
|
||||
:type '(choice
|
||||
(const :tag "Nothing" nil)
|
||||
(const :tag "Everything" t)
|
||||
(integer :tag "Max characters")))
|
||||
|
||||
(defcustom org-remind-store-UID nil
|
||||
"Non-nil means store any created UIDs in properties.
|
||||
The Remind 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 'org2rem
|
||||
:type 'boolean)
|
||||
|
||||
;;;; Exporting
|
||||
|
||||
;;; Remind export
|
||||
|
||||
;;;###autoload
|
||||
(defun org2rem-this-file ()
|
||||
"Export current file as an Remind file.
|
||||
The Remind file will be located in the same directory as the Org-mode
|
||||
file, but with extension `.rem'."
|
||||
(interactive)
|
||||
(org2rem nil buffer-file-name))
|
||||
|
||||
;;;###autoload
|
||||
(defun org2rem-all-agenda-files ()
|
||||
"Export all files in `org-agenda-files' to Remind .rem files.
|
||||
Each Remind file will be located in the same directory as the Org-mode
|
||||
file, but with extension `.rem'."
|
||||
(interactive)
|
||||
(apply 'org2rem nil (org-agenda-files t)))
|
||||
|
||||
;;;###autoload
|
||||
(defun org2rem-combine-agenda-files ()
|
||||
"Export all files in `org-agenda-files' to a single combined Remind file.
|
||||
The file is stored under the name `org-combined-agenda-remind-file'."
|
||||
(interactive)
|
||||
(apply 'org2rem t (org-agenda-files t)))
|
||||
|
||||
(defun org2rem (combine &rest files)
|
||||
"Create Remind 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-remind-file'."
|
||||
(save-excursion
|
||||
(org-agenda-prepare-buffers files)
|
||||
(let* ((dir (org-export-directory
|
||||
:ical (list :publishing-directory
|
||||
org-export-publishing-directory)))
|
||||
file rem-file rem-buffer category started org-agenda-new-buffers)
|
||||
(and (get-buffer "*rem-tmp*") (kill-buffer "*rem-tmp*"))
|
||||
(when combine
|
||||
(setq rem-file
|
||||
(if (file-name-absolute-p org-combined-agenda-remind-file)
|
||||
org-combined-agenda-remind-file
|
||||
(expand-file-name org-combined-agenda-remind-file dir))
|
||||
rem-buffer (org-get-agenda-file-buffer rem-file))
|
||||
(set-buffer rem-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 rem-file (concat (file-name-as-directory dir)
|
||||
(file-name-sans-extension
|
||||
(file-name-nondirectory buffer-file-name))
|
||||
".rem"))
|
||||
(setq rem-buffer (org-get-agenda-file-buffer rem-file))
|
||||
(with-current-buffer rem-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 rem-buffer))
|
||||
(if combine
|
||||
(and (not started) (setq started t)
|
||||
(org-start-remind-file org-remind-combined-name))
|
||||
(org-start-remind-file category))
|
||||
(org-print-remind-entries combine)
|
||||
(when (or (and combine (not files)) (not combine))
|
||||
(org-finish-remind-file)
|
||||
(set-buffer rem-buffer)
|
||||
(run-hooks 'org-before-save-Remind-file-hook)
|
||||
(save-buffer)
|
||||
(run-hooks 'org-after-save-Remind-file-hook)
|
||||
(and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait))
|
||||
))))
|
||||
(org-release-buffers org-agenda-new-buffers))))
|
||||
|
||||
(defvar org-before-save-Remind-file-hook nil
|
||||
"Hook run before an Remind file has been saved.
|
||||
This can be used to modify the result of the export.")
|
||||
|
||||
(defvar org-after-save-Remind-file-hook nil
|
||||
"Hook run after an Remind file has been saved.
|
||||
The Remind buffer is still current when this hook is run.
|
||||
A good way to use this is to tell a desktop calenndar application to re-read
|
||||
the Remind file.")
|
||||
|
||||
(defvar org-agenda-default-appointment-duration) ; defined in org-agenda.el
|
||||
(defun org-print-remind-entries (&optional combine)
|
||||
"Print Remind 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-rem-ts-to-string
|
||||
(format-time-string (cdr org-time-stamp-formats) (current-time))
|
||||
"start time:"))
|
||||
hd ts ts2 state status (inc t) pos b sexp rrule
|
||||
scheduledp deadlinep todo prefix due start
|
||||
tmp pri categories entry location summary desc uid
|
||||
remind-aw remind-ew (org-rem-ew org-remind-extra-warn-days)
|
||||
(org-rem-aw org-remind-advanced-warn-days)
|
||||
trigger diff-days (dos org-remind-deadline-over-scheduled)
|
||||
(suppress-last-newline org-remind-suppress-last-newline)
|
||||
(sexp-buffer (get-buffer-create "*rem-tmp*")))
|
||||
(org-refresh-category-properties)
|
||||
(save-excursion
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward re1 nil t)
|
||||
(catch :skip
|
||||
(org-agenda-skip)
|
||||
(when (boundp 'org-remind-verify-function)
|
||||
(unless (funcall org-remind-verify-function)
|
||||
(outline-next-heading)
|
||||
(backward-char 1)
|
||||
(throw :skip nil)))
|
||||
(setq pos (match-beginning 0)
|
||||
ts (match-string 0)
|
||||
inc t
|
||||
hd (condition-case nil
|
||||
(org-remind-cleanup-string
|
||||
(org-get-heading))
|
||||
(error (throw :skip nil)))
|
||||
summary (org-remind-cleanup-string
|
||||
(org-entry-get nil "SUMMARY"))
|
||||
desc (org-remind-cleanup-string
|
||||
(or (org-entry-get nil "DESCRIPTION")
|
||||
(and org-remind-include-body (org-get-entry)))
|
||||
t org-remind-include-body)
|
||||
location (org-remind-cleanup-string
|
||||
(org-entry-get nil "LOCATION"))
|
||||
uid (if org-remind-store-UID
|
||||
(org-id-get-create)
|
||||
(or (org-id-get) (org-id-new)))
|
||||
categories (org-export-get-remind-categories)
|
||||
deadlinep nil scheduledp nil)
|
||||
(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 tmp (buffer-substring (max (point-min)
|
||||
(- pos org-ds-keyword-length))
|
||||
pos)
|
||||
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)
|
||||
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-remind-use-deadline))
|
||||
(not (memq 'event-if-not-todo org-remind-use-deadline))))
|
||||
(throw :skip t))
|
||||
(when (and
|
||||
scheduledp
|
||||
(if todo
|
||||
(not (memq 'event-if-todo org-remind-use-scheduled))
|
||||
(not (memq 'event-if-not-todo org-remind-use-scheduled))))
|
||||
(throw :skip t))
|
||||
(setq prefix (if deadlinep "DEADLINE-" (if scheduledp "SCHEDULED-" "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]+\\)\\([dwmy]\\)>" ts)
|
||||
(setq rrule ;is recurrence value. later give it good name.
|
||||
(* (string-to-number
|
||||
(cdr (assoc
|
||||
(match-string 2 ts)
|
||||
'(("d" . "1")("w" . "7")
|
||||
("m" . "0")("y" . "0")))))
|
||||
(string-to-number (match-string 1 ts))))
|
||||
(setq rrule nil))
|
||||
(setq summary (or summary hd))
|
||||
(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 "DEADLINE: " summary)))
|
||||
(if scheduledp (setq summary (concat "SCHEDULED: " summary)))
|
||||
(if (string-match "\\`<%%" ts)
|
||||
(with-current-buffer sexp-buffer
|
||||
(insert (substring ts 1 -1) " " summary "\n"))
|
||||
(princ (format "\n## BEGIN:EVENT
|
||||
## UID: %s
|
||||
REM %s %s MSG EVENT:%s%s %s%s%%
|
||||
## CATEGORIES:%s
|
||||
## END:EVENT\n"
|
||||
(concat prefix uid)
|
||||
(org-rem-ts-to-string ts nil nil rrule)
|
||||
(org-rem-ts-to-string ts2 "UNTIL " inc)
|
||||
summary
|
||||
(if (and desc (string-match "\\S-" desc))
|
||||
(concat "%_\\\n" desc) "")
|
||||
(if (and location (string-match "\\S-" location))
|
||||
(concat "\nLOCATION: " location) "")
|
||||
(if suppress-last-newline "" "%_")
|
||||
categories)))))
|
||||
|
||||
(when (and org-remind-include-sexps
|
||||
(condition-case nil (require 'remind) (error nil))
|
||||
(fboundp 'remind-export-region))
|
||||
;; Get all the literal sexps
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^&?%%(" nil t)
|
||||
(catch :skip
|
||||
(org-agenda-skip)
|
||||
(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-rem-string sexp-buffer))
|
||||
(kill-buffer sexp-buffer))
|
||||
|
||||
(when org-remind-include-todo
|
||||
(setq prefix "TODO-")
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward org-todo-line-regexp nil t)
|
||||
(catch :skip
|
||||
(org-agenda-skip)
|
||||
(when (boundp 'org-remind-verify-function)
|
||||
(unless (funcall org-remind-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
|
||||
(or (not (member state org-done-keywords))
|
||||
(eq org-remind-include-todo 'all))
|
||||
(not (member org-archive-tag (org-get-tags-at)))
|
||||
)
|
||||
(setq hd (match-string 3)
|
||||
summary (org-remind-cleanup-string
|
||||
(org-entry-get nil "SUMMARY"))
|
||||
desc (org-remind-cleanup-string
|
||||
(or (org-entry-get nil "DESCRIPTION")
|
||||
(and org-remind-include-body (org-get-entry)))
|
||||
t org-remind-include-body)
|
||||
location (org-remind-cleanup-string
|
||||
(org-entry-get nil "LOCATION"))
|
||||
due (and (member 'todo-due org-remind-use-deadline)
|
||||
(org-entry-get nil "DEADLINE"))
|
||||
start (and (member 'todo-start org-remind-use-scheduled)
|
||||
(org-entry-get nil "SCHEDULED"))
|
||||
categories (org-export-get-remind-categories)
|
||||
uid (if org-remind-store-UID
|
||||
(org-id-get-create)
|
||||
(or (org-id-get) (org-id-new))))
|
||||
|
||||
(if (and due start)
|
||||
(setq diff-days (org-rem-time-diff-days due start)))
|
||||
|
||||
(setq remind-aw
|
||||
(if due
|
||||
(if diff-days
|
||||
(if (> diff-days 0)
|
||||
(if dos diff-days 0)
|
||||
(if dos 0 diff-days))
|
||||
1000)))
|
||||
|
||||
(if (and (numberp org-rem-aw) (> org-rem-aw 0))
|
||||
(setq remind-aw (+ (or remind-aw 0) org-rem-aw)))
|
||||
|
||||
(setq remind-ew
|
||||
(if due
|
||||
(if diff-days
|
||||
(if (> diff-days 0) due nil)
|
||||
due)))
|
||||
|
||||
(setq trigger (if dos (if due due start) (if start start due)))
|
||||
;; (and trigger (setq trigger (org-rem-ts-to-string trigger nil nil 1 remind-aw)))
|
||||
(if trigger
|
||||
(setq trigger (concat
|
||||
(format "[trigger('%s')] *%d "
|
||||
(org-rem-ts-to-remind-date-type trigger) 1)
|
||||
(if remind-aw (format "++%d" remind-aw)))))
|
||||
(and due (setq due (org-rem-ts-to-remind-date-type due)))
|
||||
(and start (setq start (org-rem-ts-to-remind-date-type start)))
|
||||
(and remind-ew (setq remind-ew (org-rem-ts-to-remind-date-type remind-ew)))
|
||||
|
||||
(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 (1+ (* 8. (/ (float (- org-lowest-priority pri))
|
||||
(- org-lowest-priority org-highest-priority))))))
|
||||
|
||||
(princ (format "\n## BEGIN:TODO
|
||||
## UID: %s
|
||||
REM %s %s %s MSG TODO: %s%s%s%s%s%s%%
|
||||
## CATEGORIES:%s
|
||||
## SEQUENCE:1
|
||||
## STATUS:%s
|
||||
## END:TODO\n"
|
||||
(concat prefix uid)
|
||||
(or trigger "") ;; dts)
|
||||
(if remind-ew (format "UNTIL [trigger('%s' + %d)]" remind-ew (or org-rem-ew 0)) "")
|
||||
(if pri (format "PRIORITY %d" pri) "")
|
||||
(or summary hd)
|
||||
(if (and desc (string-match "\\S-" desc))
|
||||
(concat "%_\\\nDESCRIPTION: " desc) "")
|
||||
(if (and location (string-match "\\S-" location))
|
||||
(concat "LOCATION: " location) "")
|
||||
(if start
|
||||
(concat
|
||||
"%_\\\n['" start "' - today()] "
|
||||
"days over, for scheduled date - "
|
||||
"[trigger('" start "')]") "")
|
||||
(if due
|
||||
(concat
|
||||
"%_\\\n[today() - '" due "'] "
|
||||
"days left, to deadline date - "
|
||||
"[trigger('" due "')]") "")
|
||||
(if suppress-last-newline "" "%_")
|
||||
categories
|
||||
status)))))))))
|
||||
|
||||
(defun org-export-get-remind-categories ()
|
||||
"Get categories according to `org-remind-categories'."
|
||||
(let ((cs org-remind-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-remind-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 (or (not s) (string-match "^[ \t\n]*$" s))
|
||||
nil
|
||||
(when 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)))))
|
||||
(if org-remind-escape-percentage
|
||||
(let ((start 0))
|
||||
(while (string-match "\\([%]\\)" s start)
|
||||
(setq start (+ (match-beginning 0) 2)
|
||||
s (replace-match "\\1\\1" nil nil s)))))
|
||||
|
||||
(let ((start 0))
|
||||
(while (string-match "\\([\n]\\)" s start)
|
||||
(setq start (+ (match-beginning 0) 4) ;; less than 4 is not correct.
|
||||
s (replace-match "%_\\\\\\1" nil nil s))))
|
||||
|
||||
(let ((start 0))
|
||||
(while (string-match "\\([[]\\)" s start)
|
||||
(setq start (+ (match-beginning 0) 5)
|
||||
s (replace-match (concat "\[" "\"" "\\1" "\"" "\]") nil nil s))))
|
||||
|
||||
;;; (when is-body
|
||||
;;; (while (string-match "[ \t]*\n[ \t]*" s)
|
||||
;;; (setq s (replace-match "%_" t t s))))
|
||||
|
||||
(setq s (org-trim s))
|
||||
(if is-body
|
||||
(if maxlength
|
||||
(if (and (numberp maxlength)
|
||||
(> (length s) maxlength))
|
||||
(setq s (substring s 0 maxlength)))))
|
||||
s))
|
||||
|
||||
(defun org-get-entry ()
|
||||
"Clean-up description string."
|
||||
(save-excursion
|
||||
(org-back-to-heading t)
|
||||
(buffer-substring (point-at-bol 2) (org-end-of-subtree t))))
|
||||
|
||||
(defun org-start-remind-file (name)
|
||||
"Start an Remind file by inserting the header."
|
||||
(let ((user user-full-name)
|
||||
(name (or name "unknown"))
|
||||
(timezone (cadr (current-time-zone))))
|
||||
(princ
|
||||
(format "# -*- Mode: shell-script; auto-fill-mode: nil -*-
|
||||
## BEGIN: Reminders
|
||||
## VERSION:2.0
|
||||
## Emacs with Org-mode
|
||||
## Calendar:%s
|
||||
## Created by: %s
|
||||
## Timezone:%s
|
||||
## Calscale:Gregorian\n" name user timezone))))
|
||||
|
||||
(defun org-finish-remind-file ()
|
||||
"Finish an Remind file by inserting the END statement."
|
||||
(princ "\n## END:Reminders\n"))
|
||||
|
||||
(defun org-rem-ts-to-remind-date-type (s)
|
||||
(format-time-string
|
||||
"%Y-%m-%d"
|
||||
(apply 'encode-time (butlast (org-parse-time-string s) 3))))
|
||||
|
||||
;; (defun org-rem-date-type-to-string (s keyword &optional inc day-repeat day-advance-warn)
|
||||
;; (if trigger
|
||||
;; (setq trigger
|
||||
;; (concat
|
||||
;; (format "[trigger('%s')] *%d "
|
||||
;; (org-rem-ts-to-remind-date-type trigger) day-repeat)
|
||||
;; (if day-advance-warn (format "++%d" day-advance-warn))))))
|
||||
|
||||
;; (format-time-string "%Y"
|
||||
;; (apply 'encode-time (butlast (org-parse-time-string "<2008-11-20 Thu 10:30>") 3)))
|
||||
|
||||
(defun org-rem-ts-to-string (s keyword &optional inc day-repeat day-advance-warn)
|
||||
"Take a time string S and convert it to Remind 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 (org-parse-time-string s 'nodefault))
|
||||
t2 fmt have-time time)
|
||||
(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 (concat
|
||||
"%d %b %Y"
|
||||
(if day-advance-warn (format " ++%d" day-advance-warn))
|
||||
(if day-repeat (format " *%d" day-repeat))
|
||||
(if have-time " AT %H:%M")))
|
||||
(concat keyword (format-time-string fmt time))))
|
||||
|
||||
(defun org-rem-time-diff-days (end start)
|
||||
(floor (/ (apply '- (mapcar
|
||||
(lambda (s)
|
||||
(let*
|
||||
((t1 (org-parse-time-string s))
|
||||
(s (car t1)) (mi (nth 1 t1))
|
||||
(h (nth 2 t1)) (d (nth 3 t1))
|
||||
(m (nth 4 t1)) (y (nth 5 t1)))
|
||||
(float-time (encode-time s mi h d m y))))
|
||||
(list end start))) (* 24 60 60))))
|
||||
|
||||
(provide 'org2rem)
|
||||
|
||||
;;; org-exp.el ends here
|
||||
28
lisp/org.el
28
lisp/org.el
|
|
@ -12605,7 +12605,7 @@ of `org-todo-keywords-1'."
|
|||
(message "%d TODO entries found"
|
||||
(org-occur (concat "^" org-outline-regexp " *" kwd-re )))))
|
||||
|
||||
(defun org-deadline (&optional arg time)
|
||||
(defun org-deadline (arg &optional time)
|
||||
"Insert the \"DEADLINE:\" string with a timestamp to make a deadline.
|
||||
With one universal prefix argument, remove any deadline from the item.
|
||||
With two universal prefix arguments, prompt for a warning delay.
|
||||
|
|
@ -12621,6 +12621,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
|
|||
org-loop-over-headlines-in-active-region
|
||||
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
|
||||
(let* ((old-date (org-entry-get nil "DEADLINE"))
|
||||
(old-date-time (org-time-string-to-time old-date))
|
||||
(repeater (and old-date
|
||||
(string-match
|
||||
"\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
|
||||
|
|
@ -12643,11 +12644,12 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
|
|||
(replace-match
|
||||
(concat org-deadline-string
|
||||
" <" rpl
|
||||
(format " -%dd" (abs
|
||||
(- (time-to-days
|
||||
(save-match-data
|
||||
(org-read-date nil t nil "Warn starting from")))
|
||||
(time-to-days nil))))
|
||||
(format " -%dd"
|
||||
(abs
|
||||
(- (time-to-days
|
||||
(save-match-data
|
||||
(org-read-date nil t nil "Warn starting from" old-date-time)))
|
||||
(time-to-days old-date-time))))
|
||||
">") t t))
|
||||
(user-error "No deadline information to update"))))
|
||||
(t
|
||||
|
|
@ -12672,7 +12674,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
|
|||
(substring org-last-inserted-timestamp -1))))))
|
||||
(message "Deadline on %s" org-last-inserted-timestamp))))))
|
||||
|
||||
(defun org-schedule (&optional arg time)
|
||||
(defun org-schedule (arg &optional time)
|
||||
"Insert the SCHEDULED: string with a timestamp to schedule a TODO item.
|
||||
With one universal prefix argument, remove any scheduling date from the item.
|
||||
With two universal prefix arguments, prompt for a delay cookie.
|
||||
|
|
@ -12688,6 +12690,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
|
|||
org-loop-over-headlines-in-active-region
|
||||
cl (if (outline-invisible-p) (org-end-of-subtree nil t))))
|
||||
(let* ((old-date (org-entry-get nil "SCHEDULED"))
|
||||
(old-date-time (org-time-string-to-time old-date))
|
||||
(repeater (and old-date
|
||||
(string-match
|
||||
"\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?"
|
||||
|
|
@ -12711,11 +12714,12 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"."
|
|||
(replace-match
|
||||
(concat org-scheduled-string
|
||||
" <" rpl
|
||||
(format " -%dd" (abs
|
||||
(- (time-to-days
|
||||
(save-match-data
|
||||
(org-read-date nil t nil "Delay until")))
|
||||
(time-to-days nil))))
|
||||
(format " -%dd"
|
||||
(abs
|
||||
(- (time-to-days
|
||||
(save-match-data
|
||||
(org-read-date nil t nil "Delay until" old-date-time)))
|
||||
(time-to-days old-date-time))))
|
||||
">") t t))
|
||||
(user-error "No scheduled information to update"))))
|
||||
(t
|
||||
|
|
|
|||
|
|
@ -1946,6 +1946,7 @@ Return output file name."
|
|||
|
||||
|
||||
(provide 'ox-ascii)
|
||||
(provide 'org-ascii) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
|
|
@ -1244,6 +1244,7 @@ Return output file name."
|
|||
|
||||
|
||||
(provide 'ox-beamer)
|
||||
(provide 'org-beamer) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
|
|
@ -3216,6 +3216,7 @@ Return output file name."
|
|||
;;;; alt = (file-name-nondirectory path)
|
||||
|
||||
(provide 'ox-html)
|
||||
(provide 'org-html) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
|
|
@ -990,6 +990,7 @@ files to build the calendar from."
|
|||
|
||||
|
||||
(provide 'ox-icalendar)
|
||||
(provide 'org-icalendar) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
|
|
@ -2888,6 +2888,7 @@ Return output file name."
|
|||
|
||||
|
||||
(provide 'ox-latex)
|
||||
(provide 'org-latex) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
|
|
@ -4376,6 +4376,7 @@ using `org-open-file'."
|
|||
org-odt-file-extensions)
|
||||
|
||||
(provide 'ox-odt)
|
||||
(provide 'org-odt) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
|
|
@ -1207,6 +1207,7 @@ Returns value on success, else nil."
|
|||
|
||||
|
||||
(provide 'ox-publish)
|
||||
(provide 'org-publish) ; Stay compatible with <8.0 configurations
|
||||
|
||||
;; Local variables:
|
||||
;; generated-autoload-file: "org-loaddefs.el"
|
||||
|
|
|
|||
Loading…
Reference in New Issue