summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--contrib/README1
-rw-r--r--contrib/lisp/htmlize.el10
-rw-r--r--contrib/lisp/org-contacts.el222
-rw-r--r--contrib/lisp/org-mac-link-grabber.el466
-rw-r--r--contrib/lisp/org-mac-link.el863
-rw-r--r--contrib/lisp/org-mac-message.el217
-rw-r--r--contrib/lisp/org-mime.el4
-rw-r--r--contrib/lisp/org-screenshot.el530
-rw-r--r--contrib/lisp/org-wl.el2
-rw-r--r--contrib/lisp/ox-bibtex.el293
-rw-r--r--contrib/lisp/ox-confluence.el21
-rw-r--r--contrib/lisp/ox-deck.el47
-rw-r--r--contrib/lisp/ox-freemind.el28
-rw-r--r--contrib/lisp/ox-groff.el35
-rw-r--r--contrib/lisp/ox-koma-letter.el568
-rw-r--r--contrib/lisp/ox-rss.el33
-rw-r--r--contrib/lisp/ox-s5.el33
-rw-r--r--contrib/lisp/ox-taskjuggler.el237
-rw-r--r--debian/changelog9
-rw-r--r--debian/emacsen-install1
-rw-r--r--etc/ORG-NEWS163
-rw-r--r--lisp/ob-C.el98
-rw-r--r--lisp/ob-R.el64
-rw-r--r--lisp/ob-comint.el2
-rw-r--r--lisp/ob-core.el285
-rw-r--r--lisp/ob-ditaa.el8
-rw-r--r--lisp/ob-eval.el1
-rw-r--r--lisp/ob-exp.el38
-rw-r--r--lisp/ob-fortran.el7
-rw-r--r--lisp/ob-gnuplot.el104
-rw-r--r--lisp/ob-haskell.el5
-rw-r--r--lisp/ob-latex.el51
-rw-r--r--lisp/ob-lob.el37
-rw-r--r--lisp/ob-ocaml.el29
-rw-r--r--lisp/ob-octave.el3
-rw-r--r--lisp/ob-org.el5
-rw-r--r--lisp/ob-python.el25
-rw-r--r--lisp/ob-ref.el5
-rw-r--r--lisp/ob-ruby.el28
-rw-r--r--lisp/ob-scheme.el205
-rw-r--r--lisp/ob-sh.el2
-rw-r--r--lisp/ob-shen.el1
-rw-r--r--lisp/ob-table.el8
-rw-r--r--lisp/ob-tangle.el46
-rw-r--r--lisp/ob.el2
-rw-r--r--lisp/org-agenda.el47
-rw-r--r--lisp/org-attach.el11
-rw-r--r--lisp/org-bibtex.el4
-rw-r--r--lisp/org-capture.el19
-rw-r--r--lisp/org-clock.el15
-rw-r--r--lisp/org-colview.el8
-rw-r--r--lisp/org-compat.el54
-rw-r--r--lisp/org-ctags.el9
-rw-r--r--lisp/org-element.el540
-rw-r--r--lisp/org-entities.el58
-rw-r--r--lisp/org-faces.el8
-rw-r--r--lisp/org-footnote.el1
-rw-r--r--lisp/org-habit.el11
-rw-r--r--lisp/org-id.el5
-rw-r--r--lisp/org-list.el100
-rw-r--r--lisp/org-loaddefs.el200
-rw-r--r--lisp/org-macro.el2
-rw-r--r--lisp/org-macs.el4
-rw-r--r--lisp/org-mhe.el1
-rw-r--r--lisp/org-mobile.el35
-rw-r--r--lisp/org-pcomplete.el14
-rw-r--r--lisp/org-protocol.el2
-rw-r--r--lisp/org-src.el4
-rw-r--r--lisp/org-table.el126
-rw-r--r--lisp/org-timer.el4
-rw-r--r--lisp/org-version.el4
-rw-r--r--lisp/org.el1275
-rw-r--r--lisp/ox-ascii.el34
-rw-r--r--lisp/ox-beamer.el81
-rw-r--r--lisp/ox-html.el663
-rw-r--r--lisp/ox-icalendar.el19
-rw-r--r--lisp/ox-latex.el291
-rw-r--r--lisp/ox-man.el25
-rw-r--r--lisp/ox-md.el24
-rw-r--r--lisp/ox-odt.el198
-rw-r--r--lisp/ox-org.el27
-rw-r--r--lisp/ox-publish.el109
-rw-r--r--lisp/ox-texinfo.el50
-rw-r--r--lisp/ox.el1319
-rw-r--r--mk/default.mk2
-rw-r--r--mk/version.mk4
86 files changed, 6532 insertions, 3717 deletions
diff --git a/contrib/README b/contrib/README
index 3b9d9b7..bdbdb47 100644
--- a/contrib/README
+++ b/contrib/README
@@ -49,6 +49,7 @@ org-notmuch.el --- Support for links to notmuch messages
org-panel.el --- Simple routines for us with bad memory
org-registry.el --- A registry for Org links
org-screen.el --- Visit screen sessions through Org-mode links
+org-screenshot.el --- Take and manage screenshots in Org-mode files
org-secretary.el --- Team management with org-mode
org-static-mathjax.el --- Muse-like tags in Org-mode
org-sudoku.el --- Create and solve SUDOKU puzzles in Org tables
diff --git a/contrib/lisp/htmlize.el b/contrib/lisp/htmlize.el
index c03d605..3bf5949 100644
--- a/contrib/lisp/htmlize.el
+++ b/contrib/lisp/htmlize.el
@@ -601,10 +601,12 @@ list."
(htmlize-attr-escape (file-relative-name file))
alt-attr)))
((plist-get imgprops :data)
- (format "<img src=\"data:image/%s;base64,%s\"%s />"
- (or (plist-get imgprops :type) "")
- (base64-encode-string (plist-get imgprops :data))
- alt-attr)))))
+ (if (equalp (plist-get imgprops :type) 'svg)
+ (plist-get imgprops :data)
+ (format "<img src=\"data:image/%s;base64,%s\"%s />"
+ (or (plist-get imgprops :type) "")
+ (base64-encode-string (plist-get imgprops :data))
+ alt-attr))))))
(defconst htmlize-ellipsis "...")
(put-text-property 0 (length htmlize-ellipsis) 'htmlize-ellipsis t htmlize-ellipsis)
diff --git a/contrib/lisp/org-contacts.el b/contrib/lisp/org-contacts.el
index a3c4aed..97171d0 100644
--- a/contrib/lisp/org-contacts.el
+++ b/contrib/lisp/org-contacts.el
@@ -25,7 +25,7 @@
;; This file contains the code for managing your contacts into Org-mode.
-;; To enter new contacts, you can use `org-capture' and a template just like
+;; To enter new contacts, you can use `org-capture' and a minimal template just like
;; this:
;; ("c" "Contacts" entry (file "~/Org/contacts.org")
@@ -34,6 +34,22 @@
;; :EMAIL: %(org-contacts-template-email)
;; :END:")))
;;
+;; You can also use a complex template, for example:
+;;
+;; ("c" "Contacts" entry (file "~/Org/contacts.org")
+;; "* %(org-contacts-template-name)
+;; :PROPERTIES:
+;; :EMAIL: %(org-contacts-template-email)
+;; :PHONE:
+;; :ALIAS:
+;; :NICKNAME:
+;; :IGNORE:
+;; :ICON:
+;; :NOTE:
+;; :ADDRESS:
+;; :BIRTHDAY:
+;; :END:")))
+;;
;;; Code:
(eval-when-compile
@@ -86,6 +102,12 @@ When set to nil, all your Org files will be used."
:type 'string
:group 'org-contacts)
+(defcustom org-contacts-ignore-property "IGNORE"
+ "Name of the property, which values will be ignored when
+completing or exporting to vcard."
+ :type 'string
+ :group 'org-contacts)
+
(defcustom org-contacts-birthday-format "Birthday: %l (%Y)"
"Format of the anniversary agenda entry.
@@ -174,6 +196,11 @@ This overrides `org-email-link-description-format' if set."
(declare-function std11-narrow-to-header "ext:std11")
(declare-function std11-fetch-field "ext:std11")
+(defconst org-contacts-property-values-separators "[,; \f\t\n\r\v]+"
+ "The default value of separators for `org-contacts-split-property'.
+
+A regexp matching strings of whitespace, `,' and `;'.")
+
(defvar org-contacts-keymap
(let ((map (make-sparse-keymap)))
(define-key map "M" 'org-contacts-view-send-email)
@@ -197,7 +224,20 @@ This overrides `org-email-link-description-format' if set."
(org-find-if (lambda (file)
(or (time-less-p org-contacts-last-update
(elt (file-attributes file) 5))))
- (org-contacts-files))))
+ (org-contacts-files))
+ (org-contacts-db-has-dead-markers-p org-contacts-db)))
+
+(defun org-contacts-db-has-dead-markers-p (org-contacts-db)
+ "Returns t if at least one dead marker is found in
+ORG-CONTACTS-DB. A dead marker in this case is a marker pointing
+to dead or no buffer."
+ ;; Scan contacts list looking for dead markers, and return t at first found.
+ (catch 'dead-marker-found
+ (while org-contacts-db
+ (unless (marker-buffer (nth 1 (car org-contacts-db)))
+ (throw 'dead-marker-found t))
+ (setq org-contacts-db (cdr org-contacts-db)))
+ nil))
(defun org-contacts-db ()
"Return the latest Org Contacts Database."
@@ -206,28 +246,37 @@ This overrides `org-email-link-description-format' if set."
(cdr (org-make-tags-matcher org-contacts-matcher)))
markers result)
(when (org-contacts-db-need-update-p)
- (message "Update Org Contacts Database")
- (dolist (file (org-contacts-files))
- (org-check-agenda-file file)
- (with-current-buffer (org-get-agenda-file-buffer file)
- (unless (eq major-mode 'org-mode)
- (error "File %s is no in `org-mode'" file))
- (org-scan-tags
- '(add-to-list 'markers (set-marker (make-marker) (point)))
- contacts-matcher
- todo-only)))
- (dolist (marker markers result)
- (org-with-point-at marker
- (add-to-list 'result
- (list (org-get-heading t) marker (org-entry-properties marker 'all)))))
- (setf org-contacts-db result
- org-contacts-last-update (current-time)))
+ (let ((progress-reporter
+ (make-progress-reporter "Updating Org Contacts Database..." 0 (length org-contacts-files)))
+ (i 0))
+ (dolist (file (org-contacts-files))
+ (org-check-agenda-file file)
+ (with-current-buffer (org-get-agenda-file-buffer file)
+ (unless (eq major-mode 'org-mode)
+ (error "File %s is no in `org-mode'" file))
+ (org-scan-tags
+ '(add-to-list 'markers (set-marker (make-marker) (point)))
+ contacts-matcher
+ todo-only))
+ (progress-reporter-update progress-reporter (setq i (1+ i))))
+ (dolist (marker markers result)
+ (org-with-point-at marker
+ (add-to-list 'result
+ (list (org-get-heading t) marker (org-entry-properties marker 'all)))))
+ (setf org-contacts-db result
+ org-contacts-last-update (current-time))
+ (progress-reporter-done progress-reporter)))
org-contacts-db))
-(defun org-contacts-filter (&optional name-match tags-match)
- "Search for a contact maching NAME-MATCH and TAGS-MATCH.
-If both match values are nil, return all contacts."
+(defun org-contacts-filter (&optional name-match tags-match prop-match)
+ "Search for a contact matching any of NAME-MATCH, TAGS-MATCH, PROP-MATCH.
+If all match values are nil, return all contacts.
+
+The optional PROP-MATCH argument is a single (PROP . VALUE) cons
+cell corresponding to the contact properties.
+"
(if (and (null name-match)
+ (null prop-match)
(null tags-match))
(org-contacts-db)
(loop for contact in (org-contacts-db)
@@ -235,6 +284,11 @@ If both match values are nil, return all contacts."
(and name-match
(org-string-match-p name-match
(first contact)))
+ (and prop-match
+ (org-find-if (lambda (prop)
+ (and (string= (car prop-match) (car prop))
+ (org-string-match-p (cdr prop-match) (cdr prop))))
+ (caddr contact)))
(and tags-match
(org-find-if (lambda (tag)
(org-string-match-p tags-match tag))
@@ -411,7 +465,8 @@ prefixes rather than just the beginning of the string."
(defun org-contacts-metadata-prefix (string collection predicate)
'(metadata .
- ((display-sort-function . org-contacts-display-sort-function))))
+ ((cycle-sort-function . org-contacts-display-sort-function)
+ (display-sort-function . org-contacts-display-sort-function))))
(defun org-contacts-complete-group (start end string)
"Complete text at START from a group.
@@ -433,7 +488,7 @@ A group FOO is composed of contacts with the tag FOO."
(or (cdr (assoc-string "ALLTAGS" (caddr contact))) "") ":")))))))
(list start end
(if (= (length completion-list) 1)
- ;; We've foudn the correct group, returns the address
+ ;; We've found the correct group, returns the address
(lexical-let ((tag (get-text-property 0 'org-contacts-group
(car completion-list))))
(lambda (string pred &optional to-ignore)
@@ -445,11 +500,11 @@ A group FOO is composed of contacts with the tag FOO."
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Grab the first email of the contact
- for email = (car (split-string
+ for email = (org-contacts-strip-link (car (org-contacts-split-property
(or
(cdr (assoc-string org-contacts-email-property
(caddr contact)))
- "")))
+ ""))))
;; If the user has an email address, append USER <EMAIL>.
if email collect (org-contacts-format-email contact-name email))
", ")))
@@ -457,6 +512,16 @@ A group FOO is composed of contacts with the tag FOO."
(completion-table-case-fold completion-list
(not org-contacts-completion-ignore-case))))))))
+
+(defun org-contacts-remove-ignored-property-values (ignore-list list)
+ "Remove all ignore-list's elements from list and you can use
+ regular expressions in the ignore list."
+ (org-remove-if (lambda (el)
+ (org-find-if (lambda (x)
+ (string-match-p x el))
+ ignore-list))
+ list))
+
(defun org-contacts-complete-name (start end string)
"Complete text at START with a user name and email."
(let* ((completion-ignore-case org-contacts-completion-ignore-case)
@@ -465,15 +530,23 @@ A group FOO is composed of contacts with the tag FOO."
;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
+
+ ;; Build the list of the email addresses which has
+ ;; been expired
+ for ignore-list = (org-contacts-split-property
+ (or (cdr (assoc-string org-contacts-ignore-property
+ (caddr contact))) ""))
;; Build the list of the user email addresses.
- for email-list = (split-string (or
- (cdr (assoc-string org-contacts-email-property
- (caddr contact))) ""))
+ for email-list = (org-contacts-remove-ignored-property-values
+ ignore-list
+ (org-contacts-split-property
+ (or (cdr (assoc-string org-contacts-email-property
+ (caddr contact))) "")))
;; If the user has email addresses…
if email-list
;; … append a list of USER <EMAIL>.
nconc (loop for email in email-list
- collect (org-contacts-format-email contact-name email))))
+ collect (org-contacts-format-email contact-name (org-contacts-strip-link email)))))
(completion-list (org-contacts-all-completions-prefix
string
(org-uniquify completion-list))))
@@ -514,7 +587,8 @@ A group FOO is composed of contacts with the tag FOO."
(email (cadr address)))
(cadar (or (org-contacts-filter
nil
- (concat org-contacts-email-property "={\\b" (regexp-quote email) "\\b}"))
+ nil
+ (cons org-contacts-email-property (concat "\\b" (regexp-quote email) "\\b")))
(when name
(org-contacts-filter
(concat "^" name "$")))))))
@@ -682,12 +756,18 @@ This adds `org-contacts-gnus-check-mail-address' and
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-check-mail-address)
(add-hook 'gnus-article-prepare-hook 'org-contacts-gnus-store-last-mail))
+(defun org-contacts-setup-completion-at-point ()
+ "Add `org-contacts-message-complete-function' as a new function
+to complete the thing at point."
+ (add-to-list 'completion-at-point-functions
+ 'org-contacts-message-complete-function))
+
+(defun org-contacts-unload-hook ()
+ (remove-hook 'message-mode-hook 'org-contacts-setup-completion-at-point))
+
(when (and org-contacts-enable-completion
(boundp 'completion-at-point-functions))
- (add-hook 'message-mode-hook
- (lambda ()
- (add-to-list 'completion-at-point-functions
- 'org-contacts-message-complete-function))))
+ (add-hook 'message-mode-hook 'org-contacts-setup-completion-at-point))
(defun org-contacts-wl-get-from-header-content ()
"Retrieve the content of the `From' header of an email.
@@ -738,11 +818,12 @@ address."
(org-with-point-at marker
(let ((emails (org-entry-get (point) org-contacts-email-property)))
(if emails
- (let ((email-list (split-string emails)))
+ (let ((email-list (org-contacts-split-property emails)))
(if (and (= (length email-list) 1) (not ask))
(compose-mail (org-contacts-format-email
(org-get-heading t) emails))
(let ((email (completing-read "Send mail to which address: " email-list)))
+ (setq email (org-contacts-strip-link email))
(org-contacts-check-mail-address email)
(compose-mail (org-contacts-format-email (org-get-heading t) email)))))
(error (format "This contact has no mail address set (no %s property)."
@@ -766,8 +847,8 @@ address."
(email-list (org-entry-get pom org-contacts-email-property))
(gravatar
(when email-list
- (loop for email in (split-string email-list)
- for gravatar = (gravatar-retrieve-synchronously email)
+ (loop for email in (org-contacts-split-property email-list)
+ for gravatar = (gravatar-retrieve-synchronously (org-contacts-strip-link email))
if (and gravatar
(not (eq gravatar 'error)))
return gravatar))))
@@ -841,27 +922,31 @@ to do our best."
(name (org-contacts-vcard-escape (car contact)))
(n (org-contacts-vcard-encode-name name))
(email (cdr (assoc-string org-contacts-email-property properties)))
- (tel (cdr (assoc-string org-contacts-tel-property properties)))
+ (tel (cdr (assoc-string org-contacts-tel-property properties)))
+ (ignore-list (cdr (assoc-string org-contacts-ignore-property properties)))
+ (ignore-list (when ignore-list
+ (org-contacts-split-property ignore-list)))
(note (cdr (assoc-string org-contacts-note-property properties)))
(bday (org-contacts-vcard-escape (cdr (assoc-string org-contacts-birthday-property properties))))
(addr (cdr (assoc-string org-contacts-address-property properties)))
(nick (org-contacts-vcard-escape (cdr (assoc-string org-contacts-nickname-property properties))))
- (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name)))
+ (head (format "BEGIN:VCARD\nVERSION:3.0\nN:%s\nFN:%s\n" n name))
+ emails-list result phones-list)
(concat head
(when email (progn
- (setq emails-list (split-string email "[,;: ]+"))
+ (setq emails-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property email)))
(setq result "")
(while emails-list
- (setq result (concat result "EMAIL:" (car emails-list) "\n"))
+ (setq result (concat result "EMAIL:" (org-contacts-strip-link (car emails-list)) "\n"))
(setq emails-list (cdr emails-list)))
result))
(when addr
(format "ADR:;;%s\n" (replace-regexp-in-string "\\, ?" ";" addr)))
(when tel (progn
- (setq phones-list (split-string tel "[,;: ]+"))
+ (setq phones-list (org-contacts-remove-ignored-property-values ignore-list (org-contacts-split-property tel)))
(setq result "")
(while phones-list
- (setq result (concat result "TEL:" (car phones-list) "\n"))
+ (setq result (concat result "TEL:" (org-contacts-strip-link (car phones-list)) "\n"))
(setq phones-list (cdr phones-list)))
result))
(when bday
@@ -910,7 +995,56 @@ Requires google-maps-el."
if addr
collect (cons (list addr) (list :label (string-to-char (car contact)))))))
-(provide 'org-contacts)
+(defun org-contacts-strip-link (link)
+ "Remove brackets, description, link type and colon from an org
+link string and return the pure link target."
+ (let (startpos colonpos endpos)
+ (setq startpos (string-match (regexp-opt '("[[tel:" "[[mailto:")) link))
+ (if startpos
+ (progn
+ (setq colonpos (string-match ":" link))
+ (setq endpos (string-match "\\]" link))
+ (if endpos (substring link (1+ colonpos) endpos) link))
+ (progn
+ (setq startpos (string-match "mailto:" link))
+ (setq colonpos (string-match ":" link))
+ (if startpos (substring link (1+ colonpos)) link)))))
+
+(defun org-contacts-split-property (string &optional separators omit-nulls)
+ "Custom version of `split-string'.
+Split a property STRING into sub-strings bounded by matches
+for SEPARATORS but keep Org links intact.
+
+The beginning and end of STRING, and each match for SEPARATORS, are
+splitting points. The substrings matching SEPARATORS are removed, and
+the substrings between the splitting points are collected as a list,
+which is returned.
+
+If SEPARATORS is non-nil, it should be a regular expression
+matching text which separates, but is not part of, the
+substrings. If nil it defaults to `org-contacts-property-values-separators',
+normally \"[,; \f\t\n\r\v]+\", and OMIT-NULLS is forced to t.
+
+If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
+that for the default value of SEPARATORS leading and trailing whitespace
+are effectively trimmed). If nil, all zero-length substrings are retained."
+ (let* ((omit-nulls (if separators omit-nulls t))
+ (rexp (or separators org-contacts-property-values-separators))
+ (inputlist (split-string string rexp omit-nulls))
+ (linkstring "")
+ (bufferstring "")
+ (proplist (list "")))
+ (while inputlist
+ (setq bufferstring (pop inputlist))
+ (if (string-match "\\[\\[" bufferstring)
+ (progn
+ (setq linkstring (concat bufferstring " "))
+ (while (not (string-match "\\]\\]" bufferstring))
+ (setq bufferstring (pop inputlist))
+ (setq linkstring (concat linkstring bufferstring " ")))
+ (setq proplist (cons (org-trim linkstring) proplist)))
+ (setq proplist (cons bufferstring proplist))))
+ (cdr (reverse proplist))))
(provide 'org-contacts)
diff --git a/contrib/lisp/org-mac-link-grabber.el b/contrib/lisp/org-mac-link-grabber.el
deleted file mode 100644
index 0598617..0000000
--- a/contrib/lisp/org-mac-link-grabber.el
+++ /dev/null
@@ -1,466 +0,0 @@
-;;; org-mac-link-grabber.el --- Grab links and url from various mac
-;; Application and insert them as links into org-mode documents
-;;
-;; Copyright (c) 2010-2013 Free Software Foundation, Inc.
-;;
-;; Author: Anthony Lander <anthony.lander@gmail.com>
-;; Version: 1.0.1
-;; Keywords: org, mac, hyperlink
-;;
-;; This file is not 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 3, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; This code allows you to grab either the current selected items, or
-;; the frontmost url in various mac appliations, and insert them as
-;; hyperlinks into the current org-mode document at point.
-;;
-;; This code is heavily based on, and indeed requires,
-;; org-mac-message.el written by John Weigley and Christopher
-;; Suckling.
-;;
-;; Detailed comments for each application interface are inlined with
-;; the code. Here is a brief overview of how the code interacts with
-;; each application:
-;;
-;; Finder.app - grab links to the selected files in the frontmost window
-;; Mail.app - grab links to the selected messages in the message list
-;; AddressBook.app - Grab links to the selected addressbook Cards
-;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Safari.app - Grab the url of the frontmost tab in the frontmost window
-;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
-;; Together.app - Grab links to the selected items in the library list
-;;
-;;
-;; Installation:
-;;
-;; add (require 'org-mac-link-grabber) to your .emacs, and optionally
-;; bind a key to activate the link grabber menu, like this:
-;;
-;; (add-hook 'org-mode-hook (lambda ()
-;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link)))
-;;
-;;
-;; Usage:
-;;
-;; Type C-c g (or whatever key you defined, as above), or type M-x
-;; omlg-grab-link RET to activate the link grabber. This will present
-;; you with a menu to choose an application from which to grab a link
-;; to insert at point. You may also type C-g to abort.
-;;
-;; Customizing:
-;;
-;; You may customize which applications appear in the grab menu by
-;; customizing the group org-mac-link-grabber. Changes take effect
-;; immediately.
-;;
-;;
-;;; Code:
-
-(require 'org)
-(require 'org-mac-message)
-
-(defgroup org-mac-link-grabber nil
- "Options concerning grabbing links from external Mac
-applications and inserting them in org documents"
- :tag "Org Mac link grabber"
- :group 'org-link)
-
-(defcustom org-mac-grab-Finder-app-p t
- "Enable menu option [F]inder to grab links from the Finder"
- :tag "Grab Finder.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Mail-app-p t
- "Enable menu option [m]ail to grab links from Mail.app"
- :tag "Grab Mail.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Addressbook-app-p t
- "Enable menu option [a]ddressbook to grab links from AddressBook.app"
- :tag "Grab AddressBook.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Safari-app-p t
- "Enable menu option [s]afari to grab links from Safari.app"
- :tag "Grab Safari.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Firefox-app-p t
- "Enable menu option [f]irefox to grab links from Firefox.app"
- :tag "Grab Firefox.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Firefox+Vimperator-p nil
- "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
- :tag "Grab Vimperator/Firefox.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Chrome-app-p t
- "Enable menu option [f]irefox to grab links from Google Chrome.app"
- :tag "Grab Google Chrome.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Together-app-p nil
- "Enable menu option [t]ogether to grab links from Together.app"
- :tag "Grab Together.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-
-(defun omlg-grab-link ()
- "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
- (interactive)
- (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
- ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
- ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
- ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
- ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
- ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
- ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
- ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)))
- (menu-string (make-string 0 ?x))
- input)
-
- ;; Create the menu string for the keymap
- (mapc '(lambda (descriptor)
- (when (elt descriptor 3)
- (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
- descriptors)
- (setf (elt menu-string (- (length menu-string) 1)) ?:)
-
- ;; Prompt the user, and grab the link
- (message menu-string)
- (setq input (read-char-exclusive))
- (mapc '(lambda (descriptor)
- (let ((key (elt (elt descriptor 0) 0))
- (active (elt descriptor 3))
- (grab-function (elt descriptor 2)))
- (when (and active (eq input key))
- (call-interactively grab-function))))
- descriptors)))
-
-(defalias 'omgl-grab-link 'omlg-grab-link
- "Renamed, and this alias will be obsolete next revision.")
-
-(defun org-mac-paste-applescript-links (as-link-list)
- "Paste in a list of links from an applescript handler. The
- links are of the form <link>::split::<name>"
- (let* ((link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-
-
-;; Handle links from Firefox.app
-;;
-;; This code allows you to grab the current active url from the main
-;; Firefox.app window, and insert it as a link into an org-mode
-;; document. Unfortunately, firefox does not expose an applescript
-;; dictionary, so this is necessarily introduces some limitations.
-;;
-;; The applescript to grab the url from Firefox.app uses the System
-;; Events application to give focus to the firefox application, select
-;; the contents of the url bar, and copy it. It then uses the title of
-;; the window as the text of the link. There is no way to grab links
-;; from other open tabs, and further, if there is more than one window
-;; open, it is not clear which one will be used (though emperically it
-;; seems that it is always the last active window).
-
-(defun as-mac-firefox-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Firefox\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using command down\n"
- " keystroke \"c\" using command down\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (car (split-string result "[\r\n]+" t))))
-
-(defun org-mac-firefox-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Firefox url...")
- (let* ((url-and-title (as-mac-firefox-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-firefox-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-firefox-get-frontmost-url)))
-
-
-;; Handle links from Google Firefox.app running the Vimperator extension
-;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
-;; Firefox
-
-(defun as-mac-vimperator-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Firefox\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"y\"\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
-
-
-(defun org-mac-vimperator-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Vimperator url...")
- (let* ((url-and-title (as-mac-vimperator-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-vimperator-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-vimperator-get-frontmost-url)))
-
-
-;; Handle links from Google Chrome.app
-;; Grab the frontmost url from Google Chrome. Same limitations are
-;; Firefox because Chrome doesn't publish an Applescript dictionary
-
-(defun as-mac-chrome-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "set oldClipboard to the clipboard\n"
- "set frontmostApplication to path to frontmost application\n"
- "tell application \"Google Chrome\"\n"
- " activate\n"
- " delay 0.15\n"
- " tell application \"System Events\"\n"
- " keystroke \"l\" using command down\n"
- " keystroke \"c\" using command down\n"
- " end tell\n"
- " delay 0.15\n"
- " set theUrl to the clipboard\n"
- " set the clipboard to oldClipboard\n"
- " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
- "end tell\n"
- "activate application (frontmostApplication as text)\n"
- "set links to {}\n"
- "copy theResult to the end of links\n"
- "return links as string\n"))))
- (car (split-string result "[\r\n]+" t))))
-
-(defun org-mac-chrome-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Chrome url...")
- (let* ((url-and-title (as-mac-chrome-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-chrome-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-chrome-get-frontmost-url)))
-
-
-;; Handle links from Safari.app
-;; Grab the frontmost url from Safari.
-
-(defun as-mac-safari-get-frontmost-url ()
- (let ((result (do-applescript
- (concat
- "tell application \"Safari\"\n"
- " set theUrl to URL of document 1\n"
- " set theName to the name of the document 1\n"
- " return theUrl & \"::split::\" & theName & \"\n\"\n"
- "end tell\n"))))
- (car (split-string result "[\r\n]+" t))))
-
-(defun org-mac-safari-get-frontmost-url ()
- (interactive)
- (message "Applescript: Getting Safari url...")
- (let* ((url-and-title (as-mac-safari-get-frontmost-url))
- (split-link (split-string url-and-title "::split::"))
- (URL (car split-link))
- (description (cadr split-link))
- (org-link))
- (when (not (string= URL ""))
- (setq org-link (org-make-link-string URL description)))
- (kill-new org-link)
- org-link))
-
-(defun org-mac-safari-insert-frontmost-url ()
- (interactive)
- (insert (org-mac-safari-get-frontmost-url)))
-
-
-;;
-;;
-;; Handle links from together.app
-;;
-;;
-
-(org-add-link-type "x-together-item" 'org-mac-together-item-open)
-
-(defun org-mac-together-item-open (uid)
- "Open the given uid, which is a reference to an item in Together"
- (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
-
-(defun as-get-selected-together-items ()
- (do-applescript
- (concat
- "tell application \"Together\"\n"
- " set theLinkList to {}\n"
- " set theSelection to selected items\n"
- " repeat with theItem in theSelection\n"
- " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
- " copy theLink to end of theLinkList\n"
- " end repeat\n"
- " return theLinkList as string\n"
- "end tell")))
-
-(defun org-mac-together-get-selected ()
- (interactive)
- (message "Applescript: Getting Togther items...")
- (org-mac-paste-applescript-links (as-get-selected-together-items)))
-
-(defun org-mac-together-insert-selected ()
- (interactive)
- (insert (org-mac-together-get-selected)))
-
-
-;;
-;;
-;; Handle links from Finder.app
-;;
-;;
-
-(defun as-get-selected-finder-items ()
- (do-applescript
-(concat
-"tell application \"Finder\"\n"
-" set theSelection to the selection\n"
-" set links to {}\n"
-" repeat with theItem in theSelection\n"
-" set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
-" copy theLink to the end of links\n"
-" end repeat\n"
-" return links as string\n"
-"end tell\n")))
-
-(defun org-mac-finder-item-get-selected ()
- (interactive)
- (message "Applescript: Getting Finder items...")
- (org-mac-paste-applescript-links (as-get-selected-finder-items)))
-
-(defun org-mac-finder-insert-selected ()
- (interactive)
- (insert (org-mac-finder-item-get-selected)))
-
-
-;;
-;;
-;; Handle links from AddressBook.app
-;;
-;;
-
-(org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
-
-(defun org-mac-addressbook-item-open (uid)
- "Open the given uid, which is a reference to an item in Together"
- (shell-command (concat "open \"addressbook:" uid "\"")))
-
-(defun as-get-selected-addressbook-items ()
- (do-applescript
- (concat
- "tell application \"Address Book\"\n"
- " set theSelection to the selection\n"
- " set links to {}\n"
- " repeat with theItem in theSelection\n"
- " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
- " copy theLink to the end of links\n"
- " end repeat\n"
- " return links as string\n"
- "end tell\n")))
-
-(defun org-mac-addressbook-item-get-selected ()
- (interactive)
- (message "Applescript: Getting Address Book items...")
- (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
-
-(defun org-mac-addressbook-insert-selected ()
- (interactive)
- (insert (org-mac-addressbook-item-get-selected)))
-
-
-(provide 'org-mac-link-grabber)
-
-;;; org-mac-link-grabber.el ends here
diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el
new file mode 100644
index 0000000..2ff6711
--- /dev/null
+++ b/contrib/lisp/org-mac-link.el
@@ -0,0 +1,863 @@
+;;; org-mac-link.el --- Grab links and url from various mac
+;; Application and insert them as links into org-mode documents
+;;
+;; Copyright (c) 2010-2013 Free Software Foundation, Inc.
+;;
+;; Authors:
+;; Anthony Lander <anthony.lander@gmail.com>
+;; John Wiegley <johnw@gnu.org>
+;; Christopher Suckling <suckling at gmail dot com>
+;; Daniil Frumin <difrumin@gmail.com>
+;;
+;;
+;; Version: 1.1
+;; Keywords: org, mac, hyperlink
+;;
+;; Version: 1.2
+;; Keywords: outlook
+;; Author: Mike McLean <mike.mclean@pobox.com>
+;; Add support for Microsoft Outlook for Mac as Org mode links
+;;
+;; This file is not 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 3, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; This code allows you to grab either the current selected items, or
+;; the frontmost url in various mac appliations, and insert them as
+;; hyperlinks into the current org-mode document at point.
+;;
+;; This code is heavily based on, and indeed incorporates,
+;; org-mac-message.el written by John Wiegley and Christopher
+;; Suckling.
+;;
+;; Detailed comments for each application interface are inlined with
+;; the code. Here is a brief overview of how the code interacts with
+;; each application:
+;;
+;; Finder.app - grab links to the selected files in the frontmost window
+;; Mail.app - grab links to the selected messages in the message list
+;; AddressBook.app - Grab links to the selected addressbook Cards
+;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
+;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
+;; Safari.app - Grab the url of the frontmost tab in the frontmost window
+;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
+;; Together.app - Grab links to the selected items in the library list
+;; Skim.app - Grab a link to the selected page in the topmost pdf document
+;; Microsoft Outlook.app - Grab a link to the selected message in the message list
+;;
+;;
+;; Installation:
+;;
+;; add (require 'org-mac-link) to your .emacs, and optionally bind a
+;; key to activate the link grabber menu, like this:
+;;
+;; (add-hook 'org-mode-hook (lambda ()
+;; (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link)))
+;;
+;; Usage:
+;;
+;; Type C-c g (or whatever key you defined, as above), or type M-x
+;; org-mac-grab-link RET to activate the link grabber. This will present
+;; you with a menu to choose an application from which to grab a link
+;; to insert at point. You may also type C-g to abort.
+;;
+;; Customizing:
+;;
+;; You may customize which applications appear in the grab menu by
+;; customizing the group `org-mac-link'. Changes take effect
+;; immediately.
+;;
+;;
+;;; Code:
+
+(require 'org)
+
+(defgroup org-mac-link nil
+ "Options concerning grabbing links from external Mac
+applications and inserting them in org documents"
+ :tag "Org Mac link"
+ :group 'org-link)
+
+(defcustom org-mac-grab-Finder-app-p t
+ "Enable menu option [F]inder to grab links from the Finder"
+ :tag "Grab Finder.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Mail-app-p t
+ "Enable menu option [m]ail to grab links from Mail.app"
+ :tag "Grab Mail.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Outlook-app-p t
+ "Enable menu option [o]utlook to grab links from Microsoft Outlook.app"
+ :tag "Grab Microsoft Outlook.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Addressbook-app-p t
+ "Enable menu option [a]ddressbook to grab links from AddressBook.app"
+ :tag "Grab AddressBook.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Safari-app-p t
+ "Enable menu option [s]afari to grab links from Safari.app"
+ :tag "Grab Safari.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Firefox-app-p t
+ "Enable menu option [f]irefox to grab links from Firefox.app"
+ :tag "Grab Firefox.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Firefox+Vimperator-p nil
+ "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
+ :tag "Grab Vimperator/Firefox.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Chrome-app-p t
+ "Enable menu option [f]irefox to grab links from Google Chrome.app"
+ :tag "Grab Google Chrome.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Together-app-p nil
+ "Enable menu option [t]ogether to grab links from Together.app"
+ :tag "Grab Together.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Skim-app-p
+ (< 0 (length (shell-command-to-string
+ "mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'")))
+ "Enable menu option [S]kim to grab page links from Skim.app"
+ :tag "Grab Skim.app page links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-Skim-highlight-selection-p nil
+ "Highlight (using notes) the selection (if present) when grabbing the a link from Skim.app"
+ :tag "Highlight selection in Skim.app"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defgroup org-mac-flagged-mail nil
+ "Options concerning linking to flagged Mail.app messages."
+ :tag "Org Mail.app"
+ :group 'org-link)
+
+(defcustom org-mac-mail-account "customize"
+ "The Mail.app account in which to search for flagged messages."
+ :group 'org-mac-flagged-mail
+ :type 'string)
+
+
+;; In mac.c, removed in Emacs 23.
+(declare-function do-applescript "org-mac-message" (script))
+(unless (fboundp 'do-applescript)
+ ;; Need to fake this using shell-command-to-string
+ (defun do-applescript (script)
+ (let (start cmd return)
+ (while (string-match "\n" script)
+ (setq script (replace-match "\r" t t script)))
+ (while (string-match "'" script start)
+ (setq start (+ 2 (match-beginning 0))
+ script (replace-match "\\'" t t script)))
+ (setq cmd (concat "osascript -e '" script "'"))
+ (setq return (shell-command-to-string cmd))
+ (concat "\"" (org-trim return) "\""))))
+
+
+(defun org-mac-grab-link ()
+ "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
+ (interactive)
+ (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
+ ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
+ ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
+ ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
+ ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
+ ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
+ ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
+ ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
+ ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
+ ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
+ (menu-string (make-string 0 ?x))
+ input)
+
+ ;; Create the menu string for the keymap
+ (mapc '(lambda (descriptor)
+ (when (elt descriptor 3)
+ (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
+ descriptors)
+ (setf (elt menu-string (- (length menu-string) 1)) ?:)
+
+ ;; Prompt the user, and grab the link
+ (message menu-string)
+ (setq input (read-char-exclusive))
+ (mapc '(lambda (descriptor)
+ (let ((key (elt (elt descriptor 0) 0))
+ (active (elt descriptor 3))
+ (grab-function (elt descriptor 2)))
+ (when (and active (eq input key))
+ (call-interactively grab-function))))
+ descriptors)))
+
+(defun org-mac-paste-applescript-links (as-link-list)
+ "Paste in a list of links from an applescript handler. The
+ links are of the form <link>::split::<name>"
+ (let* ((link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
+ (split-string as-link-list "[\r\n]+")))
+ split-link URL description orglink orglink-insert rtn orglink-list)
+ (while link-list
+ (setq split-link (split-string (pop link-list) "::split::"))
+ (setq URL (car split-link))
+ (setq description (cadr split-link))
+ (when (not (string= URL ""))
+ (setq orglink (org-make-link-string URL description))
+ (push orglink orglink-list)))
+ (setq rtn (mapconcat 'identity orglink-list "\n"))
+ (kill-new rtn)
+ rtn))
+
+
+
+;; Handle links from Firefox.app
+;;
+;; This code allows you to grab the current active url from the main
+;; Firefox.app window, and insert it as a link into an org-mode
+;; document. Unfortunately, firefox does not expose an applescript
+;; dictionary, so this is necessarily introduces some limitations.
+;;
+;; The applescript to grab the url from Firefox.app uses the System
+;; Events application to give focus to the firefox application, select
+;; the contents of the url bar, and copy it. It then uses the title of
+;; the window as the text of the link. There is no way to grab links
+;; from other open tabs, and further, if there is more than one window
+;; open, it is not clear which one will be used (though emperically it
+;; seems that it is always the last active window).
+
+(defun org-as-mac-firefox-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Firefox\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"l\" using {command down}\n"
+ " keystroke \"a\" using {command down}\n"
+ " keystroke \"c\" using {command down}\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (car (split-string result "[\r\n]+" t))))
+
+(defun org-mac-firefox-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Firefox url...")
+ (let* ((url-and-title (org-as-mac-firefox-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-firefox-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-firefox-get-frontmost-url)))
+
+
+;; Handle links from Google Firefox.app running the Vimperator extension
+;; Grab the frontmost url from Firefox+Vimperator. Same limitations are
+;; Firefox
+
+(defun org-as-mac-vimperator-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Firefox\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"y\"\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (replace-regexp-in-string "\s+-\s+Vimperator" "" (car (split-string result "[\r\n]+" t)))))
+
+
+(defun org-mac-vimperator-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Vimperator url...")
+ (let* ((url-and-title (org-as-mac-vimperator-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-vimperator-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-vimperator-get-frontmost-url)))
+
+
+;; Handle links from Google Chrome.app
+;; Grab the frontmost url from Google Chrome. Same limitations as
+;; Firefox because Chrome doesn't publish an Applescript dictionary
+
+(defun org-as-mac-chrome-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "set oldClipboard to the clipboard\n"
+ "set frontmostApplication to path to frontmost application\n"
+ "tell application \"Google Chrome\"\n"
+ " activate\n"
+ " delay 0.15\n"
+ " tell application \"System Events\"\n"
+ " keystroke \"l\" using command down\n"
+ " keystroke \"c\" using command down\n"
+ " end tell\n"
+ " delay 0.15\n"
+ " set theUrl to the clipboard\n"
+ " set the clipboard to oldClipboard\n"
+ " set theResult to (get theUrl) & \"::split::\" & (get name of window 1)\n"
+ "end tell\n"
+ "activate application (frontmostApplication as text)\n"
+ "set links to {}\n"
+ "copy theResult to the end of links\n"
+ "return links as string\n"))))
+ (car (split-string result "[\r\n]+" t))))
+
+(defun org-mac-chrome-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Chrome url...")
+ (let* ((url-and-title (org-as-mac-chrome-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-chrome-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-chrome-get-frontmost-url)))
+
+
+;; Handle links from Safari.app
+;; Grab the frontmost url from Safari.
+
+(defun org-as-mac-safari-get-frontmost-url ()
+ (let ((result (do-applescript
+ (concat
+ "tell application \"Safari\"\n"
+ " set theUrl to URL of document 1\n"
+ " set theName to the name of the document 1\n"
+ " return theUrl & \"::split::\" & theName & \"\n\"\n"
+ "end tell\n"))))
+ (car (split-string result "[\r\n]+" t))))
+
+(defun org-mac-safari-get-frontmost-url ()
+ (interactive)
+ (message "Applescript: Getting Safari url...")
+ (let* ((url-and-title (org-as-mac-safari-get-frontmost-url))
+ (split-link (split-string url-and-title "::split::"))
+ (URL (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= URL ""))
+ (setq org-link (org-make-link-string URL description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-safari-insert-frontmost-url ()
+ (interactive)
+ (insert (org-mac-safari-get-frontmost-url)))
+
+
+;;
+;;
+;; Handle links from together.app
+;;
+;;
+
+(org-add-link-type "x-together-item" 'org-mac-together-item-open)
+
+(defun org-mac-together-item-open (uid)
+ "Open the given uid, which is a reference to an item in Together"
+ (shell-command (concat "open -a Together \"x-together-item:" uid "\"")))
+
+(defun as-get-selected-together-items ()
+ (do-applescript
+ (concat
+ "tell application \"Together\"\n"
+ " set theLinkList to {}\n"
+ " set theSelection to selected items\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to (get item link of theItem) & \"::split::\" & (get name of theItem) & \"\n\"\n"
+ " copy theLink to end of theLinkList\n"
+ " end repeat\n"
+ " return theLinkList as string\n"
+ "end tell")))
+
+(defun org-mac-together-get-selected ()
+ (interactive)
+ (message "Applescript: Getting Togther items...")
+ (org-mac-paste-applescript-links (as-get-selected-together-items)))
+
+(defun org-mac-together-insert-selected ()
+ (interactive)
+ (insert (org-mac-together-get-selected)))
+
+
+;;
+;;
+;; Handle links from Finder.app
+;;
+;;
+
+(defun as-get-selected-finder-items ()
+ (do-applescript
+ (concat
+ "tell application \"Finder\"\n"
+ " set theSelection to the selection\n"
+ " set links to {}\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to \"file://\" & (POSIX path of (theItem as string)) & \"::split::\" & (get the name of theItem) & \"\n\"\n"
+ " copy theLink to the end of links\n"
+ " end repeat\n"
+ " return links as string\n"
+ "end tell\n")))
+
+(defun org-mac-finder-item-get-selected ()
+ (interactive)
+ (message "Applescript: Getting Finder items...")
+ (org-mac-paste-applescript-links (as-get-selected-finder-items)))
+
+(defun org-mac-finder-insert-selected ()
+ (interactive)
+ (insert (org-mac-finder-item-get-selected)))
+
+
+;;
+;;
+;; Handle links from AddressBook.app
+;;
+;;
+
+(org-add-link-type "addressbook" 'org-mac-addressbook-item-open)
+
+(defun org-mac-addressbook-item-open (uid)
+ "Open the given uid, which is a reference to an item in Together"
+ (shell-command (concat "open \"addressbook:" uid "\"")))
+
+(defun as-get-selected-addressbook-items ()
+ (do-applescript
+ (concat
+ "tell application \"Address Book\"\n"
+ " set theSelection to the selection\n"
+ " set links to {}\n"
+ " repeat with theItem in theSelection\n"
+ " set theLink to \"addressbook://\" & (the id of theItem) & \"::split::\" & (the name of theItem) & \"\n\"\n"
+ " copy theLink to the end of links\n"
+ " end repeat\n"
+ " return links as string\n"
+ "end tell\n")))
+
+(defun org-mac-addressbook-item-get-selected ()
+ (interactive)
+ (message "Applescript: Getting Address Book items...")
+ (org-mac-paste-applescript-links (as-get-selected-addressbook-items)))
+
+(defun org-mac-addressbook-insert-selected ()
+ (interactive)
+ (insert (org-mac-addressbook-item-get-selected)))
+
+;;
+;;
+;; Handle links from Skim.app
+;;
+;; Original code & idea by Christopher Suckling (org-mac-protocol)
+
+(org-add-link-type "skim" 'org-mac-skim-open)
+
+(defun org-mac-skim-open (uri)
+ "Visit page of pdf in Skim"
+ (let* ((page (when (string-match "::\\(.+\\)\\'" uri)
+ (match-string 1 uri)))
+ (document (substring uri 0 (match-beginning 0))))
+ (do-applescript
+ (concat
+ "tell application \"Skim\"\n"
+ "activate\n"
+ "set theDoc to \"" document "\"\n"
+ "set thePage to " page "\n"
+ "open theDoc\n"
+ "go document 1 to page thePage of document 1\n"
+ "end tell"))))
+
+
+(defun as-get-skim-page-link ()
+ (do-applescript
+ (concat
+ "tell application \"Skim\"\n"
+ "set theDoc to front document\n"
+ "set theTitle to (name of theDoc)\n"
+ "set thePath to (path of theDoc)\n"
+ "set thePage to (get index for current page of theDoc)\n"
+ "set theSelection to selection of theDoc\n"
+ "set theContent to contents of (get text for theSelection)\n"
+ "if theContent is missing value then\n"
+ " set theContent to theTitle & \", p. \" & thePage\n"
+ (when org-mac-Skim-highlight-selection-p
+ (concat
+ "else\n"
+ " tell theDoc\n"
+ " set theNote to make note with properties {type:highlight note, selection:theSelection}\n"
+ " set text of theNote to (get text for theSelection)\n"
+ " end tell\n"))
+ "end if\n"
+ "set theLink to \"skim://\" & thePath & \"::\" & thePage & "
+ "\"::split::\" & theContent\n"
+ "end tell\n"
+ "return theLink as string\n")))
+
+(defun org-mac-skim-get-page ()
+ (interactive)
+ (message "Applescript: Getting Skim page link...")
+ (let* ((link-and-descr (as-get-skim-page-link))
+ (split-link (split-string link-and-descr "::split::"))
+ (link (car split-link))
+ (description (cadr split-link))
+ (org-link))
+ (when (not (string= link ""))
+ (setq org-link (org-make-link-string link description)))
+ (kill-new org-link)
+ org-link))
+
+(defun org-mac-skim-insert-page ()
+ (interactive)
+ (insert (org-mac-skim-get-page)))
+
+
+
+;;
+;;
+;; Handle links from Microsoft Outlook.app
+;;
+
+(org-add-link-type "mac-outlook" 'org-mac-outlook-message-open)
+
+(defun org-mac-outlook-message-open (msgid)
+ "Open a message in outlook"
+ (let* ((record-id-string (format "mdfind com_microsoft_outlook_recordID==%s" msgid))
+ (found-message (replace-regexp-in-string "\n$" ""
+ (shell-command-to-string record-id-string))))
+ (if (string= found-message "")
+ (message "org-mac-link: error could not find Outlook message %s" (substring-no-properties msgid))
+ (shell-command (format "open \"`mdfind com_microsoft_outlook_recordID==%s`\"" msgid)))))
+
+(defun org-as-get-selected-outlook-mail ()
+ "AppleScript to create links to selected messages in Microsoft Outlook.app."
+ (do-applescript
+ (concat
+ "tell application \"Microsoft Outlook\"\n"
+ "set msgCount to count current messages\n"
+ "if (msgCount < 1) then\n"
+ "return\n"
+ "end if\n"
+ "set theLinkList to {}\n"
+ "set theSelection to (get current messages)\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to id of theMessage as string\n"
+ "set theURL to \"mac-outlook:\" & theID\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to theURL & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
+
+(defun org-sh-get-flagged-outlook-mail ()
+ "Shell commands to create links to flagged messages in Microsoft Outlook.app."
+ (mapconcat
+ (lambda (x) ""
+ (concat
+ "mac-outlook:"
+ (mapconcat
+ (lambda (y) "" y)
+ (split-string
+ (shell-command-to-string
+ (format "mdls -raw -name com_microsoft_outlook_recordID -name kMDItemDisplayName \"%s\"" x))
+ "\000")
+ "::split::")
+ "\n"))
+ (with-temp-buffer
+ (let ((coding-system-for-read (or file-name-coding-system 'utf-8))
+ (coding-system-for-write 'utf-8))
+ (shell-command
+ "mdfind com_microsoft_outlook_flagged==1"
+ (current-buffer)))
+ (split-string
+ (buffer-string) "\n" t))
+ ""))
+
+(defun org-mac-outlook-message-get-links (&optional select-or-flag)
+ "Create links to the messages currently selected or flagged in Microsoft Outlook.app.
+This will use AppleScript to get the message-id and the subject of the
+messages in Microsoft Outlook.app and make a link out of it.
+When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
+the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
+The Org-syntax text will be pushed to the kill ring, and also returned."
+ (interactive "sLink to (s)elected or (f)lagged messages: ")
+ (setq select-or-flag (or select-or-flag "s"))
+ (message "Org Mac Outlook: searching mailboxes...")
+ (let* ((as-link-list
+ (if (string= select-or-flag "s")
+ (org-as-get-selected-outlook-mail)
+ (if (string= select-or-flag "f")
+ (org-sh-get-flagged-outlook-mail)
+ (error "Please select \"s\" or \"f\""))))
+ (link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
+ (split-string as-link-list "[\r\n]+")))
+ split-link URL description orglink orglink-insert rtn orglink-list)
+ (while link-list
+ (setq split-link (split-string (pop link-list) "::split::"))
+ (setq URL (car split-link))
+ (setq description (cadr split-link))
+ (when (not (string= URL ""))
+ (setq orglink (org-make-link-string URL description))
+ (push orglink orglink-list)))
+ (setq rtn (mapconcat 'identity orglink-list "\n"))
+ (kill-new rtn)
+ rtn))
+
+(defun org-mac-outlook-message-insert-selected ()
+ "Insert a link to the messages currently selected in Microsoft Outlook.app.
+This will use AppleScript to get the message-id and the subject of the
+active mail in Microsoft Outlook.app and make a link out of it."
+ (interactive)
+ (insert (org-mac-outlook-message-get-links "s")))
+
+(defun org-mac-outlook-message-insert-flagged (org-buffer org-heading)
+ "Asks for an org buffer and a heading within it, and replace message links.
+If heading exists, delete all mac-outlook:// links within heading's first
+level. If heading doesn't exist, create it at point-max. Insert
+list of mac-outlook:// links to flagged mail after heading."
+ (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
+ (with-current-buffer org-buffer
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (message-re "\\[\\[\\(mac-outlook:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
+ (if (org-goto-local-search-headings org-heading nil t)
+ (if (not (eobp))
+ (progn
+ (save-excursion
+ (while (re-search-forward
+ message-re (save-excursion (outline-next-heading)) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (insert "\n" (org-mac-outlook-message-get-links "f")))
+ (flush-lines "^$" (point) (outline-next-heading)))
+ (insert "\n" (org-mac-outlook-message-get-links "f")))
+ (goto-char (point-max))
+ (insert "\n")
+ (org-insert-heading nil t)
+ (insert org-heading "\n" (org-mac-outlook-message-get-links "f"))))))
+
+
+
+;;
+;;
+;; Handle links from Mail.app
+;;
+
+(org-add-link-type "message" 'org-mac-message-open)
+
+(defun org-mac-message-open (message-id)
+ "Visit the message with the given MESSAGE-ID.
+This will use the command `open' with the message URL."
+ (start-process (concat "open message:" message-id) nil
+ "open" (concat "message://<" (substring message-id 2) ">")))
+
+(defun org-as-get-selected-mail ()
+ "AppleScript to create links to selected messages in Mail.app."
+ (do-applescript
+ (concat
+ "tell application \"Mail\"\n"
+ "set theLinkList to {}\n"
+ "set theSelection to selection\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
+
+(defun org-as-get-flagged-mail ()
+ "AppleScript to create links to flagged messages in Mail.app."
+ (do-applescript
+ (concat
+ ;; Is Growl installed?
+ "tell application \"System Events\"\n"
+ "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
+ "if (count of growlHelpers) > 0 then\n"
+ "set growlHelperApp to item 1 of growlHelpers\n"
+ "else\n"
+ "set growlHelperApp to \"\"\n"
+ "end if\n"
+ "end tell\n"
+
+ ;; Get links
+ "tell application \"Mail\"\n"
+ "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
+ "set theLinkList to {}\n"
+ "repeat with aMailbox in theMailboxes\n"
+ "set theSelection to (every message in aMailbox whose flagged status = true)\n"
+ "repeat with theMessage in theSelection\n"
+ "set theID to message id of theMessage\n"
+ "set theSubject to subject of theMessage\n"
+ "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
+ "copy theLink to end of theLinkList\n"
+
+ ;; Report progress through Growl
+ ;; This "double tell" idiom is described in detail at
+ ;; http://macscripter.net/viewtopic.php?id=24570 The
+ ;; script compiler needs static knowledge of the
+ ;; growlHelperApp. Hmm, since we're compiling
+ ;; on-the-fly here, this is likely to be way less
+ ;; portable than I'd hoped. It'll work when the name
+ ;; is still "GrowlHelperApp", though.
+ "if growlHelperApp is not \"\" then\n"
+ "tell application \"GrowlHelperApp\"\n"
+ "tell application growlHelperApp\n"
+ "set the allNotificationsList to {\"FlaggedMail\"}\n"
+ "set the enabledNotificationsList to allNotificationsList\n"
+ "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
+ "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
+ "end tell\n"
+ "end tell\n"
+ "end if\n"
+ "end repeat\n"
+ "end repeat\n"
+ "return theLinkList as string\n"
+ "end tell")))
+
+(defun org-mac-message-get-links (&optional select-or-flag)
+ "Create links to the messages currently selected or flagged in Mail.app.
+This will use AppleScript to get the message-id and the subject of the
+messages in Mail.app and make a link out of it.
+When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
+the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
+The Org-syntax text will be pushed to the kill ring, and also returned."
+ (interactive "sLink to (s)elected or (f)lagged messages: ")
+ (setq select-or-flag (or select-or-flag "s"))
+ (message "AppleScript: searching mailboxes...")
+ (let* ((as-link-list
+ (if (string= select-or-flag "s")
+ (org-as-get-selected-mail)
+ (if (string= select-or-flag "f")
+ (org-as-get-flagged-mail)
+ (error "Please select \"s\" or \"f\""))))
+ (link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
+ (split-string as-link-list "[\r\n]+")))
+ split-link URL description orglink orglink-insert rtn orglink-list)
+ (while link-list
+ (setq split-link (split-string (pop link-list) "::split::"))
+ (setq URL (car split-link))
+ (setq description (cadr split-link))
+ (when (not (string= URL ""))
+ (setq orglink (org-make-link-string URL description))
+ (push orglink orglink-list)))
+ (setq rtn (mapconcat 'identity orglink-list "\n"))
+ (kill-new rtn)
+ rtn))
+
+(defun org-mac-message-insert-selected ()
+ "Insert a link to the messages currently selected in Mail.app.
+This will use AppleScript to get the message-id and the subject of the
+active mail in Mail.app and make a link out of it."
+ (interactive)
+ (insert (org-mac-message-get-links "s")))
+
+;; The following line is for backward compatibility
+(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
+
+(defun org-mac-message-insert-flagged (org-buffer org-heading)
+ "Asks for an org buffer and a heading within it, and replace message links.
+If heading exists, delete all message:// links within heading's first
+level. If heading doesn't exist, create it at point-max. Insert
+list of message:// links to flagged mail after heading."
+ (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
+ (with-current-buffer org-buffer
+ (goto-char (point-min))
+ (let ((isearch-forward t)
+ (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
+ (if (org-goto-local-search-headings org-heading nil t)
+ (if (not (eobp))
+ (progn
+ (save-excursion
+ (while (re-search-forward
+ message-re (save-excursion (outline-next-heading)) t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ (insert "\n" (org-mac-message-get-links "f")))
+ (flush-lines "^$" (point) (outline-next-heading)))
+ (insert "\n" (org-mac-message-get-links "f")))
+ (goto-char (point-max))
+ (insert "\n")
+ (org-insert-heading nil t)
+ (insert org-heading "\n" (org-mac-message-get-links "f"))))))
+
+
+(provide 'org-mac-link)
+
+;;; org-mac-link.el ends here
diff --git a/contrib/lisp/org-mac-message.el b/contrib/lisp/org-mac-message.el
deleted file mode 100644
index dca63c9..0000000
--- a/contrib/lisp/org-mac-message.el
+++ /dev/null
@@ -1,217 +0,0 @@
-;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <johnw@gnu.org>
-;; Christopher Suckling <suckling at gmail dot com>
-
-;; Keywords: outlines, hypermedia, calendar, wp
-
-;; 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:
-;; This file implements links to Apple Mail.app messages from within
-;; Org-mode. Org-mode does not load this module by default - if you
-;; would actually like this to happen then configure the variable
-;; `org-modules' and add Org's contrib/ directory to your `load-path'.
-
-;; If you would like to create links to all flagged messages in an
-;; Apple Mail.app account, please customize the variable
-;; `org-mac-mail-account' and then call one of the following functions:
-
-;; (org-mac-message-insert-selected) copies a formatted list of links to
-;; the kill ring.
-
-;; (org-mac-message-insert-selected) inserts at point links to any
-;; messages selected in Mail.app.
-
-;; (org-mac-message-insert-flagged) searches within an org-mode buffer
-;; for a specific heading, creating it if it doesn't exist. Any
-;; message:// links within the first level of the heading are deleted
-;; and replaced with links to flagged messages.
-
-;;; Code:
-
-(require 'org)
-
-(defgroup org-mac-flagged-mail nil
- "Options concerning linking to flagged Mail.app messages."
- :tag "Org Mail.app"
- :group 'org-link)
-
-(defcustom org-mac-mail-account "customize"
- "The Mail.app account in which to search for flagged messages."
- :group 'org-mac-flagged-mail
- :type 'string)
-
-(org-add-link-type "message" 'org-mac-message-open)
-
-;; In mac.c, removed in Emacs 23.
-(declare-function do-applescript "org-mac-message" (script))
-(unless (fboundp 'do-applescript)
- ;; Need to fake this using shell-command-to-string
- (defun do-applescript (script)
- (let (start cmd return)
- (while (string-match "\n" script)
- (setq script (replace-match "\r" t t script)))
- (while (string-match "'" script start)
- (setq start (+ 2 (match-beginning 0))
- script (replace-match "\\'" t t script)))
- (setq cmd (concat "osascript -e '" script "'"))
- (setq return (shell-command-to-string cmd))
- (concat "\"" (org-trim return) "\""))))
-
-(defun org-mac-message-open (message-id)
- "Visit the message with the given MESSAGE-ID.
-This will use the command `open' with the message URL."
- (start-process (concat "open message:" message-id) nil
- "open" (concat "message://<" (substring message-id 2) ">")))
-
-(defun as-get-selected-mail ()
- "AppleScript to create links to selected messages in Mail.app."
- (do-applescript
- (concat
- "tell application \"Mail\"\n"
- "set theLinkList to {}\n"
- "set theSelection to selection\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun as-get-flagged-mail ()
- "AppleScript to create links to flagged messages in Mail.app."
- (do-applescript
- (concat
- ;; Is Growl installed?
- "tell application \"System Events\"\n"
- "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
- "if (count of growlHelpers) > 0 then\n"
- "set growlHelperApp to item 1 of growlHelpers\n"
- "else\n"
- "set growlHelperApp to \"\"\n"
- "end if\n"
- "end tell\n"
-
- ;; Get links
- "tell application \"Mail\"\n"
- "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
- "set theLinkList to {}\n"
- "repeat with aMailbox in theMailboxes\n"
- "set theSelection to (every message in aMailbox whose flagged status = true)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
-
- ;; Report progress through Growl
- ;; This "double tell" idiom is described in detail at
- ;; http://macscripter.net/viewtopic.php?id=24570 The
- ;; script compiler needs static knowledge of the
- ;; growlHelperApp. Hmm, since we're compiling
- ;; on-the-fly here, this is likely to be way less
- ;; portable than I'd hoped. It'll work when the name
- ;; is still "GrowlHelperApp", though.
- "if growlHelperApp is not \"\" then\n"
- "tell application \"GrowlHelperApp\"\n"
- "tell application growlHelperApp\n"
- "set the allNotificationsList to {\"FlaggedMail\"}\n"
- "set the enabledNotificationsList to allNotificationsList\n"
- "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
- "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
- "end tell\n"
- "end tell\n"
- "end if\n"
- "end repeat\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun org-mac-message-get-links (&optional select-or-flag)
- "Create links to the messages currently selected or flagged in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-messages in Mail.app and make a link out of it.
-When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
-the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
-The Org-syntax text will be pushed to the kill ring, and also returned."
- (interactive "sLink to (s)elected or (f)lagged messages: ")
- (setq select-or-flag (or select-or-flag "s"))
- (message "AppleScript: searching mailboxes...")
- (let* ((as-link-list
- (if (string= select-or-flag "s")
- (as-get-selected-mail)
- (if (string= select-or-flag "f")
- (as-get-flagged-mail)
- (error "Please select \"s\" or \"f\""))))
- (link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-(defun org-mac-message-insert-selected ()
- "Insert a link to the messages currently selected in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-active mail in Mail.app and make a link out of it."
- (interactive)
- (insert (org-mac-message-get-links "s")))
-
-;; The following line is for backward compatibility
-(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
-
-(defun org-mac-message-insert-flagged (org-buffer org-heading)
- "Asks for an org buffer and a heading within it, and replace message links.
-If heading exists, delete all message:// links within heading's first
-level. If heading doesn't exist, create it at point-max. Insert
-list of message:// links to flagged mail after heading."
- (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
- (with-current-buffer org-buffer
- (goto-char (point-min))
- (let ((isearch-forward t)
- (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
- (if (org-goto-local-search-headings org-heading nil t)
- (if (not (eobp))
- (progn
- (save-excursion
- (while (re-search-forward
- message-re (save-excursion (outline-next-heading)) t)
- (delete-region (match-beginning 0) (match-end 0)))
- (insert "\n" (org-mac-message-get-links "f")))
- (flush-lines "^$" (point) (outline-next-heading)))
- (insert "\n" (org-mac-message-get-links "f")))
- (goto-char (point-max))
- (insert "\n")
- (org-insert-heading nil t)
- (insert org-heading "\n" (org-mac-message-get-links "f"))))))
-
-(provide 'org-mac-message)
-
-;;; org-mac-message.el ends here
diff --git a/contrib/lisp/org-mime.el b/contrib/lisp/org-mime.el
index 855dc2d..ef2057c 100644
--- a/contrib/lisp/org-mime.el
+++ b/contrib/lisp/org-mime.el
@@ -212,14 +212,12 @@ export that region, otherwise export the entire body."
(tmp-file (make-temp-name (expand-file-name
"mail" temporary-file-directory)))
(body (org-export-string-as raw-body 'org t))
- ;; because we probably don't want to skip part of our mail
- (org-export-skip-text-before-1st-heading nil)
;; because we probably don't want to export a huge style file
(org-export-htmlize-output-type 'inline-css)
;; makes the replies with ">"s look nicer
(org-export-preserve-breaks org-mime-preserve-breaks)
;; dvipng for inline latex because MathJax doesn't work in mail
- (org-export-with-LaTeX-fragments 'dvipng)
+ (org-html-with-latex 'dvipng)
;; to hold attachments for inline html images
(html-and-images
(org-mime-replace-images
diff --git a/contrib/lisp/org-screenshot.el b/contrib/lisp/org-screenshot.el
new file mode 100644
index 0000000..a54cb8f
--- /dev/null
+++ b/contrib/lisp/org-screenshot.el
@@ -0,0 +1,530 @@
+;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
+;;
+;; Copyright (C) 2009-2013
+;; Free Software Foundation, Inc.
+;;
+;; Author: Max Mikhanosha <max@openchat.com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 8.0
+;;
+;; Released under the GNU General Public License version 3
+;; see: http://www.gnu.org/licenses/gpl-3.0.html
+;;
+;; This file is not 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 3 of the License, 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; NOTE: This library requires external screenshot taking executable "scrot",
+;; which is available as a package from all major Linux distribution. If your
+;; distribution does not have it, source can be found at:
+;;
+;; http://freecode.com/projects/scrot
+;;
+;; org-screenshot.el have been tested with scrot version 0.8.
+;;
+;; Usage:
+;;
+;; (require 'org-screenshot)
+;;
+;; Available commands with default bindings
+;;
+;; `org-screenshot-take' C-c M-s M-t and C-c M-s M-s
+;;
+;; Take the screenshot, C-u argument delays 1 second, double C-u 2 seconds
+;; triple C-u 3 seconds, and subsequent C-u add 2 seconds to the delay.
+;;
+;; Screenshot area is selected with the mouse, or left-click on the window
+;; for an entire window.
+;;
+;; `org-screenshot-rotate-prev' C-c M-s M-p and C-c M-s C-p
+;;
+;; Rotate screenshot before the point to one before it (sorted by date)
+;;
+;; `org-screenshot-rotate-next' C-c M-s M-n and C-c M-s C-n
+;;
+;; Rotate screenshot before the point to one after it
+;;
+;; `org-screenshot-show-unused' C-c M-s M-u and C-c M-s u
+;;
+;; Open dired buffer with screenshots that are not used in current
+;; Org buffer marked
+;;
+;; The screenshot take and rotate commands will update the inline images
+;; if they are already shown, if you are inserting first screenshot in the Org
+;; Buffer (and there are no other images shown), you need to manually display
+;; inline images with C-c C-x C-v
+;;
+;; Screenshot take and rotate commands offer user to continue by by using single
+;; keys, in a manner similar to to "repeat-char" of keyboard macros, user can
+;; continue rotating screenshots by pressing just the last key of the binding
+;;
+;; For example: C-c M-s M-t creates the screenshot and then user can
+;; repeatedly press M-p or M-n to rotate it back and forth with
+;; previously taken ones.
+;;
+
+(require 'org)
+(require 'dired)
+
+(defgroup org-screenshot nil
+ "Options for taking and managing screen-shots"
+ :group 'org-link)
+
+(defcustom org-screenshot-image-directory "./images/"
+ "Directory in which screenshot image files will be stored, it
+be automatically created if it does't already exist."
+ :type 'string
+ :group 'org-screenshot)
+
+(defcustom org-screenshot-file-name-format "screenshot-%2.2d.png"
+ "The string used to generate screenshot file name.
+
+Any %d format string recipe will be expanded with `format'
+function with the argument of a screenshot sequence number.
+
+A sequence like %XXXX will be replaced with string of the same
+length as there are X's, consisting of random characters in the
+range of [A-Za-z]."
+ :type 'string
+ :group 'org-screenshot)
+
+(defcustom org-screenshot-max-tries 200
+ "Number of times we will try to generate generate filename that
+does not exist. With default `org-screenshot-name-format' its the
+limit for number of screenshots, before `org-screenshot-take' is
+unable to come up with a unique name."
+ :type 'integer
+ :group 'org-screenshot)
+
+(defvar org-screenshot-map (make-sparse-keymap)
+ "Map for OrgMode screenshot related commands")
+
+;; prefix
+(org-defkey org-mode-map (kbd "C-c M-s") org-screenshot-map)
+
+;; Mnemonic is Control-C Meta "Screenshot" "Take"
+(org-defkey org-screenshot-map (kbd "M-t") 'org-screenshot-take)
+(org-defkey org-screenshot-map (kbd "M-s") 'org-screenshot-take)
+
+;; No reason to require meta key, since its our own keymap
+(org-defkey org-screenshot-map "s" 'org-screenshot-take)
+(org-defkey org-screenshot-map "t" 'org-screenshot-take)
+
+;; Rotations, the fast rotation user hint, would prefer the modifier
+;; used by the original command that started the rotation
+(org-defkey org-screenshot-map (kbd "M-n") 'org-screenshot-rotate-next)
+(org-defkey org-screenshot-map (kbd "M-p") 'org-screenshot-rotate-prev)
+(org-defkey org-screenshot-map (kbd "C-n") 'org-screenshot-rotate-next)
+(org-defkey org-screenshot-map (kbd "C-p") 'org-screenshot-rotate-prev)
+
+;; Show unused image files in Dired
+(org-defkey org-screenshot-map (kbd "M-u") 'org-screenshot-show-unused)
+(org-defkey org-screenshot-map (kbd "u") 'org-screenshot-show-unused)
+
+
+(random t)
+
+(defun org-screenshot-random-string (length)
+ "Generate a random string of LENGTH consisting of random upper
+case and lower case letters."
+ (let ((name (make-string length ?x)))
+ (dotimes (i length)
+ (let ((n (random 52)))
+ (aset name i (if (< n 26)
+ (+ ?a n)
+ (+ ?A n -26)))))
+ name))
+
+(defvar org-screenshot-process nil
+ "Currently running screenshot process")
+
+(defvar org-screenshot-directory-seq-numbers (make-hash-table :test 'equal))
+
+(defun org-screenshot-update-seq-number (directory &optional reset)
+ "Set `org-screenshot-file-name-format' sequence number for the directory.
+When RESET is NIL, increments the number stored, otherwise sets
+RESET as a new number. Intended to be called if screenshot was
+successful. Updating of sequence number is done in two steps, so
+aborted/canceled screenshot attempts don't increase the number"
+
+ (setq directory (file-name-as-directory directory))
+ (puthash directory (if reset
+ (if (numberp reset) reset 1)
+ (1+ (gethash directory
+ org-screenshot-directory-seq-numbers
+ 0)))
+ org-screenshot-directory-seq-numbers))
+
+(defun org-screenshot-generate-file-name (directory)
+ "Use `org-screenshot-name-format' to generate new screenshot
+file name for a specific directory. Keeps re-generating name if
+it already exists, up to `org-screenshot-max-tries'
+times. Returns just the file, without directory part"
+ (setq directory (file-name-as-directory directory))
+ (when (file-exists-p directory)
+ (let ((tries 0)
+ name
+ had-seq
+ (case-fold-search nil))
+ (while (and (< tries org-screenshot-max-tries)
+ (not name))
+ (incf tries)
+ (let ((tmp org-screenshot-file-name-format)
+ (seq-re "%[-0-9.]*d")
+ (rand-re "%X+"))
+ (when (string-match seq-re tmp)
+ (let ((seq (gethash
+ directory
+ org-screenshot-directory-seq-numbers 1)))
+ (setq tmp
+ (replace-regexp-in-string
+ seq-re (format (match-string 0 tmp) seq)
+ tmp)
+ had-seq t)))
+ (when (string-match rand-re tmp)
+ (setq tmp
+ (replace-regexp-in-string
+ rand-re (org-screenshot-random-string
+ (1- (length (match-string 0 tmp))))
+ tmp t)))
+ (let ((fullname (concat directory tmp)))
+ (if (file-exists-p fullname)
+ (when had-seq (org-screenshot-update-seq-number directory))
+ (setq name tmp)))))
+ name)))
+
+(defun org-screenshot-image-directory ()
+ "Return the `org-screenshot-image-directory', ensuring there is
+trailing slash, and that it exists"
+ (let ((dir (file-name-as-directory org-screenshot-image-directory)))
+ (if (file-exists-p dir)
+ dir
+ (make-directory dir t)
+ dir)))
+
+(defvar org-screenshot-last-file nil
+ "File name of the last taken or rotated screenshot file,
+without directory")
+
+(defun org-screenshot-process-done (process event file
+ orig-buffer
+ orig-delay
+ orig-event)
+ "Called when \"scrot\" process exits. PROCESS and EVENT are
+same arguments as in `set-process-sentinel'. ORIG-BUFFER,
+ORIG-DELAY and ORIG-EVENT are Org Buffer, the screenshot delay
+used, and LAST-INPUT-EVENT values from when screenshot was
+initiated.
+"
+ (setq org-screenshot-process nil)
+ (with-current-buffer (process-buffer process)
+ (if (not (equal event "finished\n"))
+ (progn
+ (insert event)
+ (cond ((save-excursion
+ (goto-char (point-min))
+ (re-search-forward "Key was pressed" nil t))
+ (ding)
+ (message "Key was pressed, screenshot aborted"))
+ (t
+ (display-buffer (process-buffer process))
+ (message "Error running \"scrot\" program")
+ (ding))))
+ (with-current-buffer orig-buffer
+ (let ((link (format "[[file:%s]]" file)))
+ (setq org-screenshot-last-file (file-name-nondirectory file))
+ (let ((beg (point)))
+ (insert link)
+ (when org-inline-image-overlays
+ (org-display-inline-images nil t beg (point))))
+ (unless (< orig-delay 3)
+ (ding))
+ (org-screenshot-rotate-continue t orig-event))))))
+
+
+;;;###autoload
+(defun org-screenshot-take (&optional delay)
+ "Take a screenshot and insert link to it at point, if image
+display is already on (see \\[org-toggle-inline-images])
+screenshot will be displayed as an image
+
+Screen area for the screenshot is selected with the mouse, left
+click on a window screenshots that window, while left click and
+drag selects a region. Pressing any key cancels the screen shot
+
+With `C-u' universal argument waits one second after target is
+selected before taking the screenshot. With double `C-u' wait two
+seconds.
+
+With triple `C-u' wait 3 seconds, and also rings the bell when
+screenshot is done, any more `C-u' after that increases delay by
+2 seconds
+"
+ (interactive "P")
+
+ ;; probably easier way to count number of C-u C-u out there
+ (setq delay
+ (cond ((null delay) 0)
+ ((integerp delay) delay)
+ ((and (consp delay)
+ (integerp (car delay))
+ (plusp (car delay)))
+ (let ((num 1)
+ (limit (car delay))
+ (cnt 0))
+ (while (< num limit)
+ (setq num (* num 4)
+ cnt (+ cnt (if (< cnt 3) 1 2))))
+ cnt))
+ (t (error "Invald delay"))))
+ (when (and org-screenshot-process
+ (member (process-status org-screenshot-process)
+ '(run stop)))
+ (error "scrot process is still running"))
+ (let* ((name (org-screenshot-generate-file-name (org-screenshot-image-directory)))
+ (file (format "%s%s" (org-screenshot-image-directory)
+ name))
+ (path (expand-file-name file)))
+ (when (get-buffer "*scrot*")
+ (with-current-buffer (get-buffer "*scrot*")
+ (erase-buffer)))
+ (setq org-screenshot-process
+ (or
+ (apply 'start-process
+ (append
+ (list "scrot" "*scrot*" "scrot" "-s" path)
+ (when (plusp delay)
+ (list "-d" (format "%d" delay)))))
+ (error "Unable to start scrot process")))
+ (when org-screenshot-process
+ (if (plusp delay)
+ (message "Click on a window, or select a rectangle (delay is %d sec)..."
+ delay)
+ (message "Click on a window, or select a rectangle..."))
+ (set-process-sentinel
+ org-screenshot-process
+ `(lambda (process event)
+ (org-screenshot-process-done
+ process event ,file ,(current-buffer) ,delay ',last-input-event))))))
+
+(defvar org-screenshot-file-list nil
+ "List of files in `org-screenshot-image-directory' used by
+`org-screenshot-rotate-prev' and `org-screenshot-rotate-next'")
+
+(defvar org-screenshot-rotation-index -1)
+
+(make-variable-buffer-local 'org-screenshot-file-list)
+(make-variable-buffer-local 'org-screenshot-rotation-index)
+
+(defun org-screenshot-rotation-init (lastfile)
+ "Initialize variable `org-screenshot-file-list' variabel with
+the list of PNG files in `org-screenshot-image-directory' sorted
+by most recent first"
+ (setq
+ org-screenshot-rotation-index -1
+ org-screenshot-file-list
+ (let ((files (directory-files org-screenshot-image-directory
+ t (org-image-file-name-regexp) t)))
+ (mapcar 'file-name-nondirectory
+ (sort files
+ (lambda (file1 file2)
+ (let ((mtime1 (nth 5 (file-attributes file1)))
+ (mtime2 (nth 5 (file-attributes file2))))
+ (setq mtime1 (+ (ash (first mtime1) 16)
+ (second mtime1)))
+ (setq mtime2 (+ (ash (first mtime2) 16)
+ (second mtime2)))
+ (> mtime1 mtime2)))))))
+ (let ((n -1) (list org-screenshot-file-list))
+ (while (and list (not (equal (pop list) lastfile)))
+ (incf n))
+ (setq org-screenshot-rotation-index n)))
+
+(defun org-screenshot-do-rotate (dir from-continue-rotating)
+ "Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, in the
+other direction"
+ (setq org-screenshot-last-file nil)
+ (let* ((ourdir (file-name-as-directory (org-screenshot-image-directory)))
+ done
+ (link-re
+ ;; taken from `org-display-inline-images'
+ (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]"))
+ newfile oldfile)
+ (save-excursion
+ ;; Search for link to image file in the same directory before the point
+ (while (not done)
+ (if (not (re-search-backward link-re (point-min) t))
+ (error "Unable to find link to image from %S directory before point" ourdir)
+ (let ((file (concat (or (match-string 3) "") (match-string 4))))
+ (when (equal (file-name-directory file)
+ ourdir)
+ (setq done t
+ oldfile (file-name-nondirectory file))))))
+ (when (or (null org-screenshot-file-list)
+ (and (not from-continue-rotating)
+ (not (member last-command
+ '(org-screenshot-rotate-prev
+ org-screenshot-rotate-next)))))
+ (org-screenshot-rotation-init oldfile))
+ (unless (> (length org-screenshot-file-list) 1)
+ (error "Can't rotate a single image file"))
+ (replace-match "" nil nil nil 1)
+
+ (setq org-screenshot-rotation-index
+ (mod (+ org-screenshot-rotation-index dir)
+ (length org-screenshot-file-list))
+ newfile (nth org-screenshot-rotation-index
+ org-screenshot-file-list))
+ ;; in case we started rotating from the file we just inserted,
+ ;; advance one more time
+ (when (equal oldfile newfile)
+ (setq org-screenshot-rotation-index
+ (mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1))
+ (length org-screenshot-file-list))
+ newfile (nth org-screenshot-rotation-index
+ org-screenshot-file-list)))
+ (replace-match (concat "file:" ourdir
+ newfile)
+ t t nil 4))
+ ;; out of save-excursion
+ (setq org-screenshot-last-file newfile)
+ (when org-inline-image-overlays
+ (org-display-inline-images nil t (match-beginning 0) (point)))))
+
+;;;###autoload
+(defun org-screenshot-rotate-prev (dir)
+ "Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, rotate
+in the other direction"
+ (interactive "p")
+ (org-screenshot-do-rotate dir nil)
+ (when org-screenshot-last-file
+ (org-screenshot-rotate-continue nil nil)))
+
+;;;###autoload
+(defun org-screenshot-rotate-next (dir)
+ "Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, rotate
+in the other direction"
+ (interactive "p")
+ (org-screenshot-do-rotate (- dir) nil)
+ (when org-screenshot-last-file
+ (org-screenshot-rotate-continue nil nil)))
+
+(defun org-screenshot-prefer-same-modifiers (list event)
+ (if (not (eventp nil)) (car list)
+ (let (ret (keys list))
+ (while (and (null ret) keys)
+ (let ((key (car keys)))
+ (if (and (= 1 (length key))
+ (equal (event-modifiers event)
+ (event-modifiers (elt key 0))))
+ (setq ret (car keys))
+ (setq keys (cdr keys)))))
+ (or ret (car list)))))
+
+(defun org-screenshot-rotate-continue (from-take-screenshot orig-event)
+ "Display the message with the name of the last changed
+image-file and inform user that they can rotate by pressing keys
+bound to `org-screenshot-rotate-next' and
+`org-screenshot-rotate-prev' in `org-screenshot-map'
+
+This works similarly to `kmacro-end-or-call-macro' so that user
+can press a long key sequence to invoke the first command, and
+then uses single keys to rotate, until unregognized key is
+entered, at which point event will be unread"
+
+ (let* ((event (if from-take-screenshot orig-event
+ last-input-event))
+ done
+ (prev-key
+ (org-screenshot-prefer-same-modifiers
+ (where-is-internal 'org-screenshot-rotate-prev
+ org-screenshot-map nil)
+ event))
+ (next-key
+ (org-screenshot-prefer-same-modifiers
+ (where-is-internal 'org-screenshot-rotate-next
+ org-screenshot-map nil)
+ event))
+ prev-key-str next-key-str)
+ (when (and (= (length prev-key) 1)
+ (= (length next-key) 1))
+ (setq
+ prev-key-str (format-kbd-macro prev-key nil)
+ next-key-str (format-kbd-macro next-key nil)
+ prev-key (elt prev-key 0)
+ next-key (elt next-key 0))
+ (while (not done)
+ (message "%S - '%s' and '%s' to rotate"
+ org-screenshot-last-file prev-key-str next-key-str)
+ (setq event (read-event))
+ (cond ((equal event prev-key)
+ (clear-this-command-keys t)
+ (org-screenshot-do-rotate 1 t)
+ (setq last-input-event nil))
+ ((equal event next-key)
+ (clear-this-command-keys t)
+ (org-screenshot-do-rotate -1 t)
+ (setq last-input-event nil))
+ (t (setq done t))))
+ (when last-input-event
+ (clear-this-command-keys t)
+ (setq unread-command-events (list last-input-event))))))
+
+;;;###autoload
+(defun org-screenshot-show-unused ()
+ "Open A Dired buffer with unused screenshots marked"
+ (interactive)
+ (let ((files-in-buffer)
+ dired-buffer
+ had-any
+ (image-re (org-image-file-name-regexp))
+ beg end)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq beg (or beg (point-min)) end (or end (point-max)))
+ (goto-char beg)
+ (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]"))
+ (case-fold-search t)
+ old file ov img type attrwidth width)
+ (while (re-search-forward re end t)
+ (setq file (concat (or (match-string 3) "") (match-string 4)))
+ (when (and (file-exists-p file)
+ (equal (file-name-directory file)
+ (org-screenshot-image-directory)))
+ (push (file-name-nondirectory file)
+ files-in-buffer))))))
+ (setq dired-buffer (dired-noselect (org-screenshot-image-directory)))
+ (with-current-buffer dired-buffer
+ (dired-unmark-all-files ?\r)
+ (dired-mark-if
+ (let ((file (dired-get-filename 'no-dir t)))
+ (and file (string-match image-re file)
+ (not (member file files-in-buffer))
+ (setq had-any t)))
+ "Unused screenshot"))
+ (when had-any (pop-to-buffer dired-buffer))))
+
+(provide 'org-screenshot)
diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el
index 7d685df..1128ef7 100644
--- a/contrib/lisp/org-wl.el
+++ b/contrib/lisp/org-wl.el
@@ -67,7 +67,7 @@ googlegroups otherwise."
(defcustom org-wl-namazu-default-index nil
"Default namazu search index."
- :type 'directory
+ :type '(choice (const nil) (directory))
:group 'org-wl)
;; Declare external functions and variables
diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el
new file mode 100644
index 0000000..29a97eb
--- /dev/null
+++ b/contrib/lisp/ox-bibtex.el
@@ -0,0 +1,293 @@
+;;; ox-bibtex.el --- Export bibtex fragments
+
+;; Copyright (C) 2009-2013 Taru Karttunen
+
+;; Author: Taru Karttunen <taruti@taruti.net>
+;; Nicolas Goaziou <n dot goaziou at gmail dot com>
+;; 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/
+;;
+;; It also introduces "cite" syntax for Org links.
+;;
+;; 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} and [[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.
+;;
+;; For LaTeX export it:
+;; 1) converts all [[cite:foo]] to \cite{foo}.
+
+;; Initialization
+
+(eval-when-compile (require 'cl))
+(org-add-link-type "cite" 'ebib)
+
+
+;;; Internal Functions
+
+(defun org-bibtex-get-file (keyword)
+ "Return bibliography file as a string.
+KEYWORD is a \"BIBLIOGRAPHY\" keyword. If no file is found,
+return nil instead."
+ (let ((value (org-element-property :value keyword)))
+ (and value
+ (string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
+ (match-string 1 value))))
+
+(defun org-bibtex-get-style (keyword)
+ "Return bibliography style as a string.
+KEYWORD is a \"BIBLIOGRAPHY\" keyword. If no style is found,
+return nil instead."
+ (let ((value (org-element-property :value keyword)))
+ (and value
+ (string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
+ (match-string 2 value))))
+
+(defun org-bibtex-get-arguments (keyword)
+ "Return \"bibtex2html\" arguments specified by the user.
+KEYWORD is a \"BIBLIOGRAPHY\" keyword. Return value is a plist
+containing `:options' and `:limit' properties. The former
+contains a list of strings to be passed as options ot
+\"bibtex2html\" process. The latter contains a boolean."
+ (let ((value (org-element-property :value keyword)))
+ (and value
+ (string-match "\\(\\S-+\\)[ \t]+\\(\\S-+\\)\\(.*\\)" value)
+ (let (options limit)
+ (dolist (arg (org-split-string (match-string 3 value))
+ ;; Return value.
+ (list :options (nreverse options) :limit limit))
+ (let* ((s (split-string arg ":"))
+ (key (car s))
+ (value (nth 1 s)))
+ (cond ((equal "limit" key)
+ (setq limit (not (equal "nil" value))))
+ ((equal "option" key) (push value options)))))))))
+
+(defun org-bibtex-citation-p (object)
+ "Non-nil when OBJECT is a citation."
+ (case (org-element-type object)
+ (link (equal (org-element-property :type object) "cite"))
+ (latex-fragment
+ (string-match "\\`\\\\cite{" (org-element-property :value object)))))
+
+(defun org-bibtex-get-citation-key (citation)
+ "Return key for a given citation, as a string.
+CITATION is a `latex-fragment' or `link' type object satisfying
+to `org-bibtex-citation-p' predicate."
+ (if (eq (org-element-type citation) 'link)
+ (org-element-property :path citation)
+ (let ((value (org-element-property :value citation)))
+ (and (string-match "\\`\\\\cite{" value)
+ (substring value (match-end 0) -1)))))
+
+
+
+;;; LaTeX Part
+
+(defadvice org-latex-keyword (around bibtex-keyword)
+ "Translate \"BIBLIOGRAPHY\" keywords into LaTeX syntax.
+Fallback to `latex' back-end for other keywords."
+ (let ((keyword (ad-get-arg 0)))
+ (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
+ ad-do-it
+ (let ((file (org-bibtex-get-file keyword))
+ (style (org-bibtex-get-style keyword)))
+ (setq ad-return-value
+ (when file
+ (concat (and style (format "\\bibliographystyle{%s}\n" style))
+ (format "\\bibliography{%s}" file))))))))
+
+(defadvice org-latex-link (around bibtex-link)
+ "Translate \"cite\" type links into LaTeX syntax.
+Fallback to `latex' back-end for other keywords."
+ (let ((link (ad-get-arg 0)))
+ (if (not (org-bibtex-citation-p link)) ad-do-it
+ (setq ad-return-value
+ (format "\\cite{%s}" (org-bibtex-get-citation-key link))))))
+
+(ad-activate 'org-latex-keyword)
+(ad-activate 'org-latex-link)
+
+
+
+;;; HTML Part
+
+(defvar org-bibtex-html-entries-alist nil) ; Dynamically scoped.
+(defvar org-bibtex-html-keywords-alist nil) ; Dynamically scoped.
+
+
+;;;; Advices
+
+(defadvice org-html-keyword (around bibtex-keyword)
+ "Translate \"BIBLIOGRAPHY\" keywords into HTML syntax.
+Fallback to `html' back-end for other keywords."
+ (let ((keyword (ad-get-arg 0)))
+ (if (not (equal (org-element-property :key keyword) "BIBLIOGRAPHY"))
+ ad-do-it
+ (setq ad-return-value
+ (cdr (assq keyword org-bibtex-html-keywords-alist))))))
+
+(defadvice org-html-latex-fragment (around bibtex-citation)
+ "Translate \"\\cite\" LaTeX fragments into HTML syntax.
+Fallback to `html' back-end for other keywords."
+ (let ((fragment (ad-get-arg 0)))
+ (if (not (org-bibtex-citation-p fragment)) ad-do-it
+ (setq ad-return-value
+ (mapconcat
+ (lambda (key)
+ (let ((key (org-trim key)))
+ (format "[<a href=\"#%s\">%s</a>]"
+ key
+ (or (cdr (assoc key org-bibtex-html-entries-alist))
+ key))))
+ (org-split-string (org-bibtex-get-citation-key fragment) ",")
+ "")))))
+
+(defadvice org-html-link (around bibtex-link)
+ "Translate \"cite:\" type links into HTML syntax.
+Fallback to `html' back-end for other types."
+ (let ((link (ad-get-arg 0)))
+ (if (not (org-bibtex-citation-p link)) ad-do-it
+ (setq ad-return-value
+ (mapconcat
+ (lambda (key)
+ (format "[<a href=\"#%s\">%s</a>]"
+ key
+ (or (cdr (assoc key org-bibtex-html-entries-alist))
+ key)))
+ (org-split-string (org-bibtex-get-citation-key link)
+ "[ \t]*,[ \t]*")
+ "")))))
+
+(ad-activate 'org-html-keyword)
+(ad-activate 'org-html-latex-fragment)
+(ad-activate 'org-html-link)
+
+
+;;;; Filter
+
+(defun org-bibtex-process-bib-files (tree backend info)
+ "Send each bibliography in parse tree to \"bibtex2html\" process.
+Return new parse tree. This function assumes current back-end is HTML."
+ ;; Initialize dynamically scoped variables. The first one
+ ;; contain an alist between keyword objects and their HTML
+ ;; translation. The second one will contain an alist between
+ ;; citation keys and names in the output (according to style).
+ (setq org-bibtex-html-entries-alist nil
+ org-bibtex-html-keywords-alist nil)
+ (org-element-map tree 'keyword
+ (lambda (keyword)
+ (when (equal (org-element-property :key keyword) "BIBLIOGRAPHY")
+ (let ((arguments (org-bibtex-get-arguments keyword))
+ (file (org-bibtex-get-file keyword))
+ temp-file)
+ ;; limit is set: collect citations throughout the document
+ ;; in TEMP-FILE and pass it to "bibtex2html" as "-citefile"
+ ;; argument.
+ (when (plist-get arguments :limit)
+ (let ((citations
+ (org-element-map tree '(latex-fragment link)
+ (lambda (object)
+ (and (org-bibtex-citation-p object)
+ (org-bibtex-get-citation-key object))))))
+ (with-temp-file (setq temp-file (make-temp-file "ox-bibtex"))
+ (insert (mapconcat 'identity citations "\n")))
+ (setq arguments
+ (plist-put arguments
+ :options
+ (append (plist-get arguments :options)
+ (list "-citefile" temp-file))))))
+ ;; Call "bibtex2html" on specified file.
+ (unless (eq 0 (apply 'call-process
+ (append '("bibtex2html" nil nil nil)
+ '("-a" "-nodoc" "-noheader" "-nofooter")
+ (list "--style"
+ (org-bibtex-get-style keyword))
+ (plist-get arguments :options)
+ (list (concat file ".bib")))))
+ (error "Executing bibtex2html failed"))
+ (and temp-file (delete-file temp-file))
+ ;; Open produced HTML file, wrap references within a block and
+ ;; return it.
+ (with-temp-buffer
+ (insert "<div id=\"bibliography\">\n<h2>References</h2>\n")
+ (insert-file-contents (concat file ".html"))
+ (insert "\n</div>")
+ ;; Update `org-bibtex-html-keywords-alist'.
+ (push (cons keyword (buffer-string))
+ org-bibtex-html-keywords-alist)
+ ;; Update `org-bibtex-html-entries-alist'.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\(\\w+\\)" nil t)
+ (push (cons (match-string 1) (match-string 2))
+ org-bibtex-html-entries-alist)))))))
+ ;; Return parse tree unchanged.
+ tree)
+
+(eval-after-load 'ox
+ '(add-to-list 'org-export-filter-parse-tree-functions
+ 'org-bibtex-process-bib-files))
+
+
+
+(provide 'ox-bibtex)
+
+;;; ox-bibtex.el ends here
diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el
index 5e01e1e..150d36c 100644
--- a/contrib/lisp/ox-confluence.el
+++ b/contrib/lisp/ox-confluence.el
@@ -166,26 +166,11 @@ EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
-Export is done in a buffer named \"*Org E-Confluence Export*\", which
+Export is done in a buffer named \"*Org CONFLUENCE Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org E-Confluence Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (text-mode)
- (org-export-add-to-stack (current-buffer) 'confluence)))
- `(org-export-as 'confluence ,subtreep ,visible-only ,body-only
- ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 'confluence "*Org E-Confluence Export*"
- subtreep visible-only body-only ext-plist)))
- (with-current-buffer outbuf (text-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'confluence "*org CONFLUENCE Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (text-mode))))
(provide 'ox-confluence)
diff --git a/contrib/lisp/ox-deck.el b/contrib/lisp/ox-deck.el
index c738389..847f7af 100644
--- a/contrib/lisp/ox-deck.el
+++ b/contrib/lisp/ox-deck.el
@@ -385,18 +385,14 @@ the \"slide\" class will be added to the to the list element,
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(let ((pkg-info (org-deck--get-packages info))
- (org-html--pre/postamble-class "deck-status")
- (info (plist-put
- (plist-put info :html-preamble (plist-get info :deck-preamble))
- :html-postamble (plist-get info :deck-postamble))))
+ (org-html--pre/postamble-class "deck-status")
+ (info (plist-put
+ (plist-put info :html-preamble (plist-get info :deck-preamble))
+ :html-postamble (plist-get info :deck-postamble))))
(mapconcat
'identity
(list
- (let* ((dt (plist-get info :html-doctype))
- (dt-cons (assoc dt org-html-doctype-alist)))
- (if dt-cons
- (cdr dt-cons)
- dt))
+ (org-html-doctype info)
(let ((lang (plist-get info :language)))
(mapconcat
(lambda (x)
@@ -528,23 +524,8 @@ Export is done in a buffer named \"*Org deck.js Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org deck.js Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (nxml-mode)
- (org-export-add-to-stack (current-buffer) 'deck)))
- `(org-export-as 'deck ,subtreep ,visible-only ,body-only ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 'deck "*Org deck.js Export*"
- subtreep visible-only body-only ext-plist)))
- ;; Set major mode.
- (with-current-buffer outbuf (nxml-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'deck "*Org deck.js Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (nxml-mode))))
(defun org-deck-export-to-html
(&optional async subtreep visible-only body-only ext-plist)
@@ -577,17 +558,9 @@ Return output file's name."
(interactive)
(let* ((extension (concat "." org-html-extension))
(file (org-export-output-file-name extension subtreep))
- (org-export-coding-system org-html-coding-system))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'deck))
- (let ((org-export-coding-system org-html-coding-system))
- `(expand-file-name
- (org-export-to-file
- 'deck ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
- (let ((org-export-coding-system org-html-coding-system))
- (org-export-to-file
- 'deck file subtreep visible-only body-only ext-plist)))))
+ (org-export-coding-system org-html-coding-system))
+ (org-export-to-file 'deck file
+ async subtreep visible-only body-only ext-plist)))
(defun org-deck-publish-to-html (plist filename pub-dir)
"Publish an org file to deck.js HTML Presentation.
diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el
index 4e90eff..aafd714 100644
--- a/contrib/lisp/ox-freemind.el
+++ b/contrib/lisp/ox-freemind.el
@@ -314,14 +314,13 @@ will result in following node:
(plist-get info :title))
(t (error "Shouldn't come here."))))
(element-contents (org-element-contents element))
- (section (assoc 'section element-contents))
+ (section (assq 'section element-contents))
(section-contents
- (let* ((translations
- (nconc (list (cons 'section
- (lambda (section contents info)
- contents)))
- (plist-get info :translate-alist))))
- (org-export-data-with-translations section translations info)))
+ (let ((backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders '((section . (lambda (e c i) c))))))
+ (org-export-data-with-backend section backend info)))
(itemized-contents-p (let ((first-child-headline
(org-element-map element-contents
'headline 'identity info t)))
@@ -519,17 +518,10 @@ file-local settings.
Return output file's name."
(interactive)
(let* ((extension (concat ".mm" ))
- (file (org-export-output-file-name extension subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'freemind))
- (let ((org-export-coding-system 'utf-8))
- `(expand-file-name
- (org-export-to-file
- 'freemind ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
- (let ((org-export-coding-system 'utf-8))
- (org-export-to-file
- 'freemind file subtreep visible-only body-only ext-plist)))))
+ (file (org-export-output-file-name extension subtreep))
+ (org-export-coding-system 'utf-8))
+ (org-export-to-file 'freemind ,file
+ async subtreep visible-only body-only ext-plist)))
(provide 'ox-freemind)
diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el
index ef54700..9a4fed1 100644
--- a/contrib/lisp/ox-groff.el
+++ b/contrib/lisp/ox-groff.el
@@ -1855,20 +1855,11 @@ file-local settings.
Return output file's name."
(interactive)
- (let ((outfile (org-export-output-file-name ".groff" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'groff))
- (let ((org-groff-registered-references nil)
- (org-groff-special-content nil))
- `(expand-file-name
- (org-export-to-file
- 'groff ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist))))
- (let ((org-groff-registered-references nil)
- (org-groff-special-content nil))
- (org-export-to-file
- 'groff outfile subtreep visible-only body-only ext-plist)))))
+ (let ((outfile (org-export-output-file-name ".groff" subtreep))
+ (org-groff-registered-references nil)
+ (org-groff-special-content nil))
+ (org-export-to-file 'groff outfile
+ async subtreep visible-only body-only ext-plist)))
(defun org-groff-export-to-pdf
(&optional async subtreep visible-only body-only ext-plist)
@@ -1896,18 +1887,10 @@ file-local settings.
Return PDF file's name."
(interactive)
- (if async
- (let ((outfile (org-export-output-file-name ".groff" subtreep)))
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'groff))
- `(expand-file-name
- (org-groff-compile
- (org-export-to-file
- 'groff ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))))
- (org-groff-compile
- (org-groff-export-to-groff
- nil subtreep visible-only body-only ext-plist))))
+ (let ((outfile (org-export-output-file-name ".groff" subtreep)))
+ (org-export-to-file 'groff outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-groff-compile file)))))
(defun org-groff-compile (file)
"Compile a Groff file.
diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el
index 0be0be9..240de29 100644
--- a/contrib/lisp/ox-koma-letter.el
+++ b/contrib/lisp/ox-koma-letter.el
@@ -4,6 +4,8 @@
;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com>
;; Alan Schmitt <alan.schmitt AT polytechnique DOT org>
+;; Viktor Rosenfeld <listuser36 AT gmail DOT com>
+;; Rasmus Pank Roulund <emacs AT pank DOT eu>
;; Keywords: org, wp, tex
;; This program is free software: you can redistribute it and/or modify
@@ -31,16 +33,67 @@
;;
;; On top of buffer keywords supported by `latex' back-end (see
;; `org-latex-options-alist'), this back-end introduces the following
-;; keywords: "CLOSING" (see `org-koma-letter-closing'), "FROM_ADDRESS"
-;; (see `org-koma-letter-from-address'), "LCO" (see
-;; `org-koma-letter-class-option-file'), "OPENING" (see
-;; `org-koma-letter-opening'), "PHONE_NUMBER" (see
-;; `org-koma-letter-phone-number'), "SIGNATURE" (see
-;; `org-koma-letter-signature') and "TO_ADDRESS".
+;; keywords:
+;; - "CLOSING" (see `org-koma-letter-closing'),
+;; - "FROM_ADDRESS" (see `org-koma-letter-from-address'),
+;; - "LCO" (see `org-koma-letter-class-option-file'),
+;; - "OPENING" (see `org-koma-letter-opening'),
+;; - "PHONE_NUMBER" (see `org-koma-letter-phone-number'),
+;; - "SIGNATURE" (see `org-koma-letter-signature')
+;; - "PLACE" (see `org-koma-letter-place')
+;; - and "TO_ADDRESS". If unspecified this is set to "\mbox{}".
+;;
+;; TO_ADDRESS and FROM_ADDRESS can also be specified using heading
+;; with the special tags specified in
+;; `org-koma-letter-special-tags-in-letter', namely "to" and "from".
+;; LaTeX line breaks are not necessary if using these headings. If
+;; both a headline and a keyword specify a to or from address the
+;; value is determined in accordance with
+;; `org-koma-letter-prefer-special-headings'.
+;;
+;; A number of OPTIONS settings can be set to change which contents is
+;; exported.
+;; - backaddress (see `org-koma-letter-use-backaddress')
+;; - foldmarks (see `org-koma-letter-use-foldmarks')
+;; - phone (see `org-koma-letter-use-phone')
+;; - email (see `org-koma-letter-use-email')
+;; - place (see `org-koma-letter-use-place')
+;; - subject, a list of format options
+;; (see `org-koma-letter-subject-format')
+;; - after-closing-order, a list of the ordering of headings with
+;; special tags after closing (see
+;; `org-koma-letter-special-tags-after-closing')
+;; - after-letter-order, as above, but after the end of the letter
+;; (see `org-koma-letter-special-tags-after-letter').
+;;
+;; The following variables works differently from the main LaTeX class
+;; - "AUTHOR": default to user-full-name but may be disabled. (see org-koma-letter-author),
+;; - "EMAIL": same as AUTHOR, (see org-koma-letter-email),
+;;
+;; Headlines are in general ignored. However, headlines with special
+;; tags can be used for specified contents like postscript (ps),
+;; carbon copy (cc), enclosures (encl) and code to be inserted after
+;; \end{letter} (after_letter). Specials tags are defined in
+;; `org-koma-letter-special-tags-after-closing' and
+;; `org-koma-letter-special-tags-after-letter'. Currently members of
+;; `org-koma-letter-special-tags-after-closing' used as macros and the
+;; content of the headline is the argument.
+;;
+;; Headlines with two and from may also be used rather than the
+;; keyword approach described above. If both a keyword and a headline
+;; with information is present precedence is determined by
+;; `org-koma-letter-prefer-special-headings'.
;;
;; You will need to add an appropriate association in
-;; `org-latex-classes' in order to use the KOMA Scrlttr2 class. For
-;; example, you can use the following code:
+;; `org-latex-classes' in order to use the KOMA Scrlttr2 class.
+;; The easiest way to do this is by adding
+;;
+;; (eval-after-load "ox-koma-letter"
+;; '(org-koma-letter-plug-into-ox))
+;;
+;; to your init file. This will add a sparse scrlttr2 class and
+;; set it as the default `org-koma-latex-default-class'. You can also
+;; add you own letter class. For instace:
;;
;; (add-to-list 'org-latex-classes
;; '("my-letter"
@@ -61,7 +114,8 @@
;; with :
;;
;; #+LATEX_CLASS: my-letter
-
+;;
+;; Or by setting `org-koma-letter-default-class'.
;;; Code:
@@ -80,58 +134,317 @@
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-closing "See you soon,"
- "Koma-Letter's closing, as a string."
+(defcustom org-koma-letter-author 'user-full-name
+ "The sender's name.
+
+This variable defaults to calling the function `user-full-name'
+which just returns the current function `user-full-name'. Alternatively a
+string, nil or a function may be given. Functions must return a
+string."
:group 'org-export-koma-letter
- :type 'string)
+ :type '(radio (function-item user-full-name)
+ (string)
+ (function)
+ (const :tag "Do not export author" nil)))
+
+(defcustom org-koma-letter-email 'org-koma-letter-email
+ "The sender's email address.
+
+This variable defaults to the value `org-koma-letter-email' which
+returns `user-mail-address'. Alternatively a string, nil or a
+function may be given. Functions must return a string."
+ :group 'org-export-koma-letter
+ :type '(radio (function-item org-koma-letter-email)
+ (string)
+ (function)
+ (const :tag "Do not export email" nil)))
-(defcustom org-koma-letter-from-address "Somewhere \\ Over the rainbow."
+(defcustom org-koma-letter-from-address nil
"Sender's address, as a string."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-opening "Dear Sir,"
- "Letter's opening, as a string."
+(defcustom org-koma-letter-phone-number nil
+ "Sender's phone number, as a string."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-phone-number "00-00-00-00"
- "Sender's phone number, as a string."
+(defcustom org-koma-letter-place nil
+ "Place from which the letter is sent."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-opening nil
+ "Letter's opening, as a string.
+
+If (1) this value is nil; (2) the letter is started with a
+headline; and (3) `org-koma-letter-headline-is-opening-maybe' is
+t the value opening will be implicit set as the headline title."
:group 'org-export-koma-letter
:type 'string)
-(defcustom org-koma-letter-signature "\\usekomavar{fromname}"
+(defcustom org-koma-letter-closing nil
+ "Koma-Letter's closing, as a string."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-prefer-special-headings nil
+ "If TO and/or FROM is specified using both a heading and a keyword the heading value will be preferred if the variable is t."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-signature nil
"String used as the signature."
:group 'org-export-koma-letter
:type 'string)
+(defcustom org-koma-letter-subject-format t
+ "Use the title as the subject of the letter.
+
+At this time the following values are allowed:
+
+ - afteropening: subject after opening.
+ - beforeopening: subject before opening.
+ - centered: subject centered.
+ - left:subject left-justified.
+ - right: subject right-justified.
+ - titled: add title/description to subject.
+ - underlined: set subject underlined.
+ - untitled: do not add title/description to subject.
+ - No-export: do no insert a subject even if present.
+
+Please refer to the KOMA-script manual (Table 4.16. in the
+English manual of 2012-07-22)."
+ :type '(radio
+ (const :tag "No export" nil)
+ (const :tag "Default options" t)
+ (set :tag "selection"
+ (const 'afteropening)
+ (const 'beforeopening)
+ (const 'centered)
+ (const 'left)
+ (const 'right)
+ (const 'underlined)
+ (const 'titled)
+ (const 'untitled))
+ (string))
+ :group 'org-export-koma-letter)
+
+
+
+(defcustom org-koma-letter-use-backaddress nil
+ "Print return address in small line above to address."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-use-foldmarks "true"
+ "Configure appearence of fold marks.
+
+Accepts any valid value for the KOMA-Script `foldmarks' option.
+
+Use `foldmarks:true' to activate default fold marks or
+`foldmarks:nil' to deactivate fold marks."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-use-phone nil
+ "Print sender's phone number."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-use-email nil
+ "Print sender's email address."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-use-place t
+ "Print the letter's place next to the date."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defcustom org-koma-letter-default-class nil
+ "Default class for `org-koma-letter'.
+
+The value must be a member of `org-latex-classes'."
+ :group 'org-export-koma-letter
+ :type 'string)
+
+(defcustom org-koma-letter-headline-is-opening-maybe t
+ "Whether a headline may be used as an opening.
+A headline is only used if #+OPENING is not set. See also
+`org-koma-letter-opening'."
+ :group 'org-export-koma-letter
+ :type 'boolean)
+
+(defconst org-koma-letter-special-tags-in-letter '(to from)
+ "Header tags related to the letter itself.")
+
+(defconst org-koma-letter-special-tags-after-closing '(ps encl cc)
+ "Header tags to be inserted after closing.")
+
+(defconst org-koma-letter-special-tags-after-letter '(after_letter)
+ "Header tags to be inserted after closing.")
+
+(defvar org-koma-letter-special-contents nil
+ "Holds special content temporarily.")
+
+
;;; Define Back-End
(org-export-define-derived-backend 'koma-letter 'latex
:options-alist
- '((:closing "CLOSING" nil org-koma-letter-closing)
- (:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
- (:lco "LCO" nil org-koma-letter-class-option-file)
- (:opening "OPENING" nil org-koma-letter-opening)
+ '((:lco "LCO" nil org-koma-letter-class-option-file)
+ (:latex-class "LATEX_CLASS" nil (if org-koma-letter-default-class
+ org-koma-letter-default-class
+ org-latex-default-class) t)
+ (:author "AUTHOR" nil (org-koma-letter--get-value org-koma-letter-author) t)
+ (:author-changed-in-buffer-p "AUTHOR" nil nil t)
+ (:from-address "FROM_ADDRESS" nil nil newline)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
- (:signature "SIGNATURE" nil nil newline)
- (:to-address "TO_ADDRESS" nil nil newline))
+ (:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
+ (:email-changed-in-buffer-p "EMAIL" nil nil t)
+ (:to-address "TO_ADDRESS" nil nil newline)
+ (:place "PLACE" nil org-koma-letter-place)
+ (:opening "OPENING" nil org-koma-letter-opening)
+ (:closing "CLOSING" nil org-koma-letter-closing)
+ (:signature "SIGNATURE" nil org-koma-letter-signature newline)
+ (:special-tags nil nil (append
+ org-koma-letter-special-tags-in-letter
+ org-koma-letter-special-tags-after-closing
+ org-koma-letter-special-tags-after-letter))
+ (:special-headings nil "special-headings"
+ org-koma-letter-prefer-special-headings)
+ (:with-after-closing nil "after-closing-order"
+ org-koma-letter-special-tags-after-closing)
+ (:with-after-letter nil "after-letter-order"
+ org-koma-letter-special-tags-after-letter)
+ (:with-backaddress nil "backaddress" org-koma-letter-use-backaddress)
+ (:with-backaddress-changed-in-buffer-p nil "backaddress" nil)
+ (:with-foldmarks nil "foldmarks" org-koma-letter-use-foldmarks)
+ (:with-foldmarks-changed-in-buffer-p nil "foldmarks" "foldmarks-not-set")
+ (:with-phone nil "phone" org-koma-letter-use-phone)
+ (:with-phone-changed-in-buffer-p nil "phone" nil)
+ (:with-email nil "email" org-koma-letter-use-email)
+ (:with-email-changed-in-buffer-p nil "email" nil)
+ (:with-place nil "place" org-koma-letter-use-place)
+ (:with-subject nil "subject" org-koma-letter-subject-format))
:translate-alist '((export-block . org-koma-letter-export-block)
(export-snippet . org-koma-letter-export-snippet)
+ (headline . org-koma-letter-headline)
(keyword . org-koma-letter-keyword)
(template . org-koma-letter-template))
:menu-entry
'(?k "Export with KOMA Scrlttr2"
- ((?K "As LaTeX buffer" org-koma-letter-export-as-latex)
- (?k "As LaTeX file" org-koma-letter-export-to-latex)
+ ((?L "As LaTeX buffer" org-koma-letter-export-as-latex)
+ (?l "As LaTeX file" org-koma-letter-export-to-latex)
(?p "As PDF file" org-koma-letter-export-to-pdf)
- (?O "As PDF file and open"
+ (?o "As PDF file and open"
(lambda (a s v b)
(if a (org-koma-letter-export-to-pdf t s v b)
(org-open-file (org-koma-letter-export-to-pdf nil s v b))))))))
+;;; Initialize class function
+
+(defun org-koma-letter-plug-into-ox ()
+ "Add a sparse `default-koma-letter' to `org-latex-classes' and set `org-koma-letter-default-class' to `default-koma-letter'."
+ (let ((class "default-koma-letter"))
+ (eval-after-load "ox-latex"
+ `(unless (member ,class 'org-latex-classes)
+ (add-to-list 'org-latex-classes
+ `(,class
+ "\\documentclass[11pt]{scrlttr2}") ())
+ (setq org-koma-letter-default-class class)))))
+
+;;; Helper functions
+
+(defun org-koma-letter-email ()
+ "Return the current `user-mail-address'."
+ user-mail-address)
+
+;; The following is taken from/inspired by ox-grof.el
+;; Thanks, Luis!
+
+(defun org-koma-letter--get-tagged-contents (key)
+ "Get contents from a headline tagged with KEY.
+Technically, the contents is stored in `org-koma-letter-special-contents'."
+ (cdr (assoc (org-koma-letter--get-value key)
+ org-koma-letter-special-contents)))
+
+(defun org-koma-letter--get-value (value)
+ "Determines if VALUE is nil, a string, a function or a symbol and return a string or nil."
+ (when value
+ (cond ((stringp value) value)
+ ((functionp value) (funcall value))
+ ((symbolp value) (symbol-name value))
+ (t value))))
+
+
+(defun org-koma-letter--special-contents-as-macro (a-list &optional keep-newlines no-tag)
+ "Find members of `org-koma-letter-special-contents' corresponding to A-LIST.
+Return them as a string to be formatted.
+
+The function is used for inserting content of speciall headings
+such as PS.
+
+If KEEP-NEWLINES is t newlines will not be removed. If NO-TAG is
+is t the content in `org-koma-letter-special-contents' will not
+be wrapped in a macro named whatever the members of A-LIST are
+called."
+ (let (output)
+ (dolist (ac* a-list output)
+ (let*
+ ((ac (org-koma-letter--get-value ac*))
+ (x (org-koma-letter--get-tagged-contents ac)))
+ (when x
+ (setq output
+ (concat
+ output "\n"
+ ;; sometimes LaTeX complains about newlines
+ ;; at the end or beginning of macros. Remove them.
+ (org-koma-letter--format-string-as-macro
+ (if keep-newlines x (org-koma-letter--normalize-string x))
+ (unless no-tag ac)))))))))
+
+(defun org-koma-letter--format-string-as-macro (string &optional macro)
+ "Format STRING as \"\\macro{string}\" if MACRO is given else as \"string\"."
+ (if macro
+ (format "\\%s{%s}" macro string)
+ (format "%s" string)))
+
+(defun org-koma-letter--normalize-string (string)
+ "Remove new lines in the beginning and end of `STRING'."
+ (replace-regexp-in-string "\\`[ \n\t]+\\|[\n\t ]*\\'" "" string))
+
+(defun org-koma-letter--determine-to-and-from (info key)
+ "Given INFO determine KEY for the letter.
+KEY should be `to' or `from'.
+
+`ox-koma-letter' allows two ways to specify to and from. If both
+are present return the preferred one as determined by
+`org-koma-letter-prefer-special-headings'."
+ (let* ((plist-alist '((from . :from-address)
+ (to . :to-address)))
+ (default-alist `((from ,org-koma-letter-from-address)
+ (to "\\mbox{}")))
+ (option-value (plist-get info (cdr-safe (assoc key plist-alist))))
+ (head-value (org-koma-letter--get-tagged-contents key))
+ (order (append
+ (funcall
+ (if (plist-get info :special-headings)
+ 'reverse 'identity)
+ `(,option-value ,head-value))
+ (cdr-safe (assoc key default-alist))))
+ tmp
+ (adr (dolist (x order tmp)
+ (when (and (not tmp) x)
+ (setq tmp x)))))
+ (when adr
+ (replace-regexp-in-string
+ "\n" "\\\\\\\\\n"
+ (org-koma-letter--normalize-string adr)))))
+
;;; Transcode Functions
;;;; Export Block
@@ -159,18 +472,52 @@ channel."
CONTENTS is nil. INFO is a plist used as a communication
channel."
(let ((key (org-element-property :key keyword))
- (value (org-element-property :value keyword)))
+ (value (org-element-property :value keyword)))
;; Handle specifically BEAMER and TOC (headlines only) keywords.
;; Otherwise, fallback to `latex' back-end.
(if (equal key "KOMA-LETTER") value
(org-export-with-backend 'latex keyword contents info))))
+
+;; Headline
+
+(defun org-koma-letter-headline (headline contents info)
+ "Transcode a HEADLINE element from Org to LaTeX.
+CONTENTS holds the contents of the headline. INFO is a plist
+holding contextual information.
+
+Note that if a headline is tagged with a tag from
+`org-koma-letter-special-tags' it will not be exported, but
+stored in `org-koma-letter-special-contents' and included at the
+appropriate place."
+ (let*
+ ((tags (org-export-get-tags headline info))
+ (tag* (car tags))
+ (tag (when tag*
+ (car (member-ignore-case
+ tag*
+ (mapcar 'symbol-name (plist-get info :special-tags)))))))
+ (if tag
+ (progn
+ (push (cons tag contents)
+ org-koma-letter-special-contents)
+ nil)
+ (unless (or (plist-get info :opening)
+ (not org-koma-letter-headline-is-opening-maybe))
+ (plist-put info :opening
+ (org-export-data (org-element-property :title headline) info)))
+ contents)))
+
+
;;;; Template
(defun org-koma-letter-template (contents info)
"Return complete document string after KOMA Scrlttr2 conversion.
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
+ ;; FIXME: instead of setq'ing org-koma-letter-special-contents and
+ ;; callying varioues stuff it might be nice to put a big let* around the templace
+ ;; as in org-groff...
(concat
;; Time-stamp.
(and (plist-get info :time-stamp-file)
@@ -186,7 +533,7 @@ holding export options."
"^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)"
class-options header t nil 1)))))
(if (not document-class-string)
- (user-error "Unknown LaTeX class `%s'")
+ (user-error "Unknown LaTeX class `%s'" class)
(org-latex-guess-babel-language
(org-latex-guess-inputenc
(org-element-normalize-string
@@ -194,37 +541,106 @@ holding export options."
document-class-string
org-latex-default-packages-alist ; Defined in org.el.
org-latex-packages-alist nil ; Defined in org.el.
- (concat (org-element-normalize-string
- (plist-get info :latex-header))
+ (concat (org-element-normalize-string (plist-get info :latex-header))
(plist-get info :latex-header-extra)))))
info)))
- ;; Define "From" data.
- (format "\\setkomavar{fromname}{%s}\n"
- (org-export-data (plist-get info :author) info))
- (format "\\setkomavar{fromaddress}{%s}\n" (plist-get info :from-address))
- (format "\\setkomavar{signature}{%s}\n" (plist-get info :signature))
- (format "\\setkomavar{fromemail}{%s}\n"
- (org-export-data (plist-get info :email) info))
- (format "\\setkomavar{fromphone}{%s}\n" (plist-get info :phone-number))
+ (let ((lco (plist-get info :lco))
+ (author (plist-get info :author))
+ (author-set (plist-get info :author-changed-in-buffer-p))
+ (from-address (org-koma-letter--determine-to-and-from info 'from))
+ (phone-number (plist-get info :phone-number))
+ (email (plist-get info :email))
+ (email-set (plist-get info :email-changed-in-buffer-p))
+ (signature (plist-get info :signature)))
+ (concat
+ ;; author or email not set in file: may be overridden by lco
+ (unless author-set
+ (when author (format "\\setkomavar{fromname}{%s}\n"
+ (org-export-data author info))))
+ (unless email-set
+ (when email (format "\\setkomavar{fromemail}{%s}\n" email)))
+ ;; Letter Class Option File
+ (when lco
+ (let ((lco-files (split-string lco " "))
+ (lco-def ""))
+ (dolist (lco-file lco-files lco-def)
+ (setq lco-def (format "%s\\LoadLetterOption{%s}\n" lco-def lco-file)))
+ lco-def))
+ ;; Define "From" data.
+ (when (and author author-set) (format "\\setkomavar{fromname}{%s}\n"
+ (org-export-data author info)))
+ (when from-address (format "\\setkomavar{fromaddress}{%s}\n" from-address))
+ (when phone-number
+ (format "\\setkomavar{fromphone}{%s}\n" phone-number))
+ (when (and email email-set) (format "\\setkomavar{fromemail}{%s}\n" email))
+ (when signature (format "\\setkomavar{signature}{%s}\n" signature))))
;; Date.
(format "\\date{%s}\n" (org-export-data (org-export-get-date info) info))
- ;; Letter Class Option File
- (format "\\LoadLetterOption{%s}\n" (plist-get info :lco))
- ;; Letter start.
+ ;; Place
+ (let ((with-place (plist-get info :with-place))
+ (place (plist-get info :place)))
+ (when (or place (not with-place))
+ (format "\\setkomavar{place}{%s}\n" (if with-place place ""))))
+ ;; KOMA options
+ (let ((with-backaddress (plist-get info :with-backaddress))
+ (with-backaddress-set (plist-get info :with-backaddress-changed-in-buffer-p))
+ (with-foldmarks (plist-get info :with-foldmarks))
+ (with-foldmarks-set
+ (not (string-equal (plist-get info :with-foldmarks-changed-in-buffer-p)
+ "foldmarks-not-set")))
+ (with-phone (plist-get info :with-phone))
+ (with-phone-set (plist-get info :with-phone-changed-in-buffer-p))
+ (with-email (plist-get info :with-email))
+ (with-email-set (plist-get info :with-email-changed-in-buffer-p)))
+ (concat
+ (when with-backaddress-set
+ (format "\\KOMAoption{backaddress}{%s}\n" (if with-backaddress "true" "false")))
+ (when with-foldmarks-set
+ (format "\\KOMAoption{foldmarks}{%s}\n" (if with-foldmarks with-foldmarks "false")))
+ (when with-phone-set
+ (format "\\KOMAoption{fromphone}{%s}\n" (if with-phone "true" "false")))
+ (when with-email-set
+ (format "\\KOMAoption{fromemail}{%s}\n" (if with-email "true" "false")))))
+ ;; Document start
"\\begin{document}\n\n"
- (format "\\setkomavar{subject}{%s}\n\n"
- (org-export-data (plist-get info :title) info))
+ ;; Subject
+ (let* ((with-subject (plist-get info :with-subject))
+ (subject-format (cond ((member with-subject '("true" "t" t)) nil)
+ ((stringp with-subject) (list with-subject))
+ ((symbolp with-subject)
+ (list (symbol-name with-subject)))
+ (t with-subject)))
+ (subject (org-export-data (plist-get info :title) info))
+ (l (length subject-format))
+ (y ""))
+ (concat
+ (when (and with-subject subject-format)
+ (concat
+ "\\KOMAoption{subject}{"
+ (apply 'format
+ (dotimes (x l y)
+ (setq y (concat (if (> x 0) "%s," "%s") y)))
+ subject-format) "}\n"))
+ (when (and subject with-subject)
+ (format "\\setkomavar{subject}{%s}\n\n" subject))))
+ ;; Letter start
(format "\\begin{letter}{%%\n%s}\n\n"
- (or (plist-get info :to-address) "no address given"))
+ (org-koma-letter--determine-to-and-from info 'to))
;; Opening.
- (format "\\opening{%s}\n\n" (plist-get info :opening))
+ (format "\\opening{%s}\n\n" (or (plist-get info :opening) ""))
;; Letter body.
contents
;; Closing.
- (format "\n\\closing{%s}\n\n" (plist-get info :closing))
+ (format "\n\\closing{%s}\n" (or (plist-get info :closing) ""))
+ (org-koma-letter--special-contents-as-macro
+ (plist-get info :with-after-closing))
;; Letter end.
- "\\end{letter}\n\\end{document}"))
-
+ "\n\\end{letter}\n"
+ (org-koma-letter--special-contents-as-macro
+ (plist-get info :with-after-letter) t t)
+ ;; Document end.
+ "\n\\end{document}"
+ ))
;;; Commands
@@ -253,7 +669,7 @@ contents of hidden elements.
When optional argument BODY-ONLY is non-nil, only write code
between \"\\begin{letter}\" and \"\\end{letter}\".
-EXT-PLIST, when provided, is a property list with external
+EXT-PLIST, when provided, is a proeprty list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
@@ -261,23 +677,10 @@ Export is done in a buffer named \"*Org KOMA-LETTER Export*\". It
will be displayed if `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org KOMA-LETTER Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (LaTeX-mode)
- (org-export-add-to-stack (current-buffer) 'koma-letter)))
- `(org-export-as 'koma-letter ,subtreep ,visible-only ,body-only
- ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 'koma-letter "*Org KOMA-LETTER Export*"
- subtreep visible-only body-only ext-plist)))
- (with-current-buffer outbuf (LaTeX-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (let (org-koma-letter-special-contents)
+ (org-export-to-buffer 'koma-letter "*Org KOMA-LETTER Export*"
+ async subtreep visible-only body-only ext-plist
+ (lambda () (LaTeX-mode)))))
;;;###autoload
(defun org-koma-letter-export-to-latex
@@ -312,16 +715,10 @@ directory.
Return output file's name."
(interactive)
- (let ((outfile (org-export-output-file-name ".tex" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'koma-letter))
- `(expand-file-name
- (org-export-to-file
- 'koma-letter ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))
- (org-export-to-file
- 'koma-letter outfile subtreep visible-only body-only ext-plist))))
+ (let ((outfile (org-export-output-file-name ".tex" subtreep))
+ (org-koma-letter-special-contents))
+ (org-export-to-file 'koma-letter outfile
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-koma-letter-export-to-pdf
@@ -353,18 +750,11 @@ file-local settings.
Return PDF file's name."
(interactive)
- (if async
- (let ((outfile (org-export-output-file-name ".tex" subtreep)))
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'koma-letter))
- `(expand-file-name
- (org-latex-compile
- (org-export-to-file
- 'koma-letter ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))))
- (org-latex-compile
- (org-koma-letter-export-to-latex
- nil subtreep visible-only body-only ext-plist))))
+ (let ((file (org-export-output-file-name ".tex" subtreep))
+ (org-koma-letter-special-contents))
+ (org-export-to-file 'koma-letter file
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
(provide 'ox-koma-letter)
diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el
index a45107b..672e970 100644
--- a/contrib/lisp/ox-rss.el
+++ b/contrib/lisp/ox-rss.el
@@ -51,6 +51,7 @@
;; :base-extension "org"
;; :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png"
;; :html-link-home "http://lumiere.ens.fr/~guerry/"
+;; :html-link-use-abs-url t
;; :rss-extension "xml"
;; :publishing-directory "/home/guerry/public_html/"
;; :publishing-function (org-rss-publish-to-rss)
@@ -160,21 +161,8 @@ non-nil."
(let ((file (buffer-file-name (buffer-base-buffer))))
(org-icalendar-create-uid file 'warn-user)
(org-rss-add-pubdate-property))
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org RSS Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (text-mode)
- (org-export-add-to-stack (current-buffer) 'rss)))
- `(org-export-as 'rss ,subtreep ,visible-only))
- (let ((outbuf (org-export-to-buffer
- 'rss "*Org RSS Export*" subtreep visible-only)))
- (with-current-buffer outbuf (text-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'rss "*Org RSS Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
;;;###autoload
(defun org-rss-export-to-rss (&optional async subtreep visible-only)
@@ -203,12 +191,7 @@ Return output file's name."
(org-rss-add-pubdate-property))
(let ((outfile (org-export-output-file-name
(concat "." org-rss-extension) subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'rss))
- `(expand-file-name
- (org-export-to-file 'rss ,outfile ,subtreep ,visible-only)))
- (org-export-to-file 'rss outfile subtreep visible-only))))
+ (org-export-to-file 'rss outfile async subtreep visible-only)))
;;;###autoload
(defun org-rss-publish-to-rss (plist filename pub-dir)
@@ -219,6 +202,14 @@ is the property list for the given project. PUB-DIR is the
publishing directory.
Return output file name."
+ (let ((bf (get-file-buffer filename)))
+ (if bf
+ (with-current-buffer bf
+ (org-rss-add-pubdate-property)
+ (write-file filename))
+ (find-file filename)
+ (org-rss-add-pubdate-property)
+ (write-file filename) (kill-buffer)))
(org-publish-org-to
'rss filename (concat "." org-rss-extension) plist pub-dir))
diff --git a/contrib/lisp/ox-s5.el b/contrib/lisp/ox-s5.el
index 3ea77b2..d97a9b2 100644
--- a/contrib/lisp/ox-s5.el
+++ b/contrib/lisp/ox-s5.el
@@ -306,7 +306,7 @@ holding export options."
(mapconcat
'identity
(list
- (plist-get info :html-doctype)
+ (org-html-doctype info)
(format "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">"
(plist-get info :language) (plist-get info :language))
"<head>"
@@ -369,23 +369,8 @@ Export is done in a buffer named \"*Org S5 Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org S5 Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (nxml-mode)
- (org-export-add-to-stack (current-buffer) 's5)))
- `(org-export-as 's5 ,subtreep ,visible-only ,body-only ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 's5 "*Org S5 Export*"
- subtreep visible-only body-only ext-plist)))
- ;; Set major mode.
- (with-current-buffer outbuf (nxml-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 's5 "*Org S5 Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (nxml-mode))))
(defun org-s5-export-to-html
(&optional async subtreep visible-only body-only ext-plist)
@@ -419,16 +404,8 @@ Return output file's name."
(let* ((extension (concat "." org-html-extension))
(file (org-export-output-file-name extension subtreep))
(org-export-coding-system org-html-coding-system))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 's5))
- (let ((org-export-coding-system org-html-coding-system))
- `(expand-file-name
- (org-export-to-file
- 's5 ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
- (let ((org-export-coding-system org-html-coding-system))
- (org-export-to-file
- 's5 file subtreep visible-only body-only ext-plist)))))
+ (org-export-to-file 's5 file
+ async subtreep visible-only body-only ext-plist)))
(defun org-s5-publish-to-html (plist filename pub-dir)
"Publish an org file to S5 HTML Presentation.
diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el
index 4724ec3..13f2f5e 100644
--- a/contrib/lisp/ox-taskjuggler.el
+++ b/contrib/lisp/ox-taskjuggler.el
@@ -141,6 +141,7 @@
;; org-global-properties-fixed
;; - What about property inheritance and org-property-inherit-p?
;; - Use TYPE_TODO as an way to assign resources
+;; - Add support for org-export-with-planning
;;
;;; Code:
@@ -213,7 +214,7 @@ marked with `org-taskjuggler-project-tag'"
(defcustom org-taskjuggler-default-reports
'("textreport report \"Plan\" {
formats html
- header '== <-query attribute=\"name\"-> =='
+ header '== %title =='
center -8<-
[#Plan Plan] | [#Resource_Allocation Resource Allocation]
@@ -245,10 +246,11 @@ resourcereport resourceGraph \"\" {
}")
"Default reports for the project.
These are sensible default reports to give a good out-of-the-box
-result when exporting without defining any reports. If you want
-to define your own reports you can change them here or simply
-define the default reports so that they include an external
-report definition as follows:
+result when exporting without defining any reports. \"%title\"
+anywhere in the reports will be replaced with the document title.
+If you want to define your own reports you can change them here
+or simply define the default reports so that they include an
+external report definition as follows:
include reports.tji
@@ -324,6 +326,31 @@ 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-taskjuggler-process-command
+ "tj3 --silent --no-color --output-dir %o %f"
+ "Command to process a Taskjuggler file.
+The command will be given to the shell as a command to process a
+Taskjuggler file. \"%f\" in the command will be replaced by the
+full file name, \"%o\" by the reports directory (see
+`org-taskjuggler-reports-directory').
+
+If you are targeting Taskjuggler 2.4 (see
+`org-taskjuggler-target-version') this setting is ignored."
+ :group 'org-export-taskjuggler)
+
+(defcustom org-taskjuggler-reports-directory "reports"
+ "Default directory to generate the Taskjuggler reports in.
+The command `org-taskjuggler-process-command' generates the
+reports and associated files such as CSS inside this directory.
+
+If the directory is not an absolute path it is relative to the
+directory of the exported file. The directory is created if it
+doesn't exist.
+
+If you are targeting Taskjuggler 2.4 (see
+`org-taskjuggler-target-version') this setting is ignored."
+ :group 'org-export-taskjuggler)
+
(defcustom org-taskjuggler-keep-project-as-task t
"Non-nil keeps the project headline as an umbrella task for all tasks.
Setting this to nil will allow maintaining completely separated
@@ -348,10 +375,14 @@ This hook is run with the name of the file as argument.")
:menu-entry
'(?J "Export to TaskJuggler"
((?j "As TJP file" (lambda (a s v b) (org-taskjuggler-export a s v)))
- (?o "As TJP file and open"
+ (?p "As TJP file and process"
(lambda (a s v b)
(if a (org-taskjuggler-export a s v)
- (org-taskjuggler-export-and-open s v))))))
+ (org-taskjuggler-export-and-process s v))))
+ (?o "As TJP file, process and open"
+ (lambda (a s v b)
+ (if a (org-taskjuggler-export a s v)
+ (org-taskjuggler-export-process-and-open s v))))))
;; This property will be used to store unique ids in communication
;; channel. Ids will be retrieved with `org-taskjuggler-get-id'.
:options-alist '((:taskjuggler-unique-ids nil nil nil)))
@@ -367,6 +398,7 @@ communication channel. Return value is an alist between
headlines and their associated ID. IDs are hierarchical, which
means they only need to be unique among the task siblings."
(let* (alist
+ build-id ; For byte-compiler.
(build-id
(lambda (tasks local-ids)
(org-element-map tasks 'headline
@@ -402,13 +434,14 @@ INFO is a plist used as a communication channel. First headline
in buffer with `org-taskjuggler-project-tag' defines the project.
If no such task is defined, pick the first headline in buffer.
If there is no headline at all, return nil."
- (or (org-element-map (plist-get info :parse-tree) 'headline
- (lambda (hl)
- (and (member org-taskjuggler-project-tag
- (org-export-get-tags hl info))
- hl))
- info t)
- (org-element-map tree 'headline 'identity info t)))
+ (let ((tree (plist-get info :parse-tree)))
+ (or (org-element-map tree 'headline
+ (lambda (hl)
+ (and (member org-taskjuggler-project-tag
+ (org-export-get-tags hl info))
+ hl))
+ info t)
+ (org-element-map tree 'headline 'identity info t))))
(defun org-taskjuggler-get-id (item info)
"Return id for task or resource ITEM.
@@ -426,14 +459,17 @@ ITEM is a headline. Return value is a string."
(defun org-taskjuggler-get-start (item)
"Return start date for task or resource ITEM.
ITEM is a headline. Return value is a string or nil if ITEM
-doesn't have any start date defined.."
+doesn't have any start date defined."
(let ((scheduled (org-element-property :scheduled item)))
- (and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d"))))
+ (or
+ (and scheduled (org-timestamp-format scheduled "%Y-%02m-%02d"))
+ (and (memq 'start org-taskjuggler-valid-task-attributes)
+ (org-element-property :START item)))))
(defun org-taskjuggler-get-end (item)
"Return end date for task or resource ITEM.
ITEM is a headline. Return value is a string or nil if ITEM
-doesn't have any end date defined.."
+doesn't have any end date defined."
(let ((deadline (org-element-property :deadline item)))
(and deadline (org-timestamp-format deadline "%Y-%02m-%02d"))))
@@ -514,7 +550,8 @@ channel."
(setq depends
(org-element-map tasks 'headline
(lambda (task)
- (let ((task-id (org-element-property :TASK_ID task)))
+ (let ((task-id (or (org-element-property :TASK_ID task)
+ (org-element-property :ID task))))
(and task-id (member task-id deps-ids) task)))
info)))
;; Check BLOCKER and DEPENDS properties. If "previous-sibling"
@@ -538,34 +575,34 @@ DEPENDENCIES is list of dependencies for TASK, as returned by
`org-taskjuggler-resolve-depedencies'. TASK is a headline.
INFO is a plist used as a communication channel. Return value
doesn't include leading \"depends\"."
- (let ((dep-str (concat (org-element-property :BLOCKER task)
- " "
- (org-element-property :DEPENDS task)))
- (get-path
- (lambda (dep)
- ;; Return path to DEP relatively to TASK.
- (let ((parent (org-export-get-parent task))
- (exclamations 1)
- (option
- (let ((id (org-element-property :TASK_ID dep)))
- (and id
- (string-match (concat id " +\\({.*?}\\)") dep-str)
- (org-match-string-no-properties 1))))
- path)
- ;; Compute number of exclamation marks by looking for the
- ;; common ancestor between TASK and DEP.
- (while (not (org-element-map parent 'headline
- (lambda (hl) (eq hl dep))))
- (incf exclamations)
- (setq parent (org-export-get-parent parent)))
- ;; Build path from DEP to PARENT.
- (while (not (eq parent dep))
- (push (org-taskjuggler-get-id dep info) path)
- (setq dep (org-export-get-parent dep)))
- ;; Return full path. Add dependency options, if any.
- (concat (make-string exclamations ?!)
- (mapconcat 'identity path ".")
- (and option (concat " " option)))))))
+ (let* ((dep-str (concat (org-element-property :BLOCKER task)
+ " "
+ (org-element-property :DEPENDS task)))
+ (get-path
+ (lambda (dep)
+ ;; Return path to DEP relatively to TASK.
+ (let ((parent (org-export-get-parent task))
+ (exclamations 1)
+ (option
+ (let ((id (org-element-property :TASK_ID dep)))
+ (and id
+ (string-match (concat id " +\\({.*?}\\)") dep-str)
+ (org-match-string-no-properties 1))))
+ path)
+ ;; Compute number of exclamation marks by looking for the
+ ;; common ancestor between TASK and DEP.
+ (while (not (org-element-map parent 'headline
+ (lambda (hl) (eq hl dep))))
+ (incf exclamations)
+ (setq parent (org-export-get-parent parent)))
+ ;; Build path from DEP to PARENT.
+ (while (not (eq parent dep))
+ (push (org-taskjuggler-get-id dep info) path)
+ (setq dep (org-export-get-parent dep)))
+ ;; Return full path. Add dependency options, if any.
+ (concat (make-string exclamations ?!)
+ (mapconcat 'identity path ".")
+ (and option (concat " " option)))))))
;; Return dependencies string, without the leading "depends".
(mapconcat (lambda (dep) (funcall get-path dep)) dependencies ", ")))
@@ -659,8 +696,18 @@ Return complete project plan as a string in TaskJuggler syntax."
(mapconcat
(lambda (report) (org-taskjuggler--build-report report info))
main-reports "")
- (mapconcat 'org-element-normalize-string
- org-taskjuggler-default-reports ""))))))))
+ ;; insert title in default reports
+ (let* ((title (org-export-data (plist-get info :title) info))
+ (report-title (if (string= title "")
+ (org-taskjuggler-get-name project)
+ title)))
+ (mapconcat
+ 'org-element-normalize-string
+ (mapcar
+ (function
+ (lambda (report)
+ (replace-regexp-in-string "%title" report-title report t t)))
+ org-taskjuggler-default-reports) "")))))))))
(defun org-taskjuggler--build-project (project info)
"Return a project declaration.
@@ -847,20 +894,14 @@ Return output file's name."
(interactive)
(let ((outfile
(org-export-output-file-name org-taskjuggler-extension subtreep)))
- (if async
- (org-export-async-start
- (lambda (f)
- (org-export-add-to-stack f 'taskjuggler)
- (run-hook-with-args 'org-taskjuggler-final-hook f))
- `(expand-file-name
- (org-export-to-file 'taskjuggler ,outfile ,subtreep ,visible-only)))
- (org-export-to-file 'taskjuggler outfile subtreep visible-only)
- (run-hook-with-args 'org-taskjuggler-final-hook outfile)
- outfile)))
+ (org-export-to-file 'taskjuggler outfile
+ async subtreep visible-only nil nil
+ (lambda (file)
+ (run-hook-with-args 'org-taskjuggler-final-hook file) nil))))
;;;###autoload
-(defun org-taskjuggler-export-and-open (&optional subtreep visible-only)
- "Export current buffer to a TaskJuggler file and open it.
+(defun org-taskjuggler-export-and-process (&optional subtreep visible-only)
+ "Export current buffer to a TaskJuggler file and process it.
The exporter looks for a tree with tag that matches
`org-taskjuggler-project-tag' and takes this as the tasks for
@@ -887,12 +928,78 @@ first.
When optional argument VISIBLE-ONLY is non-nil, don't export
contents of hidden elements.
-Open file with the TaskJuggler GUI."
+Return a list of reports."
+ (interactive)
+ (let ((file (org-taskjuggler-export nil subtreep visible-only)))
+ (org-taskjuggler-compile file)))
+
+;;;###autoload
+(defun org-taskjuggler-export-process-and-open (&optional subtreep visible-only)
+ "Export current buffer to a TaskJuggler file, process and open it.
+
+Export and process the file using
+`org-taskjuggler-export-and-process' and open the generated
+reports with a browser.
+
+If you are targeting TaskJuggler 2.4 (see
+`org-taskjuggler-target-version') the processing and display of
+the reports is done using the TaskJuggler GUI."
(interactive)
- (let* ((file (org-taskjuggler-export nil subtreep visible-only))
- (process-name "TaskJugglerUI")
- (command (concat process-name " " file)))
- (start-process-shell-command process-name nil command)))
+ (if (< org-taskjuggler-target-version 3.0)
+ (let* ((process-name "TaskJugglerUI")
+ (command
+ (concat process-name " "
+ (org-taskjuggler-export nil subtreep visible-only))))
+ (start-process-shell-command process-name nil command))
+ (dolist (report (org-taskjuggler-export-and-process subtreep visible-only))
+ (org-open-file report))))
+
+(defun org-taskjuggler-compile (file)
+ "Compile a TaskJuggler file.
+
+FILE is the name of the file being compiled. Processing is done
+through the command given in `org-taskjuggler-process-command'.
+
+Return a list of reports."
+ (let* ((full-name (file-truename file))
+ (out-dir
+ (expand-file-name
+ org-taskjuggler-reports-directory (file-name-directory file)))
+ errors)
+ (message (format "Processing TaskJuggler file %s..." file))
+ (save-window-excursion
+ (let ((outbuf (get-buffer-create "*Org Taskjuggler Output*")))
+ (unless (file-directory-p out-dir)
+ (make-directory out-dir t))
+ (with-current-buffer outbuf (erase-buffer))
+ (shell-command
+ (replace-regexp-in-string
+ "%f" (shell-quote-argument full-name)
+ (replace-regexp-in-string
+ "%o" (shell-quote-argument out-dir)
+ org-taskjuggler-process-command t t) t t) outbuf)
+ ;; Collect standard errors from output buffer.
+ (setq errors (org-taskjuggler--collect-errors outbuf)))
+ (if (not errors)
+ (message "Process completed.")
+ (error (format "TaskJuggler failed with errors: %s" errors))))
+ (file-expand-wildcards (format "%s/*.html" out-dir))))
+
+(defun org-taskjuggler--collect-errors (buffer)
+ "Collect some kind of errors from \"tj3\" command output.
+
+BUFFER is the buffer containing output.
+
+Return collected error types as a string, or nil if there was
+none."
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (let ((case-fold-search t)
+ (errors ""))
+ (while (re-search-forward "^.+:[0-9]+: \\(.*\\)$" nil t)
+ (setq errors (concat errors " " (match-string 1))))
+ (and (org-string-nw-p errors) (org-trim errors))))))
(provide 'ox-taskjuggler)
diff --git a/debian/changelog b/debian/changelog
index d60c583..14c2227 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,12 @@
+org-mode (8.2.1-1) unstable; urgency=low
+
+ * New upstream release
+ * Do not support emacs22 anymore (Closes: #719037)
+ * Recommend texlive-generic-recommended and texlive-latex-recommended
+ (Closes: #725126)
+
+ -- Sebastien Delafond <seb@debian.org> Sun, 27 Oct 2013 17:14:14 +0100
+
org-mode (8.0.7-2) unstable; urgency=low
* Do not Recommend remember-el anymore, as it's obsolete with Org 8.x
diff --git a/debian/emacsen-install b/debian/emacsen-install
index 34eb5fc..6b00d3e 100644
--- a/debian/emacsen-install
+++ b/debian/emacsen-install
@@ -13,6 +13,7 @@ LOG=$(tempfile -pelc_ -s.log -m644)
case ${FLAVOR} in
emacs) exit 0 ;; # generic emacs package
emacs21) exit 0 ;; # not supported anymore as of 6.26a-3
+ emacs22) exit 0 ;; # not supported anymore as of 8.x
xemacs*) exit 0 ;; # not supported anymore as of 7.x
esac
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 1ba85b2..15e6a06 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -8,6 +8,169 @@ See the end of the file for license conditions.
Please send Org bug reports to emacs-orgmode@gnu.org.
+* Version 8.2
+
+** Incompatible changes
+
+*** Combine org-mac-message.el and org-mac-link-grabber into org-mac-link.el
+
+Please remove calls to =(require 'org-mac-message)= and =(require
+'org-mac-link-grabber)= in your =.emacs= initialization file. All you
+need now is =(require 'org-mac-link)=.
+
+Additionally, replace any calls to =ogml-grab-link= to
+=org-mac-grab-link=. For example, replace this line:
+
+: (define-key org-mode-map (kbd "C-c g") 'omgl-grab-link)
+
+with this:
+
+: (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link)
+
+*** HTML export: Replace =HTML_HTML5_FANCY= by =:html-html5-fancy= (...)
+
+Some of the HTML specific export options in Org <8.1 are either nil or
+t, like =#+HTML_INCLUDE_STYLE=. We replaced these binary options with
+option keywords like :html-include-style.
+
+So you need to replace
+
+: #+HTML_INCLUDE_STYLE: t
+
+by
+
+: #+OPTIONS: :html-include-style t
+
+Options affected by this change: =HTML5_FANCY=, =HTML_INCLUDE_SCRIPTS=
+and =HTML_INCLUDE_STYLE=.
+
+*** Add an argument to ~org-export-to-file~ and ~org-export-to-buffer~
+
+~org-export-to-file~ and ~org-export-to-file~ can run in a different
+process when provided a non-nil =ASYNC= optional argument, without
+relying on ~org-export-async-start~ macro.
+
+Since =ASYNC= is the first of optional arguments, you have to shift
+the other optional arguments accordingly.
+
+*** Export back-ends are now structures
+
+Export back-ends are now structures, and stored as such in the
+communication channel during an export process. In other words, from
+now on, ~(plist-get info :back-end)~ will return a structure instead
+of a symbol.
+
+Arguments in hooks and in filters are still symbols, though.
+
+** Important bugfixes
+
+*** [[doc:org-insert-heading][org-insert-heading]] has been rewritten and bugs are now fixed
+*** The replacement of disputed keys is now turned of when reading a date
+
+*** Match string for sparse trees can now contain a slash in a property value
+
+ You can now have searches like SOMEPROP="aaa/bbb". Until now,
+ this would break because the slash would be interpreted as the
+ separator starting a TOTO match string.
+** New features
+
+*** =C-c ^ x= will now sort checklist items by their checked status
+
+See [[doc:org-sort-list][org-sort-list]]: hitting =C-c ^ x= will put checked items at the end
+of the list.
+*** Various LaTeX export enhancements
+
+- Support SVG images
+- Support for .pgf files
+- LaTeX Babel blocks can now be exported as =.tikz= files
+- Allow =latexmk= as an option for [[doc:org-latex-pdf-process][org-latex-pdf-process]]
+- When using =\usepackage[AUTO]{babel}=, AUTO will automatically be
+ replaced with a value compatible with ~org-export-default-language~
+ or ~LANGUAGE~ keyword.
+- The dependency on the =latexsym= LaTeX package has been removed, we
+ now use =amssymb= symbols by default instead.
+
+*** New functions for paragraph motion
+
+ The commands =C-down= and =C-up= now invoke special commands
+ that use knowledge from the org-elements parser to move the cursor
+ in a paragraph-like way.
+
+*** New entities in =org-entities.el=
+
+Add support for ell, imath, jmath, varphi, varpi, aleph, gimel, beth,
+dalet, cdots, S (§), dag, ddag, colon, therefore, because, triangleq,
+leq, geq, lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq,
+preccurleyeq, succ, succeq, succurleyeq, setminus, nexist(s), mho,
+check, frown, diamond. Changes loz, vert, checkmark, smile and tilde.
+
+*** Anonymous export back-ends
+
+~org-export-create-backend~ can create anonymous export back-ends,
+which can then be passed to export functions like
+~org-export-to-file~, ~org-export-to-buffer~ or ~org-export-as~.
+
+It allows for quick translation of Org syntax without the overhead of
+registering a new back-end.
+
+*** New agenda fortnight view
+
+ The agenda has not, in addition to day, week, month, and year
+ views, also a fortnight view covering 14 days.
+** New options
+
+*** New option [[doc:org-bookmark-names-plist][org-bookmark-names-plist]]
+
+This allows to specify the names of automatic bookmarks.
+*** New option [[doc:org-agenda-ignore-drawer-properties][org-agenda-ignore-drawer-properties]]
+
+This allows more flexibility when optimizing the agenda generation.
+See http://orgmode.org/worg/agenda-optimization.html for details.
+*** New option: [[doc:org-html-link-use-abs-url][org-html-link-use-abs-url]] to force using absolute URLs
+
+This is an export/publishing option, and should be used either within
+the =#+OPTIONS= line(s) or within a [[doc:org-publish-project-alist][org-publish-project-alist]].
+
+Setting this option to =t= is needed when the HTML output does not
+allow relative URLs. For example, the =contrib/lisp/ox-rss.el=
+library produces a RSS feed, and RSS feeds need to use absolute URLs,
+so a combination of =:html-link-home "..." and :html-link-use-abs-url
+t= is required---see the configuration example in the comment section
+of =ox-rss.el=.
+
+*** New option [[doc:org-babel-ditaa-java-cmd][org-babel-ditaa-java-cmd]]
+
+This makes java executable configurable for ditaa blocks.
+
+*** New options [[doc:org-babel-latex-htlatex][org-babel-latex-htlatex]] and [[doc:org-babel-latex-htlatex-packages][org-babel-latex-htlatex-packages]]
+
+This enables SVG generation from latex code blocks.
+
+*** New option: [[doc:org-habit-show-done-alwyays-green][org-habit-show-done-alwyays-green]]
+
+See [[http://lists.gnu.org/archive/html/emacs-orgmode/2013-05/msg00214.html][this message]] from Max Mikhanosha.
+
+*** New option: [[doc:org-babel-inline-result-wrap][org-babel-inline-result-wrap]]
+
+If you set this to the following
+
+: (setq org-babel-inline-result-wrap "$%s$")
+
+then inline code snippets will be wrapped into the formatting string.
+
+*** New option: [[doc:org-special-ctrl-o][org-special-ctrl-o]]
+
+ This variable can be used to turn off the special behavior of
+ =C-o= in tables.
+** New contributed packages
+
+- =ox-bibtex.el= by Nicolas Goaziou :: an utility to handle BibTeX
+ export to both LaTeX and HTML exports. It uses the [[http://www.lri.fr/~filliatr/bibtex2html/][bibtex2html]]
+ software.
+
+- =org-screenshot.el= by Max Mikhanosha :: an utility to handle
+ screenshots easily from Org, using the external tool [[http://freecode.com/projects/scrot][scrot]].
+
* Version 8.0.1
** Installation
diff --git a/lisp/ob-C.el b/lisp/ob-C.el
index b1e8a06..e9eec93 100644
--- a/lisp/ob-C.el
+++ b/lisp/ob-C.el
@@ -44,24 +44,24 @@
(defvar org-babel-C-compiler "gcc"
"Command used to compile a C source code file into an
- executable.")
+executable.")
(defvar org-babel-C++-compiler "g++"
"Command used to compile a C++ source code file into an
- executable.")
+executable.")
(defvar org-babel-c-variant nil
"Internal variable used to hold which type of C (e.g. C or C++)
is currently being evaluated.")
(defun org-babel-execute:cpp (body params)
- "Execute BODY according to PARAMS. This function calls
-`org-babel-execute:C++'."
+ "Execute BODY according to PARAMS.
+This function calls `org-babel-execute:C++'."
(org-babel-execute:C++ body params))
(defun org-babel-execute:C++ (body params)
- "Execute a block of C++ code with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of C++ code with org-babel.
+This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:C++ (body params)
@@ -70,8 +70,8 @@ header arguments (calls `org-babel-C-expand')."
(let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params)))
(defun org-babel-execute:C (body params)
- "Execute a block of C code with org-babel. This function is
-called by `org-babel-execute-src-block'."
+ "Execute a block of C code with org-babel.
+This function is called by `org-babel-execute-src-block'."
(let ((org-babel-c-variant 'c)) (org-babel-C-execute body params)))
(defun org-babel-expand-body:c (body params)
@@ -146,10 +146,10 @@ it's header arguments."
body) "\n") "\n")))
(defun org-babel-C-ensure-main-wrap (body)
- "Wrap body in a \"main\" function call if none exists."
+ "Wrap BODY in a \"main\" function call if none exists."
(if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body)
body
- (format "int main() {\n%s\nreturn(0);\n}\n" body)))
+ (format "int main() {\n%s\nreturn 0;\n}\n" body)))
(defun org-babel-prep-session:C (session params)
"This function does nothing as C is a compiled language with no
@@ -163,6 +163,59 @@ support for sessions"
;; helper functions
+(defun org-babel-C-format-val (type val)
+ "Handle the FORMAT part of TYPE with the data from VAL."
+ (let ((format-data (cadr type)))
+ (if (stringp format-data)
+ (cons "" (format format-data val))
+ (funcall format-data val))))
+
+(defun org-babel-C-val-to-C-type (val)
+ "Determine the type of VAL.
+Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type.
+FORMAT can be either a format string or a function which is called with VAL."
+ (cond
+ ((integerp val) '("int" "%d"))
+ ((floatp val) '("double" "%f"))
+ ((or (listp val) (vectorp val))
+ (lexical-let ((type (org-babel-C-val-to-C-list-type val)))
+ (list (car type)
+ (lambda (val)
+ (cons
+ (format "[%d]%s"
+ (length val)
+ (car (org-babel-C-format-val type (elt val 0))))
+ (concat "{ "
+ (mapconcat (lambda (v)
+ (cdr (org-babel-C-format-val type v)))
+ val
+ ", ")
+ " }"))))))
+ (t ;; treat unknown types as string
+ '("char" (lambda (val)
+ (let ((s (format "%s" val))) ;; convert to string for unknown types
+ (cons (format "[%d]" (1+ (length s)))
+ (concat "\"" s "\""))))))))
+
+(defun org-babel-C-val-to-C-list-type (val)
+ "Determine the C array type of a VAL."
+ (let (type)
+ (mapc
+ #'(lambda (i)
+ (let* ((tmp-type (org-babel-C-val-to-C-type i))
+ (type-name (car type))
+ (tmp-type-name (car tmp-type)))
+ (when (and type (not (string= type-name tmp-type-name)))
+ (if (and (member type-name '("int" "double" "int32_t"))
+ (member tmp-type-name '("int" "double" "int32_t")))
+ (setq tmp-type '("double" "" "%f"))
+ (error "Only homogeneous lists are supported by C. You can not mix %s and %s"
+ type-name
+ tmp-type-name)))
+ (setq type tmp-type)))
+ val)
+ type))
+
(defun org-babel-C-var-to-C (pair)
"Convert an elisp val into a string of C code specifying a var
of the same value."
@@ -173,22 +226,17 @@ of the same value."
(setq val (symbol-name val))
(when (= (length val) 1)
(setq val (string-to-char val))))
- (cond
- ((integerp val)
- (format "int %S = %S;" var val))
- ((floatp val)
- (format "double %S = %S;" var val))
- ((or (integerp val))
- (format "char %S = '%S';" var val))
- ((stringp val)
- (format "char %S[%d] = \"%s\";"
- var (+ 1 (length val)) val))
- (t
- (format "u32 %S = %S;" var val)))))
-
+ (let* ((type-data (org-babel-C-val-to-C-type val))
+ (type (car type-data))
+ (formated (org-babel-C-format-val type-data val))
+ (suffix (car formated))
+ (data (cdr formated)))
+ (format "%s %s%s = %s;"
+ type
+ var
+ suffix
+ data))))
(provide 'ob-C)
-
-
;;; ob-C.el ends here
diff --git a/lisp/ob-R.el b/lisp/ob-R.el
index 67d3c37..74d7513 100644
--- a/lisp/ob-R.el
+++ b/lisp/ob-R.el
@@ -93,8 +93,13 @@
inside
(list "dev.off()"))
inside))
- (append (org-babel-variable-assignments:R params)
- (list body))) "\n")))
+ (append
+ (when (cdr (assoc :prologue params))
+ (list (cdr (assoc :prologue params))))
+ (org-babel-variable-assignments:R params)
+ (list body)
+ (when (cdr (assoc :epilogue params))
+ (list (cdr (assoc :epilogue params)))))) "\n")))
(defun org-babel-execute:R (body params)
"Execute a block of R code.
@@ -234,31 +239,40 @@ current code buffer."
(and (member "graphics" (cdr (assq :result-params params)))
(cdr (assq :file params))))
+(defvar org-babel-R-graphics-devices
+ '((:bmp "bmp" "filename")
+ (:jpg "jpeg" "filename")
+ (:jpeg "jpeg" "filename")
+ (:tikz "tikz" "file")
+ (:tiff "tiff" "filename")
+ (:png "png" "filename")
+ (:svg "svg" "file")
+ (:pdf "pdf" "file")
+ (:ps "postscript" "file")
+ (:postscript "postscript" "file"))
+ "An alist mapping graphics file types to R functions.
+
+Each member of this list is a list with three members:
+1. the file extension of the graphics file, as an elisp :keyword
+2. the R graphics device function to call to generate such a file
+3. the name of the argument to this function which specifies the
+ file to write to (typically \"file\" or \"filename\")")
+
(defun org-babel-R-construct-graphics-device-call (out-file params)
"Construct the call to the graphics device."
- (let ((devices
- '((:bmp . "bmp")
- (:jpg . "jpeg")
- (:jpeg . "jpeg")
- (:tikz . "tikz")
- (:tiff . "tiff")
- (:png . "png")
- (:svg . "svg")
- (:pdf . "pdf")
- (:ps . "postscript")
- (:postscript . "postscript")))
- (allowed-args '(:width :height :bg :units :pointsize
- :antialias :quality :compression :res
- :type :family :title :fonts :version
- :paper :encoding :pagecentre :colormodel
- :useDingbats :horizontal))
- (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
- (match-string 1 out-file)))
- (extra-args (cdr (assq :R-dev-args params))) filearg args)
- (setq device (or (and device (cdr (assq (intern (concat ":" device))
- devices))) "png"))
- (setq filearg
- (if (member device '("pdf" "postscript" "svg" "tikz")) "file" "filename"))
+ (let* ((allowed-args '(:width :height :bg :units :pointsize
+ :antialias :quality :compression :res
+ :type :family :title :fonts :version
+ :paper :encoding :pagecentre :colormodel
+ :useDingbats :horizontal))
+ (device (and (string-match ".+\\.\\([^.]+\\)" out-file)
+ (match-string 1 out-file)))
+ (device-info (or (assq (intern (concat ":" device))
+ org-babel-R-graphics-devices)
+ (assq :png org-babel-R-graphics-devices)))
+ (extra-args (cdr (assq :R-dev-args params))) filearg args)
+ (setq device (nth 1 device-info))
+ (setq filearg (nth 2 device-info))
(setq args (mapconcat
(lambda (pair)
(if (member (car pair) allowed-args)
diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el
index f156297..8b03e2d 100644
--- a/lisp/ob-comint.el
+++ b/lisp/ob-comint.el
@@ -117,7 +117,7 @@ or user `keyboard-quit' during execution of body."
string-buffer))
(setq raw (substring string-buffer (match-end 0))))
(split-string string-buffer comint-prompt-regexp)))))
-(def-edebug-spec org-babel-comint-with-output (form body))
+(def-edebug-spec org-babel-comint-with-output (sexp body))
(defun org-babel-comint-input-command (buffer cmd)
"Pass CMD to BUFFER.
diff --git a/lisp/ob-core.el b/lisp/ob-core.el
index 721c378..cc6b7a9 100644
--- a/lisp/ob-core.el
+++ b/lisp/ob-core.el
@@ -1,6 +1,6 @@
;;; ob-core.el --- working with code blocks in org-mode
-;; Copyright (C) 2009-2012 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
;; Authors: Eric Schulte
;; Dan Davison
@@ -95,6 +95,7 @@
(declare-function org-unescape-code-in-string "org-src" (s))
(declare-function org-table-to-lisp "org-table" (&optional txt))
(declare-function org-reverse-string "org" (string))
+(declare-function org-element-context "org-element" (&optional ELEMENT))
(defgroup org-babel nil
"Code block evaluation and management in `org-mode' documents."
@@ -152,6 +153,12 @@ See also `org-babel-noweb-wrap-start'."
:group 'org-babel
:type 'string)
+(defcustom org-babel-inline-result-wrap "=%s="
+ "Format string used to wrap inline results.
+This string must include a \"%s\" which will be replaced by the results."
+ :group 'org-babel
+ :type 'string)
+
(defun org-babel-noweb-wrap (&optional regexp)
(concat org-babel-noweb-wrap-start
(or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)")
@@ -182,7 +189,7 @@ See also `org-babel-noweb-wrap-start'."
;; (4) header arguments
"\\([^\n]*\\)\n"
;; (5) body
- "\\([^\000]*?\n\\)?[ \t]*#\\+end_src")
+ "\\([^\000]*?\n\\)??[ \t]*#\\+end_src")
"Regexp used to identify code blocks.")
(defvar org-babel-inline-src-block-regexp
@@ -245,7 +252,7 @@ references; a process which could likely result in the execution
of other code blocks.
Returns a list
- (language body header-arguments-alist switches name indent)."
+ (language body header-arguments-alist switches name indent block-head)."
(let ((case-fold-search t) head info name indent)
;; full code block
(if (setq head (org-babel-where-is-src-block-head))
@@ -268,7 +275,7 @@ Returns a list
;; resolve variable references and add summary parameters
(when (and info (not light))
(setf (nth 2 info) (org-babel-process-params (nth 2 info))))
- (when info (append info (list name indent)))))
+ (when info (append info (list name indent head)))))
(defvar org-current-export-file) ; dynamically bound
(defmacro org-babel-check-confirm-evaluate (info &rest body)
@@ -438,6 +445,7 @@ then run `org-babel-switch-to-session'."
(dir . :any)
(eval . ((never query)))
(exports . ((code results both none)))
+ (epilogue . :any)
(file . :any)
(file-desc . :any)
(hlines . ((no yes)))
@@ -449,6 +457,7 @@ then run `org-babel-switch-to-session'."
(noweb-sep . :any)
(padline . ((yes no)))
(post . :any)
+ (prologue . :any)
(results . ((file list vector table scalar verbatim)
(raw html latex org code pp drawer)
(replace silent none append prepend)
@@ -458,6 +467,7 @@ then run `org-babel-switch-to-session'."
(session . :any)
(shebang . :any)
(tangle . ((tangle yes no :any)))
+ (tangle-mode . ((#o755 #o555 #o444 :any)))
(var . :any)
(wrap . :any)))
@@ -469,8 +479,7 @@ specific header arguments as well.")
(defvar org-babel-default-header-args
'((:session . "none") (:results . "replace") (:exports . "code")
- (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")
- (:padnewline . "yes"))
+ (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no"))
"Default arguments to use when evaluating a source block.")
(defvar org-babel-default-inline-header-args
@@ -529,6 +538,12 @@ can not be resolved.")
;;; functions
(defvar call-process-region)
+(defvar org-babel-current-src-block-location nil
+ "Marker pointing to the src block currently being executed.
+This may also point to a call line or an inline code block. If
+multiple blocks are being executed (e.g., in chained execution
+through use of the :var header argument) this marker points to
+the outer-most code block.")
;;;###autoload
(defun org-babel-execute-src-block (&optional arg info params)
@@ -547,7 +562,11 @@ Optionally supply a value for PARAMS which will be merged with
the header arguments specified at the front of the source code
block."
(interactive)
- (let* ((info (if info
+ (let* ((org-babel-current-src-block-location
+ (or org-babel-current-src-block-location
+ (nth 6 info)
+ (org-babel-where-is-src-block-head)))
+ (info (if info
(copy-tree info)
(org-babel-get-src-block-info)))
(merged-params (org-babel-merge-params (nth 2 info) params)))
@@ -586,7 +605,7 @@ block."
(or (org-bound-and-true-p
org-babel-call-process-region-original)
(symbol-function 'call-process-region)))
- (indent (car (last info)))
+ (indent (nth 5 info))
result cmd)
(unwind-protect
(let ((call-process-region
@@ -610,7 +629,8 @@ block."
(if (member "none" result-params)
(progn
(funcall cmd body params)
- (message "result silenced"))
+ (message "result silenced")
+ (setq result nil))
(setq result
((lambda (result)
(if (and (eq (cdr (assoc :result-type params))
@@ -643,9 +663,9 @@ block."
(setq result-params
(remove "file" result-params)))))
(org-babel-insert-result
- result result-params info new-hash indent lang)
- (run-hooks 'org-babel-after-execute-hook)
- result))
+ result result-params info new-hash indent lang))
+ (run-hooks 'org-babel-after-execute-hook)
+ result)
(setq call-process-region
'org-babel-call-process-region-original)))))))))
@@ -655,7 +675,14 @@ Expand a block of code with org-babel according to its header
arguments. This generic implementation of body expansion is
called for languages which have not defined their own specific
org-babel-expand-body:lang function."
- (mapconcat #'identity (append var-lines (list body)) "\n"))
+ (let ((pro (cdr (assoc :prologue params)))
+ (epi (cdr (assoc :epilogue params))))
+ (mapconcat #'identity
+ (append (when pro (list pro))
+ var-lines
+ (list body)
+ (when epi (list epi)))
+ "\n")))
;;;###autoload
(defun org-babel-expand-src-block (&optional arg info params)
@@ -750,7 +777,7 @@ arguments and pop open the results in a preview buffer."
(lang-headers (intern (concat "org-babel-header-args:" lang)))
(headers (org-babel-combine-header-arg-lists
org-babel-common-header-args-w-values
- (if (boundp lang-headers) (eval lang-headers) nil)))
+ (when (boundp lang-headers) (eval lang-headers))))
(arg (org-icompleting-read
"Header Arg: "
(mapcar
@@ -911,6 +938,10 @@ evaluation mechanisms."
(defvar org-bracket-link-regexp)
+(defun org-babel-active-location-p ()
+ (memq (car (save-match-data (org-element-context)))
+ '(babel-call inline-babel-call inline-src-block src-block)))
+
;;;###autoload
(defun org-babel-open-src-block-result (&optional re-run)
"If `point' is on a src block then open the results of the
@@ -918,7 +949,7 @@ source code block, otherwise return nil. With optional prefix
argument RE-RUN the source-code block is evaluated even if
results already exist."
(interactive "P")
- (let ((info (org-babel-get-src-block-info)))
+ (let ((info (org-babel-get-src-block-info 'light)))
(when info
(save-excursion
;; go to the results, if there aren't any then run the block
@@ -971,24 +1002,25 @@ end-body --------- point at the end of the body"
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-src-block-regexp nil t)
- (goto-char (match-beginning 0))
- (let ((full-block (match-string 0))
- (beg-block (match-beginning 0))
- (end-block (match-end 0))
- (lang (match-string 2))
- (beg-lang (match-beginning 2))
- (end-lang (match-end 2))
- (switches (match-string 3))
- (beg-switches (match-beginning 3))
- (end-switches (match-end 3))
- (header-args (match-string 4))
- (beg-header-args (match-beginning 4))
- (end-header-args (match-end 4))
- (body (match-string 5))
- (beg-body (match-beginning 5))
- (end-body (match-end 5)))
- ,@body
- (goto-char end-block))))
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 0))
+ (let ((full-block (match-string 0))
+ (beg-block (match-beginning 0))
+ (end-block (match-end 0))
+ (lang (match-string 2))
+ (beg-lang (match-beginning 2))
+ (end-lang (match-end 2))
+ (switches (match-string 3))
+ (beg-switches (match-beginning 3))
+ (end-switches (match-end 3))
+ (header-args (match-string 4))
+ (beg-header-args (match-beginning 4))
+ (end-header-args (match-end 4))
+ (body (match-string 5))
+ (beg-body (match-beginning 5))
+ (end-body (match-end 5)))
+ ,@body
+ (goto-char end-block)))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
(def-edebug-spec org-babel-map-src-blocks (form body))
@@ -1009,8 +1041,9 @@ buffer."
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-inline-src-block-regexp nil t)
- (goto-char (match-beginning 1))
- (save-match-data ,@body)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
@@ -1034,8 +1067,9 @@ buffer."
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward org-babel-lob-one-liner-regexp nil t)
- (goto-char (match-beginning 1))
- (save-match-data ,@body)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
@@ -1058,9 +1092,11 @@ buffer."
(setq to-be-removed (current-buffer))
(goto-char (point-min))
(while (re-search-forward ,rx nil t)
- (goto-char (match-beginning 1))
- (when (looking-at org-babel-inline-src-block-regexp)(forward-char 1))
- (save-match-data ,@body)
+ (when (org-babel-active-location-p)
+ (goto-char (match-beginning 1))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ (forward-char 1))
+ (save-match-data ,@body))
(goto-char (match-end 0))))
(unless visited-p (kill-buffer to-be-removed))
(goto-char point))))
@@ -1142,9 +1178,12 @@ the current subtree."
(defun org-babel-set-current-result-hash (hash)
"Set the current in-buffer hash to HASH."
(org-babel-where-is-src-block-result)
- (save-excursion (goto-char (match-beginning 3))
- ;; (mapc #'delete-overlay (overlays-at (point)))
- (replace-match hash nil nil nil 3)
+ (save-excursion (goto-char (match-beginning 5))
+ (mapc #'delete-overlay (overlays-at (point)))
+ (forward-char org-babel-hash-show)
+ (mapc #'delete-overlay (overlays-at (point)))
+ (replace-match hash nil nil nil 5)
+ (goto-char (point-at-bol))
(org-babel-hide-hash)))
(defun org-babel-hide-hash ()
@@ -1275,26 +1314,38 @@ portions of results lines."
(defvar org-file-properties)
(defun org-babel-params-from-properties (&optional lang)
"Retrieve parameters specified as properties.
-Return an association list of any source block params which
-may be specified in the properties of the current outline entry."
+Return a list of association lists of source block params
+specified in the properties of the current outline entry."
(save-match-data
- (let (val sym)
- (org-babel-parse-multiple-vars
- (delq nil
- (mapcar
- (lambda (header-arg)
- (and (setq val (org-entry-get (point) header-arg t))
- (cons (intern (concat ":" header-arg))
- (org-babel-read val))))
+ (list
+ ;; DEPRECATED header arguments specified as separate property at
+ ;; point of definition
+ (let (val sym)
+ (org-babel-parse-multiple-vars
+ (delq nil
(mapcar
- #'symbol-name
+ (lambda (header-arg)
+ (and (setq val (org-entry-get (point) header-arg t))
+ (cons (intern (concat ":" header-arg))
+ (org-babel-read val))))
(mapcar
- #'car
- (org-babel-combine-header-arg-lists
- org-babel-common-header-args-w-values
- (progn
- (setq sym (intern (concat "org-babel-header-args:" lang)))
- (and (boundp sym) (eval sym))))))))))))
+ #'symbol-name
+ (mapcar
+ #'car
+ (org-babel-combine-header-arg-lists
+ org-babel-common-header-args-w-values
+ (progn
+ (setq sym (intern (concat "org-babel-header-args:" lang)))
+ (and (boundp sym) (eval sym))))))))))
+ ;; header arguments specified with the header-args property at
+ ;; point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ "header-args" 'inherit))
+ (when lang ;; language-specific header arguments at point of call
+ (org-babel-parse-header-arguments
+ (org-entry-get org-babel-current-src-block-location
+ (concat "header-args:" lang) 'inherit))))))
(defvar org-src-preserve-indentation)
(defun org-babel-parse-src-block-match ()
@@ -1320,12 +1371,13 @@ may be specified in the properties of the current outline entry."
(insert (org-unescape-code-in-string body))
(unless preserve-indentation (org-do-remove-indentation))
(buffer-string)))
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) ""))))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (when (boundp lang-headers) (eval lang-headers))
+ (append
+ (org-babel-params-from-properties lang)
+ (list (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) ""))))))
switches
block-indentation)))
@@ -1335,12 +1387,13 @@ may be specified in the properties of the current outline entry."
(lang-headers (intern (concat "org-babel-default-header-args:" lang))))
(list lang
(org-unescape-code-in-string (org-no-properties (match-string 5)))
- (org-babel-merge-params
- org-babel-default-inline-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- (org-babel-parse-header-arguments
- (org-no-properties (or (match-string 4) "")))))))
+ (apply #'org-babel-merge-params
+ org-babel-default-inline-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append
+ (org-babel-params-from-properties lang)
+ (list (org-babel-parse-header-arguments
+ (org-no-properties (or (match-string 4) "")))))))))
(defun org-babel-balanced-split (string alts)
"Split STRING on instances of ALTS.
@@ -1581,7 +1634,7 @@ If the point is not on a source block then return nil."
(< top initial) (< initial bottom)
(progn (goto-char top) (beginning-of-line 1)
(looking-at org-babel-src-block-regexp))
- (point))))))
+ (point-marker))))))
;;;###autoload
(defun org-babel-goto-src-block-head ()
@@ -1676,7 +1729,8 @@ buffer or nil if no such result exists."
(when (and (string= "name" (downcase (match-string 1)))
(or (beginning-of-line 1)
(looking-at org-babel-src-block-regexp)
- (looking-at org-babel-multi-line-header-regexp)))
+ (looking-at org-babel-multi-line-header-regexp)
+ (looking-at org-babel-lob-one-liner-regexp)))
(throw 'is-a-code-block (org-babel-find-named-result name (point))))
(beginning-of-line 0) (point))))))
@@ -1753,9 +1807,13 @@ region is not active then the point is demarcated."
(move-end-of-line 2))
(sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>))
(let ((start (point))
- (lang (org-icompleting-read "Lang: "
- (mapcar (lambda (el) (symbol-name (car el)))
- org-babel-load-languages)))
+ (lang (org-icompleting-read
+ "Lang: "
+ (mapcar #'symbol-name
+ (delete-dups
+ (append (mapcar #'car org-babel-load-languages)
+ (mapcar (lambda (el) (intern (car el)))
+ org-src-lang-modes))))))
(body (delete-and-extract-region
(if (org-region-active-p) (mark) (point)) (point))))
(insert (concat (if (looking-at "^") "" "\n")
@@ -1781,10 +1839,7 @@ following the source block."
(looking-at org-babel-lob-one-liner-regexp)))
(inlinep (when (org-babel-get-inline-src-block-matches)
(match-end 0)))
- (name (if on-lob-line
- (mapconcat #'identity (butlast (org-babel-lob-get-info))
- "")
- (nth 4 (or info (org-babel-get-src-block-info 'light)))))
+ (name (nth 4 (or info (org-babel-get-src-block-info 'light))))
(head (unless on-lob-line (org-babel-where-is-src-block-head)))
found beg end)
(when head (goto-char head))
@@ -1860,14 +1915,14 @@ following the source block."
((org-at-item-p) (org-babel-read-list))
((looking-at org-bracket-link-regexp) (org-babel-read-link))
((looking-at org-block-regexp) (org-babel-trim (match-string 4)))
- ((looking-at "^[ \t]*: ")
+ ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$"))
(setq result-string
(org-babel-trim
(mapconcat (lambda (line)
- (if (and (> (length line) 1)
- (string-match "^[ \t]*: \\(.+\\)" line))
- (match-string 1 line)
- line))
+ (or (and (> (length line) 1)
+ (string-match "^[ \t]*: ?\\(.+\\)" line)
+ (match-string 1 line))
+ ""))
(split-string
(buffer-substring
(point) (org-babel-result-end)) "[\r\n]+")
@@ -2131,7 +2186,7 @@ code ---- the results are extracted in the syntax of the source
(progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1))
nil t)
(forward-char 1))
- (while (looking-at "[ \t]*\\(: \\|\\[\\[\\)")
+ (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)")
(forward-line 1))))
(point)))))
@@ -2164,8 +2219,9 @@ file's directory then expand relative links."
(funcall chars-between end (save-excursion (goto-char end) (point-at-eol))))
(save-excursion
(goto-char beg)
- (insert (format "=%s=" (prog1 (buffer-substring beg end)
- (delete-region beg end)))))
+ (insert (format org-babel-inline-result-wrap
+ (prog1 (buffer-substring beg end)
+ (delete-region beg end)))))
(let ((size (count-lines beg end)))
(save-excursion
(cond ((= size 0)) ; do nothing for an empty result
@@ -2222,7 +2278,8 @@ parameters when merging lists."
new-params))
result-params)
output)))
- params results exports tangle noweb cache vars shebang comments padline)
+ params results exports tangle noweb cache vars shebang comments padline
+ clearnames)
(mapc
(lambda (plist)
@@ -2239,21 +2296,25 @@ parameters when merging lists."
(setq vars
(append
(if (member name (mapcar #'car vars))
- (delq nil
- (mapcar
- (lambda (p)
- (unless (equal (car p) name) p))
- vars))
+ (progn
+ (push name clearnames)
+ (delq nil
+ (mapcar
+ (lambda (p)
+ (unless (equal (car p) name) p))
+ vars)))
vars)
(list (cons name pair))))
;; if no name is given and we already have named variables
;; then assign to named variables in order
(if (and vars (nth variable-index vars))
- (prog1 (setf (cddr (nth variable-index vars))
- (concat (symbol-name
- (car (nth variable-index vars)))
- "=" (cdr pair)))
- (incf variable-index))
+ (let ((name (car (nth variable-index vars))))
+ (push name clearnames) ; clear out colnames
+ ; and rownames
+ ; for replace vars
+ (prog1 (setf (cddr (nth variable-index vars))
+ (concat (symbol-name name) "=" (cdr pair)))
+ (incf variable-index)))
(error "Variable \"%s\" must be assigned a default value"
(cdr pair))))))
(:results
@@ -2300,6 +2361,20 @@ parameters when merging lists."
plists)
(setq vars (reverse vars))
(while vars (setq params (cons (cons :var (cddr (pop vars))) params)))
+ ;; clear out col-names and row-names for replaced variables
+ (mapc
+ (lambda (name)
+ (mapc
+ (lambda (param)
+ (when (assoc param params)
+ (setf (cdr (assoc param params))
+ (org-remove-if (lambda (pair) (equal (car pair) name))
+ (cdr (assoc param params))))
+ (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param)
+ (null (cdr pair))))
+ params))))
+ (list :colname-names :rowname-names)))
+ clearnames)
(mapc
(lambda (hd)
(let ((key (intern (concat ":" (symbol-name hd))))
@@ -2360,7 +2435,7 @@ would set the value of argument \"a\" equal to \"9\". Note that
these arguments are not evaluated in the current source-code
block but are passed literally to the \"example-block\"."
(let* ((parent-buffer (or parent-buffer (current-buffer)))
- (info (or info (org-babel-get-src-block-info)))
+ (info (or info (org-babel-get-src-block-info 'light)))
(lang (nth 0 info))
(body (nth 1 info))
(ob-nww-start org-babel-noweb-wrap-start)
@@ -2511,10 +2586,10 @@ block but are passed literally to the \"example-block\"."
(defun org-babel-read (cell &optional inhibit-lisp-eval)
"Convert the string value of CELL to a number if appropriate.
Otherwise if cell looks like lisp (meaning it starts with a
-\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, otherwise
-return it unmodified as a string. Optional argument NO-LISP-EVAL
-inhibits lisp evaluation for situations in which is it not
-appropriate."
+\"(\", \"'\", \"`\" or a \"[\") then read it as lisp,
+otherwise return it unmodified as a string. Optional argument
+NO-LISP-EVAL inhibits lisp evaluation for situations in which is
+it not appropriate."
(if (and (stringp cell) (not (equal cell "")))
(or (org-babel-number-p cell)
(if (and (not inhibit-lisp-eval)
diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el
index d3d76e5..60ab8c5 100644
--- a/lisp/ob-ditaa.el
+++ b/lisp/ob-ditaa.el
@@ -58,6 +58,11 @@
:group 'org-babel
:type 'string)
+(defcustom org-babel-ditaa-java-cmd "java"
+ "Java executable to use when evaluating ditaa blocks."
+ :group 'org-babel
+ :type 'string)
+
(defcustom org-ditaa-eps-jar-path
(expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path))
"Path to the DitaaEps.jar executable."
@@ -86,7 +91,8 @@ This function is called by `org-babel-execute-src-block'."
(java (cdr (assoc :java params)))
(in-file (org-babel-temp-file "ditaa-"))
(eps (cdr (assoc :eps params)))
- (cmd (concat "java " java " " org-ditaa-jar-option " "
+ (cmd (concat org-babel-ditaa-java-cmd
+ " " java " " org-ditaa-jar-option " "
(shell-quote-argument
(expand-file-name
(if eps org-ditaa-eps-jar-path org-ditaa-jar-path)))
diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el
index 681362f..85a8c4e 100644
--- a/lisp/ob-eval.el
+++ b/lisp/ob-eval.el
@@ -27,6 +27,7 @@
;; shell commands.
;;; Code:
+(require 'org-macs)
(eval-when-compile (require 'cl))
(defvar org-babel-error-buffer-name "*Org-Babel Error Output*")
diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el
index 1aa9c92..c8479e3 100644
--- a/lisp/ob-exp.el
+++ b/lisp/ob-exp.el
@@ -122,11 +122,11 @@ Assume point is at the beginning of block's starting line."
(org-babel-exp-in-export-file lang
(setf (nth 2 info)
(org-babel-process-params
- (org-babel-merge-params
- org-babel-default-header-args
- (org-babel-params-from-properties lang)
- (if (boundp lang-headers) (eval lang-headers) nil)
- raw-params))))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ (if (boundp lang-headers) (eval lang-headers) nil)
+ (append (org-babel-params-from-properties lang)
+ (list raw-params))))))
(setf hash (org-babel-sha1-hash info)))
(org-babel-exp-do-export info 'block hash)))))
@@ -206,17 +206,20 @@ this template."
(results
(org-babel-exp-do-export
(list "emacs-lisp" "results"
- (org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-lob-header-args
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat ":var results="
- (mapconcat 'identity
- (butlast lob-info)
- " ")))))
- "" nil (car (last lob-info)))
+ (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-lob-header-args
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat 'identity
+ (butlast lob-info 2)
+ " ")))))))
+ "" (nth 3 lob-info) (nth 2 lob-info))
'lob))
(rep (org-fill-template
org-babel-exp-call-line-template
@@ -387,7 +390,8 @@ inhibit insertion of results into the buffer."
(org-babel-expand-noweb-references
info (org-babel-exp-get-export-buffer))
(nth 1 info)))
- (info (copy-sequence info)))
+ (info (copy-sequence info))
+ (org-babel-current-src-block-location (point-marker)))
;; skip code blocks which we can't evaluate
(when (fboundp (intern (concat "org-babel-execute:" lang)))
(org-babel-eval-wipe-error-buffer)
diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el
index 1eab03e..df7bfa0 100644
--- a/lisp/ob-fortran.el
+++ b/lisp/ob-fortran.el
@@ -32,6 +32,7 @@
(declare-function org-entry-get "org"
(pom property &optional inherit literal-nil))
+(declare-function org-every "org" (pred seq))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90"))
@@ -143,6 +144,12 @@ of the same value."
((stringp val)
(format "character(len=%d), parameter :: %S = '%s'\n"
(length val) var val))
+ ;; val is a matrix
+ ((and (listp val) (org-every #'listp val))
+ (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n"
+ var (length val) (length (car val))
+ (org-babel-fortran-transform-list val)
+ (length (car val)) (length val)))
((listp val)
(format "real, parameter :: %S(%d) = %s\n"
var (length val) (org-babel-fortran-transform-list val)))
diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el
index 4b3a1c6..cc9186b 100644
--- a/lisp/ob-gnuplot.el
+++ b/lisp/ob-gnuplot.el
@@ -52,77 +52,117 @@
'((:results . "file") (:exports . "results") (:session . nil))
"Default arguments to use when evaluating a gnuplot source block.")
+(defvar org-babel-header-args:gnuplot
+ '((title . :any)
+ (lines . :any)
+ (sets . :any)
+ (x-labels . :any)
+ (y-labels . :any)
+ (timefmt . :any)
+ (time-ind . :any)
+ (missing . :any)
+ (term . :any))
+ "Gnuplot specific header args.")
+
(defvar org-babel-gnuplot-timestamp-fmt nil)
+(defvar *org-babel-gnuplot-missing* nil)
+
+(defcustom *org-babel-gnuplot-terms*
+ '((eps . "postscript eps"))
+ "List of file extensions and the associated gnuplot terminal."
+ :group 'org-babel
+ :type '(repeat (cons (symbol :tag "File extension")
+ (string :tag "Gnuplot terminal"))))
+
(defun org-babel-gnuplot-process-vars (params)
"Extract variables from PARAMS and process the variables.
Dumps all vectors into files and returns an association list
of variable names and the related value to be used in the gnuplot
code."
- (mapcar
- (lambda (pair)
- (cons
- (car pair) ;; variable name
- (if (listp (cdr pair)) ;; variable value
- (org-babel-gnuplot-table-to-data
- (cdr pair) (org-babel-temp-file "gnuplot-") params)
- (cdr pair))))
- (mapcar #'cdr (org-babel-get-header params :var))))
+ (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params))))
+ (mapcar
+ (lambda (pair)
+ (cons
+ (car pair) ;; variable name
+ (if (listp (cdr pair)) ;; variable value
+ (org-babel-gnuplot-table-to-data
+ (cdr pair) (org-babel-temp-file "gnuplot-") params)
+ (cdr pair))))
+ (mapcar #'cdr (org-babel-get-header params :var)))))
(defun org-babel-expand-body:gnuplot (body params)
"Expand BODY according to PARAMS, return the expanded body."
(save-window-excursion
(let* ((vars (org-babel-gnuplot-process-vars params))
(out-file (cdr (assoc :file params)))
- (term (or (cdr (assoc :term params))
- (when out-file (file-name-extension out-file))))
+ (prologue (cdr (assoc :prologue params)))
+ (epilogue (cdr (assoc :epilogue params)))
+ (term (or (cdr (assoc :term params))
+ (when out-file
+ (let ((ext (file-name-extension out-file)))
+ (or (cdr (assoc (intern (downcase ext))
+ *org-babel-gnuplot-terms*))
+ ext)))))
(cmdline (cdr (assoc :cmdline params)))
- (title (plist-get params :title))
- (lines (plist-get params :line))
- (sets (plist-get params :set))
- (x-labels (plist-get params :xlabels))
- (y-labels (plist-get params :ylabels))
- (timefmt (plist-get params :timefmt))
- (time-ind (or (plist-get params :timeind)
+ (title (cdr (assoc :title params)))
+ (lines (cdr (assoc :line params)))
+ (sets (cdr (assoc :set params)))
+ (x-labels (cdr (assoc :xlabels params)))
+ (y-labels (cdr (assoc :ylabels params)))
+ (timefmt (cdr (assoc :timefmt params)))
+ (time-ind (or (cdr (assoc :timeind params))
(when timefmt 1)))
+ (missing (cdr (assoc :missing params)))
(add-to-body (lambda (text) (setq body (concat text "\n" body))))
output)
;; append header argument settings to body
- (when title (funcall add-to-body (format "set title '%s'" title))) ;; title
- (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) ;; line
+ (when title (funcall add-to-body (format "set title '%s'" title)))
+ (when lines (mapc (lambda (el) (funcall add-to-body el)) lines))
+ (when missing
+ (funcall add-to-body (format "set datafile missing '%s'" missing)))
(when sets
(mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets))
(when x-labels
(funcall add-to-body
(format "set xtics (%s)"
(mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
+ (format "\"%s\" %d"
+ (cdr pair) (car pair)))
x-labels ", "))))
(when y-labels
(funcall add-to-body
(format "set ytics (%s)"
(mapconcat (lambda (pair)
- (format "\"%s\" %d" (cdr pair) (car pair)))
+ (format "\"%s\" %d"
+ (cdr pair) (car pair)))
y-labels ", "))))
(when time-ind
(funcall add-to-body "set xdata time")
(funcall add-to-body (concat "set timefmt \""
(or timefmt
"%Y-%m-%d-%H:%M:%S") "\"")))
- (when out-file (funcall add-to-body (format "set output \"%s\"" out-file)))
+ (when out-file
+ ;; set the terminal at the top of the block
+ (funcall add-to-body (format "set output \"%s\"" out-file))
+ ;; and close the terminal at the bottom of the block
+ (setq body (concat body "\nset output\n")))
(when term (funcall add-to-body (format "set term %s" term)))
;; insert variables into code body: this should happen last
;; placing the variables at the *top* of the code in case their
;; values are used later
- (funcall add-to-body (mapconcat #'identity
- (org-babel-variable-assignments:gnuplot params)
- "\n"))
+ (funcall add-to-body
+ (mapconcat #'identity
+ (org-babel-variable-assignments:gnuplot params)
+ "\n"))
;; replace any variable names preceded by '$' with the actual
;; value of the variable
(mapc (lambda (pair)
(setq body (replace-regexp-in-string
(format "\\$%s" (car pair)) (cdr pair) body)))
- vars))
+ vars)
+ (when prologue (funcall add-to-body prologue))
+ (when epilogue (setq body (concat body "\n" epilogue))))
body))
(defun org-babel-execute:gnuplot (body params)
@@ -199,7 +239,8 @@ then create one. Return the initialized session. The current
(defun org-babel-gnuplot-quote-timestamp-field (s)
"Convert S from timestamp to Unix time and export to gnuplot."
- (format-time-string org-babel-gnuplot-timestamp-fmt (org-time-string-to-time s)))
+ (format-time-string org-babel-gnuplot-timestamp-fmt
+ (org-time-string-to-time s)))
(defvar org-table-number-regexp)
(defvar org-ts-regexp3)
@@ -210,7 +251,12 @@ then create one. Return the initialized session. The current
(if (string-match org-table-number-regexp s) s
(if (string-match org-ts-regexp3 s)
(org-babel-gnuplot-quote-timestamp-field s)
- (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\""))))
+ (if (zerop (length s))
+ (or *org-babel-gnuplot-missing* s)
+ (if (string-match "[ \"]" "?")
+ (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"")
+ "\"")
+ s)))))
(defun org-babel-gnuplot-table-to-data (table data-file params)
"Export TABLE to DATA-FILE in a format readable by gnuplot.
diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el
index 6f0fbcd..a012711 100644
--- a/lisp/ob-haskell.el
+++ b/lisp/ob-haskell.el
@@ -52,7 +52,8 @@
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs"))
-(defvar org-babel-default-header-args:haskell '())
+(defvar org-babel-default-header-args:haskell
+ '((:padlines . "no")))
(defvar org-babel-haskell-lhs2tex-command "lhs2tex")
@@ -149,7 +150,7 @@ specifying a variable of the same value."
(defvar org-src-preserve-indentation)
(declare-function org-export-to-file "ox"
(backend file
- &optional subtreep visible-only body-only ext-plist))
+ &optional async subtreep visible-only body-only ext-plist))
(defun org-babel-haskell-export-to-lhs (&optional arg)
"Export to a .lhs file with all haskell code blocks escaped.
When called with a prefix argument the resulting
diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el
index 94d5133..edc9fe8 100644
--- a/lisp/ob-latex.el
+++ b/lisp/ob-latex.el
@@ -50,6 +50,17 @@
'((:results . "latex") (:exports . "results"))
"Default arguments to use when evaluating a LaTeX source block.")
+(defcustom org-babel-latex-htlatex nil
+ "The htlatex command to enable conversion of latex to SVG or HTML."
+ :group 'org-babel
+ :type 'string)
+
+(defcustom org-babel-latex-htlatex-packages
+ '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}")
+ "Packages to use for htlatex export."
+ :group 'org-babel
+ :type '(list string))
+
(defun org-babel-expand-body:latex (body params)
"Expand BODY according to PARAMS, return the expanded body."
(mapc (lambda (pair) ;; replace variables
@@ -84,7 +95,11 @@ This function is called by `org-babel-execute-src-block'."
((and (string-match "\\.png$" out-file) (not imagemagick))
(org-create-formula-image
body out-file org-format-latex-options in-buffer))
- ((or (string-match "\\.pdf$" out-file) imagemagick)
+ ((string-match "\\.tikz$" out-file)
+ (when (file-exists-p out-file) (delete-file out-file))
+ (with-temp-file out-file
+ (insert body)))
+ ((or (string-match "\\.pdf$" out-file) imagemagick)
(with-temp-file tex-file
(require 'ox-latex)
(insert
@@ -124,6 +139,40 @@ This function is called by `org-babel-execute-src-block'."
transient-pdf-file out-file im-in-options im-out-options)
(when (file-exists-p transient-pdf-file)
(delete-file transient-pdf-file))))))
+ ((and (or (string-match "\\.svg$" out-file)
+ (string-match "\\.html$" out-file))
+ org-babel-latex-htlatex)
+ (with-temp-file tex-file
+ (insert (concat
+ "\\documentclass[preview]{standalone}
+\\def\\pgfsysdriver{pgfsys-tex4ht.def}
+"
+ (mapconcat (lambda (pkg)
+ (concat "\\usepackage" pkg))
+ org-babel-latex-htlatex-packages
+ "\n")
+ "\\begin{document}"
+ body
+ "\\end{document}")))
+ (when (file-exists-p out-file) (delete-file out-file))
+ (let ((default-directory (file-name-directory tex-file)))
+ (shell-command (format "%s %s" org-babel-latex-htlatex tex-file)))
+ (cond
+ ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg"))
+ (if (string-match "\\.svg$" out-file)
+ (progn
+ (shell-command "pwd")
+ (shell-command (format "mv %s %s"
+ (concat (file-name-sans-extension tex-file) "-1.svg")
+ out-file)))
+ (error "SVG file produced but HTML file requested.")))
+ ((file-exists-p (concat (file-name-sans-extension tex-file) ".html"))
+ (if (string-match "\\.html$" out-file)
+ (shell-command "mv %s %s"
+ (concat (file-name-sans-extension tex-file)
+ ".html")
+ out-file)
+ (error "HTML file produced but SVG file requested.")))))
((string-match "\\.\\([^\\.]+\\)$" out-file)
(error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument"
(match-string 1 out-file))))
diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el
index 802aa60..d37940a 100644
--- a/lisp/ob-lob.el
+++ b/lisp/ob-lob.el
@@ -35,7 +35,7 @@
This is an association list. Populate the library by adding
files to `org-babel-lob-files'.")
-(defcustom org-babel-lob-files '()
+(defcustom org-babel-lob-files nil
"Files used to populate the `org-babel-library-of-babel'.
To add files to this list use the `org-babel-lob-ingest' command."
:group 'org-babel
@@ -114,25 +114,38 @@ if so then run the appropriate source block from the Library."
(or (funcall nonempty 8 19) ""))
(funcall nonempty 9 18)))
(list (length (if (= (length (match-string 12)) 0)
- (match-string 2) (match-string 11)))))))))
+ (match-string 2) (match-string 11)))
+ (save-excursion
+ (forward-line -1)
+ (and (looking-at (concat org-babel-src-name-regexp
+ "\\([^\n]*\\)$"))
+ (org-no-properties (match-string 1))))))))))
(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el
(defun org-babel-lob-execute (info)
"Execute the lob call specified by INFO."
- (let* ((mkinfo (lambda (p) (list "emacs-lisp" "results" p nil nil (nth 2 info))))
- (pre-params (org-babel-merge-params
- org-babel-default-header-args
- org-babel-default-header-args:emacs-lisp
- (org-babel-params-from-properties)
- (org-babel-parse-header-arguments
- (org-no-properties
- (concat ":var results="
- (mapconcat #'identity (butlast info) " "))))))
+ (let* ((mkinfo (lambda (p)
+ (list "emacs-lisp" "results" p nil
+ (nth 3 info) ;; name
+ (nth 2 info))))
+ (pre-params (apply #'org-babel-merge-params
+ org-babel-default-header-args
+ org-babel-default-header-args:emacs-lisp
+ (append
+ (org-babel-params-from-properties)
+ (list
+ (org-babel-parse-header-arguments
+ (org-no-properties
+ (concat
+ ":var results="
+ (mapconcat #'identity (butlast info 2)
+ " "))))))))
(pre-info (funcall mkinfo pre-params))
(cache-p (and (cdr (assoc :cache pre-params))
(string= "yes" (cdr (assoc :cache pre-params)))))
(new-hash (when cache-p (org-babel-sha1-hash pre-info)))
- (old-hash (when cache-p (org-babel-current-result-hash))))
+ (old-hash (when cache-p (org-babel-current-result-hash)))
+ (org-babel-current-src-block-location (point-marker)))
(if (and cache-p (equal new-hash old-hash))
(save-excursion (goto-char (org-babel-where-is-src-block-result))
(forward-line 1)
diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el
index 6a83908..25f79c5 100644
--- a/lisp/ob-ocaml.el
+++ b/lisp/ob-ocaml.el
@@ -51,6 +51,13 @@
(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;")
(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe")
+(defcustom org-babel-ocaml-command "ocaml"
+ "Name of the command for executing Ocaml code."
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :group 'org-babel
+ :type 'string)
+
(defun org-babel-execute:ocaml (body params)
"Execute a block of Ocaml code with Babel."
(let* ((vars (mapcar #'cdr (org-babel-get-header params :var)))
@@ -63,7 +70,7 @@
(session org-babel-ocaml-eoe-output t full-body)
(insert
(concat
- (org-babel-chomp full-body)"\n"org-babel-ocaml-eoe-indicator))
+ (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator))
(tuareg-interactive-send-input)))
(clean
(car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out)
@@ -74,10 +81,13 @@
(progn (setq out t) nil))))
(mapcar #'org-babel-trim (reverse raw))))))))
(org-babel-reassemble-table
- (let ((raw (org-babel-trim clean)))
- (org-babel-result-cond (cdr (assoc :result-params params))
- ;; strip type information from output
- (if (string-match "= \\(.+\\)$" raw) (match-string 1 raw) raw)
+ (let ((raw (org-babel-trim clean))
+ (result-params (cdr (assoc :result-params params))))
+ (org-babel-result-cond result-params
+ ;; strip type information from output unless verbatim is specified
+ (if (and (not (member "verbatim" result-params))
+ (string-match "= \\(.+\\)$" raw))
+ (match-string 1 raw) raw)
(org-babel-ocaml-parse-output raw)))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
@@ -93,9 +103,10 @@
(stringp session))
session
tuareg-interactive-buffer-name)))
- (save-window-excursion
- (if (fboundp 'tuareg-run-caml) (tuareg-run-caml) (tuareg-run-ocaml))
- (get-buffer tuareg-interactive-buffer-name))))
+ (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed)
+ (tuareg-run-process-if-needed org-babel-ocaml-command)
+ (tuareg-run-caml)))
+ (get-buffer tuareg-interactive-buffer-name)))
(defun org-babel-variable-assignments:ocaml (params)
"Return list of ocaml statements assigning the block's variables."
@@ -113,7 +124,7 @@
(defun org-babel-ocaml-parse-output (output)
"Parse OUTPUT.
OUTPUT is string output from an ocaml process."
- (let ((regexp "%s = \\(.+\\)$"))
+ (let ((regexp "[^:]+ : %s = \\(.+\\)$"))
(cond
((string-match (format regexp "string") output)
(org-babel-read (match-string 1 output)))
diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el
index c2a3abb..40bedfd 100644
--- a/lisp/ob-octave.el
+++ b/lisp/ob-octave.el
@@ -151,7 +151,8 @@ create. Return the initialized session."
"Create an octave inferior process buffer.
If there is not a current inferior-process-buffer in SESSION then
create. Return the initialized session."
- (if matlabp (require 'matlab) (require 'octave-inf))
+ (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror)
+ (require 'octave)))
(unless (string= session "none")
(let ((session (or session
(if matlabp "*Inferior Matlab*" "*Inferior Octave*"))))
diff --git a/lisp/ob-org.el b/lisp/ob-org.el
index 18cce3b..892c56c 100644
--- a/lisp/ob-org.el
+++ b/lisp/ob-org.el
@@ -43,8 +43,9 @@
(defun org-babel-expand-body:org (body params)
(dolist (var (mapcar #'cdr (org-babel-get-header params :var)))
(setq body (replace-regexp-in-string
- (regexp-quote (format "$%s" (car var))) (cdr var) body
- nil 'literal)))
+ (regexp-quote (format "$%s" (car var)))
+ (format "%s" (cdr var))
+ body nil 'literal)))
body)
(defun org-babel-execute:org (body params)
diff --git a/lisp/ob-python.el b/lisp/ob-python.el
index eca4c82..17da109 100644
--- a/lisp/ob-python.el
+++ b/lisp/ob-python.el
@@ -33,7 +33,7 @@
(declare-function org-remove-indentation "org" )
(declare-function py-shell "ext:python-mode" (&optional argprompt))
(declare-function py-toggle-shells "ext:python-mode" (arg))
-(declare-function run-python "ext:python" (&optional cmd noshow new))
+(declare-function run-python "ext:python" (cmd &optional dedicated show))
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("python" . "py"))
@@ -179,21 +179,20 @@ then create. Return the initialized session."
(require org-babel-python-mode)
(save-window-excursion
(let* ((session (if session (intern session) :default))
- (python-buffer (org-babel-python-session-buffer session)))
+ (python-buffer (org-babel-python-session-buffer session))
+ (cmd (if (member system-type '(cygwin windows-nt ms-dos))
+ (concat org-babel-python-command " -i")
+ org-babel-python-command)))
(cond
((and (eq 'python org-babel-python-mode)
(fboundp 'run-python)) ; python.el
- (if (version< "24.1" emacs-version)
- (progn
- (unless python-buffer
- (setq python-buffer (org-babel-python-with-earmufs session)))
- (let ((python-shell-buffer-name
- (org-babel-python-without-earmufs python-buffer)))
- (run-python
- (if (member system-type '(cygwin windows-nt ms-dos))
- (concat org-babel-python-command " -i")
- org-babel-python-command))))
- (run-python)))
+ (if (not (version< "24.1" emacs-version))
+ (run-python cmd)
+ (unless python-buffer
+ (setq python-buffer (org-babel-python-with-earmufs session)))
+ (let ((python-shell-buffer-name
+ (org-babel-python-without-earmufs python-buffer)))
+ (run-python cmd))))
((and (eq 'python-mode org-babel-python-mode)
(fboundp 'py-shell)) ; python-mode.el
;; Make sure that py-which-bufname is initialized, as otherwise
diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el
index a2814ea..5a3c8ba 100644
--- a/lisp/ob-ref.el
+++ b/lisp/ob-ref.el
@@ -83,7 +83,10 @@ the variable."
(let ((var (match-string 1 assignment))
(ref (match-string 2 assignment)))
(cons (intern var)
- (let ((out (org-babel-read ref)))
+ (let ((out (save-excursion
+ (when org-babel-current-src-block-location
+ (goto-char org-babel-current-src-block-location))
+ (org-babel-read ref))))
(if (equal out ref)
(if (string-match "^\".*\"$" ref)
(read ref)
diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el
index 20fb418..af52831 100644
--- a/lisp/ob-ruby.el
+++ b/lisp/ob-ruby.el
@@ -50,6 +50,22 @@
(defvar org-babel-ruby-command "ruby"
"Name of command to use for executing ruby code.")
+(defcustom org-babel-ruby-hline-to "nil"
+ "Replace hlines in incoming tables with this when translating to ruby."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+(defcustom org-babel-ruby-nil-to 'hline
+ "Replace 'nil' in ruby tables with this before returning."
+ :group 'org-babel
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'string)
+
+
+
(defun org-babel-execute:ruby (body params)
"Execute a block of Ruby code with Babel.
This function is called by `org-babel-execute-src-block'."
@@ -115,13 +131,21 @@ Convert an elisp value into a string of ruby source code
specifying a variable of the same value."
(if (listp var)
(concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]")
- (format "%S" var)))
+ (if (equal var 'hline)
+ org-babel-ruby-hline-to
+ (format "%S" var))))
(defun org-babel-ruby-table-or-string (results)
"Convert RESULTS into an appropriate elisp value.
If RESULTS look like a table, then convert them into an
Emacs-lisp table, otherwise return the results as a string."
- (org-babel-script-escape results))
+ ((lambda (res)
+ (if (listp res)
+ (mapcar (lambda (el) (if (equal el 'nil)
+ org-babel-ruby-nil-to el))
+ res)
+ res))
+ (org-babel-script-escape results)))
(defun org-babel-ruby-initiate-session (&optional session params)
"Initiate a ruby session.
diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el
index 89dd003..f979640 100644
--- a/lisp/ob-scheme.el
+++ b/lisp/ob-scheme.el
@@ -2,7 +2,7 @@
;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
-;; Author: Eric Schulte
+;; Authors: Eric Schulte, Michael Gauland
;; Keywords: literate programming, reproducible research, scheme
;; Homepage: http://orgmode.org
@@ -33,27 +33,25 @@
;; - a working scheme implementation
;; (e.g. guile http://www.gnu.org/software/guile/guile.html)
;;
-;; - for session based evaluation cmuscheme.el is required which is
-;; included in Emacs
+;; - for session based evaluation geiser is required, which is available from
+;; ELPA.
;;; Code:
(require 'ob)
-(eval-when-compile (require 'cl))
+(require 'geiser nil t)
+(defvar geiser-repl--repl) ; Defined in geiser-repl.el
+(defvar geiser-impl--implementation) ; Defined in geiser-impl.el
+(defvar geiser-default-implementation) ; Defined in geiser-impl.el
+(defvar geiser-active-implementations) ; Defined in geiser-impl.el
-(declare-function run-scheme "ext:cmuscheme" (cmd))
+(declare-function run-geiser "geiser-repl" (impl))
+(declare-function geiser-mode "geiser-mode" ())
+(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg))
+(declare-function geiser-repl-exit "geiser-repl" (&optional arg))
(defvar org-babel-default-header-args:scheme '()
"Default header arguments for scheme code blocks.")
-(defvar org-babel-scheme-eoe "org-babel-scheme-eoe"
- "String to indicate that evaluation has completed.")
-
-(defcustom org-babel-scheme-cmd "guile"
- "Name of command used to evaluate scheme blocks."
- :group 'org-babel
- :version "24.1"
- :type 'string)
-
(defun org-babel-expand-body:scheme (body params)
"Expand BODY according to PARAMS, return the expanded body."
(let ((vars (mapcar #'cdr (org-babel-get-header params :var))))
@@ -65,72 +63,127 @@
")\n" body ")")
body)))
-(defvar scheme-program-name)
+
+(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal)
+ "Map of scheme sessions to session names.")
+
+(defun org-babel-scheme-cleanse-repl-map ()
+ "Remove dead buffers from the REPL map."
+ (maphash
+ (lambda (x y)
+ (when (not (buffer-name y))
+ (remhash x org-babel-scheme-repl-map)))
+ org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-session-buffer (session-name)
+ "Look up the scheme buffer for a session; return nil if it doesn't exist."
+ (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions
+ (gethash session-name org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-set-session-buffer (session-name buffer)
+ "Record the scheme buffer used for a given session."
+ (puthash session-name buffer org-babel-scheme-repl-map))
+
+(defun org-babel-scheme-get-buffer-impl (buffer)
+ "Returns the scheme implementation geiser associates with the buffer."
+ (with-current-buffer (set-buffer buffer)
+ geiser-impl--implementation))
+
+(defun org-babel-scheme-get-repl (impl name)
+ "Switch to a scheme REPL, creating it if it doesn't exist:"
+ (let ((buffer (org-babel-scheme-get-session-buffer name)))
+ (or buffer
+ (progn
+ (run-geiser impl)
+ (if name
+ (progn
+ (rename-buffer name t)
+ (org-babel-scheme-set-session-buffer name (current-buffer))))
+ (current-buffer)))))
+
+(defun org-babel-scheme-make-session-name (buffer name impl)
+ "Generate a name for the session buffer.
+
+For a named session, the buffer name will be the session name.
+
+If the session is unnamed (nil), generate a name.
+
+If the session is 'none', use nil for the session name, and
+org-babel-scheme-execute-with-geiser will use a temporary session."
+ (let ((result
+ (cond ((not name)
+ (concat buffer " " (symbol-name impl) " REPL"))
+ ((string= name "none") nil)
+ (name))))
+ result))
+
+(defun org-babel-scheme-execute-with-geiser (code output impl repl)
+ "Execute code in specified REPL. If the REPL doesn't exist, create it
+using the given scheme implementation.
+
+Returns the output of executing the code if the output parameter
+is true; otherwise returns the last value."
+ (let ((result nil))
+ (with-temp-buffer
+ (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl))
+ (newline)
+ (insert (if output
+ (format "(with-output-to-string (lambda () %s))" code)
+ code))
+ (geiser-mode)
+ (let ((repl-buffer (save-current-buffer
+ (org-babel-scheme-get-repl impl repl))))
+ (when (not (eq impl (org-babel-scheme-get-buffer-impl
+ (current-buffer))))
+ (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl)
+ (org-babel-scheme-get-buffer-impl (current-buffer))
+ (symbolp (org-babel-scheme-get-buffer-impl
+ (current-buffer)))))
+ (setq geiser-repl--repl repl-buffer)
+ (setq geiser-impl--implementation nil)
+ (geiser-eval-region (point-min) (point-max))
+ (setq result
+ (if (equal (substring (current-message) 0 3) "=> ")
+ (replace-regexp-in-string "^=> " "" (current-message))
+ "\"An error occurred.\""))
+ (when (not repl)
+ (save-current-buffer (set-buffer repl-buffer)
+ (geiser-repl-exit))
+ (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil)
+ (kill-buffer repl-buffer))
+ (setq result (if (or (string= result "#<void>")
+ (string= result "#<unspecified>"))
+ nil
+ (read result)))))
+ result))
+
(defun org-babel-execute:scheme (body params)
"Execute a block of Scheme code with org-babel.
This function is called by `org-babel-execute-src-block'"
- (let* ((result-type (cdr (assoc :result-type params)))
- (org-babel-scheme-cmd (or (cdr (assoc :scheme params))
- org-babel-scheme-cmd))
- (full-body (org-babel-expand-body:scheme body params))
- (result (if (not (string= (cdr (assoc :session params)) "none"))
- ;; session evaluation
- (let ((session (org-babel-prep-session:scheme
- (cdr (assoc :session params)) params)))
- (org-babel-comint-with-output
- (session (format "%S" org-babel-scheme-eoe) t body)
- (mapc
- (lambda (line)
- (insert (org-babel-chomp line))
- (comint-send-input nil t))
- (list body (format "%S" org-babel-scheme-eoe)))))
- ;; external evaluation
- (let ((script-file (org-babel-temp-file "scheme-script-")))
- (with-temp-file script-file
- (insert
- ;; return the value or the output
- (if (string= result-type "value")
- (format "(display %s)" full-body)
- full-body)))
- (org-babel-eval
- (format "%s %s" org-babel-scheme-cmd
- (org-babel-process-file-name script-file)) "")))))
- (org-babel-result-cond (cdr (assoc :result-params params))
- result (read result))))
-
-(defun org-babel-prep-session:scheme (session params)
- "Prepare SESSION according to the header arguments specified in PARAMS."
- (let* ((session (org-babel-scheme-initiate-session session))
- (vars (mapcar #'cdr (org-babel-get-header params :var)))
- (var-lines
- (mapcar
- (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var)))))
- vars)))
- (when session
- (org-babel-comint-in-buffer session
- (sit-for .5) (goto-char (point-max))
- (mapc (lambda (var)
- (insert var) (comint-send-input nil t)
- (org-babel-comint-wait-for-output session)
- (sit-for .1) (goto-char (point-max))) var-lines)))
- session))
-
-(defun org-babel-scheme-initiate-session (&optional session)
- "If there is not a current inferior-process-buffer in SESSION
-then create. Return the initialized session."
- (require 'cmuscheme)
- (unless (string= session "none")
- (let ((session-buffer (save-window-excursion
- (run-scheme org-babel-scheme-cmd)
- (rename-buffer session)
- (current-buffer))))
- (if (org-babel-comint-buffer-livep session-buffer)
- (progn (sit-for .25) session-buffer)
- (sit-for .5)
- (org-babel-scheme-initiate-session session)))))
+ (let* ((source-buffer (current-buffer))
+ (source-buffer-name (replace-regexp-in-string ;; zap surrounding *
+ "^ ?\\*\\([^*]+\\)\\*" "\\1"
+ (buffer-name source-buffer))))
+ (save-excursion
+ (org-babel-reassemble-table
+ (let* ((result-type (cdr (assoc :result-type params)))
+ (impl (or (when (cdr (assoc :scheme params))
+ (intern (cdr (assoc :scheme params))))
+ geiser-default-implementation
+ (car geiser-active-implementations)))
+ (session (org-babel-scheme-make-session-name
+ source-buffer-name (cdr (assoc :session params)) impl))
+ (full-body (org-babel-expand-body:scheme body params)))
+ (org-babel-scheme-execute-with-geiser
+ full-body ; code
+ (string= result-type "output") ; output?
+ impl ; implementation
+ (and (not (string= session "none")) session))) ; session
+ (org-babel-pick-name (cdr (assoc :colname-names params))
+ (cdr (assoc :colnames params)))
+ (org-babel-pick-name (cdr (assoc :rowname-names params))
+ (cdr (assoc :rownames params)))))))
(provide 'ob-scheme)
-
-
;;; ob-scheme.el ends here
diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el
index 7eda1b5..ec1306b 100644
--- a/lisp/ob-sh.el
+++ b/lisp/ob-sh.el
@@ -106,7 +106,7 @@ var of the same value."
"Convert an elisp value to a string."
(let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v)))))
(cond
- ((and (listp var) (or (listp (car var)) 'hline))
+ ((and (listp var) (or (listp (car var)) (equal (car var) 'hline)))
(orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var)))
((listp var)
(mapconcat echo-var var "\n"))
diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el
index a41580f..dc6313d 100644
--- a/lisp/ob-shen.el
+++ b/lisp/ob-shen.el
@@ -36,6 +36,7 @@
(require 'ob)
(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go))
+(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var))
(defvar org-babel-default-header-args:shen '()
"Default header arguments for shen code blocks.")
diff --git a/lisp/ob-table.el b/lisp/ob-table.el
index 869d992..8b3e36d 100644
--- a/lisp/ob-table.el
+++ b/lisp/ob-table.el
@@ -97,9 +97,11 @@ as shown in the example below.
(lambda (el)
(if (eq '$ el)
(prog1 nil (setq quote t))
- (prog1 (if quote
- (format "\"%s\"" el)
- (org-no-properties el))
+ (prog1
+ (cond
+ (quote (format "\"%s\"" el))
+ ((stringp el) (org-no-properties el))
+ (t el))
(setq quote nil))))
(cdr var)))))
variables)))
diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el
index f15567f..8141943 100644
--- a/lisp/ob-tangle.el
+++ b/lisp/ob-tangle.el
@@ -30,7 +30,10 @@
(eval-when-compile
(require 'cl))
+(declare-function org-edit-special "org" (&optional arg))
(declare-function org-link-escape "org" (text &optional table))
+(declare-function org-store-link "org" (arg))
+(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer))
(declare-function org-heading-components "org" ())
(declare-function org-back-to-heading "org" (invisible-ok))
(declare-function org-fill-template "org" (template alist))
@@ -111,7 +114,7 @@ result. The default value is `org-babel-trim'."
(defun org-babel-find-file-noselect-refresh (file)
"Find file ensuring that the latest changes on disk are
represented in the file."
- (find-file-noselect file)
+ (find-file-noselect file 'nowarn)
(with-current-buffer (get-file-buffer file)
(revert-buffer t t t)))
@@ -185,7 +188,7 @@ used to limit the exported source code blocks by language."
org-babel-default-header-args))
(tangle-file
(when (equal arg '(16))
- (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info))))
+ (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light))))
(user-error "Point is not in a source code block"))))
path-collector)
(mapc ;; map over all languages
@@ -207,6 +210,7 @@ used to limit the exported source code blocks by language."
(let* ((tangle (funcall get-spec :tangle))
(she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb))
(funcall get-spec :shebang)))
+ (tangle-mode (funcall get-spec :tangle-mode))
(base-name (cond
((string= "yes" tangle)
(file-name-sans-extension
@@ -224,7 +228,7 @@ used to limit the exported source code blocks by language."
(make-directory (file-name-directory file-name) 'parents))
;; delete any old versions of file
(when (and (file-exists-p file-name)
- (not (member file-name path-collector)))
+ (not (member file-name (mapcar #'car path-collector))))
(delete-file file-name))
;; drop source-block to file
(with-temp-buffer
@@ -242,10 +246,14 @@ used to limit the exported source code blocks by language."
(insert content)
(write-region nil nil file-name))))
;; if files contain she-bangs, then make the executable
- (when she-bang (set-file-modes file-name #o755))
+ (when she-bang
+ (unless tangle-mode (setq tangle-mode #o755)))
;; update counter
(setq block-counter (+ 1 block-counter))
- (add-to-list 'path-collector file-name)))))
+ (add-to-list 'path-collector
+ (cons file-name tangle-mode)
+ nil
+ (lambda (a b) (equal (car a) (car b))))))))
specs)))
(if (equal arg '(4))
(org-babel-tangle-single-block 1 t)
@@ -253,15 +261,20 @@ used to limit the exported source code blocks by language."
(message "Tangled %d code block%s from %s" block-counter
(if (= block-counter 1) "" "s")
(file-name-nondirectory
- (buffer-file-name (or (buffer-base-buffer) (current-buffer)))))
+ (buffer-file-name
+ (or (buffer-base-buffer) (current-buffer)))))
;; run `org-babel-post-tangle-hook' in all tangled files
(when org-babel-post-tangle-hook
(mapc
(lambda (file)
(org-babel-with-temp-filebuffer file
(run-hooks 'org-babel-post-tangle-hook)))
- path-collector))
- path-collector))))
+ (mapcar #'car path-collector)))
+ ;; set permissions on tangled files
+ (mapc (lambda (pair)
+ (when (cdr pair) (set-file-modes (car pair) (cdr pair))))
+ path-collector)
+ (mapcar #'car path-collector)))))
(defun org-babel-tangle-clean ()
"Remove comments inserted by `org-babel-tangle'.
@@ -493,13 +506,15 @@ which enable the original code blocks to be found."
"Jump from a tangled code file to the related Org-mode file."
(interactive)
(let ((mid (point))
- start end done
+ start body-start end done
target-buffer target-char link path block-name body)
(save-window-excursion
(save-excursion
(while (and (re-search-backward org-bracket-link-analytic-regexp nil t)
(not ; ever wider searches until matching block comments
(and (setq start (point-at-eol))
+ (setq body-start (save-excursion
+ (forward-line 2) (point-at-bol)))
(setq link (match-string 0))
(setq path (match-string 3))
(setq block-name (match-string 5))
@@ -520,8 +535,19 @@ which enable the original code blocks to be found."
(org-babel-next-src-block
(string-to-number (match-string 1 block-name)))
(org-babel-goto-named-src-block block-name))
+ ;; position at the beginning of the code block body
+ (goto-char (org-babel-where-is-src-block-head))
+ (forward-line 1)
+ ;; Use org-edit-special to isolate the code.
+ (org-edit-special)
+ ;; Then move forward the correct number of characters in the
+ ;; code buffer.
+ (forward-char (- mid body-start))
+ ;; And return to the Org-mode buffer with the point in the right
+ ;; place.
+ (org-edit-src-exit)
(setq target-char (point)))
- (pop-to-buffer target-buffer)
+ (org-src-switch-to-buffer target-buffer t)
(prog1 body (goto-char target-char))))
(provide 'ob-tangle)
diff --git a/lisp/ob.el b/lisp/ob.el
index 6cacac7..827dd04 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -22,6 +22,8 @@
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Code:
+(require 'org-macs)
+(require 'org-compat)
(require 'ob-eval)
(require 'ob-core)
(require 'ob-comint)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 270a73d..8cfe858 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -227,7 +227,9 @@ As the value of this option simply gets inserted into the HTML <head> header,
you can \"misuse\" it to also add other text to the header."
:group 'org-agenda-export
:group 'org-export-html
- :type 'string)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-agenda-persistent-filter nil
"When set, keep filters from one agenda view to the next."
@@ -328,6 +330,7 @@ the daily/weekly agenda, see `org-agenda-skip-function'.")
(const org-agenda-span)
(choice (const :tag "Day" 'day)
(const :tag "Week" 'week)
+ (const :tag "Fortnight" 'fortnight)
(const :tag "Month" 'month)
(const :tag "Year" 'year)
(integer :tag "Custom")))
@@ -1124,7 +1127,8 @@ option will be ignored."
Should be 1 or 7.
Obsolete, see `org-agenda-span'."
:group 'org-agenda-daily/weekly
- :type 'integer)
+ :type '(choice (const nil)
+ (integer)))
(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
@@ -1135,6 +1139,7 @@ Custom commands can set this variable in the options section."
:group 'org-agenda-daily/weekly
:type '(choice (const :tag "Day" day)
(const :tag "Week" week)
+ (const :tag "Fortnight" fortnight)
(const :tag "Month" month)
(const :tag "Year" year)
(integer :tag "Custom")))
@@ -1729,9 +1734,7 @@ that passed since this item was scheduled first."
These entries are added to the agenda when pressing \"[\"."
:group 'org-agenda-line-format
:version "24.1"
- :type '(list
- (string :tag "Scheduled today ")
- (string :tag "Scheduled previously")))
+ :type 'string)
(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ")
"Text preceding deadline items in the agenda view.
@@ -1894,7 +1897,7 @@ returns a face, or nil if does not want to specify a face and let
the normal rules apply."
:group 'org-agenda-line-format
:version "24.1"
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-category-icon-alist nil
"Alist of category icon to be displayed in agenda views.
@@ -1976,7 +1979,7 @@ Note that for the purpose of tag filtering, only the lower-case version of
all tags will be considered, so that this function will only ever see
the lower-case version of all tags."
:group 'org-agenda
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-agenda-bulk-custom-functions nil
"Alist of characters and custom functions for bulk actions.
@@ -2334,7 +2337,11 @@ The following commands are available:
["Week View" org-agenda-week-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'week)
- :keys "v w (or just w)"]
+ :keys "v w"]
+ ["Fortnight View" org-agenda-fortnight-view
+ :active (org-agenda-check-type nil 'agenda)
+ :style radio :selected (eq org-agenda-current-span 'fortnight)
+ :keys "v f"]
["Month View" org-agenda-month-view
:active (org-agenda-check-type nil 'agenda)
:style radio :selected (eq org-agenda-current-span 'month)
@@ -4171,7 +4178,7 @@ items if they have an hour specification like [h]h:mm."
(sd (or start-day today))
(ndays (org-agenda-span-to-ndays span sd))
(org-agenda-start-on-weekday
- (if (eq ndays 7)
+ (if (or (eq ndays 7) (eq ndays 14))
org-agenda-start-on-weekday))
(thefiles (org-agenda-files nil 'ifmode))
(files thefiles)
@@ -4340,6 +4347,7 @@ items if they have an hour specification like [h]h:mm."
(cond ((symbolp n) n)
((= n 1) 'day)
((= n 7) 'week)
+ ((= n 14) 'fortnight)
(t n)))
(defun org-agenda-span-to-ndays (span &optional start-day)
@@ -4348,6 +4356,7 @@ START-DAY is an absolute time value."
(cond ((numberp span) span)
((eq span 'day) 1)
((eq span 'week) 7)
+ ((eq span 'fortnight) 14)
((eq span 'month)
(let ((date (calendar-gregorian-from-absolute start-day)))
(calendar-last-day-of-month (car date) (caddr date))))
@@ -7829,6 +7838,8 @@ With prefix ARG, go forward that many times the current span."
(setq sd (+ arg sd)))
((eq span 'week)
(setq sd (+ (* 7 arg) sd)))
+ ((eq span 'fortnight)
+ (setq sd (+ (* 14 arg) sd)))
((eq span 'month)
(setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
sd (calendar-absolute-from-gregorian greg2))
@@ -7858,7 +7869,7 @@ With prefix ARG, go backward that many times the current span."
(defun org-agenda-view-mode-dispatch ()
"Call one of the view mode commands."
(interactive)
- (message "View: [d]ay [w]eek [m]onth [y]ear [SPC]reset [q]uit/abort
+ (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
[a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
(let ((a (read-char-exclusive)))
@@ -7866,6 +7877,7 @@ With prefix ARG, go backward that many times the current span."
(?\ (call-interactively 'org-agenda-reset-view))
(?d (call-interactively 'org-agenda-day-view))
(?w (call-interactively 'org-agenda-week-view))
+ (?t (call-interactively 'org-agenda-fortnight-view))
(?m (call-interactively 'org-agenda-month-view))
(?y (call-interactively 'org-agenda-year-view))
(?l (call-interactively 'org-agenda-log-mode))
@@ -7904,6 +7916,15 @@ week 12 of year 2007. Years in the range 1938-2037 can also be
written as 2-digit years."
(interactive "P")
(org-agenda-change-time-span 'week iso-week))
+(defun org-agenda-fortnight-view (&optional iso-week)
+ "Switch to daily view for agenda.
+With argument ISO-WEEK, switch to the corresponding ISO week.
+If ISO-WEEK has more then 2 digits, only the last two encode the
+week. Any digits before this encode a year. So 200712 means
+week 12 of year 2007. Years in the range 1938-2037 can also be
+written as 2-digit years."
+ (interactive "P")
+ (org-agenda-change-time-span 'fortnight iso-week))
(defun org-agenda-month-view (&optional month)
"Switch to monthly view for agenda.
With argument MONTH, switch to that month."
@@ -7925,7 +7946,7 @@ written as 2-digit years."
(defun org-agenda-change-time-span (span &optional n)
"Change the agenda view to SPAN.
-SPAN may be `day', `week', `month', `year'."
+SPAN may be `day', `week', `fortnight', `month', `year'."
(org-agenda-check-type t 'agenda)
(let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
(curspan (nth 2 args)))
@@ -7946,7 +7967,7 @@ SPAN may be `day', `week', `month', `year'."
(defun org-agenda-compute-starting-span (sd span &optional n)
"Compute starting date for agenda.
-SPAN may be `day', `week', `month', `year'. The return value
+SPAN may be `day', `week', `fortnight', `month', `year'. The return value
is a cons cell with the starting date and the number of days,
so that the date SD will be in that range."
(let* ((greg (calendar-gregorian-from-absolute sd))
@@ -7959,7 +7980,7 @@ so that the date SD will be in that range."
(setq sd (+ (calendar-absolute-from-gregorian
(list mg 1 yg))
n -1))))
- ((eq span 'week)
+ ((or (eq span 'week) (eq span 'fortnight))
(let* ((nt (calendar-day-of-week
(calendar-gregorian-from-absolute sd)))
(d (if org-agenda-start-on-weekday
diff --git a/lisp/org-attach.el b/lisp/org-attach.el
index faefa6b..898d911 100644
--- a/lisp/org-attach.el
+++ b/lisp/org-attach.el
@@ -42,6 +42,8 @@
(require 'org-id)
(require 'org)
+(declare-function vc-git-root "vc-git" (file))
+
(defgroup org-attach nil
"Options concerning entry attachments in Org-mode."
:tag "Org Attach"
@@ -261,14 +263,15 @@ the ATTACH_DIR property) their own attachment directory."
(defun org-attach-commit ()
"Commit changes to git if `org-attach-directory' is properly initialized.
This checks for the existence of a \".git\" directory in that directory."
- (let ((dir (expand-file-name org-attach-directory))
- (changes 0))
- (when (file-exists-p (expand-file-name ".git" dir))
+ (let* ((dir (expand-file-name org-attach-directory))
+ (git-dir (vc-git-root dir))
+ (changes 0))
+ (when git-dir
(with-temp-buffer
(cd dir)
(let ((have-annex
(and org-attach-git-annex-cutoff
- (file-exists-p (expand-file-name ".git/annex" dir)))))
+ (file-exists-p (expand-file-name "annex" git-dir)))))
(dolist (new-or-modified
(split-string
(shell-command-to-string
diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el
index 39902c0..8d85335 100644
--- a/lisp/org-bibtex.el
+++ b/lisp/org-bibtex.el
@@ -224,7 +224,9 @@
For example setting to 'BIB_' would allow interoperability with fireforg."
:group 'org-bibtex
:version "24.1"
- :type 'string)
+ :type '(choice
+ (const nil)
+ (string)))
(defcustom org-bibtex-treat-headline-as-title t
"Treat headline text as title if title property is absent.
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index a4f0fd0..0a6e4e4 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -1267,8 +1267,11 @@ Of course, if exact position has been required, just put it there."
(save-restriction
(widen)
(goto-char pos)
- (with-demoted-errors
- (bookmark-set "org-capture-last-stored"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
(move-marker org-capture-last-stored-marker (point)))))))
(defun org-capture-narrow (beg end)
@@ -1734,11 +1737,15 @@ The template may still contain \"%?\" for cursor positioning."
(goto-char (match-beginning 0))
(let ((template-start (point)))
(forward-char 1)
- (let ((result (org-eval
- (org-capture--expand-keyword-in-embedded-elisp
- (read (current-buffer))))))
+ (let* ((sexp (read (current-buffer)))
+ (result (org-eval
+ (org-capture--expand-keyword-in-embedded-elisp sexp))))
(delete-region template-start (point))
- (insert result))))))
+ (when result
+ (if (stringp result)
+ (insert result)
+ (error "Capture template sexp `%s' must evaluate to string or nil"
+ sexp))))))))
(defun org-capture--expand-keyword-in-embedded-elisp (attr)
"Recursively replace capture link keywords in ATTR sexp.
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index fc619e0..9f22562 100644
--- a/lisp/org-clock.el
+++ b/lisp/org-clock.el
@@ -159,7 +159,7 @@ state to switch it to."
This is the string shown in the mode line when a clock is running.
The function is called with point at the beginning of the headline."
:group 'org-clock
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-clock-string-limit 0
"Maximum length of clock strings in the mode line. 0 means no limit."
@@ -263,6 +263,7 @@ The function or program will be called with the notification
string as argument."
:group 'org-clock
:type '(choice
+ (const nil)
(string :tag "Program")
(function :tag "Function")))
@@ -361,13 +362,13 @@ play with them."
"Format string for the total time cells."
:group 'org-clock
:version "24.1"
- :type 'boolean)
+ :type 'string)
(defcustom org-clock-file-time-cell-format "*%s*"
"Format string for the file time cells."
:group 'org-clock
:version "24.1"
- :type 'boolean)
+ :type 'string)
(defcustom org-clock-clocked-in-display 'mode-line
"When clocked in for a task, org-mode can display the current
@@ -1667,6 +1668,12 @@ Optional argument N tells to change by that many units."
(message "Clock canceled")
(run-hooks 'org-clock-cancel-hook))
+(defcustom org-clock-goto-before-context 2
+ "Number of lines of context to display before currently clocked-in entry.
+This applies when using `org-clock-goto'."
+ :group 'org-clock
+ :type 'integer)
+
;;;###autoload
(defun org-clock-goto (&optional select)
"Go to the currently clocked-in entry, or to the most recently clocked one.
@@ -1690,7 +1697,7 @@ With prefix arg SELECT, offer recently clocked tasks for selection."
(org-show-entry)
(org-back-to-heading t)
(org-cycle-hide-drawers 'children)
- (recenter)
+ (recenter org-clock-goto-before-context)
(org-reveal)
(if recent
(message "No running clock, this is the most recently clocked task"))
diff --git a/lisp/org-colview.el b/lisp/org-colview.el
index a98deec..8790ad4 100644
--- a/lisp/org-colview.el
+++ b/lisp/org-colview.el
@@ -169,8 +169,10 @@ This is the compiled version of the format.")
(get-text-property (point-at-bol) 'face))
'default))
(color (list :foreground (face-attribute ref-face :foreground)))
- (face (list color 'org-column ref-face))
- (face1 (list color 'org-agenda-column-dateline ref-face))
+ (font (list :height (face-attribute 'default :height)
+ :family (face-attribute 'default :family)))
+ (face (list color font 'org-column ref-face))
+ (face1 (list color font 'org-agenda-column-dateline ref-face))
(cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp))
pom property ass width f string ov column val modval s2 title calc)
;; Check if the entry is in another buffer.
@@ -1304,10 +1306,10 @@ PARAMS is a property list of parameters:
(if (eq 'hline x) x (cons "" x)))
tbl))
(setq tbl (append tbl (list (cons "/" (make-list nfields "<>"))))))
- (setq pos (point))
(when content-lines
(while (string-match "^#" (car content-lines))
(insert (pop content-lines) "\n")))
+ (setq pos (point))
(insert (org-listtable-to-string tbl))
(when (plist-get params :width)
(insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x)))
diff --git a/lisp/org-compat.el b/lisp/org-compat.el
index bd81f68..c4d15d8 100644
--- a/lisp/org-compat.el
+++ b/lisp/org-compat.el
@@ -113,18 +113,41 @@ any other entries, and any resulting duplicates will be removed entirely."
;;;; Emacs/XEmacs compatibility
-(defun org-defvaralias (new-alias base-variable &optional docstring)
- "Compatibility function for defvaralias.
+(eval-and-compile
+ (defun org-defvaralias (new-alias base-variable &optional docstring)
+ "Compatibility function for defvaralias.
Don't do the aliasing when `defvaralias' is not bound."
- (declare (indent 1))
- (when (fboundp 'defvaralias)
- (defvaralias new-alias base-variable docstring)))
+ (declare (indent 1))
+ (when (fboundp 'defvaralias)
+ (defvaralias new-alias base-variable docstring)))
-(eval-and-compile
(when (and (not (boundp 'user-emacs-directory))
(boundp 'user-init-directory))
(org-defvaralias 'user-emacs-directory 'user-init-directory)))
+(when (featurep 'xemacs)
+ (defadvice custom-handle-keyword
+ (around org-custom-handle-keyword
+ activate preactivate)
+ "Remove custom keywords not recognized to avoid producing an error."
+ (cond
+ ((eq (ad-get-arg 1) :package-version))
+ (t ad-do-it)))
+ (defadvice define-obsolete-variable-alias
+ (around org-define-obsolete-variable-alias
+ (obsolete-name current-name &optional when docstring)
+ activate preactivate)
+ "Declare arguments defined in later versions of Emacs."
+ ad-do-it)
+ (defadvice define-obsolete-function-alias
+ (around org-define-obsolete-function-alias
+ (obsolete-name current-name &optional when docstring)
+ activate preactivate)
+ "Declare arguments defined in later versions of Emacs."
+ ad-do-it)
+ (defvar customize-package-emacs-version-alist nil)
+ (defvar temporary-file-directory (temp-directory)))
+
;; Keys
(defconst org-xemacs-key-equivalents
'(([mouse-1] . [button1])
@@ -313,9 +336,12 @@ Works on both Emacs and XEmacs."
(indent-line-to column)))
(defun org-move-to-column (column &optional force buffer)
- (if (featurep 'xemacs)
- (org-xemacs-without-invisibility (move-to-column column force buffer))
- (move-to-column column force)))
+ ;; set buffer-invisibility-spec to nil so that move-to-column
+ ;; does the right thing despite the presence of invisible text.
+ (let ((buffer-invisibility-spec nil))
+ (if (featurep 'xemacs)
+ (org-xemacs-without-invisibility (move-to-column column force buffer))
+ (move-to-column column force))))
(defun org-get-x-clipboard-compat (value)
"Get the clipboard value on XEmacs or Emacs 21."
@@ -390,11 +416,11 @@ TIME defaults to the current time."
"Suppress popup windows.
Let-bind some variables to nil around BODY to achieve the desired
effect, which variables to use depends on the Emacs version."
- (if (org-version-check "24.2.50" "" :predicate)
- `(let (pop-up-frames display-buffer-alist)
- ,@body)
- `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
- ,@body)))
+ (if (org-version-check "24.2.50" "" :predicate)
+ `(let (pop-up-frames display-buffer-alist)
+ ,@body)
+ `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function)
+ ,@body)))
(if (fboundp 'string-match-p)
(defalias 'org-string-match-p 'string-match-p)
diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el
index 833c1dd..9d8ed6c 100644
--- a/lisp/org-ctags.el
+++ b/lisp/org-ctags.el
@@ -131,7 +131,7 @@
;;
;; (progn
;; (message "-- rebuilding tags tables...")
-;; (mapc 'org-create-tags tags-table-list))
+;; (mapc 'org-ctags-create-tags tags-table-list))
;;; Code:
@@ -156,11 +156,8 @@ Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/
See the ctags documentation for more information.")
(defcustom org-ctags-path-to-ctags
- (case system-type
- (windows-nt "ctags.exe")
- (darwin "ctags-exuberant")
- (t "ctags-exuberant"))
- "Full path to the ctags executable file."
+ (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags")
+ "Name of the ctags executable file."
:group 'org-ctags
:version "24.1"
:type 'file)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 3cf87b2..807fdb4 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -683,9 +683,12 @@ Assume point is at the beginning of the footnote definition."
"^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
(match-beginning 0)
(point))))
- (contents-begin (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" ending)
- (and (/= (point) ending) (point))))
+ (contents-begin (progn
+ (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (cond ((= (point) ending) nil)
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
(contents-end (and contents-begin ending))
(end (progn (goto-char ending)
(skip-chars-forward " \r\t\n" limit)
@@ -1151,6 +1154,90 @@ CONTENTS is the contents of the element."
;;;; Plain List
+(defun org-element--list-struct (limit)
+ ;; Return structure of list at point. Internal function. See
+ ;; `org-list-struct' for details.
+ (let ((case-fold-search t)
+ (top-ind limit)
+ (item-re (org-item-re))
+ (drawers-re (concat ":\\("
+ (mapconcat 'regexp-quote org-drawers "\\|")
+ "\\):[ \t]*$"))
+ (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
+ items struct)
+ (save-excursion
+ (catch 'exit
+ (while t
+ (cond
+ ;; At limit: end all items.
+ ((>= (point) limit)
+ (throw 'exit
+ (let ((end (progn (skip-chars-backward " \r\t\n")
+ (forward-line)
+ (point))))
+ (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) end)))))
+ ;; At list end: end all items.
+ ((looking-at org-list-end-re)
+ (throw 'exit (dolist (item items (sort (nconc items struct)
+ 'car-less-than-car))
+ (setcar (nthcdr 6 item) (point)))))
+ ;; At a new item: end previous sibling.
+ ((looking-at item-re)
+ (let ((ind (save-excursion (skip-chars-forward " \t")
+ (current-column))))
+ (setq top-ind (min top-ind ind))
+ (while (and items (<= ind (nth 1 (car items))))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (point))
+ (push item struct)))
+ (push (progn (looking-at org-list-full-item-re)
+ (let ((bullet (match-string-no-properties 1)))
+ (list (point)
+ ind
+ bullet
+ (match-string-no-properties 2) ; counter
+ (match-string-no-properties 3) ; checkbox
+ ;; Description tag.
+ (and (save-match-data
+ (string-match "[-+*]" bullet))
+ (match-string-no-properties 4))
+ ;; Ending position, unknown so far.
+ nil)))
+ items))
+ (forward-line 1))
+ ;; Skip empty lines.
+ ((looking-at "^[ \t]*$") (forward-line))
+ ;; Skip inline tasks and blank lines along the way.
+ ((and inlinetask-re (looking-at inlinetask-re))
+ (forward-line)
+ (let ((origin (point)))
+ (when (re-search-forward inlinetask-re limit t)
+ (if (looking-at "^\\*+ END[ \t]*$") (forward-line)
+ (goto-char origin)))))
+ ;; At some text line. Check if it ends any previous item.
+ (t
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (when (<= ind top-ind)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (while (<= ind (nth 1 (car items)))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (line-beginning-position))
+ (push item struct)
+ (unless items
+ (throw 'exit (sort struct 'car-less-than-car))))))
+ ;; Skip blocks (any type) and drawers contents.
+ (cond
+ ((and (looking-at "#\\+BEGIN\\(:[ \t]*$\\|_\\S-\\)+")
+ (re-search-forward
+ (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
+ limit t)))
+ ((and (looking-at drawers-re)
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
+ (forward-line))))))))
+
(defun org-element-plain-list-parser (limit affiliated structure)
"Parse a plain list.
@@ -1167,9 +1254,8 @@ containing `:type', `:begin', `:end', `:contents-begin' and
Assume point is at the beginning of the list."
(save-excursion
- (let* ((struct (or structure (org-list-struct)))
+ (let* ((struct (or structure (org-element--list-struct limit)))
(prevs (org-list-prevs-alist struct))
- (parents (org-list-parents-alist struct))
(type (org-list-get-list-type (point) struct prevs))
(contents-begin (point))
(begin (car affiliated))
@@ -2015,11 +2101,11 @@ Return a list whose CAR is `node-property' and CDR is a plist
containing `:key', `:value', `:begin', `:end' and `:post-blank'
keywords."
(save-excursion
+ (looking-at org-property-re)
(let ((case-fold-search t)
(begin (point))
- (key (progn (looking-at "[ \t]*:\\(.*?\\):[ \t]+\\(.*?\\)[ \t]*$")
- (org-match-string-no-properties 1)))
- (value (org-match-string-no-properties 2))
+ (key (org-match-string-no-properties 2))
+ (value (org-match-string-no-properties 3))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (point-at-bol)))))
@@ -2089,20 +2175,21 @@ Assume point is at the beginning of the paragraph."
(re-search-forward
"^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Stop at valid blocks.
- (and (looking-at
- "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid latex environments.
(and (looking-at
- "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
+ "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
(save-excursion
(re-search-forward
(format "^[ \t]*\\\\end{%s}[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid keywords.
(looking-at "[ \t]*#\\+\\S-+:")
@@ -2560,17 +2647,15 @@ Assume point is at the first star marker."
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor (limit)
+(defun org-element-text-markup-successor ()
"Search for the next text-markup object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is a symbol among `bold',
`italic', `underline', `strike-through', `code' and `verbatim'
and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re limit t)
+ (when (re-search-forward org-emph-re nil t)
(let ((marker (match-string 3)))
(cons (cond
((equal marker "*") 'bold)
@@ -2652,11 +2737,9 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor (limit)
+(defun org-element-latex-or-entity-successor ()
"Search for the next latex-fragment or entity object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `entity' or
`latex-fragment' and CDR is beginning position."
(save-excursion
@@ -2670,7 +2753,7 @@ Return value is a cons cell whose CAR is `entity' or
(concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
matchers "\\|")
"\\|" entity-re)
- limit t)
+ nil t)
(goto-char (match-beginning 0))
(if (looking-at entity-re)
;; Determine if it's a real entity or a LaTeX command.
@@ -2722,18 +2805,16 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor (limit)
+(defun org-element-export-snippet-successor ()
"Search for the next export-snippet object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `export-snippet' and CDR
its beginning position."
(save-excursion
(let (beg)
- (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
(setq beg (match-beginning 0))
- (search-forward "@@" limit t))
+ (search-forward "@@" nil t))
(cons 'export-snippet beg)))))
@@ -2789,21 +2870,19 @@ CONTENTS is nil."
(concat ":" (org-element-interpret-data inline-def))))))
(format "[%s]" (concat label def))))
-(defun org-element-footnote-reference-successor (limit)
+(defun org-element-footnote-reference-successor ()
"Search for the next footnote-reference object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `footnote-reference' and
CDR is beginning position."
(save-excursion
(catch 'exit
- (while (re-search-forward org-footnote-re limit t)
+ (while (re-search-forward org-footnote-re nil t)
(save-excursion
(let ((beg (match-beginning 0))
(count 1))
(backward-char)
- (while (re-search-forward "[][]" limit t)
+ (while (re-search-forward "[][]" nil t)
(if (equal (match-string 0) "[") (incf count) (decf count))
(when (zerop count)
(throw 'exit (cons 'footnote-reference beg))))))))))
@@ -2846,11 +2925,9 @@ CONTENTS is nil."
main-source)
(and post-options (format "[%s]" post-options)))))
-(defun org-element-inline-babel-call-successor (limit)
+(defun org-element-inline-babel-call-successor ()
"Search for the next inline-babel-call object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
@@ -2858,7 +2935,7 @@ CDR is beginning position."
;; `org-babel-inline-lob-one-liner-regexp'.
(when (re-search-forward
"call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
- limit t)
+ nil t)
(cons 'inline-babel-call (match-beginning 0)))))
@@ -2867,8 +2944,6 @@ CDR is beginning position."
(defun org-element-inline-src-block-parser ()
"Parse inline source block at point.
-LIMIT bounds the search.
-
Return a list whose CAR is `inline-src-block' and CDR a plist
with `:begin', `:end', `:language', `:value', `:parameters' and
`:post-blank' as keywords.
@@ -2903,16 +2978,14 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor (limit)
+(defun org-element-inline-src-block-successor ()
"Search for the next inline-babel-call element.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-babel-inline-src-block-regexp limit t)
+ (when (re-search-forward org-babel-inline-src-block-regexp nil t)
(cons 'inline-src-block (match-beginning 1)))))
;;;; Italic
@@ -3006,15 +3079,13 @@ Assume point is at the beginning of the line break."
CONTENTS is nil."
"\\\\\n")
-(defun org-element-line-break-successor (limit)
+(defun org-element-line-break-successor ()
"Search for the next line-break object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `line-break' and CDR is
beginning position."
(save-excursion
- (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
(goto-char (match-beginning 1)))))
;; A line break can only happen on a non-empty line.
(when (and beg (re-search-backward "\\S-" (point-at-bol) t))
@@ -3127,28 +3198,24 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor (limit)
+(defun org-element-link-successor ()
"Search for the next link object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
(save-excursion
(let ((link-regexp
(if (not org-target-link-regexp) org-any-link-re
(concat org-any-link-re "\\|" org-target-link-regexp))))
- (when (re-search-forward link-regexp limit t)
+ (when (re-search-forward link-regexp nil t)
(cons 'link (match-beginning 0))))))
-(defun org-element-plain-link-successor (limit)
+(defun org-element-plain-link-successor ()
"Search for the next plain link object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
- (and (save-excursion (re-search-forward org-plain-link-re limit t))
+ (and (save-excursion (re-search-forward org-plain-link-re nil t))
(cons 'link (match-beginning 0))))
@@ -3196,17 +3263,15 @@ Assume point is at the macro."
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor (limit)
+(defun org-element-macro-successor ()
"Search for the next macro object.
-LIMIT bounds the search.
-
Return value is cons cell whose CAR is `macro' and CDR is
beginning position."
(save-excursion
(when (re-search-forward
"{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- limit t)
+ nil t)
(cons 'macro (match-beginning 0)))))
@@ -3242,15 +3307,13 @@ Assume point is at the radio target."
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor (limit)
+(defun org-element-radio-target-successor ()
"Search for the next radio-target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `radio-target' and CDR
is beginning position."
(save-excursion
- (when (re-search-forward org-radio-target-regexp limit t)
+ (when (re-search-forward org-radio-target-regexp nil t)
(cons 'radio-target (match-beginning 0)))))
@@ -3282,15 +3345,13 @@ Assume point is at the beginning of the statistics-cookie."
CONTENTS is nil."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor (limit)
+(defun org-element-statistics-cookie-successor ()
"Search for the next statistics cookie object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `statistics-cookie' and
CDR is beginning position."
(save-excursion
- (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
(cons 'statistics-cookie (match-beginning 0)))))
@@ -3363,16 +3424,14 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor (limit)
+(defun org-element-sub/superscript-successor ()
"Search for the next sub/superscript object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is either `subscript' or
`superscript' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp limit t)
+ (when (re-search-forward org-match-substring-regexp nil t)
(cons (if (string= (match-string 2) "_") 'subscript 'superscript)
(match-beginning 2)))))
@@ -3439,11 +3498,9 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor (limit)
+(defun org-element-table-cell-successor ()
"Search for the next table-cell object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `table-cell' and CDR is
beginning position."
(when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point))))
@@ -3476,15 +3533,13 @@ Assume point is at the target."
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor (limit)
+(defun org-element-target-successor ()
"Search for the next target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `target' and CDR is
beginning position."
(save-excursion
- (when (re-search-forward org-target-regexp limit t)
+ (when (re-search-forward org-target-regexp nil t)
(cons 'target (match-beginning 0)))))
@@ -3662,11 +3717,9 @@ CONTENTS is nil."
(eq type 'active-range)
(and hour-end minute-end)))))))))
-(defun org-element-timestamp-successor (limit)
+(defun org-element-timestamp-successor ()
"Search for the next timestamp object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `timestamp' and CDR is
beginning position."
(save-excursion
@@ -3676,7 +3729,7 @@ beginning position."
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
"\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- limit t)
+ nil t)
(cons 'timestamp (match-beginning 0)))))
@@ -3758,14 +3811,14 @@ CONTENTS is nil."
(limit &optional granularity special structure)
"Parse the element starting at point.
-LIMIT bounds the search.
-
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
element.
Possible types are defined in `org-element-all-elements'.
+LIMIT bounds the search.
+
Optional argument GRANULARITY determines the depth of the
recursion. Allowed values are `headline', `greater-element',
`element', `object' or nil. When it is broader than `object' (or
@@ -3875,7 +3928,8 @@ element it has to parse."
;; List.
((looking-at (org-item-re))
(org-element-plain-list-parser
- limit affiliated (or structure (org-list-struct))))
+ limit affiliated
+ (or structure (org-element--list-struct limit))))
;; Default element: Paragraph.
(t (org-element-paragraph-parser limit affiliated)))))))))
@@ -4314,57 +4368,56 @@ RESTRICTION is a list of object successors which are allowed in
the current object."
(let ((candidates 'initial))
(save-excursion
- (goto-char beg)
- (while (and (< (point) end)
- (setq candidates (org-element--get-next-object-candidates
- end restriction candidates)))
- (let ((next-object
- (let ((pos (apply 'min (mapcar 'cdr candidates))))
- (save-excursion
- (goto-char pos)
- (funcall (intern (format "org-element-%s-parser"
- (car (rassq pos candidates)))))))))
- ;; 1. Text before any object. Untabify it.
- (let ((obj-beg (org-element-property :begin next-object)))
- (unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
- (let ((obj-end (org-element-property :end next-object))
- (cont-beg (org-element-property :contents-begin next-object)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (save-restriction
- (narrow-to-region
- cont-beg
- (org-element-property :contents-end next-object))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates)))
+ (let ((next-object
+ (let ((pos (apply 'min (mapcar 'cdr candidates))))
+ (save-excursion
+ (goto-char pos)
+ (funcall (intern (format "org-element-%s-parser"
+ (car (rassq pos candidates)))))))))
+ ;; 1. Text before any object. Untabify it.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) obj-beg))))))
+ ;; 2. Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ ;; Fill contents of NEXT-OBJECT by side-effect, if it has
+ ;; a recursive type.
+ (when (and cont-beg
+ (memq (car next-object) org-element-recursive-objects))
(org-element--parse-objects
- (point-min) (point-max) next-object
- (org-element-restriction next-object))))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
- (unless (= (point) end)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc)))
-
-(defun org-element--get-next-object-candidates (limit restriction objects)
+ cont-beg (org-element-property :contents-end next-object)
+ next-object (org-element-restriction next-object)))
+ (setq acc (org-element-adopt-elements acc next-object))
+ (goto-char obj-end))))
+ ;; 3. Text after last object. Untabify it.
+ (unless (eobp)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) end)))))
+ ;; Result.
+ acc))))
+
+(defun org-element--get-next-object-candidates (restriction objects)
"Return an alist of candidates for the next object.
-LIMIT bounds the search, and RESTRICTION narrows candidates to
-some object successors.
+RESTRICTION is a list of object types, as symbols. Only
+candidates with such types are looked after.
OBJECTS is the previous candidates alist. If it is set to
`initial', no search has been done before, and all symbols in
@@ -4379,7 +4432,7 @@ beginning position."
;; allowed in RESTRICTION.
(mapcar
(lambda (res)
- (funcall (intern (format "org-element-%s-successor" res)) limit))
+ (funcall (intern (format "org-element-%s-successor" res))))
restriction)
;; Focus on objects returned during last search. Keep those
;; still after point. Search again objects before it.
@@ -4390,8 +4443,7 @@ beginning position."
(succ (or (cdr (assq type org-element-object-successor-alist))
type)))
(and succ
- (funcall (intern (format "org-element-%s-successor" succ))
- limit)))))
+ (funcall (intern (format "org-element-%s-successor" succ)))))))
objects))))
@@ -4683,11 +4735,12 @@ first element of current section."
(org-back-to-heading)
(forward-line)
(org-skip-whitespace)
- (when (> (line-beginning-position) origin)
+ (when (or (eobp) (> (line-beginning-position) origin))
;; In blank lines just after the headline, point still
;; belongs to the headline.
(throw 'exit
- (progn (org-back-to-heading)
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
(if (not keep-trail)
(org-element-headline-parser (point-max) t)
(list (org-element-headline-parser
@@ -4728,11 +4781,18 @@ first element of current section."
;; into elements with an explicit ending, but
;; return that element instead.
(and (= cend origin)
- (memq type
- '(center-block
- drawer dynamic-block inlinetask item
- plain-list property-drawer quote-block
- special-block))))
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at the
+ ;; end of a buffer without a final new
+ ;; line, return last element in last
+ ;; item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type
@@ -4763,103 +4823,109 @@ object type, but always include `:begin', `:end', `:parent' and
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation."
- (org-with-wide-buffer
- (let* ((origin (point))
- (element (or element (org-element-at-point)))
- (type (org-element-type element))
- end)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, move to beginning of the
- ;; element or secondary string and set END to the other side.
- (if (not (or (let ((post (org-element-property :post-affiliated element)))
- (and post (> post origin)
- (< (org-element-property :begin element) origin)
- (progn (beginning-of-line)
- (looking-at org-element--affiliated-re)
- (member (upcase (match-string 1))
- org-element-parsed-keywords))
- ;; We're at an affiliated keyword. Change
- ;; type to retrieve correct restrictions.
- (setq type 'keyword)
- ;; Determine if we're at main or dual value.
- (if (and (match-end 2) (<= origin (match-end 2)))
- (progn (goto-char (match-beginning 2))
- (setq end (match-end 2)))
- (goto-char (match-end 0))
- (setq end (line-end-position)))))
- (and (eq type 'item)
- (let ((tag (org-element-property :tag element)))
- (and tag
- (progn
- (beginning-of-line)
- (search-forward tag (point-at-eol))
- (goto-char (match-beginning 0))
- (and (>= origin (point))
- (<= origin
- ;; `1+' is required so some
- ;; successors can match
- ;; properly their object.
- (setq end (1+ (match-end 0)))))))))
- (and (memq type '(headline inlinetask))
- (progn (beginning-of-line)
- (skip-chars-forward "* ")
- (setq end (point-at-eol))))
- (and (memq type '(paragraph table-row verse-block))
- (let ((cbeg (org-element-property
- :contents-begin element))
- (cend (org-element-property
- :contents-end element)))
- (and cbeg cend ; cbeg is nil for table rules
- (>= origin cbeg)
- (<= origin cend)
- (progn (goto-char cbeg) (setq end cend)))))
- (and (eq type 'keyword)
- (let ((key (org-element-property :key element)))
- (and (member key org-element-document-properties)
- (progn (beginning-of-line)
- (search-forward key (line-end-position) t)
- (forward-char)
- (setq end (line-end-position))))))))
- element
+ (catch 'objects-forbidden
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ context)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, narrow buffer to the
+ ;; containing area. Otherwise, return ELEMENT.
+ (cond
+ ;; At a parsed affiliated keyword, check if we're inside main
+ ;; or dual value.
+ ((let ((post (org-element-property :post-affiliated element)))
+ (and post (< origin post)))
+ (beginning-of-line)
+ (looking-at org-element--affiliated-re)
+ (cond
+ ((not (member (upcase (match-string 1)) org-element-parsed-keywords))
+ (throw 'objects-forbidden element))
+ ((< (match-end 0) origin)
+ (narrow-to-region (match-end 0) (line-end-position)))
+ ((and (match-beginning 2)
+ (>= origin (match-beginning 2))
+ (< origin (match-end 2)))
+ (narrow-to-region (match-beginning 2) (match-end 2)))
+ (t (throw 'objects-forbidden element)))
+ ;; Also change type to retrieve correct restrictions.
+ (setq type 'keyword))
+ ;; At an item, objects can only be located within tag, if any.
+ ((eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (if (not tag) (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward tag (line-end-position))
+ (goto-char (match-beginning 0))
+ (if (and (>= origin (point)) (< origin (match-end 0)))
+ (narrow-to-region (point) (match-end 0))
+ (throw 'objects-forbidden element)))))
+ ;; At an headline or inlinetask, objects are located within
+ ;; their title.
+ ((memq type '(headline inlinetask))
+ (goto-char (org-element-property :begin element))
+ (skip-chars-forward "* ")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element)))
+ ;; At a paragraph, a table-row or a verse block, objects are
+ ;; located within their contents.
+ ((memq type '(paragraph table-row verse-block))
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ ;; CBEG is nil for table rules.
+ (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (narrow-to-region cbeg cend)
+ (throw 'objects-forbidden element))))
+ ;; At a parsed keyword, objects are located within value.
+ ((eq type 'keyword)
+ (if (not (member (org-element-property :key element)
+ org-element-document-properties))
+ (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward ":")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element))))
+ (t (throw 'objects-forbidden element)))
+ (goto-char (point-min))
(let ((restriction (org-element-restriction type))
- (parent element)
- (candidates 'initial))
- (catch 'exit
- (while (setq candidates (org-element--get-next-object-candidates
- end restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin)
- (if (/= obj-end end) (goto-char obj-end)
- (throw 'exit
- (org-element-put-property
- object :parent parent))))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (> cbeg origin) (< cend origin))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- candidates 'initial
- end cend)))))))
- parent))))))
+ (parent element)
+ (candidates 'initial))
+ (catch 'exit
+ (while (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates))
+ (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+ candidates)))
+ ;; If ORIGIN is before next object in element, there's
+ ;; no point in looking further.
+ (if (> (cdr closest-cand) origin) (throw 'exit parent)
+ (let* ((object
+ (progn (goto-char (cdr closest-cand))
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest-cand))))))
+ (cbeg (org-element-property :contents-begin object))
+ (cend (org-element-property :contents-end object))
+ (obj-end (org-element-property :end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive object or at
+ ;; an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (throw 'exit
+ (org-element-put-property object :parent parent)))
+ ;; Otherwise, move within current object and
+ ;; restrict search to the end of its contents.
+ (t (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (org-element-put-property object :parent parent)
+ (setq parent object
+ restriction (org-element-restriction object)
+ candidates 'initial)))))))
+ parent))))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
diff --git a/lisp/org-entities.el b/lisp/org-entities.el
index 019b6c8..638da78 100644
--- a/lisp/org-entities.el
+++ b/lisp/org-entities.el
@@ -154,6 +154,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("real" "\\Re" t "&real;" "R" "R" "ℜ")
("image" "\\Im" t "&image;" "I" "I" "ℑ")
("weierp" "\\wp" t "&weierp;" "P" "P" "℘")
+ ("ell" "\\ell" t "&ell;" "ell" "ell" "ℓ")
+ ("imath" "\\imath" t "&imath;" "[dotless i]" "dotless i" "ı")
+ ("jmath" "\\jmath" t "&jmath;" "[dotless j]" "dotless j" "ȷ")
"** Greek"
("Alpha" "A" nil "&Alpha;" "Alpha" "Alpha" "Α")
@@ -203,6 +206,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("upsilon" "\\upsilon" t "&upsilon;" "upsilon" "upsilon" "υ")
("Phi" "\\Phi" t "&Phi;" "Phi" "Phi" "Φ")
("phi" "\\phi" t "&phi;" "phi" "phi" "φ")
+ ("varphi" "\\varphi" t "&varphi;" "varphi" "varphi" "ɸ")
("Chi" "X" nil "&Chi;" "Chi" "Chi" "Χ")
("chi" "\\chi" t "&chi;" "chi" "chi" "χ")
("acutex" "\\acute x" t "&acute;x" "'x" "'x" "𝑥́")
@@ -212,10 +216,15 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("Omega" "\\Omega" t "&Omega;" "Omega" "Omega" "Ω")
("omega" "\\omega" t "&omega;" "omega" "omega" "ω")
("piv" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
+ ("varpi" "\\varpi" t "&piv;" "omega-pi" "omega-pi" "ϖ")
("partial" "\\partial" t "&part;" "[partial differential]" "[partial differential]" "∂")
"** Hebrew"
("alefsym" "\\aleph" t "&alefsym;" "aleph" "aleph" "ℵ")
+ ("aleph" "\\aleph" t "&aleph;" "aleph" "aleph" "ℵ")
+ ("gimel" "\\gimel" t "&gimel;" "gimel" "gimel" "ℷ")
+ ("beth" "\\beth" t "&beth;" "beth" "beth" "ב")
+ ("dalet" "\\daleth" t "&daleth;" "dalet" "dalet" "ד")
"** Dead languages"
("ETH" "\\DH{}" nil "&ETH;" "D" "Ð" "Ð")
@@ -226,6 +235,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
"* Punctuation"
"** Dots and Marks"
("dots" "\\dots{}" nil "&hellip;" "..." "..." "…")
+ ("cdots" "\\cdots{}" t "&ctdot;" "..." "..." "⋯")
("hellip" "\\dots{}" nil "&hellip;" "..." "..." "…")
("middot" "\\textperiodcentered{}" nil "&middot;" "." "·" "·")
("iexcl" "!`" nil "&iexcl;" "!" "¡" "¡")
@@ -253,20 +263,23 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
"* Other"
"** Misc. (often used)"
("circ" "\\^{}" nil "&circ;" "^" "^" "ˆ")
- ("vert" "\\vert{}" t "&#124;" "|" "|" "|")
+ ("vert" "\\vert{}" t "&vert;" "|" "|" "|")
("brvbar" "\\textbrokenbar{}" nil "&brvbar;" "|" "¦" "¦")
+ ("S" "\\S" nil "&sect;" "paragraph" "§" "§")
("sect" "\\S" nil "&sect;" "paragraph" "§" "§")
("amp" "\\&" nil "&amp;" "&" "&" "&")
("lt" "\\textless{}" nil "&lt;" "<" "<" "<")
("gt" "\\textgreater{}" nil "&gt;" ">" ">" ">")
- ("tilde" "\\~{}" nil "&tilde;" "~" "~" "~")
+ ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~")
("slash" "/" nil "/" "/" "/" "/")
("plus" "+" nil "+" "+" "+" "+")
("under" "\\_" nil "_" "_" "_" "_")
("equal" "=" nil "=" "=" "=" "=")
("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^")
("dagger" "\\textdagger{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
+ ("dag" "\\dag{}" nil "&dagger;" "[dagger]" "[dagger]" "†")
("Dagger" "\\textdaggerdbl{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
+ ("ddag" "\\ddag{}" nil "&Dagger;" "[doubledagger]" "[doubledagger]" "‡")
"** Whitespace"
("nbsp" "~" nil "&nbsp;" " " " " " ")
@@ -297,6 +310,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("plusmn" "\\textpm{}" nil "&plusmn;" "+-" "±" "±")
("times" "\\texttimes{}" nil "&times;" "*" "×" "×")
("frasl" "/" nil "&frasl;" "/" "/" "⁄")
+ ("colon" "\\colon" t ":" ":" ":" ":")
("div" "\\textdiv{}" nil "&divide;" "/" "÷" "÷")
("frac12" "\\textonehalf{}" nil "&frac12;" "1/2" "½" "½")
("frac14" "\\textonequarter{}" nil "&frac14;" "1/4" "¼" "¼")
@@ -326,7 +340,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("cap" "\\cap" t "&cap;" "[intersection]" "[intersection]" "∩")
("cup" "\\cup" t "&cup;" "[union]" "[union]" "∪")
("int" "\\int" t "&int;" "[integral]" "[integral]" "∫")
+ ("therefore" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
("there4" "\\therefore" t "&there4;" "[therefore]" "[therefore]" "∴")
+ ("because" "\\because" t "&because;" "[because]" "[because]" "∵")
("sim" "\\sim" t "&sim;" "~" "~" "∼")
("cong" "\\cong" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
("simeq" "\\simeq" t "&cong;" "[approx. equal to]" "[approx. equal to]" "≅")
@@ -335,8 +351,26 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("ne" "\\ne" t "&ne;" "[not equal to]" "[not equal to]" "≠")
("neq" "\\neq" t "&ne;" "[not equal to]" "[not equal to]" "≠")
("equiv" "\\equiv" t "&equiv;" "[identical to]" "[identical to]" "≡")
+
+ ("triangleq" "\\triangleq" t "&triangleq;" "[defined to]" "[defined to]" "≜")
("le" "\\le" t "&le;" "<=" "<=" "≤")
+ ("leq" "\\le" t "&le;" "<=" "<=" "≤")
("ge" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("geq" "\\ge" t "&ge;" ">=" ">=" "≥")
+ ("lessgtr" "\\lessgtr" t "&lessgtr;" "[less than or greater than]" "[less than or greater than]" "≶")
+ ("lesseqgtr" "\\lesseqgtr" t "&lesseqgtr;" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚")
+ ("ll" "\\ll" t "&Lt;" "<<" "<<" "≪")
+ ("Ll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("lll" "\lll" t "&Ll;" "<<<" "<<<" "⋘")
+ ("gg" "\\gg" t "&Gt;" ">>" ">>" "≫")
+ ("Gg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("ggg" "\\ggg" t "&Gg;" ">>>" ">>>" "⋙")
+ ("prec" "\\prec" t "&pr;" "[precedes]" "[precedes]" "≺")
+ ("preceq" "\\preceq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("preccurlyeq" "\\preccurlyeq" t "&prcue;" "[precedes or equal]" "[precedes or equal]" "≼")
+ ("succ" "\\succ" t "&sc;" "[succeeds]" "[succeeds]" "≻")
+ ("succeq" "\\succeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
+ ("succcurlyeq" "\\succcurlyeq" t "&sccue;" "[succeeds or equal]" "[succeeds or equal]" "≽")
("sub" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
("subset" "\\subset" t "&sub;" "[subset of]" "[subset of]" "⊂")
("sup" "\\supset" t "&sup;" "[superset of]" "[superset of]" "⊃")
@@ -345,9 +379,12 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("sube" "\\subseteq" t "&sube;" "[subset of or equal to]" "[subset of or equal to]" "⊆")
("nsup" "\\not\\supset" t "&nsup;" "[not a superset of]" "[not a superset of]" "⊅")
("supe" "\\supseteq" t "&supe;" "[superset of or equal to]" "[superset of or equal to]" "⊇")
+ ("setminus" "\\setminus" t "&setminus;" "\" "\" "⧵")
("forall" "\\forall" t "&forall;" "[for all]" "[for all]" "∀")
("exist" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
("exists" "\\exists" t "&exist;" "[there exists]" "[there exists]" "∃")
+ ("nexist" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
+ ("nexists" "\\nexists" t "&exist;" "[there does not exists]" "[there does not exists]" "∄")
("empty" "\\empty" t "&empty;" "[empty set]" "[empty set]" "∅")
("emptyset" "\\emptyset" t "&empty;" "[empty set]" "[empty set]" "∅")
("isin" "\\in" t "&isin;" "[element of]" "[element of]" "∈")
@@ -366,6 +403,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("rfloor" "\\rfloor" t "&rfloor;" "[right floor]" "[right floor]" "⌋")
("lang" "\\langle" t "&lang;" "<" "<" "⟨")
("rang" "\\rangle" t "&rang;" ">" ">" "⟩")
+ ("hbar" "\\hbar" t "&hbar;" "hbar" "hbar" "ℏ")
+ ("mho" "\\mho" t "&mho;" "mho" "mho" "℧")
"** Arrows"
("larr" "\\leftarrow" t "&larr;" "<-" "<-" "←")
@@ -436,7 +475,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ")
("oplus" "\\oplus" t "&oplus;" "[circled plus]" "[circled plus]" "⊕")
("otimes" "\\otimes" t "&otimes;" "[circled times]" "[circled times]" "⊗")
- ("checkmark" "\\checkmark" t "&#10003;" "[checkmark]" "[checkmark]" "✓")
+ ("check" "\\checkmark" t "&checkmark;" "[checkmark]" "[checkmark]" "✓")
+ ("checkmark" "\\checkmark" t "&check;" "[checkmark]" "[checkmark]" "✓")
"** Miscellaneous (seldom used)"
("para" "\\P{}" nil "&para;" "[pilcrow]" "¶" "¶")
@@ -451,7 +491,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("rlm" "" nil "&rlm;" "" "" "‏")
"** Smilies"
- ("smile" "\\smile" t "&#9786;" ":-)" ":-)" "⌣")
+ ("smile" "\\smile" t "&smile;" ":-)" ":-)" "⌣")
+ ("frown" "\\frown" t "&frown;" ":-(" ":-(" "⌢")
("smiley" "\\smiley{}" nil "&#9786;" ":-)" ":-)" "☺")
("blacksmile" "\\blacksmiley{}" nil "&#9787;" ":-)" ":-)" "☻")
("sad" "\\frownie{}" nil "&#9785;" ":-(" ":-(" "☹")
@@ -463,10 +504,11 @@ packages to be loaded, add these packages to `org-latex-packages-alist'."
("spadesuit" "\\spadesuit" t "&spades;" "[spades]" "[spades]" "♠")
("hearts" "\\heartsuit" t "&hearts;" "[hearts]" "[hearts]" "♥")
("heartsuit" "\\heartsuit" t "&heartsuit;" "[hearts]" "[hearts]" "♥")
- ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "♦")
- ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "♦")
- ("Diamond" "\\diamond" t "&diamond;" "[diamond]" "[diamond]" "⋄")
- ("loz" "\\diamond" t "&loz;" "[lozenge]" "[lozenge]" "◊")
+ ("diams" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamondsuit" "\\diamondsuit" t "&diams;" "[diamonds]" "[diamonds]" "◆")
+ ("diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("Diamond" "\\diamondsuit" t "&diamond;" "[diamond]" "[diamond]" "◆")
+ ("loz" "\\lozenge" t "&loz;" "[lozenge]" "[lozenge]" "⧫")
)
"Default entities used in Org-mode to produce special characters.
For details see `org-entities-user'.")
diff --git a/lisp/org-faces.el b/lisp/org-faces.el
index 5472964..d64fd0e 100644
--- a/lisp/org-faces.el
+++ b/lisp/org-faces.el
@@ -217,12 +217,6 @@ column view defines special faces for each outline level. See the file
"Face for column display of entry properties."
:group 'org-faces)
-(when (fboundp 'set-face-attribute)
- ;; Make sure that a fixed-width face is used when we have a column table.
- (set-face-attribute 'org-column nil
- :height (face-attribute 'default :height)
- :family (face-attribute 'default :family)))
-
(defface org-agenda-column-dateline
(org-compatible-face 'org-column
'((t nil)))
@@ -264,7 +258,7 @@ column view defines special faces for each outline level. See the file
'((((class color) (background light)) (:foreground "Purple" :underline t))
(((class color) (background dark)) (:foreground "Cyan" :underline t))
(t (:underline t)))
- "Face for links."
+ "Face for footnotes."
:group 'org-faces)
(defface org-ellipsis
diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el
index b014cd8..3c0d97c 100644
--- a/lisp/org-footnote.el
+++ b/lisp/org-footnote.el
@@ -166,6 +166,7 @@ The main values of this variable can be set with in-buffer options:
#+STARTUP: nofnadjust"
:group 'org-footnote
:type '(choice
+ (const :tag "No adjustment" nil)
(const :tag "Renumber" renumber)
(const :tag "Sort" sort)
(const :tag "Renumber and Sort" t)))
diff --git a/lisp/org-habit.el b/lisp/org-habit.el
index 8465ba4..eba9037 100644
--- a/lisp/org-habit.el
+++ b/lisp/org-habit.el
@@ -85,6 +85,12 @@ today's agenda, even if they are not scheduled."
:version "24.1"
:type 'character)
+(defcustom org-habit-show-done-always-green nil
+ "Non-nil means DONE days will always be green in the consistency graph.
+It will be green even if it was done after the deadline."
+ :group 'org-habit
+ :type 'boolean)
+
(defface org-habit-clear-face
'((((background light)) (:background "#8270f9"))
(((background dark)) (:background "blue")))
@@ -272,8 +278,9 @@ Habits are assigned colors on the following basis:
(if donep
'(org-habit-ready-face . org-habit-ready-future-face)
'(org-habit-alert-face . org-habit-alert-future-face)))
- (t
- '(org-habit-overdue-face . org-habit-overdue-future-face)))))
+ ((and org-habit-show-done-always-green donep)
+ '(org-habit-ready-face . org-habit-ready-future-face))
+ (t '(org-habit-overdue-face . org-habit-overdue-future-face)))))
(defun org-habit-build-graph (habit starting current ending)
"Build a graph for the given HABIT, from STARTING to ENDING.
diff --git a/lisp/org-id.el b/lisp/org-id.el
index 32c05e6..f1fa05b 100644
--- a/lisp/org-id.el
+++ b/lisp/org-id.el
@@ -437,6 +437,7 @@ and time is the usual three-integer representation of time."
;; Storing ID locations (files)
+;;;###autoload
(defun org-id-update-id-locations (&optional files silent)
"Scan relevant files for IDs.
Store the relation between files and corresponding IDs.
@@ -527,7 +528,9 @@ When CHECK is given, prepare detailed information about duplicate IDs."
(org-id-hash-to-alist org-id-locations)
org-id-locations)))
(with-temp-file org-id-locations-file
- (print out (current-buffer))))))
+ (let ((print-level nil)
+ (print-length nil))
+ (print out (current-buffer)))))))
(defun org-id-locations-load ()
"Read the data from `org-id-locations-file'."
diff --git a/lisp/org-list.el b/lisp/org-list.el
index 86afe11..1b3c509 100644
--- a/lisp/org-list.el
+++ b/lisp/org-list.el
@@ -1863,9 +1863,10 @@ Initial position of cursor is restored after the changes."
(item-re (org-item-re))
(shift-body-ind
(function
- ;; Shift the indentation between END and BEG by DELTA.
- ;; Start from the line before END.
- (lambda (end beg delta)
+ ;; Shift the indentation between END and BEG by DELTA. If
+ ;; MAX-IND is non-nil, ensure that no line will be indented
+ ;; more than that number. Start from the line before END.
+ (lambda (end beg delta max-ind)
(goto-char end)
(skip-chars-backward " \r\t\n")
(beginning-of-line)
@@ -1879,7 +1880,8 @@ Initial position of cursor is restored after the changes."
;; Shift only non-empty lines.
((org-looking-at-p "^[ \t]*\\S-")
(let ((i (org-get-indentation)))
- (org-indent-line-to (+ i delta)))))
+ (org-indent-line-to
+ (if max-ind (min (+ i delta) max-ind) (+ i delta))))))
(forward-line -1)))))
(modify-item
(function
@@ -1915,53 +1917,60 @@ Initial position of cursor is restored after the changes."
(indent-to new-ind)))))))
;; 1. First get list of items and position endings. We maintain
;; two alists: ITM-SHIFT, determining indentation shift needed
- ;; at item, and END-POS, a pseudo-alist where key is ending
+ ;; at item, and END-LIST, a pseudo-alist where key is ending
;; position and value point.
(let (end-list acc-end itm-shift all-ends sliced-struct)
- (mapc (lambda (e)
- (let* ((pos (car e))
- (ind-pos (org-list-get-ind pos struct))
- (ind-old (org-list-get-ind pos old-struct))
- (bul-pos (org-list-get-bullet pos struct))
- (bul-old (org-list-get-bullet pos old-struct))
- (ind-shift (- (+ ind-pos (length bul-pos))
- (+ ind-old (length bul-old))))
- (end-pos (org-list-get-item-end pos old-struct)))
- (push (cons pos ind-shift) itm-shift)
- (unless (assq end-pos old-struct)
- ;; To determine real ind of an ending position that
- ;; is not at an item, we have to find the item it
- ;; belongs to: it is the last item (ITEM-UP), whose
- ;; ending is further than the position we're
- ;; interested in.
- (let ((item-up (assoc-default end-pos acc-end '>)))
- (push (cons end-pos item-up) end-list)))
- (push (cons end-pos pos) acc-end)))
- old-struct)
+ (dolist (e old-struct)
+ (let* ((pos (car e))
+ (ind-pos (org-list-get-ind pos struct))
+ (ind-old (org-list-get-ind pos old-struct))
+ (bul-pos (org-list-get-bullet pos struct))
+ (bul-old (org-list-get-bullet pos old-struct))
+ (ind-shift (- (+ ind-pos (length bul-pos))
+ (+ ind-old (length bul-old))))
+ (end-pos (org-list-get-item-end pos old-struct)))
+ (push (cons pos ind-shift) itm-shift)
+ (unless (assq end-pos old-struct)
+ ;; To determine real ind of an ending position that
+ ;; is not at an item, we have to find the item it
+ ;; belongs to: it is the last item (ITEM-UP), whose
+ ;; ending is further than the position we're
+ ;; interested in.
+ (let ((item-up (assoc-default end-pos acc-end '>)))
+ (push (cons end-pos item-up) end-list)))
+ (push (cons end-pos pos) acc-end)))
;; 2. Slice the items into parts that should be shifted by the
- ;; same amount of indentation. The slices are returned in
- ;; reverse order so changes modifying buffer do not change
- ;; positions they refer to.
+ ;; same amount of indentation. Each slice follow the pattern
+ ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in
+ ;; reverse order.
(setq all-ends (sort (append (mapcar 'car itm-shift)
(org-uniquify (mapcar 'car end-list)))
'<))
(while (cdr all-ends)
(let* ((up (pop all-ends))
(down (car all-ends))
- (ind (if (assq up struct)
- (cdr (assq up itm-shift))
- (cdr (assq (cdr (assq up end-list)) itm-shift)))))
- (push (list down up ind) sliced-struct)))
+ (itemp (assq up struct))
+ (item (if itemp up (cdr (assq up end-list))))
+ (ind (cdr (assq item itm-shift)))
+ ;; If we're not at an item, there's a child of the item
+ ;; point belongs to above. Make sure this slice isn't
+ ;; moved within that child by specifying a maximum
+ ;; indentation.
+ (max-ind (and (not itemp)
+ (+ (org-list-get-ind item struct)
+ (length (org-list-get-bullet item struct))
+ org-list-indent-offset))))
+ (push (list down up ind max-ind) sliced-struct)))
;; 3. Shift each slice in buffer, provided delta isn't 0, from
;; end to beginning. Take a special action when beginning is
;; at item bullet.
- (mapc (lambda (e)
- (unless (zerop (nth 2 e)) (apply shift-body-ind e))
- (let* ((beg (nth 1 e))
- (cell (assq beg struct)))
- (unless (or (not cell) (equal cell (assq beg old-struct)))
- (funcall modify-item beg))))
- sliced-struct))
+ (dolist (e sliced-struct)
+ (unless (and (zerop (nth 2 e)) (not (nth 3 e)))
+ (apply shift-body-ind e))
+ (let* ((beg (nth 1 e))
+ (cell (assq beg struct)))
+ (unless (or (not cell) (equal cell (assq beg old-struct)))
+ (funcall modify-item beg)))))
;; 4. Go back to initial position and clean marker.
(goto-char origin)
(move-marker origin nil)))
@@ -2799,13 +2808,14 @@ optional argument WITH-CASE, the sorting considers case as well.
The command prompts for the sorting type unless it has been given
to the function through the SORTING-TYPE argument, which needs to
-be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
-meaning of each character:
+be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the
+detailed meaning of each character:
n Numerically, by converting the beginning of the item to a number.
a Alphabetically. Only the first line of item is checked.
t By date/time, either the first active time stamp in the entry, if
any, or by the first inactive one. In a timer list, sort the timers.
+x By \"checked\" status of a check list.
Capital letters will reverse the sort order.
@@ -2827,7 +2837,7 @@ ignores hidden links."
(or sorting-type
(progn
(message
- "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
+ "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:")
(read-char-exclusive))))
(getkey-func
(or getkey-func
@@ -2844,7 +2854,8 @@ ignores hidden links."
(sort-func (cond
((= dcst ?a) 'string<)
((= dcst ?f) compare-func)
- ((= dcst ?t) '<)))
+ ((= dcst ?t) '<)
+ ((= dcst ?x) 'string<)))
(next-record (lambda ()
(skip-chars-forward " \r\t\n")
(or (eobp) (beginning-of-line))))
@@ -2875,6 +2886,9 @@ ignores hidden links."
(point-at-eol) t)))
(org-time-string-to-seconds (match-string 0)))
(t (org-float-time now))))
+ ((= dcst ?x) (or (and (stringp (match-string 1))
+ (match-string 1))
+ ""))
((= dcst ?f)
(if getkey-func
(let ((value (funcall getkey-func)))
diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el
index f911927..0862dcb 100644
--- a/lisp/org-loaddefs.el
+++ b/lisp/org-loaddefs.el
@@ -14,7 +14,7 @@
;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe
;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info
;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob-core"
-;;;;;; "ob-core.el" "e079d8aba02a20a56288a4ed1f86d604")
+;;;;;; "ob-core.el" "5020331fabde60f15398bf24d3981977")
;;; Generated autoloads from ob-core.el
(autoload 'org-babel-execute-safely-maybe "ob-core" "\
@@ -240,7 +240,7 @@ Describe all keybindings behind `org-babel-key-prefix'.
;;;***
;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe)
-;;;;;; "ob-lob" "ob-lob.el" "be09335287121c6bf4403a57f3244b94")
+;;;;;; "ob-lob" "ob-lob.el" "d94d0930566ed1471ffe0d04603ac1bc")
;;; Generated autoloads from ob-lob.el
(autoload 'org-babel-lob-execute-maybe "ob-lob" "\
@@ -258,7 +258,7 @@ Return a Library of Babel function call as a string.
;;;***
;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle"
-;;;;;; "ob-tangle.el" "f2e6212ecf8512d3893e6198962eb888")
+;;;;;; "ob-tangle.el" "4be192fcb6c6b0ed49ed439b74cbc014")
;;; Generated autoloads from ob-tangle.el
(autoload 'org-babel-tangle-file "ob-tangle" "\
@@ -290,7 +290,7 @@ used to limit the exported source code blocks by language.
;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views
;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda
;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el"
-;;;;;; (20959 48141))
+;;;;;; (21065 1984))
;;; Generated autoloads from org-agenda.el
(autoload 'org-toggle-sticky-agenda "org-agenda" "\
@@ -598,7 +598,7 @@ This command is set with the variable `org-archive-default-command'.
;;;***
-;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "0f042777440a0b6677b74d048cc07bba")
+;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "2acf3dc22dcf986b2dbf07e1c0f4bba4")
;;; Generated autoloads from org-attach.el
(autoload 'org-attach "org-attach" "\
@@ -621,8 +621,8 @@ Extract anniversaries from BBDB for display in the agenda.
;;;***
;;;### (autoloads (org-capture-import-remember-templates org-capture
-;;;;;; org-capture-string) "org-capture" "org-capture.el" (20959
-;;;;;; 48141))
+;;;;;; org-capture-string) "org-capture" "org-capture.el" (21034
+;;;;;; 2917))
;;; Generated autoloads from org-capture.el
(autoload 'org-capture-string "org-capture" "\
@@ -667,7 +667,7 @@ Set `org-capture-templates' to be similar to `org-remember-templates'.
;;;### (autoloads (org-dblock-write:clocktable org-clock-report org-clock-get-clocktable
;;;;;; org-clock-display org-clock-sum org-clock-goto org-clock-cancel
;;;;;; org-clock-out org-clock-in-last org-clock-in org-resolve-clocks)
-;;;;;; "org-clock" "org-clock.el" "dc41f9f7d7c12101c0f61cfa3276c451")
+;;;;;; "org-clock" "org-clock.el" "f999bab8b47b8a6252326354ab4c7908")
;;; Generated autoloads from org-clock.el
(autoload 'org-resolve-clocks "org-clock" "\
@@ -769,7 +769,7 @@ Write the standard clocktable.
;;;***
;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview
-;;;;;; org-columns) "org-colview" "org-colview.el" (20959 48141))
+;;;;;; org-columns) "org-colview" "org-colview.el" (21055 52523))
;;; Generated autoloads from org-colview.el
(autoload 'org-columns "org-colview" "\
@@ -813,7 +813,7 @@ Turn on or update column view in the agenda.
;;;***
;;;### (autoloads (org-check-version) "org-compat" "org-compat.el"
-;;;;;; (20959 48141))
+;;;;;; (21034 2917))
;;; Generated autoloads from org-compat.el
(autoload 'org-check-version "org-compat" "\
@@ -838,7 +838,7 @@ tree can be found.
;;;***
;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data)
-;;;;;; "org-element" "org-element.el" "63f37029da475dfaf7d33aa9b1ced9fa")
+;;;;;; "org-element" "org-element.el" "40963ed55ee478e87d9b5d7252b51b9d")
;;; Generated autoloads from org-element.el
(autoload 'org-element-interpret-data "org-element" "\
@@ -928,7 +928,7 @@ Show the raw feed buffer of a feed.
;;;***
;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote"
-;;;;;; "org-footnote.el" "0c5e60ed6c35672fea1ddebc70d622d7")
+;;;;;; "org-footnote.el" "498ce4bcc019503ef9657f915606b130")
;;; Generated autoloads from org-footnote.el
(autoload 'org-footnote-action "org-footnote" "\
@@ -959,9 +959,9 @@ referenced sequence.
;;;***
-;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find
-;;;;;; org-id-goto org-id-get org-id-get-create) "org-id" "org-id.el"
-;;;;;; "7b374ed9fe87717fa9c66320c507cd02")
+;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-update-id-locations
+;;;;;; org-id-find org-id-goto org-id-get org-id-get-create) "org-id"
+;;;;;; "org-id.el" "058cecf9786ef0ba525ed56f747a79e0")
;;; Generated autoloads from org-id.el
(autoload 'org-id-get-create "org-id" "\
@@ -995,6 +995,16 @@ With optional argument MARKERP, return the position as a new marker.
\(fn ID &optional MARKERP)" nil nil)
+(autoload 'org-id-update-id-locations "org-id" "\
+Scan relevant files for IDs.
+Store the relation between files and corresponding IDs.
+This will scan all agenda files, all associated archives, and all
+files currently mentioned in `org-id-locations'.
+When FILES is given, scan these files instead.
+When CHECK is given, prepare detailed information about duplicate IDs.
+
+\(fn &optional FILES SILENT)" t nil)
+
(autoload 'org-id-find-id-file "org-id" "\
Query the id database for the file in which this ID is located.
@@ -1036,7 +1046,7 @@ Dispatch to the appropriate function to store a link to an IRC session.
;;;***
;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el"
-;;;;;; (20959 48141))
+;;;;;; (21034 2917))
;;; Generated autoloads from org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
@@ -1047,7 +1057,7 @@ Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX a
;;;***
;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile"
-;;;;;; "org-mobile.el" "385f6e8212babd40eb1d232951b3aa53")
+;;;;;; "org-mobile.el" "c69640ad752b53de4ac6874cbf252ec2")
;;; Generated autoloads from org-mobile.el
(autoload 'org-mobile-push "org-mobile" "\
@@ -1098,7 +1108,7 @@ line directly before or after the table.
;;;;;; org-table-justify-field-maybe org-table-align org-table-export
;;;;;; org-table-import org-table-convert-region org-table-create
;;;;;; org-table-create-or-convert-from-region org-table-create-with-table\.el)
-;;;;;; "org-table" "org-table.el" "62264557dc8b58dedacbfeabf2b684de")
+;;;;;; "org-table" "org-table.el" "3c271d409dab6979db5a32f1f13820f5")
;;; Generated autoloads from org-table.el
(autoload 'org-table-create-with-table\.el "org-table" "\
@@ -1692,7 +1702,7 @@ provide ORGTBL directives for the generated table.
;;;***
;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region
-;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "24d58bf234f548224d83186703c58ff0")
+;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "c0a04a9b6c18954e7eadb2f39ca2e805")
;;; Generated autoloads from org-timer.el
(autoload 'org-timer-start "org-timer" "\
@@ -1753,7 +1763,7 @@ replace any running timer.
;;;***
;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el"
-;;;;;; (20987 50561))
+;;;;;; (21066 16879))
;;; Generated autoloads from org-version.el
(autoload 'org-release "org-version" "\
@@ -1779,7 +1789,7 @@ The location of ODT styles.")
;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct
;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate
;;;;;; turn-on-orgtbl org-version org-babel-load-file org-babel-do-load-languages)
-;;;;;; "org" "org.el" (20981 63218))
+;;;;;; "org" "org.el" (21055 52523))
;;; Generated autoloads from org.el
(autoload 'org-babel-do-load-languages "org" "\
@@ -2002,7 +2012,7 @@ Call the customize function with org as argument.
;;;### (autoloads (org-ascii-publish-to-utf8 org-ascii-publish-to-latin1
;;;;;; org-ascii-publish-to-ascii org-ascii-export-to-ascii org-ascii-export-as-ascii)
-;;;;;; "ox-ascii" "ox-ascii.el" "5f7a6cd3b95f22ce8e88639a2b243fce")
+;;;;;; "ox-ascii" "ox-ascii.el" "31dee5d02171d258b9bb18ee9aa5312a")
;;; Generated autoloads from ox-ascii.el
(autoload 'org-ascii-export-as-ascii "ox-ascii" "\
@@ -2105,7 +2115,7 @@ Return output file name.
;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex
;;;;;; org-beamer-insert-options-template org-beamer-select-environment
;;;;;; org-beamer-export-to-pdf org-beamer-export-to-latex org-beamer-export-as-latex
-;;;;;; org-beamer-mode) "ox-beamer" "ox-beamer.el" "11dab554b2c2ee20a9a438bc326e8d50")
+;;;;;; org-beamer-mode) "ox-beamer" "ox-beamer.el" "5c4d3f062f8733a52c5db34802d9cd3e")
;;; Generated autoloads from ox-beamer.el
(autoload 'org-beamer-mode "ox-beamer" "\
@@ -2247,7 +2257,7 @@ Return output file name.
;;;### (autoloads (org-html-publish-to-html org-html-export-to-html
;;;;;; org-html-convert-region-to-html org-html-export-as-html org-html-htmlize-generate-css)
-;;;;;; "ox-html" "ox-html.el" "c2b19e22435d430bf1593bea56e42027")
+;;;;;; "ox-html" "ox-html.el" "34ee110c82e50b2994c7404c69f5b0a0")
;;; Generated autoloads from ox-html.el
(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
@@ -2355,7 +2365,7 @@ Return output file name.
;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files
;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el"
-;;;;;; "c6f84f8db517191e8801d63586766cf9")
+;;;;;; "02da3bde4cd0abae11ec2334c0b3c83e")
;;; Generated autoloads from ox-icalendar.el
(autoload 'org-icalendar-export-to-ics "ox-icalendar" "\
@@ -2407,7 +2417,7 @@ The file is stored under the name chosen in
;;;### (autoloads (org-latex-publish-to-pdf org-latex-publish-to-latex
;;;;;; org-latex-export-to-pdf org-latex-export-to-latex org-latex-convert-region-to-latex
-;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "f52187024b023fd6440cf60e6ae07fc9")
+;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "a33b28d484ae85af5b338e9ef175718e")
;;; Generated autoloads from ox-latex.el
(autoload 'org-latex-export-as-latex "ox-latex" "\
@@ -2476,8 +2486,6 @@ EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
file-local settings.
-Return output file's name.
-
\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil)
(autoload 'org-latex-export-to-pdf "ox-latex" "\
@@ -2535,7 +2543,7 @@ Return output file name.
;;;***
;;;### (autoloads (org-md-export-to-markdown org-md-convert-region-to-md
-;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "262746b5e61bae2dd8fa7b41a62f0b43")
+;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "9613796f5e2e5a59ccd56f1fb52df3c7")
;;; Generated autoloads from ox-md.el
(autoload 'org-md-export-as-markdown "ox-md" "\
@@ -2597,7 +2605,7 @@ Return output file's name.
;;;***
;;;### (autoloads (org-odt-convert org-odt-export-to-odt org-odt-export-as-odf-and-open
-;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "39cfdee79dd956aaa2c77d9fcbd784f8")
+;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "d211042456ad899332c26ca9dcad8724")
;;; Generated autoloads from ox-odt.el
(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp)
@@ -2660,7 +2668,7 @@ using `org-open-file'.
;;;***
;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org)
-;;;;;; "ox-org" "ox-org.el" "f98bca16d7ddf4ac4fae1846af828ddf")
+;;;;;; "ox-org" "ox-org.el" "0b39e4bd2eb545309d3495257b1ced80")
;;; Generated autoloads from ox-org.el
(autoload 'org-org-export-as-org "ox-org" "\
@@ -2734,7 +2742,7 @@ Return output file name.
;;;### (autoloads (org-publish-current-project org-publish-current-file
;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el"
-;;;;;; "d325ba3d14653089f60939fd3886e5ff")
+;;;;;; "5ece54cc06ba971c01450eb7a8359e21")
;;; Generated autoloads from ox-publish.el
(defalias 'org-publish-project 'org-publish)
@@ -2778,7 +2786,7 @@ the project.
;;;***
;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo)
-;;;;;; "ox-texinfo" "ox-texinfo.el" "cab6e0b3aba287d44098955a1cbbff8e")
+;;;;;; "ox-texinfo" "ox-texinfo.el" "84c96e4b93249af64d8e4a3959149d33")
;;; Generated autoloads from ox-texinfo.el
(autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\
@@ -2802,14 +2810,18 @@ this command to convert it.
;;;***
-;;;### (autoloads (org-export-dispatch org-export-insert-default-template
-;;;;;; org-export-replace-region-by org-export-string-as org-export-to-file
-;;;;;; org-export-to-buffer org-export-as) "ox" "ox.el" "4f0b60e1ffe1fa2295371b17a6d6e885")
+;;;### (autoloads (org-export-dispatch org-export-to-file org-export-to-buffer
+;;;;;; org-export-insert-default-template org-export-replace-region-by
+;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "76fb6fbf6c207c4514de682af5006106")
;;; Generated autoloads from ox.el
(autoload 'org-export-as "ox" "\
Transcode current Org buffer into BACKEND code.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
If narrowing is active in the current buffer, only transcode its
narrowed part.
@@ -2833,41 +2845,13 @@ Return code as a string.
\(fn BACKEND &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil)
-(autoload 'org-export-to-buffer "ox" "\
-Call `org-export-as' with output to a specified buffer.
-
-BACKEND is the back-end used for transcoding, as a symbol.
-
-BUFFER is the output buffer. If it already exists, it will be
-erased first, otherwise, it will be created.
-
-Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
-EXT-PLIST are similar to those used in `org-export-as', which
-see.
-
-Depending on `org-export-copy-to-kill-ring', add buffer contents
-to kill ring. Return buffer.
-
-\(fn BACKEND BUFFER &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil)
-
-(autoload 'org-export-to-file "ox" "\
-Call `org-export-as' with output to a specified file.
-
-BACKEND is the back-end used for transcoding, as a symbol. FILE
-is the name of the output file, as a string.
-
-Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
-EXT-PLIST are similar to those used in `org-export-as', which
-see.
-
-Depending on `org-export-copy-to-kill-ring', add file contents
-to kill ring. Return output file's name.
-
-\(fn BACKEND FILE &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil)
-
(autoload 'org-export-string-as "ox" "\
Transcode STRING into BACKEND code.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
When optional argument BODY-ONLY is non-nil, only return body
code, without preamble nor postamble.
@@ -2881,22 +2865,94 @@ Return code as a string.
(autoload 'org-export-replace-region-by "ox" "\
Replace the active region by its export to BACKEND.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
\(fn BACKEND)" nil nil)
(autoload 'org-export-insert-default-template "ox" "\
Insert all export keywords with default values at beginning of line.
-BACKEND is a symbol representing the export back-end for which
-specific export options should be added to the template, or
-`default' for default template. When it is nil, the user will be
-prompted for a category.
+BACKEND is a symbol referring to the name of a registered export
+back-end, for which specific export options should be added to
+the template, or `default' for default template. When it is nil,
+the user will be prompted for a category.
If SUBTREEP is non-nil, export configuration will be set up
locally for the subtree through node properties.
\(fn &optional BACKEND SUBTREEP)" t nil)
+(autoload 'org-export-to-buffer "ox" "\
+Call `org-export-as' with output to a specified buffer.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+BUFFER is the name of the output buffer. If it already exists,
+it will be erased first, otherwise, it will be created.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should then be accessible
+through the `org-export-stack' interface. When ASYNC is nil, the
+buffer is displayed if `org-export-show-temporary-export-buffer'
+is non-nil.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is a function which should accept
+no argument. It is always called within the current process,
+from BUFFER, with point at its beginning. Export back-ends can
+use it to set a major mode there, e.g,
+
+ (defun org-latex-export-as-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ (interactive)
+ (org-export-to-buffer 'latex \"*Org LATEX Export*\"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+This function returns BUFFER.
+
+\(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil)
+
+(autoload 'org-export-to-file "ox" "\
+Call `org-export-as' with output to a specified file.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. FILE is the name of the output file, as
+a string.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer file then be accessible
+through the `org-export-stack' interface.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is called with FILE as its
+argument and happens asynchronously when ASYNC is non-nil. It
+has to return a file name, or nil. Export back-ends can use this
+to send the output file through additional processing, e.g,
+
+ (defun org-latex-export-to-latex
+ (&optional async subtreep visible-only body-only ext-plist)
+ (interactive)
+ (let ((outfile (org-export-output-file-name \".tex\" subtreep)))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))
+
+The function returns either a file name returned by POST-PROCESS,
+or FILE.
+
+\(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil)
+
(autoload 'org-export-dispatch "ox" "\
Export dispatcher for Org mode.
diff --git a/lisp/org-macro.el b/lisp/org-macro.el
index 153b3b1..fa74d83 100644
--- a/lisp/org-macro.el
+++ b/lisp/org-macro.el
@@ -37,12 +37,14 @@
;; {{{email}}} and {{{title}}} macros.
;;; Code:
+(require 'org-macs)
(declare-function org-element-at-point "org-element" (&optional keep-trail))
(declare-function org-element-context "org-element" (&optional element))
(declare-function org-element-property "org-element" (property element))
(declare-function org-element-type "org-element" (element))
(declare-function org-remove-double-quotes "org" (s))
+(declare-function org-mode "org" ())
(declare-function org-file-contents "org" (file &optional noerror))
(declare-function org-with-wide-buffer "org-macs" (&rest body))
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index cc837d0..0083d29 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -33,7 +33,9 @@
(eval-and-compile
(unless (fboundp 'declare-function)
- (defmacro declare-function (fn file &optional arglist fileonly)))
+ (defmacro declare-function (fn file &optional arglist fileonly)
+ `(autoload ',fn ,file)))
+
(if (>= emacs-major-version 23)
(defsubst org-char-to-string(c)
"Defsubst to decode UTF-8 character values in emacs 23 and beyond."
diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el
index 48767b7..7d6e4ec 100644
--- a/lisp/org-mhe.el
+++ b/lisp/org-mhe.el
@@ -30,6 +30,7 @@
;;; Code:
+(require 'org-macs)
(require 'org)
;; Customization variables
diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 7cdaf34..a43896b 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -319,23 +319,24 @@ create all custom agenda views, for upload to the mobile phone."
(org-agenda-tag-filter org-agenda-tag-filter)
(org-agenda-redo-command org-agenda-redo-command))
(save-excursion
- (save-window-excursion
- (run-hooks 'org-mobile-pre-push-hook)
- (org-mobile-check-setup)
- (org-mobile-prepare-file-lists)
- (message "Creating agendas...")
- (let ((inhibit-redisplay t)
- (org-agenda-files (mapcar 'car org-mobile-files-alist)))
- (org-mobile-create-sumo-agenda))
- (message "Creating agendas...done")
- (org-save-all-org-buffers) ; to save any IDs created by this process
- (message "Copying files...")
- (org-mobile-copy-agenda-files)
- (message "Writing index file...")
- (org-mobile-create-index-file)
- (message "Writing checksums...")
- (org-mobile-write-checksums)
- (run-hooks 'org-mobile-post-push-hook)))
+ (save-restriction
+ (save-window-excursion
+ (run-hooks 'org-mobile-pre-push-hook)
+ (org-mobile-check-setup)
+ (org-mobile-prepare-file-lists)
+ (message "Creating agendas...")
+ (let ((inhibit-redisplay t)
+ (org-agenda-files (mapcar 'car org-mobile-files-alist)))
+ (org-mobile-create-sumo-agenda))
+ (message "Creating agendas...done")
+ (org-save-all-org-buffers) ; to save any IDs created by this process
+ (message "Copying files...")
+ (org-mobile-copy-agenda-files)
+ (message "Writing index file...")
+ (org-mobile-create-index-file)
+ (message "Writing checksums...")
+ (org-mobile-write-checksums)
+ (run-hooks 'org-mobile-post-push-hook))))
(setq org-agenda-buffer-name org-agenda-curbuf-name
org-agenda-this-buffer-name org-agenda-curbuf-name))
(redraw-display)
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index e464684..77f68f4 100644
--- a/lisp/org-pcomplete.el
+++ b/lisp/org-pcomplete.el
@@ -36,7 +36,7 @@
(declare-function org-split-string "org" (string &optional separators))
(declare-function org-make-org-heading-search-string "org"
- (&optional string heading))
+ (&optional string))
(declare-function org-get-buffer-tags "org" ())
(declare-function org-get-tags "org" ())
(declare-function org-buffer-property-keys "org"
@@ -257,6 +257,8 @@ When completing for #+STARTUP, for example, this function returns
(file-name-nondirectory visited-file)))
(buffer-name (buffer-base-buffer)))))))
+
+(declare-function org-export-backend-options "org-export" (cl-x))
(defun pcomplete/org-mode/file-option/options ()
"Complete arguments for the #+OPTIONS file option."
(while (pcomplete-here
@@ -269,9 +271,9 @@ When completing for #+STARTUP, for example, this function returns
"|:" "tags:" "tasks:" "<:" "todo:")
;; OPTION items from registered back-ends.
(let (items)
- (dolist (back-end (org-bound-and-true-p
- org-export-registered-backends))
- (dolist (option (plist-get (cdr back-end) :options-alist))
+ (dolist (backend (org-bound-and-true-p
+ org-export--registered-backends))
+ (dolist (option (org-export-backend-options backend))
(let ((item (nth 2 option)))
(when item (push (concat item ":") items)))))
items))))))
@@ -324,7 +326,7 @@ This needs more work, to handle headings with lots of spaces in them."
(let (tbl)
(while (re-search-forward org-todo-line-regexp nil t)
(push (org-make-org-heading-search-string
- (match-string-no-properties 3) t)
+ (match-string-no-properties 3))
tbl))
(pcomplete-uniqify-list tbl)))
(substring pcomplete-stub 1))))
@@ -394,7 +396,7 @@ Complete a language in the first field, the header arguments and switches."
'("-n" "-r" "-l"
":cache" ":colnames" ":comments" ":dir" ":eval" ":exports"
":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames"
- ":session" ":shebang" ":tangle" ":var"))))
+ ":session" ":shebang" ":tangle" ":tangle-mode" ":var"))))
(defun pcomplete/org-mode/block-option/clocktable ()
"Complete keywords in a clocktable line."
diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el
index d676c39..24a319d 100644
--- a/lisp/org-protocol.el
+++ b/lisp/org-protocol.el
@@ -265,7 +265,7 @@ Here is an example:
This is usually a single character string but can also be a
string with two characters."
:group 'org-protocol
- :type 'string)
+ :type '(choice (const nil) (string)))
(defcustom org-protocol-data-separator "/+\\|\\?"
"The default data separator to use.
diff --git a/lisp/org-src.el b/lisp/org-src.el
index 81b8e40..062d2d7 100644
--- a/lisp/org-src.el
+++ b/lisp/org-src.el
@@ -179,7 +179,7 @@ but which mess up the display of a snippet in Org exported files.")
(defcustom org-src-lang-modes
'(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist)
("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql)
- ("calc" . fundamental) ("C" . c) ("cpp" . c++)
+ ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++)
("screen" . shell-script))
"Alist mapping languages to their major mode.
The key is the language name, the value is the string that should
@@ -757,6 +757,8 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"."
(delete-region beg (max beg end))
(unless (string-match "\\`[ \t]*\\'" code)
(insert code))
+ ;; Make sure the overlay stays in place
+ (when (eq context 'save) (move-overlay ovl beg (point)))
(goto-char beg)
(if single (just-one-space))))
(if (memq t (mapcar (lambda (overlay)
diff --git a/lisp/org-table.el b/lisp/org-table.el
index c5a3aca..246cf8d 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -94,6 +94,22 @@ this variable requires a restart of Emacs to become effective."
| | |
"))
"Templates for radio tables in different major modes.
+Each template must define lines that will be treated as a comment and that
+must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\"
+lines where \"%n\" will be replaced with the name of the table during
+insertion of the tempate. The transformed table will later be inserted
+between these lines.
+
+The template should also contain a minimal table in a multiline comment.
+If multiline comments are not possible in the buffer language,
+you can pack it into a string that will not be used when the code
+is compiled or executed. Above the table will you need a line with
+the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to
+convert the table into a data structure useful in the
+language of the buffer. Check the manual for the section on
+\"Translator functions\", and more generally check out
+http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax
+
All occurrences of %n in a template will be replaced with the name of the
table, obtained by prompting the user."
:group 'org-table
@@ -419,68 +435,38 @@ available parameters."
(org-split-string (match-string 1 line)
"[ \t]*|[ \t]*")))))))
-(defvar org-table-colgroup-info nil) ; Dynamically scoped.
+(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
(defun org-table-clean-before-export (lines &optional maybe-quoted)
"Check if the table has a marking column.
If yes remove the column and the special lines."
- (setq org-table-colgroup-info nil)
- (if (memq nil
- (mapcar
- (lambda (x) (or (string-match "^[ \t]*|-" x)
- (string-match
- (if maybe-quoted
- "^[ \t]*| *\\\\?\\([\#!$*_^ /]\\) *|"
- "^[ \t]*| *\\([\#!$*_^ /]\\) *|")
- x)))
- lines))
- ;; No special marking column
- (progn
- (setq org-table-clean-did-remove-column nil)
- (delq nil
- (mapcar
- (lambda (x)
- (cond
- ((org-table-colgroup-line-p x)
- ;; This line contains colgroup info, extract it
- ;; and then discard the line
- (setq org-table-colgroup-info
- (mapcar (lambda (x)
- (cond ((member x '("<" "&lt;")) :start)
- ((member x '(">" "&gt;")) :end)
- ((member x '("<>" "&lt;&gt;")) :startend)))
- (org-split-string x "[ \t]*|[ \t]*")))
- nil)
- ((org-table-cookie-line-p x)
- ;; This line contains formatting cookies, discard it
- nil)
- (t x)))
- lines)))
- ;; there is a special marking column
- (setq org-table-clean-did-remove-column t)
+ (let ((special (if maybe-quoted
+ "^[ \t]*| *\\\\?[\#!$*_^/ ] *|"
+ "^[ \t]*| *[\#!$*_^/ ] *|"))
+ (ignore (if maybe-quoted
+ "^[ \t]*| *\\\\?[!$_^/] *|"
+ "^[ \t]*| *[!$_^/] *|")))
+ (setq org-table-clean-did-remove-column
+ (not (memq nil
+ (mapcar
+ (lambda (line)
+ (or (string-match org-table-hline-regexp line)
+ (string-match special line)))
+ lines))))
(delq nil
(mapcar
- (lambda (x)
+ (lambda (line)
(cond
- ((org-table-colgroup-line-p x)
- ;; This line contains colgroup info, extract it
- ;; and then discard the line
- (setq org-table-colgroup-info
- (mapcar (lambda (x)
- (cond ((member x '("<" "&lt;")) :start)
- ((member x '(">" "&gt;")) :end)
- ((member x '("<>" "&lt;&gt;")) :startend)))
- (cdr (org-split-string x "[ \t]*|[ \t]*"))))
- nil)
- ((org-table-cookie-line-p x)
- ;; This line contains formatting cookies, discard it
+ ((or (org-table-colgroup-line-p line) ;; colgroup info
+ (org-table-cookie-line-p line) ;; formatting cookies
+ (and org-table-clean-did-remove-column
+ (string-match ignore line))) ;; non-exportable data
nil)
- ((string-match "^[ \t]*| *\\([!_^/$]\\|\\\\\\$\\) *|" x)
- ;; ignore this line
- nil)
- ((or (string-match "^\\([ \t]*\\)|-+\\+" x)
- (string-match "^\\([ \t]*\\)|[^|]*|" x))
+ ((and org-table-clean-did-remove-column
+ (or (string-match "^\\([ \t]*\\)|-+\\+" line)
+ (string-match "^\\([ \t]*\\)|[^|]*|" line)))
;; remove the first column
- (replace-match "\\1|" t nil x))))
+ (replace-match "\\1|" t nil line))
+ (t line)))
lines))))
(defconst org-table-translate-regexp
@@ -567,7 +553,7 @@ nil When nil, the command tries to be smart and figure out the
- when each line contains a TAB, assume TAB-separated material
- when each line contains a comma, assume CSV material
- else, assume one or more SPACE characters as separator."
- (interactive "rP")
+ (interactive "r\nP")
(let* ((beg (min beg0 end0))
(end (max beg0 end0))
re)
@@ -2750,7 +2736,7 @@ $xyz-> %s
@r$c-> %s
$1-> %s\n" orig formula form0 form))
(if (listp ev)
- (princ (format " %s^\nError: %s"
+ (princ (format " %s^\nError: %s"
(make-string (car ev) ?\-) (nth 1 ev)))
(princ (format "Result: %s\nFormat: %s\nFinal: %s"
ev (or fmt "NONE")
@@ -4407,30 +4393,6 @@ overwritten, and the table is not marked as requiring realignment."
(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
"Regular expression matching exponentials as produced by calc.")
-(defun orgtbl-export (table target)
- (let ((func (intern (concat "orgtbl-to-" (symbol-name target))))
- (lines (org-split-string table "[ \t]*\n[ \t]*"))
- org-table-last-alignment org-table-last-column-widths
- maxcol column)
- (if (not (fboundp func))
- (user-error "Cannot export orgtbl table to %s" target))
- (setq lines (org-table-clean-before-export lines))
- (setq table
- (mapcar
- (lambda (x)
- (if (string-match org-table-hline-regexp x)
- 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- lines))
- (setq maxcol (apply 'max (mapcar (lambda (x) (if (listp x) (length x) 0))
- table)))
- (loop for i from (1- maxcol) downto 0 do
- (setq column (mapcar (lambda (x) (if (listp x) (nth i x) nil)) table))
- (setq column (delq nil column))
- (push (apply 'max (mapcar 'string-width column)) org-table-last-column-widths)
- (push (> (/ (apply '+ (mapcar (lambda (x) (if (string-match org-table-number-regexp x) 1 0)) column)) maxcol) org-table-number-fraction) org-table-last-alignment))
- (funcall func table nil)))
-
(defun orgtbl-gather-send-defs ()
"Gather a plist of :name, :transform, :params for each destination before
a radio table."
@@ -4453,14 +4415,14 @@ a radio table."
(save-excursion
(goto-char (point-min))
(unless (re-search-forward
- (concat "BEGIN RECEIVE ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
+ (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t)
(user-error "Don't know where to insert translated table"))
(goto-char (match-beginning 0))
(beginning-of-line 2)
(save-excursion
(let ((beg (point)))
(unless (re-search-forward
- (concat "END RECEIVE ORGTBL +" name) nil t)
+ (concat "END +RECEIVE +ORGTBL +" name) nil t)
(user-error "Cannot find end of insertion region"))
(beginning-of-line 1)
(delete-region beg (point))))
diff --git a/lisp/org-timer.el b/lisp/org-timer.el
index 2351c4c..db7760d 100644
--- a/lisp/org-timer.el
+++ b/lisp/org-timer.el
@@ -370,6 +370,8 @@ VALUE can be `on', `off', or `pause'."
(message "%d minute(s) %d seconds left before next time out"
rmins rsecs))))
+(defvar org-clock-sound)
+
;;;###autoload
(defun org-timer-set-timer (&optional opt)
"Prompt for a duration and set a timer.
@@ -429,7 +431,7 @@ replace any running timer."
(run-with-timer
secs nil `(lambda ()
(setq org-timer-current-timer nil)
- (org-notify ,(format "%s: time out" hl) t)
+ (org-notify ,(format "%s: time out" hl) ,org-clock-sound)
(setq org-timer-timer-is-countdown nil)
(org-timer-set-mode-line 'off)
(run-hooks 'org-timer-done-hook))))
diff --git a/lisp/org-version.el b/lisp/org-version.el
index 6f7f8e7..fbb4dc6 100644
--- a/lisp/org-version.el
+++ b/lisp/org-version.el
@@ -5,13 +5,13 @@
(defun org-release ()
"The release version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-release "8.0.7"))
+ (let ((org-release "8.2.1"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-git-version "8.0.7-dist"))
+ (let ((org-git-version "8.2.1-dist"))
org-git-version))
;;;###autoload
(defvar org-odt-data-dir "/usr/share/emacs/etc/org"
diff --git a/lisp/org.el b/lisp/org.el
index 798816b..6d34bce 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -416,8 +416,7 @@ For export specific modules, see also `org-export-backends'."
(const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira)
(const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn)
(const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal)
- (const :tag "C mac-link-grabber Grab links and URLs from various Mac applications" org-mac-link-grabber)
- (const :tag "C mac-message: Links to messages in Apple Mail" org-mac-message)
+ (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link)
(const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix)
(const :tag "C man: Support for links to manpages in Org-mode" org-man)
(const :tag "C mew: Links to Mew folders/messages" org-mew)
@@ -436,8 +435,9 @@ For export specific modules, see also `org-export-backends'."
(const :tag "C wl: Links to Wanderlust folders/messages" org-wl)
(repeat :tag "External packages" :inline t (symbol :tag "Package"))))
-(defvar org-export-registered-backends) ; From ox.el
+(defvar org-export--registered-backends) ; From ox.el.
(declare-function org-export-derived-backend-p "ox" (backend &rest backends))
+(declare-function org-export-backend-name "ox" (backend))
(defcustom org-export-backends '(ascii html icalendar latex)
"List of export back-ends that should be always available.
@@ -451,30 +451,29 @@ needed.
This variable needs to be set before org.el is loaded. If you
need to make a change while Emacs is running, use the customize
-interface or run the following code, where VALUE stands for the
-new value of the variable, after updating it:
+interface or run the following code, where VAL stands for the new
+value of the variable, after updating it:
\(progn
- \(setq org-export-registered-backends
+ \(setq org-export--registered-backends
\(org-remove-if-not
\(lambda (backend)
- \(or (memq backend val)
- \(catch 'parentp
- \(mapc
- \(lambda (b)
- \(and (org-export-derived-backend-p b (car backend))
- \(throw 'parentp t)))
- val)
- nil)))
- org-export-registered-backends))
- \(let ((new-list (mapcar 'car org-export-registered-backends)))
+ \(let ((name (org-export-backend-name backend)))
+ \(or (memq name val)
+ \(catch 'parentp
+ \(dolist (b val)
+ \(and (org-export-derived-backend-p b name)
+ \(throw 'parentp t)))))))
+ org-export--registered-backends))
+ \(let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
\(dolist (backend val)
\(cond
\((not (load (format \"ox-%s\" backend) t t))
\(message \"Problems while trying to load export back-end `%s'\"
backend))
\((not (memq backend new-list)) (push backend new-list))))
- \(set-default var new-list)))
+ \(set-default 'org-export-backends new-list)))
Adding a back-end to this list will also pull the back-end it
depends on, if any."
@@ -488,21 +487,20 @@ depends on, if any."
;; Any back-end not required anymore (not present in VAL and not
;; a parent of any back-end in the new value) is removed from the
;; list of registered back-ends.
- (setq org-export-registered-backends
+ (setq org-export--registered-backends
(org-remove-if-not
(lambda (backend)
- (or (memq backend val)
- (catch 'parentp
- (mapc
- (lambda (b)
- (and (org-export-derived-backend-p b (car backend))
- (throw 'parentp t)))
- val)
- nil)))
- org-export-registered-backends))
+ (let ((name (org-export-backend-name backend)))
+ (or (memq name val)
+ (catch 'parentp
+ (dolist (b val)
+ (and (org-export-derived-backend-p b name)
+ (throw 'parentp t)))))))
+ org-export--registered-backends))
;; Now build NEW-LIST of both new back-ends and required
;; parents.
- (let ((new-list (mapcar 'car org-export-registered-backends)))
+ (let ((new-list (mapcar 'org-export-backend-name
+ org-export--registered-backends)))
(dolist (backend val)
(cond
((not (load (format "ox-%s" backend) t t))
@@ -1033,6 +1031,21 @@ commands in the Help buffer using the `?' speed command."
(function)
(sexp))))))
+(defcustom org-bookmark-names-plist
+ '(:last-capture "org-capture-last-stored"
+ :last-refile "org-refile-last-stored"
+ :last-capture-marker "org-capture-last-stored-marker")
+ "Names for bookmarks automatically set by some Org commands.
+This can provide strings as names for a number of bookmakrs Org sets
+automatically. The following keys are currently implemented:
+ :last-capture
+ :last-capture-marker
+ :last-refile
+When a key does not show up in the property list, the corresponding bookmark
+is not set."
+ :group 'org-structure
+ :type 'plist)
+
(defgroup org-cycle nil
"Options concerning visibility cycling in Org-mode."
:tag "Org Cycle"
@@ -1278,6 +1291,11 @@ OK to kill that hidden subtree. When nil, kill without remorse."
(const :tag "Protect hidden subtrees with a security query" t)
(const :tag "Never kill a hidden subtree with C-k" error)))
+(defcustom org-special-ctrl-o t
+ "Non-nil means, make `C-o' insert a row in tables."
+ :group 'org-edit-structure
+ :type 'boolean)
+
(defcustom org-catch-invisible-edits nil
"Check if in invisible region before inserting or deleting a character.
Valid values are:
@@ -1596,7 +1614,7 @@ two parameters: the first one is the link, the second one is the
description generated by `org-insert-link'. The function should
return the description to use."
:group 'org-link
- :type 'function)
+ :type '(choice (const nil) (function)))
(defgroup org-link-store nil
"Options concerning storing links in Org-mode."
@@ -1685,7 +1703,7 @@ Org contains a function for this, so if you set this variable to
`org-translate-link-from-planner', you should be able follow many
links created by planner."
:group 'org-link-follow
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-follow-link-hook nil
"Hook that is run after a link has been followed."
@@ -1767,6 +1785,11 @@ another window."
(const vm-visit-folder)
(const vm-visit-folder-other-window)
(const vm-visit-folder-other-frame)))
+ (cons (const vm-imap)
+ (choice
+ (const vm-visit-imap-folder)
+ (const vm-visit-imap-folder-other-window)
+ (const vm-visit-imap-folder-other-frame)))
(cons (const gnus)
(choice
(const gnus)
@@ -2165,7 +2188,9 @@ should be continued. For example, the function may decide that the entire
subtree of the current entry should be excluded and move point to the end
of the subtree."
:group 'org-refile
- :type 'function)
+ :type '(choice
+ (const nil)
+ (function)))
(defcustom org-refile-use-cache nil
"Non-nil means cache refile targets to speed up the process.
@@ -2808,7 +2833,9 @@ The user can set a different function here, which should take a string
as an argument and return the numeric priority."
:group 'org-priorities
:version "24.1"
- :type 'function)
+ :type '(choice
+ (const nil)
+ (function)))
(defgroup org-time nil
"Options concerning time stamps and deadlines in Org-mode."
@@ -3271,7 +3298,7 @@ automatically if necessary."
:type '(choice
(const :tag "Always" t)
(const :tag "Never" nil)
- (const :tag "When selection characters are configured" 'auto)))
+ (const :tag "When selection characters are configured" auto)))
(defcustom org-fast-tag-selection-single-key nil
"Non-nil means fast tag selection exits after first change.
@@ -3492,7 +3519,7 @@ value The value that should be modified.
The function should return the value that should be displayed,
or nil if the normal value should be used."
:group 'org-properties
- :type 'function)
+ :type '(choice (const nil) (function)))
(defcustom org-effort-property "Effort"
"The property that is being used to keep track of effort estimates.
@@ -3754,11 +3781,9 @@ images at the same place."
(defcustom org-format-latex-header "\\documentclass{article}
\\usepackage[usenames]{color}
-\\usepackage{amsmath}
-\\usepackage[mathscr]{eucal}
-\\pagestyle{empty} % do not remove
\[PACKAGES]
\[DEFAULT-PACKAGES]
+\\pagestyle{empty} % do not remove
% The settings below are copied from fullpage.sty
\\setlength{\\textwidth}{\\paperwidth}
\\addtolength{\\textwidth}{-3cm}
@@ -3805,13 +3830,13 @@ header, or they will be appended."
("" "longtable" nil)
("" "float" nil)
("" "wrapfig" nil)
+ ("" "rotating" nil)
("normalem" "ulem" t)
+ ("" "amsmath" t)
("" "textcomp" t)
("" "marvosym" t)
("" "wasysym" t)
- ("" "latexsym" t)
("" "amssymb" t)
- ("" "amstext" nil)
("" "hyperref" nil)
"\\tolerance=1000")
"Alist of default packages to be inserted in the header.
@@ -3823,15 +3848,16 @@ The packages in this list are needed by one part or another of
Org mode to function properly:
- inputenc, fontenc: for basic font and character selection
-- amstext: for subscript and superscript
-- textcomp, marvosymb, wasysym, latexsym, amssym: for various
- symbols used for interpreting the entities in `org-entities'.
- You can skip some of these packages if you don't use any of the
- symbols in it.
-- ulem: for underline and strike-through
+- fixltx2e: Important patches of LaTeX itself
- graphicx: for including images
+- longtable: For multipage tables
- float, wrapfig: for figure placement
-- longtable: for long tables
+- rotating: for sideways figures and tables
+- ulem: for underline and strike-through
+- amsmath: for subscript and superscript and math environments
+- textcomp, marvosymb, wasysym, amssymb: for various symbols used
+ for interpreting the entities in `org-entities'. You can skip
+ some of these packages if you don't use any of their symbols.
- hyperref: for cross references
Therefore you should not modify this variable unless you know
@@ -4285,7 +4311,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(looking-at org-table-hline-regexp))
nil))
-(defvar org-table-clean-did-remove-column nil)
(defun org-table-map-tables (function &optional quietly)
"Apply FUNCTION to the start of all tables in the buffer."
(save-excursion
@@ -4305,12 +4330,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables."
(re-search-forward org-table-any-border-regexp nil 1))))
(unless quietly (message "Mapping tables: done")))
-;; Declare and autoload functions from ox.el and al.
-
-(declare-function org-export-get-environment "ox"
- (&optional backend subtreep ext-plist))
-(declare-function org-latex-guess-inputenc "ox-latex" (header))
-
;; Declare and autoload functions from org-agenda.el
(eval-and-compile
@@ -4493,7 +4512,7 @@ Otherwise, these types are allowed:
inactive: only inactive timestamps (<...)
scheduled: only scheduled timestamps
deadline: only deadline timestamps"
- :type '(choice (const :tag "Scheduled or deadline" 'scheduled-or-deadline)
+ :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline)
(const :tag "All timestamps" all)
(const :tag "Only active timestamps" active)
(const :tag "Only inactive timestamps" inactive)
@@ -4836,7 +4855,7 @@ Support for group tags is controlled by the option
;; Process the tags.
(when (and (not tags) org-tag-alist)
(setq tags
- (mapcar
+ (mapcar
(lambda (tg) (cond ((eq (car tg) :startgroup) "{")
((eq (car tg) :endgroup) "}")
((eq (car tg) :grouptags) ":")
@@ -5327,8 +5346,6 @@ The following commands are available:
(org-set-local 'outline-regexp org-outline-regexp)
(org-set-local 'outline-level 'org-outline-level)
(setq bidi-paragraph-direction 'left-to-right)
- ;; FIXME Circumvent a bug in outline.el (Emacs <24.4)
- (set (make-local-variable 'paragraph-start) " \\|[ \t]*$\\|\\*+ ")
(when (and org-ellipsis
(fboundp 'set-display-table-slot) (boundp 'buffer-display-table)
(fboundp 'make-glyph-code))
@@ -6133,8 +6150,22 @@ Use `org-reduced-level' to remove the effect of `org-odd-levels'."
(defvar org-font-lock-keywords nil)
-(defconst org-property-re (org-re "^[ \t]*\\(:\\([-[:alnum:]_]+\\+?\\):\\)[ \t]*\\([^ \t\r\n].*\\)")
- "Regular expression matching a property line.")
+(defsubst org-re-property (property &optional literal)
+ "Return a regexp matching a PROPERTY line.
+Match group 3 will be set to the value if it exists."
+ (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:"
+ (if literal property (regexp-quote property))
+ "\\):\\)[ \t]+\\(?3:[^ \t\r\n].*?\\)\\(?5:[ \t]*\\)$"))
+
+(defconst org-property-re
+ (org-re-property ".*?" 'literal)
+ "Regular expression matching a property line.
+There are four matching groups:
+1: :PROPKEY: including the leading and trailing colon,
+2: PROPKEY without the leading and trailing colon,
+3: PROPVAL without leading or trailing spaces,
+4: the indentation of the current line,
+5: trailing whitespace.")
(defvar org-font-lock-hook nil
"Functions to be called for special font lock stuff.")
@@ -6481,6 +6512,11 @@ and subscripts."
(defvar org-inlinetask-min-level)
+(defun org-unlogged-message (&rest args)
+ "Display a message, but avoid logging it in the *Messages* buffer."
+ (let ((message-log-max nil))
+ (apply 'message args)))
+
;;;###autoload
(defun org-cycle (&optional arg)
"TAB-action and visibility cycling for Org-mode.
@@ -6535,8 +6571,7 @@ in special contexts.
(and org-cycle-level-after-item/entry-creation
(or (org-cycle-level)
(org-cycle-item-indentation))))
- (let* (message-log-max ; Don't populate the *Messages* buffer
- (limit-level
+ (let* ((limit-level
(or org-cycle-max-level
(and (boundp 'org-inlinetask-min-level)
org-inlinetask-min-level
@@ -6567,11 +6602,11 @@ in special contexts.
((equal arg '(16))
(setq last-command 'dummy)
(org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties"))
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties"))
((equal arg '(64))
(show-all)
- (message "Entire buffer visible, including drawers"))
+ (org-unlogged-message "Entire buffer visible, including drawers"))
;; Table: enter it or move to the next field.
((org-at-table-p 'any)
@@ -6651,17 +6686,16 @@ in special contexts.
(defun org-cycle-internal-global ()
"Do the global cycling action."
;; Hack to avoid display of messages for .org attachments in Gnus
- (let (message-log-max ; Don't populate the *Messages* buffer
- (ga (string-match "\\*fontification" (buffer-name))))
+ (let ((ga (string-match "\\*fontification" (buffer-name))))
(cond
((and (eq last-command this-command)
(eq org-cycle-global-status 'overview))
;; We just created the overview - now do table of contents
;; This can be slow in very large buffers, so indicate action
(run-hook-with-args 'org-pre-cycle-hook 'contents)
- (unless ga (message "CONTENTS..."))
+ (unless ga (org-unlogged-message "CONTENTS..."))
(org-content)
- (unless ga (message "CONTENTS...done"))
+ (unless ga (org-unlogged-message "CONTENTS...done"))
(setq org-cycle-global-status 'contents)
(run-hook-with-args 'org-cycle-hook 'contents))
@@ -6670,7 +6704,7 @@ in special contexts.
;; We just showed the table of contents - now show everything
(run-hook-with-args 'org-pre-cycle-hook 'all)
(show-all)
- (unless ga (message "SHOW ALL"))
+ (unless ga (org-unlogged-message "SHOW ALL"))
(setq org-cycle-global-status 'all)
(run-hook-with-args 'org-cycle-hook 'all))
@@ -6678,14 +6712,13 @@ in special contexts.
;; Default action: go to overview
(run-hook-with-args 'org-pre-cycle-hook 'overview)
(org-overview)
- (unless ga (message "OVERVIEW"))
+ (unless ga (org-unlogged-message "OVERVIEW"))
(setq org-cycle-global-status 'overview)
(run-hook-with-args 'org-cycle-hook 'overview)))))
(defun org-cycle-internal-local ()
"Do the local cycling action."
- (let (message-log-max ; Don't populate the *Messages* buffer
- (goal-column 0) eoh eol eos has-children children-skipped struct)
+ (let ((goal-column 0) eoh eol eos has-children children-skipped struct)
;; First, determine end of headline (EOH), end of subtree or item
;; (EOS), and if item or heading has children (HAS-CHILDREN).
(save-excursion
@@ -6725,7 +6758,7 @@ in special contexts.
;; Nothing is hidden behind this heading
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'empty))
- (message "EMPTY ENTRY")
+ (org-unlogged-message "EMPTY ENTRY")
(setq org-cycle-subtree-status nil)
(save-excursion
(goto-char eos)
@@ -6760,7 +6793,7 @@ in special contexts.
(mapc (lambda (e) (org-list-set-item-visibility e struct 'folded))
(org-list-get-all-items (point) struct prevs))
(goto-char (if (< end eos) end eos)))))))
- (message "CHILDREN")
+ (org-unlogged-message "CHILDREN")
(save-excursion
(goto-char eos)
(outline-next-heading)
@@ -6776,7 +6809,8 @@ in special contexts.
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-pre-cycle-hook 'subtree))
(outline-flag-region eoh eos nil)
- (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
+ (org-unlogged-message
+ (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE"))
(setq org-cycle-subtree-status 'subtree)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'subtree)))
@@ -6784,7 +6818,7 @@ in special contexts.
;; Default action: hide the subtree.
(run-hook-with-args 'org-pre-cycle-hook 'folded)
(outline-flag-region eoh eos t)
- (message "FOLDED")
+ (org-unlogged-message "FOLDED")
(setq org-cycle-subtree-status 'folded)
(unless (org-before-first-heading-p)
(run-hook-with-args 'org-cycle-hook 'folded))))))
@@ -6804,7 +6838,7 @@ With a numeric prefix, show all headlines up to that level."
(setq org-cycle-global-status 'contents))
((equal arg '(4))
(org-set-startup-visibility)
- (message "Startup visibility, plus VISIBILITY properties."))
+ (org-unlogged-message "Startup visibility, plus VISIBILITY properties."))
(t
(org-cycle '(4))))))
@@ -6865,7 +6899,7 @@ of the first headline in the buffer. This is important, because if the
first headline is not level one, then (hide-sublevels 1) gives confusing
results."
(interactive)
- (let ((l (org-current-line))
+ (let ((pos (point))
(level (save-excursion
(goto-char (point-min))
(if (re-search-forward (concat "^" outline-regexp) nil t)
@@ -6874,7 +6908,7 @@ results."
(funcall outline-level))))))
(and level (hide-sublevels level))
(recenter '(4))
- (org-goto-line l)))
+ (goto-char pos)))
(defun org-content (&optional arg)
"Show all headlines in the buffer, like a table of contents.
@@ -7514,168 +7548,149 @@ the current headline. If point is not at the beginning, split the line
and create a new headline with the text in the current line after point
\(see `org-M-RET-may-split-line' on how to modify this behavior).
+If point is at the beginning of a normal line, turn this line into
+a heading.
+
When INVISIBLE-OK is set, stop at invisible headlines when going back.
This is important for non-interactive uses of the command."
(interactive "P")
(if (org-called-interactively-p 'any) (org-reveal))
- (cond
- ((or (= (buffer-size) 0)
- (and (not (save-excursion
- (and (ignore-errors (org-back-to-heading invisible-ok))
- (org-at-heading-p))))
- (or arg (not (org-in-item-p)))))
- (insert
- (if (org-previous-line-empty-p) "" "\n")
- (if (org-in-src-block-p) ",* " "* "))
- (run-hooks 'org-insert-heading-hook))
- ((or arg
- (and (not (org-in-item-p)) org-insert-heading-respect-content)
- (not (org-insert-item
- (save-excursion
- (beginning-of-line)
- (looking-at org-list-full-item-re)
- (match-string 3)))))
- (let (begn endn)
- (when (org-buffer-narrowed-p)
- (setq begn (point-min) endn (point-max))
- (widen))
- (let* ((empty-line-p nil)
- (eops (equal arg '(16))) ; insert at end of parent subtree
- (org-insert-heading-respect-content
- (or (not (null arg)) org-insert-heading-respect-content))
- (level nil)
- (on-heading (org-at-heading-p))
- ;; Get a level to fall back on
- (fix-level
- (save-excursion
- (org-back-to-heading t)
- (looking-at org-outline-regexp)
- (make-string (1- (length (match-string 0))) ?*)))
- (on-empty-line
- (save-excursion (beginning-of-line 1) (looking-at "^\\s-*$")))
- (head (save-excursion
- (condition-case nil
- (progn
- (org-back-to-heading invisible-ok)
- (when (and (not on-heading)
- (featurep 'org-inlinetask)
- (integerp org-inlinetask-min-level)
- (>= (length (match-string 0))
- org-inlinetask-min-level))
- ;; Find a heading level before the inline task
- (while (and (setq level (org-up-heading-safe))
- (>= level org-inlinetask-min-level)))
- (if (org-at-heading-p)
- (org-back-to-heading invisible-ok)
- (error "This should not happen")))
- (unless (and (save-excursion
- (save-match-data
- (org-backward-heading-same-level 1 invisible-ok))
- (= (point) (match-beginning 0)))
- (not (org-previous-line-empty-p t)))
- (setq empty-line-p (org-previous-line-empty-p)))
- (match-string 0))
- (error (or fix-level "* ")))))
- (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a))
- pos hide-previous previous-pos)
- (if ;; At the beginning of a heading, open a new line for insertion
- (and (bolp) (org-at-heading-p)
- (not eops)
- (or (bobp)
- (save-excursion (backward-char 1) (not (outline-invisible-p)))))
- (open-line (if blank 2 1))
- (save-excursion
- (setq previous-pos (point-at-bol))
- (end-of-line)
- (setq hide-previous (outline-invisible-p)))
- (and org-insert-heading-respect-content
- (save-excursion
- (while (outline-invisible-p)
- (org-show-subtree)
- (org-up-heading-safe))))
- (let ((split
- (and (org-get-alist-option org-M-RET-may-split-line 'headline)
- (save-excursion
- (let ((p (point)))
- (goto-char (point-at-bol))
- (and (looking-at org-complex-heading-regexp)
- (match-beginning 4)
- (> p (match-beginning 4)))))))
- tags pos)
- (cond
- ;; Insert a new line, possibly at end of parent subtree
- ((and (not arg) (not on-heading) (not on-empty-line)
- (not (save-excursion
- (beginning-of-line 1)
- (or (looking-at org-list-full-item-re)
- ;; Don't convert :end: lines to headline
- (looking-at "^\\s-*:end:")
- (looking-at "^\\s-*#\\+end_?")))))
- (beginning-of-line 1))
- (org-insert-heading-respect-content
- (if (not eops)
- (progn
- (org-end-of-subtree nil t)
- (and (looking-at "^\\*") (backward-char 1))
- (while (and (not (bobp))
- ;; Don't delete spaces in empty headlines
- (not (looking-back org-outline-regexp))
- (member (char-before) '(?\ ?\t ?\n)))
- (backward-delete-char 1)))
- (let ((p (point)))
- (org-up-heading-safe)
- (if (= p (point))
- (goto-char (point-max))
- (org-end-of-subtree nil t))))
- (when (featurep 'org-inlinetask)
- (while (and (not (eobp))
- (looking-at "\\(\\*+\\)[ \t]+")
- (>= (length (match-string 1))
- org-inlinetask-min-level))
- (org-end-of-subtree nil t)))
- (or (bolp) (newline))
- (or (org-previous-line-empty-p)
- (and blank (newline)))
- (if (or empty-line-p eops) (open-line 1)))
- ;; Insert a headling containing text after point
- ((org-at-heading-p)
- (when hide-previous
- (show-children)
- (org-show-entry))
- (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$")
- (setq tags (and (match-end 2) (match-string 2)))
- (and (match-end 1)
- (delete-region (match-beginning 1) (match-end 1)))
- (setq pos (point-at-bol))
- (or split (end-of-line 1))
- (delete-horizontal-space)
- (if (string-match "\\`\\*+\\'"
- (buffer-substring (point-at-bol) (point)))
- (insert " "))
- (newline (if blank 2 1))
- (when tags
+ (let ((itemp (org-in-item-p))
+ (may-split (org-get-alist-option org-M-RET-may-split-line 'headline))
+ (respect-content (or org-insert-heading-respect-content
+ (equal arg '(16))))
+ (initial-content "")
+ (adjust-empty-lines t))
+
+ (cond
+
+ ((or (= (buffer-size) 0)
+ (and (not (save-excursion
+ (and (ignore-errors (org-back-to-heading invisible-ok))
+ (org-at-heading-p))))
+ (or arg (not itemp))))
+ ;; At beginning of buffer or so hight up that only a heading makes sense.
+ (insert
+ (if (or (bobp) (org-previous-line-empty-p)) "" "\n")
+ (if (org-in-src-block-p) ",* " "* "))
+ (run-hooks 'org-insert-heading-hook))
+
+ ((and itemp (not (equal arg '(4))))
+ ;; Insert an item
+ (org-insert-item))
+
+ (t
+ ;; Insert a heading
+ (save-restriction
+ (widen)
+ (let* ((level nil)
+ (on-heading (org-at-heading-p))
+ (empty-line-p (if on-heading
+ (org-previous-line-empty-p)
+ ;; We will decide later
+ nil))
+ ;; Get a level string to fall back on
+ (fix-level
(save-excursion
- (goto-char pos)
- (end-of-line 1)
- (insert " " tags)
- (org-set-tags nil 'align))))
- (t
- (or split (end-of-line 1))
- (newline (cond ((and blank (not on-empty-line)) 2)
- (blank 1)
- (on-empty-line 0) (t 1)))))))
- (insert head) (just-one-space)
- (setq pos (point))
- (end-of-line 1)
- (unless (= (point) pos) (just-one-space) (backward-delete-char 1))
- (when (and org-insert-heading-respect-content hide-previous)
- (save-excursion
- (goto-char previous-pos)
- (hide-subtree)))
- (when (and begn endn)
- (narrow-to-region (min (point) begn) (max (point) endn)))
- (run-hooks 'org-insert-heading-hook))))))
+ (org-back-to-heading t)
+ (if (org-previous-line-empty-p) (setq empty-line-p t))
+ (looking-at org-outline-regexp)
+ (make-string (1- (length (match-string 0))) ?*)))
+ (stars
+ (save-excursion
+ (condition-case nil
+ (progn
+ (org-back-to-heading invisible-ok)
+ (when (and (not on-heading)
+ (featurep 'org-inlinetask)
+ (integerp org-inlinetask-min-level)
+ (>= (length (match-string 0))
+ org-inlinetask-min-level))
+ ;; Find a heading level before the inline task
+ (while (and (setq level (org-up-heading-safe))
+ (>= level org-inlinetask-min-level)))
+ (if (org-at-heading-p)
+ (org-back-to-heading invisible-ok)
+ (error "This should not happen")))
+ (unless (and (save-excursion
+ (save-match-data
+ (org-backward-heading-same-level
+ 1 invisible-ok))
+ (= (point) (match-beginning 0)))
+ (not (org-previous-line-empty-p t)))
+ (setq empty-line-p (or empty-line-p
+ (org-previous-line-empty-p))))
+ (match-string 0))
+ (error (or fix-level "* ")))))
+ (blank-a (cdr (assq 'heading org-blank-before-new-entry)))
+ (blank (if (eq blank-a 'auto) empty-line-p blank-a))
+ pos hide-previous previous-pos)
+
+ ;; If we insert after content, move there and clean up whitespace
+ (when respect-content
+ (org-end-of-subtree nil t)
+ (skip-chars-backward " \r\n")
+ (and (looking-at "[ \t]+") (replace-match ""))
+ (forward-char 1)
+ (when (looking-at "^\\*")
+ (backward-char 1)
+ (insert "\n")))
+
+ ;; If we are splitting, grab the text that should be moved to the new headline
+ (when may-split
+ (if (org-on-heading-p)
+ ;; This is a heading, we split intelligently (keeping tags)
+ (let ((pos (point)))
+ (goto-char (point-at-bol))
+ (unless (looking-at org-complex-heading-regexp)
+ (error "This should not happen"))
+ (when (and (match-beginning 4)
+ (> pos (match-beginning 4))
+ (< pos (match-end 4)))
+ (setq initial-content (buffer-substring pos (match-end 4)))
+ (goto-char pos)
+ (delete-region (point) (match-end 4))
+ (if (looking-at "[ \t]*$")
+ (replace-match "")
+ (insert (make-string (length initial-content) ?\ )))
+ (setq initial-content (org-trim initial-content)))
+ (goto-char pos))
+ ;; a normal line
+ (unless (bolp)
+ (setq initial-content (buffer-substring (point) (point-at-eol)))
+ (delete-region (point) (point-at-eol))
+ (setq initial-content (org-trim initial-content)))))
+
+ ;; If we are at the beginning of the line, insert before it. Else after
+ (cond
+ ((and (bolp) (looking-at "[ \t]*$")))
+ ((and (bolp) (not (looking-at "[ \t]*$")))
+ (open-line 1))
+ (t
+ (goto-char (point-at-eol))
+ (insert "\n")))
+
+ ;; Insert the new heading
+ (insert stars)
+ (just-one-space)
+ (insert initial-content)
+ (when adjust-empty-lines
+ (if (or (not blank)
+ (and blank (not (org-previous-line-empty-p))))
+ (org-N-empty-lines-before-current (if blank 1 0))))
+ (run-hooks 'org-insert-heading-hook)))))))
+
+(defun org-N-empty-lines-before-current (N)
+ "Make the number of empty lines before current exactly N.
+So this will delete or add empty lines."
+ (save-excursion
+ (goto-char (point-at-bol))
+ (if (looking-back "\\s-+" nil 'greedy)
+ (replace-match ""))
+ (or (bobp) (insert "\n"))
+ (while (> N 0)
+ (insert "\n")
+ (setq N (1- N)))))
(defun org-get-heading (&optional no-tags no-todo)
"Return the heading of the current entry, without the stars.
@@ -7748,7 +7763,7 @@ This is a list with the following elements:
"Insert heading with `org-insert-heading-respect-content' set to t."
(interactive "P")
(let ((org-insert-heading-respect-content t))
- (org-insert-heading arg invisible-ok)))
+ (org-insert-heading '(4) invisible-ok)))
(defun org-insert-todo-heading-respect-content (&optional force-state)
"Insert TODO heading with `org-insert-heading-respect-content' set to t."
@@ -8888,6 +8903,8 @@ buffer. It will also recognize item context in multiline items."
org-fb-vars))
(orgstruct-mode 1)
(setq org-fb-vars nil)
+ (unless org-local-vars
+ (setq org-local-vars (org-get-local-variables)))
(let (var val)
(mapc
(lambda (x)
@@ -8962,26 +8979,30 @@ buffer. It will also recognize item context in multiline items."
(let ((f (or (car-safe cell) cell))
(disable-when-heading-prefix (cdr-safe cell)))
(when (fboundp f)
- (dolist (binding (nconc (where-is-internal f org-mode-map)
- (where-is-internal f outline-mode-map)))
- ;; TODO use local-function-key-map
- (dolist (rep '(("<tab>" . "TAB")
- ("<return>" . "RET")
- ("<escape>" . "ESC")
- ("<delete>" . "DEL")))
- (setq binding (read-kbd-macro
- (let ((case-fold-search))
- (replace-regexp-in-string
- (regexp-quote (cdr rep))
- (car rep)
- (key-description binding))))))
- (let ((key (lookup-key orgstruct-mode-map binding)))
- (when (or (not key) (numberp key))
- (condition-case nil
- (org-defkey orgstruct-mode-map
- binding
- (orgstruct-make-binding f binding disable-when-heading-prefix))
- (error nil))))))))
+ (let ((new-bindings))
+ (dolist (binding (nconc (where-is-internal f org-mode-map)
+ (where-is-internal f outline-mode-map)))
+ (push binding new-bindings)
+ ;; TODO use local-function-key-map
+ (dolist (rep '(("<tab>" . "TAB")
+ ("<return>" . "RET")
+ ("<escape>" . "ESC")
+ ("<delete>" . "DEL")))
+ (setq binding (read-kbd-macro
+ (let ((case-fold-search))
+ (replace-regexp-in-string
+ (regexp-quote (cdr rep))
+ (car rep)
+ (key-description binding)))))
+ (pushnew binding new-bindings :test 'equal)))
+ (dolist (binding new-bindings)
+ (let ((key (lookup-key orgstruct-mode-map binding)))
+ (when (or (not key) (numberp key))
+ (condition-case nil
+ (org-defkey orgstruct-mode-map
+ binding
+ (orgstruct-make-binding f binding disable-when-heading-prefix))
+ (error nil)))))))))
(run-hooks 'orgstruct-setup-hook))
(defun orgstruct-make-binding (fun key disable-when-heading-prefix)
@@ -9028,7 +9049,10 @@ if `orgstruct-heading-prefix-regexp' is non-nil."
(not
(let* ,bindings
(org-context-p 'headline 'item
- ,(when (memq fun '(org-insert-heading))
+ ,(when (memq fun
+ '(org-insert-heading
+ org-insert-heading-respect-content
+ org-meta-return))
'(when orgstruct-is-++
'item-body))))))))
(if fallback
@@ -9713,7 +9737,7 @@ according to FMT (default from `org-email-link-description-format')."
This is the list that is used for internal purposes.")
(defconst org-link-escape-chars-browser
- '(?\ )
+ '(?\ ?\")
"List of escapes for characters that are problematic in links.
This is the list that is used before handing over to the browser.")
@@ -10443,16 +10467,24 @@ application the system uses for this file type."
(apply cmd (nreverse args1))))
((member type '("http" "https" "ftp" "news"))
- (browse-url (concat type ":" (if (org-string-match-p "[[:nonascii:] ]" path)
- (org-link-escape
- path org-link-escape-chars-browser)
- path))))
+ (browse-url
+ (concat type ":"
+ (if (org-string-match-p
+ (concat "[[:nonascii:]"
+ org-link-escape-chars-browser "]")
+ path)
+ (org-link-escape path org-link-escape-chars-browser)
+ path))))
((string= type "doi")
- (browse-url (concat org-doi-server-url (if (org-string-match-p "[[:nonascii:] ]" path)
- (org-link-escape
- path org-link-escape-chars-browser)
- path))))
+ (browse-url
+ (concat org-doi-server-url
+ (if (org-string-match-p
+ (concat "[[:nonascii:]"
+ org-link-escape-chars-browser "]")
+ path)
+ (org-link-escape path org-link-escape-chars-browser)
+ path))))
((member type '("message"))
(browse-url (concat type ":" path)))
@@ -10508,8 +10540,14 @@ application the system uses for this file type."
(error "Abort"))))
((and (string= type "thisfile")
- (run-hook-with-args-until-success
- 'org-open-link-functions path)))
+ (or (run-hook-with-args-until-success
+ 'org-open-link-functions path)
+ (and (string-match "^id:" link)
+ (or (featurep 'org-id) (require 'org-id))
+ (progn
+ (funcall (nth 1 (assoc "id" org-link-protocols))
+ (substring path 3))
+ t)))))
((string= type "thisfile")
(if arg
@@ -11406,7 +11444,6 @@ the different parts of the path and defaults to \"/\".
If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
(interactive "P")
(let* (case-fold-search
- message-log-max ; Don't populate the *Messages* buffer
(bfn (buffer-file-name (buffer-base-buffer)))
(path (and (derived-mode-p 'org-mode) (org-get-outline-path)))
res)
@@ -11423,7 +11460,7 @@ If JUST-RETURN-STRING is non-nil, return a string, don't display a message."
separator))
(if just-return-string
(org-no-properties res)
- (message "%s" res))))
+ (org-unlogged-message "%s" res))))
(defvar org-refile-history nil
"History for refiling operations.")
@@ -11462,7 +11499,13 @@ and not actually move anything.
With a double prefix arg \\[universal-argument] \\[universal-argument], \
go to the location where the last refiling operation has put the subtree.
-With a prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `2', refile to the running clock.
+
+With a numeric prefix argument of `3', emulate `org-refile-keep'
+being set to `t' and copy to the target location, don't move it.
+Beware that keeping refiled entries may result in duplicated ID
+properties.
RFLOC can be a refile location obtained in a different way.
@@ -11485,6 +11528,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(region-start (and regionp (region-beginning)))
(region-end (and regionp (region-end)))
(filename (buffer-file-name (buffer-base-buffer cbuf)))
+ (org-refile-keep (if (equal goto 3) t org-refile-keep))
pos it nbuf file re level reversed)
(setq last-command nil)
(when regionp
@@ -11543,7 +11587,7 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(setq nbuf (or (find-buffer-visiting file)
(find-file-noselect file)))
- (if goto
+ (if (and goto (not (equal goto 3)))
(progn
(org-pop-to-buffer-same-window nbuf)
(goto-char pos)
@@ -11584,13 +11628,19 @@ prefix argument (`C-u C-u C-u C-c C-w')."
(and org-auto-align-tags
(let ((org-loop-over-headlines-in-active-region nil))
(org-set-tags nil t)))
- (with-demoted-errors
- (bookmark-set "org-refile-last-stored"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-refile)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
;; If we are refiling for capture, make sure that the
;; last-capture pointers point here
(when (org-bound-and-true-p org-refile-for-capture)
- (with-demoted-errors
- (bookmark-set "org-capture-last-stored-marker"))
+ (let ((bookmark-name (plist-get org-bookmark-names-plist
+ :last-capture-marker)))
+ (when bookmark-name
+ (with-demoted-errors
+ (bookmark-set bookmark-name))))
(move-marker org-capture-last-stored-marker (point)))
(if (fboundp 'deactivate-mark) (deactivate-mark))
(run-hooks 'org-after-refile-insert-hook))))
@@ -11913,22 +11963,21 @@ This function can be used in a hook."
;;;; Completion
+(declare-function org-export-backend-name "org-export" (cl-x))
+(declare-function org-export-backend-options "org-export" (cl-x))
(defun org-get-export-keywords ()
"Return a list of all currently understood export keywords.
Export keywords include options, block names, attributes and
keywords relative to each registered export back-end."
- (delq nil
- (let (keywords)
- (mapc
- (lambda (back-end)
- (let ((props (cdr back-end)))
- ;; Back-end name (for keywords, like #+LATEX:)
- (push (upcase (symbol-name (car back-end))) keywords)
- ;; Back-end options.
- (mapc (lambda (option) (push (cadr option) keywords))
- (plist-get (cdr back-end) :options-alist))))
- (org-bound-and-true-p org-export-registered-backends))
- keywords)))
+ (let (keywords)
+ (dolist (backend
+ (org-bound-and-true-p org-export--registered-backends)
+ (delq nil keywords))
+ ;; Back-end name (for keywords, like #+LATEX:)
+ (push (upcase (symbol-name (org-export-backend-name backend))) keywords)
+ (dolist (option-entry (org-export-backend-options backend))
+ ;; Back-end options.
+ (push (nth 1 option-entry) keywords)))))
(defconst org-options-keywords
'("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:"
@@ -14006,10 +14055,19 @@ See also `org-scan-tags'.
minus tag mm
tagsmatch todomatch tagsmatcher todomatcher kwd matcher
orterms term orlist re-p str-p level-p level-op time-p
- prop-p pn pv po gv rest)
+ prop-p pn pv po gv rest (start 0) (ss 0))
;; Expand group tags
(setq match (org-tags-expand match))
- (if (string-match "/+" match)
+
+ ;; Check if there is a TODO part of this match, which would be the
+ ;; part after a "/". TO make sure that this slash is not part of
+ ;; a property value to be matched against, we also check that there
+ ;; is no " after that slash.
+ ;; First, find the last slash
+ (while (string-match "/+" match ss)
+ (setq start (match-beginning 0) ss (match-end 0)))
+ (if (and (string-match "/+" match start)
+ (not (save-match-data (string-match "\"" match start))))
;; match contains also a todo-matching request
(progn
(setq tagsmatch (substring match 0 (match-beginning 0))
@@ -15002,16 +15060,6 @@ Being in this list makes sure that they are offered for completion.")
org-property-end-re "\\)\n?")
"Matches an entire clock drawer.")
-(defsubst org-re-property (property)
- "Return a regexp matching a PROPERTY line.
-Match group 1 will be set to the value."
- (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)"))
-
-(defsubst org-re-property-keyword (property)
- "Return a regexp matching a PROPERTY line, possibly with no
-value for the property."
- (concat "^[ \t]*:" (regexp-quote property) ":[ \t]*\\(\\S-.*\\)?"))
-
(defun org-property-action ()
"Do an action on properties."
(interactive)
@@ -15092,13 +15140,9 @@ When INCREMENT is non-nil, set the property to the next allowed value."
(defun org-at-property-p ()
"Is cursor inside a property drawer?"
(save-excursion
- (beginning-of-line 1)
- (when (looking-at (org-re "^[ \t]*\\(:\\([[:alpha:]][[:alnum:]_-]*\\):\\)[ \t]*\\(.*\\)"))
- (save-match-data ;; Used by calling procedures
- (let ((p (point))
- (range (unless (org-before-first-heading-p)
- (org-get-property-block))))
- (and range (<= (car range) p) (< p (cdr range))))))))
+ (when (equal 'node-property (car (org-element-at-point)))
+ (beginning-of-line 1)
+ (looking-at org-property-re))))
(defun org-get-property-block (&optional beg end force)
"Return the (beg . end) range of the body of the property drawer.
@@ -15223,11 +15267,10 @@ things up because then unnecessary parsing is avoided."
(setq range (org-get-property-block beg end))
(when range
(goto-char (car range))
- (while (re-search-forward
- (org-re "^[ \t]*:\\([[:alpha:]][[:alnum:]_-]*\\):[ \t]*\\(\\S-.*\\)?")
+ (while (re-search-forward org-property-re
(cdr range) t)
- (setq key (org-match-string-no-properties 1)
- value (org-trim (or (org-match-string-no-properties 2) "")))
+ (setq key (org-match-string-no-properties 2)
+ value (org-trim (or (org-match-string-no-properties 3) "")))
(unless (member key excluded)
(push (cons key (or value "")) props)))))
(if clocksum
@@ -15276,8 +15319,8 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy."
(setq props
(org-update-property-plist
key
- (if (match-end 1)
- (org-match-string-no-properties 1) "")
+ (if (match-end 3)
+ (org-match-string-no-properties 3) "")
props)))))
val)
(goto-char (car range))
@@ -15466,7 +15509,7 @@ and the new value.")
(setq range (org-get-property-block beg end 'force))
(goto-char (car range))
(if (re-search-forward
- (org-re-property-keyword property) (cdr range) t)
+ (org-re-property property) (cdr range) t)
(progn
(delete-region (match-beginning 0) (match-end 0))
(goto-char (match-beginning 0)))
@@ -15496,10 +15539,9 @@ formats in the current buffer."
(while (re-search-forward org-property-start-re nil t)
(setq range (org-get-property-block))
(goto-char (car range))
- (while (re-search-forward
- (org-re "^[ \t]*:\\([-[:alnum:]_]+\\):")
+ (while (re-search-forward org-property-re
(cdr range) t)
- (add-to-list 'rtn (org-match-string-no-properties 1)))
+ (add-to-list 'rtn (org-match-string-no-properties 2)))
(outline-next-heading))))
(when include-specials
@@ -15537,7 +15579,7 @@ formats in the current buffer."
(let ((re (org-re-property key))
values)
(while (re-search-forward re nil t)
- (add-to-list 'values (org-trim (match-string 1))))
+ (add-to-list 'values (org-trim (match-string 3))))
(delete "" values)))))
(defun org-insert-property-drawer ()
@@ -15566,7 +15608,9 @@ formats in the current buffer."
(beginning-of-line 1)))
(org-skip-over-state-notes)
(skip-chars-backward " \t\n\r")
- (if (eq (char-before) ?*) (forward-char 1))
+ (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n)))
+ (forward-char 1))
+ (goto-char (point-at-eol))
(let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:"))
(beginning-of-line 0)
(org-indent-to-column indent)
@@ -15999,7 +16043,10 @@ If there is already a timestamp at the cursor, it will be
modified.
With two universal prefix arguments, insert an active timestamp
-with the current time without prompting the user."
+with the current time without prompting the user.
+
+When called from lisp, the timestamp is inactive if INACTIVE is
+non-nil."
(interactive "P")
(let* ((ts nil)
(default-time
@@ -16046,7 +16093,7 @@ with the current time without prompting the user."
" " repeater ">"))))
(message "Timestamp updated"))
((equal arg '(16))
- (org-insert-time-stamp (current-time) t))
+ (org-insert-time-stamp (current-time) t inactive))
(t
(setq time (let ((this-command this-command))
(org-read-date arg 'totime nil nil default-time default-input inactive)))
@@ -16068,7 +16115,7 @@ with the current time without prompting the user."
(setq dh (- h2 h1) dm (- m2 m1))
(if (< dm 0) (setq dm (+ dm 60) dh (1- dh)))
(concat t1 "+" (number-to-string dh)
- (if (/= 0 dm) (concat ":" (number-to-string dm))))))))
+ (and (/= 0 dm) (format ":%02d" dm)))))))
(defun org-time-stamp-inactive (&optional arg)
"Insert an inactive time stamp.
@@ -16098,7 +16145,8 @@ So these are more for recording a certain time/date."
(defvar org-read-date-inactive)
(defvar org-read-date-minibuffer-local-map
- (let ((map (make-sparse-keymap)))
+ (let* ((org-replace-disputed-keys nil)
+ (map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(org-defkey map (kbd ".")
(lambda () (interactive)
@@ -17647,6 +17695,21 @@ is not set, the tables are not re-aligned, etc."
:version "24.3"
:group 'org-agenda)
+(defcustom org-agenda-ignore-drawer-properties nil
+ "Avoid updating text properties when building the agenda.
+Properties are used to prepare buffers for effort estimates, appointments,
+and subtree-local categories.
+If you don't use these in the agenda, you can add them to this list and
+agenda building will be a bit faster.
+The value is a list, with zero or more of the symbols `effort', `appt',
+or `category'."
+ :type '(set :greedy t
+ (const effort)
+ (const appt)
+ (const category))
+ :version "24.3"
+ :group 'org-agenda)
+
(defun org-duration-string-to-minutes (s &optional output-to-string)
"Convert a duration string S to minutes.
@@ -18008,9 +18071,12 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
;; this is only run for setting agenda tags from setup
;; file
(org-set-regexps-and-options)))
- (org-refresh-category-properties)
- (org-refresh-properties org-effort-property 'org-effort)
- (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)
+ (or (memq 'category org-agenda-ignore-drawer-properties)
+ (org-refresh-category-properties))
+ (or (memq 'effort org-agenda-ignore-drawer-properties)
+ (org-refresh-properties org-effort-property 'org-effort))
+ (or (memq 'appt org-agenda-ignore-drawer-properties)
+ (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime))
(setq org-todo-keywords-for-agenda
(append org-todo-keywords-for-agenda org-todo-keywords-1))
(setq org-done-keywords-for-agenda
@@ -18222,37 +18288,38 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
(interactive "P")
(unless buffer-file-name
(user-error "Can't preview LaTeX fragment in a non-file buffer"))
- (org-remove-latex-fragment-image-overlays)
- (save-excursion
- (save-restriction
- (let (beg end at msg)
- (cond
- ((or (equal subtree '(16))
- (not (save-excursion
- (re-search-backward org-outline-regexp-bol nil t))))
- (setq beg (point-min) end (point-max)
- msg "Creating images for buffer...%s"))
- ((equal subtree '(4))
- (org-back-to-heading)
- (setq beg (point) end (org-end-of-subtree t)
- msg "Creating images for subtree...%s"))
- (t
- (if (setq at (org-inside-LaTeX-fragment-p))
- (goto-char (max (point-min) (- (cdr at) 2)))
- (org-back-to-heading))
- (setq beg (point) end (progn (outline-next-heading) (point))
- msg (if at "Creating image...%s"
- "Creating images for entry...%s"))))
- (message msg "")
- (narrow-to-region beg end)
- (goto-char beg)
- (org-format-latex
- (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
- (file-name-nondirectory
- buffer-file-name)))
- default-directory 'overlays msg at 'forbuffer
- org-latex-create-formula-image-program)
- (message msg "done. Use `C-c C-c' to remove images.")))))
+ (when (display-graphic-p)
+ (org-remove-latex-fragment-image-overlays)
+ (save-excursion
+ (save-restriction
+ (let (beg end at msg)
+ (cond
+ ((or (equal subtree '(16))
+ (not (save-excursion
+ (re-search-backward org-outline-regexp-bol nil t))))
+ (setq beg (point-min) end (point-max)
+ msg "Creating images for buffer...%s"))
+ ((equal subtree '(4))
+ (org-back-to-heading)
+ (setq beg (point) end (org-end-of-subtree t)
+ msg "Creating images for subtree...%s"))
+ (t
+ (if (setq at (org-inside-LaTeX-fragment-p))
+ (goto-char (max (point-min) (- (cdr at) 2)))
+ (org-back-to-heading))
+ (setq beg (point) end (progn (outline-next-heading) (point))
+ msg (if at "Creating image...%s"
+ "Creating images for entry...%s"))))
+ (message msg "")
+ (narrow-to-region beg end)
+ (goto-char beg)
+ (org-format-latex
+ (concat org-latex-preview-ltxpng-directory (file-name-sans-extension
+ (file-name-nondirectory
+ buffer-file-name)))
+ default-directory 'overlays msg at 'forbuffer
+ org-latex-create-formula-image-program)
+ (message msg "done. Use `C-c C-c' to remove images."))))))
(defun org-format-latex (prefix &optional dir overlays msg at
forbuffer processing-type)
@@ -18485,20 +18552,25 @@ share a good deal of logic."
"Invalid value of `org-latex-create-formula-image-program'")))
string tofile options buffer))
+(declare-function org-export-get-backend "ox" (name))
(declare-function org-export--get-global-options "ox" (&optional backend))
(declare-function org-export--get-inbuffer-options "ox" (&optional backend))
+(declare-function org-latex-guess-inputenc "ox-latex" (header))
+(declare-function org-latex-guess-babel-language "ox-latex" (header info))
(defun org-create-formula--latex-header ()
"Return LaTeX header appropriate for previewing a LaTeX snippet."
- (org-latex-guess-inputenc
- (org-splice-latex-header
- org-format-latex-header
- org-latex-default-packages-alist
- org-latex-packages-alist t
- (plist-get
- (org-combine-plists
- (org-export--get-global-options 'latex)
- (org-export--get-inbuffer-options 'latex))
- :latex-header))))
+ (let ((info (org-combine-plists (org-export--get-global-options
+ (org-export-get-backend 'latex))
+ (org-export--get-inbuffer-options
+ (org-export-get-backend 'latex)))))
+ (org-latex-guess-babel-language
+ (org-latex-guess-inputenc
+ (org-splice-latex-header
+ org-format-latex-header
+ org-latex-default-packages-alist
+ org-latex-packages-alist t
+ (plist-get info :latex-header)))
+ info)))
;; This function borrows from Ganesh Swami's latex2png.el
(defun org-create-formula-image-with-dvipng (string tofile options buffer)
@@ -18581,7 +18653,7 @@ share a good deal of logic."
(font-height (face-font 'default))
(face-attribute 'default :height nil)))
(scale (or (plist-get options (if buffer :scale :html-scale)) 1.0))
- (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.))))))
+ (dpi (number-to-string (* scale (floor (if buffer fnh 120.)))))
(fg (or (plist-get options (if buffer :foreground :html-foreground))
"black"))
(bg (or (plist-get options (if buffer :background :html-background))
@@ -18774,53 +18846,54 @@ When REFRESH is set, refresh existing images between BEG and END.
This will create new image displays only if necessary.
BEG and END default to the buffer boundaries."
(interactive "P")
- (unless refresh
- (org-remove-inline-images)
- (if (fboundp 'clear-image-cache) (clear-image-cache)))
- (save-excursion
- (save-restriction
- (widen)
- (setq beg (or beg (point-min)) end (or end (point-max)))
- (goto-char beg)
- (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
- (substring (org-image-file-name-regexp) 0 -2)
- "\\)\\]" (if include-linked "" "\\]")))
- (case-fold-search t)
- old file ov img type attrwidth width)
- (while (re-search-forward re end t)
- (setq old (get-char-property-and-overlay (match-beginning 1)
- 'org-image-overlay)
- file (expand-file-name
- (concat (or (match-string 3) "") (match-string 4))))
- (when (image-type-available-p 'imagemagick)
- (setq attrwidth (if (or (listp org-image-actual-width)
- (null org-image-actual-width))
- (save-excursion
- (save-match-data
- (when (re-search-backward
- "#\\+attr.*:width[ \t]+\\([^ ]+\\)"
- (save-excursion
- (re-search-backward "^[ \t]*$\\|\\`" nil t)) t)
- (string-to-number (match-string 1))))))
- width (cond ((eq org-image-actual-width t) nil)
- ((null org-image-actual-width) attrwidth)
- ((numberp org-image-actual-width)
- org-image-actual-width)
- ((listp org-image-actual-width)
- (or attrwidth (car org-image-actual-width))))
- type (if width 'imagemagick)))
- (when (file-exists-p file)
- (if (and (car-safe old) refresh)
- (image-refresh (overlay-get (cdr old) 'display))
- (setq img (save-match-data (create-image file type nil :width width)))
- (when img
- (setq ov (make-overlay (match-beginning 0) (match-end 0)))
- (overlay-put ov 'display img)
- (overlay-put ov 'face 'default)
- (overlay-put ov 'org-image-overlay t)
- (overlay-put ov 'modification-hooks
- (list 'org-display-inline-remove-overlay))
- (push ov org-inline-image-overlays)))))))))
+ (when (display-graphic-p)
+ (unless refresh
+ (org-remove-inline-images)
+ (if (fboundp 'clear-image-cache) (clear-image-cache)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq beg (or beg (point-min)) end (or end (point-max)))
+ (goto-char beg)
+ (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]" (if include-linked "" "\\]")))
+ (case-fold-search t)
+ old file ov img type attrwidth width)
+ (while (re-search-forward re end t)
+ (setq old (get-char-property-and-overlay (match-beginning 1)
+ 'org-image-overlay)
+ file (expand-file-name
+ (concat (or (match-string 3) "") (match-string 4))))
+ (when (image-type-available-p 'imagemagick)
+ (setq attrwidth (if (or (listp org-image-actual-width)
+ (null org-image-actual-width))
+ (save-excursion
+ (save-match-data
+ (when (re-search-backward
+ "#\\+attr.*:width[ \t]+\\([^ ]+\\)"
+ (save-excursion
+ (re-search-backward "^[ \t]*$\\|\\`" nil t)) t)
+ (string-to-number (match-string 1))))))
+ width (cond ((eq org-image-actual-width t) nil)
+ ((null org-image-actual-width) attrwidth)
+ ((numberp org-image-actual-width)
+ org-image-actual-width)
+ ((listp org-image-actual-width)
+ (or attrwidth (car org-image-actual-width))))
+ type (if width 'imagemagick)))
+ (when (file-exists-p file)
+ (if (and (car-safe old) refresh)
+ (image-refresh (overlay-get (cdr old) 'display))
+ (setq img (save-match-data (create-image file type nil :width width)))
+ (when img
+ (setq ov (make-overlay (match-beginning 0) (match-end 0)))
+ (overlay-put ov 'display img)
+ (overlay-put ov 'face 'default)
+ (overlay-put ov 'org-image-overlay t)
+ (overlay-put ov 'modification-hooks
+ (list 'org-display-inline-remove-overlay))
+ (push ov org-inline-image-overlays))))))))))
(define-obsolete-function-alias
'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3")
@@ -19036,6 +19109,8 @@ BEG and END default to the buffer boundaries."
(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches)
(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies)
(org-defkey org-mode-map [remap open-line] 'org-open-line)
+(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph)
+(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph)
(org-defkey org-mode-map "\C-m" 'org-return)
(org-defkey org-mode-map "\C-j" 'org-return-indent)
(org-defkey org-mode-map "\C-c?" 'org-table-field-info)
@@ -20153,6 +20228,12 @@ This command does many different things, depending on context:
(when (and (eq (org-element-type parent) 'item)
(= (point-at-bol) (org-element-property :begin parent)))
(setq context parent type 'item))))
+ ;; When heading text is a link, treat the heading, not the link,
+ ;; as the current element
+ (when (eq type 'link)
+ (let ((parent (org-element-property :parent context)))
+ (when (and (eq (org-element-type parent) 'headline))
+ (setq context parent type 'headline))))
;; Act according to type of element or object at point.
(case type
(clock (org-clock-update-time-maybe))
@@ -20298,11 +20379,16 @@ Also updates the keyword regular expressions."
(funcall org-finish-function))))
(defun org-open-line (n)
- "Insert a new row in tables, call `open-line' elsewhere."
+ "Insert a new row in tables, call `open-line' elsewhere.
+If `org-special-ctrl-o' is nil, just call `open-line' everywhere."
(interactive "*p")
- (if (org-at-table-p)
- (org-table-insert-row)
- (open-line n)))
+ (cond
+ ((not org-special-ctrl-o)
+ (open-line n))
+ ((org-at-table-p)
+ (org-table-insert-row))
+ (t
+ (open-line n))))
(defun org-return (&optional indent)
"Goto next table row or insert a newline.
@@ -20621,17 +20707,22 @@ number of stars to add."
(defun org-meta-return (&optional arg)
"Insert a new heading or wrap a region in a table.
-Calls `org-insert-heading' or `org-table-wrap-region', depending on context.
-See the individual commands for more information."
+Calls `org-insert-heading' or `org-table-wrap-region', depending
+on context. See the individual commands for more information."
(interactive "P")
(org-check-before-invisible-edit 'insert)
- (cond
- ((run-hook-with-args-until-success 'org-metareturn-hook))
- ((or (org-at-drawer-p) (org-in-drawer-p) (org-at-property-p))
- (newline-and-indent))
- ((org-at-table-p)
- (call-interactively 'org-table-wrap-region))
- (t (call-interactively 'org-insert-heading))))
+ (or (run-hook-with-args-until-success 'org-metareturn-hook)
+ (let* ((element (org-element-at-point))
+ (type (org-element-type element)))
+ (when (eq type 'table-row)
+ (setq element (org-element-property :parent element))
+ (setq type 'table))
+ (if (and (eq type 'table)
+ (eq (org-element-property :type element) 'org)
+ (>= (point) (org-element-property :contents-begin element))
+ (< (point) (org-element-property :contents-end element)))
+ (call-interactively 'org-table-wrap-region)
+ (call-interactively 'org-insert-heading)))))
;;; Menu entries
@@ -21733,6 +21824,20 @@ Taken from `reduce' in cl-seq.el with all keyword arguments but
(setq cl-accum (funcall cl-func cl-accum (pop cl-seq))))
cl-accum))
+(defun org-every (pred seq)
+ "Return true if PREDICATE is true of every element of SEQ.
+Adapted from `every' in cl.el."
+ (catch 'org-every
+ (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq)
+ t))
+
+(defun org-some (pred seq)
+ "Return true if PREDICATE is true of any element of SEQ.
+Adapted from `some' in cl.el."
+ (catch 'org-some
+ (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq)
+ nil))
+
(defun org-back-over-empty-lines ()
"Move backwards over whitespace, to the beginning of the first empty line.
Returns the number of empty lines passed."
@@ -21997,11 +22102,10 @@ hierarchy of headlines by UP levels before marking the subtree."
;; Special polishing for properties, see `org-property-format'
(setq column (current-column))
(beginning-of-line 1)
- (if (looking-at
- "\\([ \t]*\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)")
- (replace-match (concat (match-string 1)
+ (if (looking-at org-property-re)
+ (replace-match (concat (match-string 4)
(format org-property-format
- (match-string 2) (match-string 3)))
+ (match-string 1) (match-string 3)))
t t))
(org-move-to-column column))))
@@ -22074,28 +22178,26 @@ hierarchy of headlines by UP levels before marking the subtree."
;; `org-setup-filling' installs filling and auto-filling related
;; variables during `org-mode' initialization.
+(defvar org-element-paragraph-separate) ; org-element.el
(defun org-setup-filling ()
- (interactive)
+ (require 'org-element)
;; Prevent auto-fill from inserting unwanted new items.
(when (boundp 'fill-nobreak-predicate)
(org-set-local
'fill-nobreak-predicate
(org-uniquify
(append fill-nobreak-predicate
- '(org-fill-paragraph-separate-nobreak-p
- org-fill-line-break-nobreak-p
+ '(org-fill-line-break-nobreak-p
org-fill-paragraph-with-timestamp-nobreak-p)))))
+ (let ((paragraph-ending (substring org-element-paragraph-separate 1)))
+ (org-set-local 'paragraph-start paragraph-ending)
+ (org-set-local 'paragraph-separate paragraph-ending))
(org-set-local 'fill-paragraph-function 'org-fill-paragraph)
(org-set-local 'auto-fill-inhibit-regexp nil)
(org-set-local 'adaptive-fill-function 'org-adaptive-fill-function)
(org-set-local 'normal-auto-fill-function 'org-auto-fill-function)
(org-set-local 'comment-line-break-function 'org-comment-line-break-function))
-(defvar org-element-paragraph-separate) ; org-element.el
-(defun org-fill-paragraph-separate-nobreak-p ()
- "Non-nil when a new line at point would end current paragraph."
- (looking-at (substring org-element-paragraph-separate 1)))
-
(defun org-fill-line-break-nobreak-p ()
"Non-nil when a new line at point would create an Org line break."
(save-excursion
@@ -22115,70 +22217,73 @@ hierarchy of headlines by UP levels before marking the subtree."
Return fill prefix, as a string, or nil if current line isn't
meant to be filled. For convenience, if `adaptive-fill-regexp'
matches in paragraphs or comments, use it."
- (let (prefix)
- (catch 'exit
- (when (derived-mode-p 'message-mode)
- (save-excursion
- (beginning-of-line)
- (cond ((or (not (message-in-body-p))
- (looking-at orgtbl-line-start-regexp))
- (throw 'exit nil))
- ((looking-at message-cite-prefix-regexp)
- (throw 'exit (match-string-no-properties 0)))
- ((looking-at org-outline-regexp)
- (throw 'exit (make-string (length (match-string 0)) ? ))))))
- (org-with-wide-buffer
- (let* ((p (line-beginning-position))
- (element (save-excursion
- (beginning-of-line)
- (or (ignore-errors (org-element-at-point))
- (user-error "An element cannot be parsed line %d"
- (line-number-at-pos (point))))))
- (type (org-element-type element))
- (post-affiliated (org-element-property :post-affiliated element)))
- (unless (and post-affiliated (< p post-affiliated))
- (case type
- (comment
+ (catch 'exit
+ (when (derived-mode-p 'message-mode)
+ (save-excursion
+ (beginning-of-line)
+ (cond ((or (not (message-in-body-p))
+ (looking-at orgtbl-line-start-regexp))
+ (throw 'exit nil))
+ ((looking-at message-cite-prefix-regexp)
+ (throw 'exit (match-string-no-properties 0)))
+ ((looking-at org-outline-regexp)
+ (throw 'exit (make-string (length (match-string 0)) ? ))))))
+ (org-with-wide-buffer
+ (let* ((p (line-beginning-position))
+ (element (save-excursion
+ (beginning-of-line)
+ (or (ignore-errors (org-element-at-point))
+ (user-error "An element cannot be parsed line %d"
+ (line-number-at-pos (point))))))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element)))
+ (unless (and post-affiliated (< p post-affiliated))
+ (case type
+ (comment
+ (save-excursion
+ (beginning-of-line)
+ (looking-at "[ \t]*")
+ (concat (match-string 0) "# ")))
+ (footnote-definition "")
+ ((item plain-list)
+ (make-string (org-list-item-body-column
+ (or post-affiliated
+ (org-element-property :begin element)))
+ ? ))
+ (paragraph
+ ;; Fill prefix is usually the same as the current line,
+ ;; unless the paragraph is at the beginning of an item.
+ (let ((parent (org-element-property :parent element)))
(save-excursion
(beginning-of-line)
- (looking-at "[ \t]*#")
- (goto-char (match-end 0))
- (let ((comment-prefix (match-string 0)))
- (if (looking-at adaptive-fill-regexp)
- (concat comment-prefix (match-string 0))
- comment-prefix))))
- (footnote-definition "")
- ((item plain-list)
- (make-string (org-list-item-body-column
- (or post-affiliated
- (org-element-property :begin element)))
- ? ))
- (paragraph
- ;; Fill prefix is usually the same as the current line,
- ;; unless the paragraph is at the beginning of an item.
- (let ((parent (org-element-property :parent element)))
- (save-excursion
- (beginning-of-line)
- (cond ((eq (org-element-type parent) 'item)
- (make-string (org-list-item-body-column
- (org-element-property :begin parent))
- ? ))
- ((looking-at adaptive-fill-regexp) (match-string 0))
- ((looking-at "[ \t]+") (match-string 0))
- (t "")))))
- (comment-block
- ;; Only fill contents if P is within block boundaries.
- (let* ((cbeg (save-excursion (goto-char post-affiliated)
- (forward-line)
- (point)))
- (cend (save-excursion
- (goto-char (org-element-property :end element))
- (skip-chars-backward " \r\t\n")
- (line-beginning-position))))
- (when (and (>= p cbeg) (< p cend))
- (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
- (match-string 0)
- "")))))))))))
+ (cond ((eq (org-element-type parent) 'item)
+ (make-string (org-list-item-body-column
+ (org-element-property :begin parent))
+ ? ))
+ ((and adaptive-fill-regexp
+ ;; Locally disable
+ ;; `adaptive-fill-function' to let
+ ;; `fill-context-prefix' handle
+ ;; `adaptive-fill-regexp' variable.
+ (let (adaptive-fill-function)
+ (fill-context-prefix
+ post-affiliated
+ (org-element-property :end element)))))
+ ((looking-at "[ \t]+") (match-string 0))
+ (t "")))))
+ (comment-block
+ ;; Only fill contents if P is within block boundaries.
+ (let* ((cbeg (save-excursion (goto-char post-affiliated)
+ (forward-line)
+ (point)))
+ (cend (save-excursion
+ (goto-char (org-element-property :end element))
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (when (and (>= p cbeg) (< p cend))
+ (if (save-excursion (beginning-of-line) (looking-at "[ \t]+"))
+ (match-string 0)
+ ""))))))))))
(declare-function message-goto-body "message" ())
(defvar message-cite-prefix-regexp) ; From message.el
@@ -22588,7 +22693,7 @@ to work in this buffer and calls `reftex-citation' to insert a citation
into the buffer.
Export of such citations to both LaTeX and HTML is handled by the contributed
-package org-exp-bibtex by Taru Karttunen."
+package ox-bibtex by Taru Karttunen."
(interactive)
(let ((reftex-docstruct-symbol 'rds)
(reftex-cite-format "\\cite{%l}")
@@ -22619,7 +22724,7 @@ beyond the end of the headline."
(special (if (consp org-special-ctrl-a/e)
(car org-special-ctrl-a/e)
org-special-ctrl-a/e))
- refpos)
+ deactivate-mark refpos)
(if (org-bound-and-true-p visual-line-mode)
(beginning-of-visual-line 1)
(beginning-of-line 1))
@@ -22671,7 +22776,10 @@ beyond the end of the headline."
(when (and (= (point) pos) (eq last-command this-command))
(goto-char after-bullet))))))))
(org-no-warnings
- (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (and (featurep 'xemacs) (setq zmacs-region-stays t))))
+ (setq disable-point-adjustment
+ (or (not (invisible-p (point)))
+ (not (invisible-p (max (point-min) (1- (point))))))))
(defun org-end-of-line (&optional arg)
"Go to the end of the line.
@@ -22684,7 +22792,8 @@ the cursor is already beyond the end of the headline."
(move-fun (cond ((org-bound-and-true-p visual-line-mode)
'end-of-visual-line)
((fboundp 'move-end-of-line) 'move-end-of-line)
- (t 'end-of-line))))
+ (t 'end-of-line)))
+ deactivate-mark)
(if (or (not special) arg) (call-interactively move-fun)
(let* ((element (save-excursion (beginning-of-line)
(org-element-at-point)))
@@ -22708,7 +22817,10 @@ the cursor is already beyond the end of the headline."
;; after it. Use `end-of-line' to stay on current line.
(call-interactively 'end-of-line))
(t (call-interactively move-fun)))))
- (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))))
+ (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))
+ (setq disable-point-adjustment
+ (or (not (invisible-p (point)))
+ (not (invisible-p (max (point-min) (1- (point))))))))
(define-key org-mode-map "\C-a" 'org-beginning-of-line)
(define-key org-mode-map "\C-e" 'org-end-of-line)
@@ -23182,6 +23294,152 @@ When BLOCK-REGEXP is non-nil, use this regexp to find blocks."
(interactive "p")
(org-next-block arg t block-regexp))
+(defun org-forward-paragraph ()
+ "Move forward to beginning of next paragraph or equivalent.
+
+The function moves point to the beginning of the next visible
+structural element, which can be a paragraph, a table, a list
+item, etc. It also provides some special moves for convenience:
+
+ - On an affiliated keyword, jump to the beginning of the
+ relative element.
+ - On an item or a footnote definition, move to the second
+ element inside, if any.
+ - On a table or a property drawer, jump after it.
+ - On a verse or source block, stop after blank lines."
+ (interactive)
+ (when (eobp) (user-error "Cannot move further down"))
+ (let* ((deactivate-mark nil)
+ (element (org-element-at-point))
+ (type (org-element-type element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (contents-begin (org-element-property :contents-begin element))
+ (contents-end (org-element-property :contents-end element))
+ (end (let ((end (org-element-property :end element)) (parent element))
+ (while (and (setq parent (org-element-property :parent parent))
+ (= (org-element-property :contents-end parent) end))
+ (setq end (org-element-property :end parent)))
+ end)))
+ (cond ((not element)
+ (skip-chars-forward " \r\t\n")
+ (or (eobp) (beginning-of-line)))
+ ;; On affiliated keywords, move to element's beginning.
+ ((and post-affiliated (< (point) post-affiliated))
+ (goto-char post-affiliated))
+ ;; At a table row, move to the end of the table. Similarly,
+ ;; at a node property, move to the end of the property
+ ;; drawer.
+ ((memq type '(node-property table-row))
+ (goto-char (org-element-property
+ :end (org-element-property :parent element))))
+ ((memq type '(property-drawer table)) (goto-char end))
+ ;; Consider blank lines as separators in verse and source
+ ;; blocks to ease editing.
+ ((memq type '(src-block verse-block))
+ (when (eq type 'src-block)
+ (setq contents-end
+ (save-excursion (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position))))
+ (beginning-of-line)
+ (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n"))
+ (if (not (re-search-forward "^[ \t]*$" contents-end t))
+ (goto-char end)
+ (skip-chars-forward " \r\t\n")
+ (if (= (point) contents-end) (goto-char end)
+ (beginning-of-line))))
+ ;; With no contents, just skip element.
+ ((not contents-begin) (goto-char end))
+ ;; If contents are invisible, skip the element altogether.
+ ((outline-invisible-p (line-end-position))
+ (case type
+ (headline
+ (org-with-limited-levels (outline-next-visible-heading 1)))
+ ;; At a plain list, make sure we move to the next item
+ ;; instead of skipping the whole list.
+ (plain-list (forward-char)
+ (org-forward-paragraph))
+ (otherwise (goto-char end))))
+ ((>= (point) contents-end) (goto-char end))
+ ((>= (point) contents-begin)
+ ;; This can only happen on paragraphs and plain lists.
+ (case type
+ (paragraph (goto-char end))
+ ;; At a plain list, try to move to second element in
+ ;; first item, if possible.
+ (plain-list (end-of-line)
+ (org-forward-paragraph))))
+ ;; When contents start on the middle of a line (e.g. in
+ ;; items and footnote definitions), try to reach first
+ ;; element starting after current line.
+ ((> (line-end-position) contents-begin)
+ (end-of-line)
+ (org-forward-paragraph))
+ (t (goto-char contents-begin)))))
+
+(defun org-backward-paragraph ()
+ "Move backward to start of previous paragraph or equivalent.
+
+The function moves point to the beginning of the current
+structural element, which can be a paragraph, a table, a list
+item, etc., or to the beginning of the previous visible one if
+point is already there. It also provides some special moves for
+convenience:
+
+ - On an affiliated keyword, jump to the first one.
+ - On a table or a property drawer, move to its beginning.
+ - On a verse or source block, stop before blank lines."
+ (interactive)
+ (when (bobp) (user-error "Cannot move further up"))
+ (let* ((deactivate-mark nil)
+ (element (org-element-at-point))
+ (type (org-element-type element))
+ (contents-begin (org-element-property :contents-begin element))
+ (contents-end (org-element-property :contents-end element))
+ (post-affiliated (org-element-property :post-affiliated element))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((not element) (goto-char (point-min)))
+ ((= (point) begin)
+ (backward-char)
+ (org-backward-paragraph))
+ ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin))
+ ((memq type '(node-property table-row))
+ (goto-char (org-element-property
+ :post-affiliated (org-element-property :parent element))))
+ ((memq type '(property-drawer table)) (goto-char begin))
+ ((memq type '(src-block verse-block))
+ (when (eq type 'src-block)
+ (setq contents-begin
+ (save-excursion (goto-char begin) (forward-line) (point))))
+ (if (= (point) contents-begin) (goto-char post-affiliated)
+ ;; Inside a verse block, see blank lines as paragraph
+ ;; separators.
+ (let ((origin (point)))
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (when (re-search-backward "^[ \t]*$" contents-begin 'move)
+ (skip-chars-forward " \r\t\n" origin)
+ (if (= (point) origin) (goto-char contents-begin)
+ (beginning-of-line))))))
+ ((not contents-begin) (goto-char (or post-affiliated begin)))
+ ((eq type 'paragraph)
+ (goto-char contents-begin)
+ ;; When at first paragraph in an item or a footnote definition,
+ ;; move directly to beginning of line.
+ (let ((parent-contents
+ (org-element-property
+ :contents-begin (org-element-property :parent element))))
+ (when (and parent-contents (= parent-contents contents-begin))
+ (beginning-of-line))))
+ ;; At the end of a greater element, move to the beginning of the
+ ;; last element within.
+ ((>= (point) contents-end)
+ (goto-char (1- contents-end))
+ (org-backward-paragraph))
+ (t (goto-char (or post-affiliated begin))))
+ ;; Ensure we never leave point invisible.
+ (when (outline-invisible-p (point)) (beginning-of-visual-line))))
+
(defun org-forward-element ()
"Move forward by one element.
Move to the next element at the same level, when possible."
@@ -23611,7 +23869,8 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]."
(not (member-ignore-case word (org-get-export-keywords)))
(not (member-ignore-case
word (mapcar 'car org-element-block-name-alist)))
- (not (member-ignore-case word '("BEGIN" "END" "ATTR"))))))
+ (not (member-ignore-case word '("BEGIN" "END" "ATTR")))
+ (not (org-in-src-block-p)))))
(defun org-remove-flyspell-overlays-in (beg end)
"Remove flyspell overlays in region."
diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el
index 59d0152..74a7c64 100644
--- a/lisp/ox-ascii.el
+++ b/lisp/ox-ascii.el
@@ -1657,8 +1657,7 @@ contextual information."
(buffer-substring (point-min) (point))))
(t (org-remove-indentation (org-element-property :value table))))
;; Possible add a caption string below.
- (when (and caption (not org-ascii-caption-above))
- (concat "\n" caption)))))
+ (and (not org-ascii-caption-above) caption))))
;;;; Table Cell
@@ -1902,23 +1901,8 @@ Export is done in a buffer named \"*Org ASCII Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org ASCII Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (text-mode)
- (org-export-add-to-stack (current-buffer) 'ascii)))
- `(org-export-as 'ascii ,subtreep ,visible-only ,body-only
- ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 'ascii "*Org ASCII Export*"
- subtreep visible-only body-only ext-plist)))
- (with-current-buffer outbuf (text-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'ascii "*Org ASCII Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (text-mode))))
;;;###autoload
(defun org-ascii-export-to-ascii
@@ -1950,15 +1934,9 @@ file-local settings.
Return output file's name."
(interactive)
- (let ((outfile (org-export-output-file-name ".txt" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'ascii))
- `(expand-file-name
- (org-export-to-file
- 'ascii ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))
- (org-export-to-file
- 'ascii outfile subtreep visible-only body-only ext-plist))))
+ (let ((file (org-export-output-file-name ".txt" subtreep)))
+ (org-export-to-file 'ascii file
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-ascii-publish-to-ascii (plist filename pub-dir)
diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el
index b6e0f3a..a975d24 100644
--- a/lisp/ox-beamer.el
+++ b/lisp/ox-beamer.el
@@ -194,12 +194,13 @@ open The opening template for the environment, with the following escapes
%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
+ %r the raw headline text (i.e. without any processing)
+ %H if there is headline text, that raw text in {} braces
+ %U if there is headline text, that raw text in [] brackets
close The closing string of the environment."
:group 'org-export-beamer
:version "24.4"
- :package-version '(Org . "8.0")
+ :package-version '(Org . "8.1")
:type '(repeat
(list
(string :tag "Environment")
@@ -538,11 +539,14 @@ used as a communication channel."
((not env) "column")
;; Use specified environment.
(t env))))
- (env-format (unless (member environment '("column" "columns"))
- (assoc environment
- (append org-beamer-environments-special
- org-beamer-environments-extra
- org-beamer-environments-default))))
+ (raw-title (org-element-property :raw-value headline))
+ (env-format
+ (cond ((member environment '("column" "columns")) nil)
+ ((assoc environment
+ (append org-beamer-environments-extra
+ org-beamer-environments-default)))
+ (t (user-error "Wrong block type at a headline named \"%s\""
+ raw-title))))
(title (org-export-data (org-element-property :title headline) info))
(options (let ((options (org-element-property :BEAMER_OPT headline)))
(if (not options) ""
@@ -587,7 +591,7 @@ used as a communication channel."
(if (equal environment "column") options "")
(format "%s\\textwidth" column-width)))
;; Block's opening string.
- (when env-format
+ (when (nth 2 env-format)
(concat
(org-fill-template
(nth 2 env-format)
@@ -608,12 +612,15 @@ used as a communication channel."
(cons "A" "")))))
(list (cons "o" options)
(cons "h" title)
- (cons "H" (if (equal title "") "" (format "{%s}" title)))
- (cons "U" (if (equal title "") "" (format "[%s]" title))))))
+ (cons "r" raw-title)
+ (cons "H" (if (equal raw-title "") ""
+ (format "{%s}" raw-title)))
+ (cons "U" (if (equal raw-title "") ""
+ (format "[%s]" raw-title))))))
"\n"))
contents
- ;; Block's closing string.
- (when environment (concat (nth 3 env-format) "\n"))
+ ;; Block's closing string, if any.
+ (and (nth 3 env-format) (concat (nth 3 env-format) "\n"))
(when column-width "\\end{column}\n")
(when end-columns-p "\\end{columns}"))))
@@ -1058,23 +1065,8 @@ Export is done in a buffer named \"*Org BEAMER Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org BEAMER Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (LaTeX-mode)
- (org-export-add-to-stack (current-buffer) 'beamer)))
- `(org-export-as 'beamer ,subtreep ,visible-only ,body-only
- ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 'beamer "*Org BEAMER Export*"
- subtreep visible-only body-only ext-plist)))
- (with-current-buffer outbuf (LaTeX-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'beamer "*Org BEAMER Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
;;;###autoload
(defun org-beamer-export-to-latex
@@ -1106,16 +1098,9 @@ file-local settings.
Return output file's name."
(interactive)
- (let ((outfile (org-export-output-file-name ".tex" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'beamer))
- `(expand-file-name
- (org-export-to-file
- 'beamer ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))
- (org-export-to-file
- 'beamer outfile subtreep visible-only body-only ext-plist))))
+ (let ((file (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'beamer file
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-beamer-export-to-pdf
@@ -1147,18 +1132,10 @@ file-local settings.
Return PDF file's name."
(interactive)
- (if async
- (let ((outfile (org-export-output-file-name ".tex" subtreep)))
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'beamer))
- `(expand-file-name
- (org-latex-compile
- (org-export-to-file
- 'beamer ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))))
- (org-latex-compile
- (org-beamer-export-to-latex
- nil subtreep visible-only body-only ext-plist))))
+ (let ((file (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'beamer file
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
;;;###autoload
(defun org-beamer-select-environment ()
diff --git a/lisp/ox-html.el b/lisp/ox-html.el
index 8794882..14b31b2 100644
--- a/lisp/ox-html.el
+++ b/lisp/ox-html.el
@@ -37,7 +37,7 @@
(require 'ox)
(require 'ox-publish)
(require 'format-spec)
-(eval-when-compile (require 'cl) (require 'table))
+(eval-when-compile (require 'cl) (require 'table nil 'noerror))
;;; Function Declarations
@@ -116,6 +116,8 @@
(:html-link-org-as-html nil nil org-html-link-org-files-as-html)
(:html-doctype "HTML_DOCTYPE" nil org-html-doctype)
(:html-container "HTML_CONTAINER" nil org-html-container-element)
+ (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy)
+ (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url)
(:html-link-home "HTML_LINK_HOME" nil org-html-link-home)
(:html-link-up "HTML_LINK_UP" nil org-html-link-up)
(:html-mathjax "HTML_MATHJAX" nil "" space)
@@ -123,8 +125,8 @@
(:html-preamble nil "html-preamble" org-html-preamble)
(:html-head "HTML_HEAD" nil org-html-head newline)
(:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline)
- (:html-head-include-default-style "HTML_INCLUDE_STYLE" nil org-html-head-include-default-style newline)
- (:html-head-include-scripts "HTML_INCLUDE_SCRIPTS" nil org-html-head-include-scripts newline)
+ (:html-head-include-default-style nil "html-style" org-html-head-include-default-style)
+ (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts)
(:html-table-attributes nil nil org-html-table-default-attributes)
(:html-table-row-tags nil nil org-html-table-row-tags)
(:html-xml-declaration nil nil org-html-xml-declaration)
@@ -143,6 +145,38 @@
(defvar org-html--pre/postamble-class "status"
"CSS class used for pre/postamble")
+(defconst org-html-doctype-alist
+ '(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\"
+\"http://www.w3.org/TR/html4/strict.dtd\">")
+ ("html4-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
+\"http://www.w3.org/TR/html4/loose.dtd\">")
+ ("html4-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\"
+\"http://www.w3.org/TR/html4/frameset.dtd\">")
+
+ ("xhtml-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")
+ ("xhtml-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">")
+ ("xhtml-framset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">")
+ ("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\"
+\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">")
+
+ ("html5" . "<!DOCTYPE html>")
+ ("xhtml5" . "<!DOCTYPE html>"))
+ "An alist mapping (x)html flavors to specific doctypes.")
+
+(defconst org-html-html5-elements
+ '("article" "aside" "audio" "canvas" "details" "figcaption"
+ "figure" "footer" "header" "menu" "meter" "nav" "output"
+ "progress" "section" "video")
+ "New elements in html5.
+
+<hgroup> is not included because it's currently impossible to
+wrap special blocks around multiple headlines. For other blocks
+that should contain headlines, use the HTML_CONTAINER property on
+the headline itself.")
+
(defconst org-html-special-string-regexps
'(("\\\\-" . "&#x00ad;") ; shy
("---\\([^-]\\)" . "&#x2014;\\1") ; mdash
@@ -680,16 +714,14 @@ When nil, the links still point to the plain `.org' file."
;;;; Links :: Inline images
-(defcustom org-html-inline-images 'maybe
+(defcustom org-html-inline-images t
"Non-nil means inline images into exported HTML pages.
This is done using an <img> tag. When nil, an anchor with href is used to
-link to the image. If this option is `maybe', then images in links with
-an empty description will be inlined, while images with a description will
-be linked only."
+link to the image."
:group 'org-export-html
- :type '(choice (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "When there is no description" maybe)))
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type 'boolean)
(defcustom org-html-inline-image-rules
'(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")
@@ -748,7 +780,9 @@ in all modes you want. Then, use the command
'(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides")
"Default attributes and values which will be used in table tags.
This is a plist where attributes are symbols, starting with
-colons, and values are strings."
+colons, and values are strings.
+
+When exporting to HTML5, these values will be disregarded."
:group 'org-export-html
:version "24.4"
:package-version '(Org . "8.0")
@@ -856,7 +890,9 @@ CSS classes, then this prefix can be very useful."
"The extension for exported HTML files.
%s will be replaced with the charset of the exported file.
This may be a string, or an alist with export extensions
-and corresponding declarations."
+and corresponding declarations.
+
+This declaration only applies when exporting to XHTML."
:group 'org-export-html
:type '(choice
(string :tag "Single declaration")
@@ -872,8 +908,7 @@ Use utf-8 as the default value."
:package-version '(Org . "8.0")
:type 'coding-system)
-(defcustom org-html-doctype
- "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"
+(defcustom org-html-doctype "xhtml-strict"
"Document type definition to use for exported HTML files.
Can be set with the in-buffer HTML_DOCTYPE property or for
publishing, with :html-doctype."
@@ -882,6 +917,20 @@ publishing, with :html-doctype."
:package-version '(Org . "8.0")
:type 'string)
+(defcustom org-html-html5-fancy nil
+ "Non-nil means using new HTML5 elements.
+This variable is ignored for anything other than HTML5 export.
+
+For compatibility with Internet Explorer, it's probably a good
+idea to download some form of the html5shiv (for instance
+https://code.google.com/p/html5shiv/) and add it to your
+HTML_HEAD_EXTRA, so that your pages don't break for users of IE
+versions 8 and below."
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.0")
+ :type 'boolean)
+
(defcustom org-html-container-element "div"
"HTML element to use for wrapping top level sections.
Can be set with the in-buffer HTML_CONTAINER property or for
@@ -962,7 +1011,8 @@ You can also customize this for each buffer, using something like
(const :format " " mathml) (boolean))))
(defcustom org-html-mathjax-template
- "<script type=\"text/javascript\" src=\"%PATH\">
+ "<script type=\"text/javascript\" src=\"%PATH\"></script>
+<script type=\"text/javascript\">
<!--/*--><![CDATA[/*><!--*/
MathJax.Hub.Config({
// Only one of the two following lines, depending on user settings
@@ -1026,7 +1076,7 @@ Setting :html-postamble in publishing projects will take
precedence over this variable."
:group 'org-export-html
:type '(choice (const :tag "No postamble" nil)
- (const :tag "Auto postamble" 'auto)
+ (const :tag "Auto postamble" auto)
(const :tag "Default formatting string" t)
(string :tag "Custom formatting string")
(function :tag "Function (must return a string)")))
@@ -1035,7 +1085,7 @@ precedence over this variable."
'(("en" "<p class=\"author\">Author: %a (%e)</p>
<p class=\"date\">Date: %d</p>
<p class=\"creator\">%c</p>
-<p class=\"xhtml-validation\">%v</p>"))
+<p class=\"validation\">%v</p>"))
"Alist of languages and format strings for the HTML postamble.
The first element of each list is the language code, as used for
@@ -1056,11 +1106,12 @@ postamble itself. This format string can contain these elements:
If you need to use a \"%\" character, you need to escape it
like that: \"%%\"."
:group 'org-export-html
- :type '(alist :key-type (string :tag "Language")
- :value-type (string :tag "Format string")))
+ :type '(repeat
+ (list (string :tag "Language")
+ (string :tag "Format string"))))
(defcustom org-html-validation-link
- "<a href=\"http://validator.w3.org/check?uri=referer\">Validate XHTML 1.0</a>"
+ "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>"
"Link to HTML validation service."
:group 'org-export-html
:type 'string)
@@ -1120,8 +1171,9 @@ like that: \"%%\".
See the default value of `org-html-postamble-format' for an
example."
:group 'org-export-html
- :type '(alist :key-type (string :tag "Language")
- :value-type (string :tag "Format string")))
+ :type '(repeat
+ (list (string :tag "Language")
+ (string :tag "Format string"))))
(defcustom org-html-link-up ""
"Where should the \"UP\" link of exported HTML pages lead?"
@@ -1133,6 +1185,13 @@ example."
:group 'org-export-html
:type '(string :tag "File or URL"))
+(defcustom org-html-link-use-abs-url nil
+ "Should we prepend relative links with HTML_LINK_HOME?"
+ :group 'org-export-html
+ :version "24.4"
+ :package-version '(Org . "8.1")
+ :type 'boolean)
+
(defcustom org-html-home/up-format
"<div id=\"org-div-home-and-up\">
<a accesskey=\"h\" href=\"%s\"> UP </a>
@@ -1240,6 +1299,26 @@ CSS classes, then this prefix can be very useful."
;;; Internal Functions
+(defun org-html-xhtml-p (info)
+ (let ((dt (downcase (plist-get info :html-doctype))))
+ (string-match-p "xhtml" dt)))
+
+(defun org-html-html5-p (info)
+ (let ((dt (downcase (plist-get info :html-doctype))))
+ (member dt '("html5" "xhtml5" "<!doctype html>"))))
+
+(defun org-html-close-tag (tag attr info)
+ (concat "<" tag " " attr
+ (if (org-html-xhtml-p info) " />" ">")))
+
+(defun org-html-doctype (info)
+ "Return correct html doctype tag from `org-html-doctype-alist',
+or the literal value of :html-doctype from INFO if :html-doctype
+is not found in the alist.
+INFO is a plist used as a communication channel."
+ (let ((dt (plist-get info :html-doctype)))
+ (or (cdr (assoc dt org-html-doctype-alist)) dt)))
+
(defun org-html--make-attribute-string (attributes)
"Return a list of attributes, as a string.
ATTRIBUTES is a plist where values are either strings or nil. An
@@ -1253,32 +1332,43 @@ attributes with a nil value will be omitted from the result."
"\"" "&quot;" (org-html-encode-plain-text item))))
(setcar output (format "%s=\"%s\"" key value))))))))
-(defun org-html-format-inline-image (src &optional
- caption label attr standalone-p)
- "Format an inline image from SRC.
-CAPTION, LABEL and ATTR are optional arguments providing the
-caption, the label and the attribute of the image.
-When STANDALONE-P is t, wrap the <img.../> into a <div>...</div>."
- (let* ((id (if (not label) ""
- (format " id=\"%s\"" (org-export-solidify-link-text label))))
- (attr (concat attr
- (cond
- ((string-match "\\<alt=" (or attr "")) "")
- ((string-match "^ltxpng/" src)
- (format " alt=\"%s\""
- (org-html-encode-plain-text
- (org-find-text-property-in-string
- 'org-latex-src src))))
- (t (format " alt=\"%s\""
- (file-name-nondirectory src)))))))
- (cond
- (standalone-p
- (let ((img (format "<img src=\"%s\" %s/>" src attr)))
- (format "\n<div%s class=\"figure\">%s%s\n</div>"
- id (format "\n<p>%s</p>" img)
- (if (and caption (not (string= caption "")))
- (format "\n<p>%s</p>" caption) ""))))
- (t (format "<img src=\"%s\" %s/>" src (concat attr id))))))
+(defun org-html--wrap-image (contents info &optional caption label)
+ "Wrap CONTENTS string within an appropriate environment for images.
+INFO is a plist used as a communication channel. When optional
+arguments CAPTION and LABEL are given, use them for caption and
+\"id\" attribute."
+ (let ((html5-fancy (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))))
+ (format (if html5-fancy "\n<figure%s>%s%s\n</figure>"
+ "\n<div%s class=\"figure\">%s%s\n</div>")
+ ;; ID.
+ (if (not (org-string-nw-p label)) ""
+ (format " id=\"%s\"" (org-export-solidify-link-text label)))
+ ;; Contents.
+ (format "\n<p>%s</p>" contents)
+ ;; Caption.
+ (if (not (org-string-nw-p caption)) ""
+ (format (if html5-fancy "\n<figcaption>%s</figcaption>"
+ "\n<p>%s</p>")
+ caption)))))
+
+(defun org-html--format-image (source attributes info)
+ "Return \"img\" tag with given SOURCE and ATTRIBUTES.
+SOURCE is a string specifying the location of the image.
+ATTRIBUTES is a plist, as returned by
+`org-export-read-attribute'. INFO is a plist used as
+a communication channel."
+ (org-html-close-tag
+ "img"
+ (org-html--make-attribute-string
+ (org-combine-plists
+ (list :src source
+ :alt (if (string-match-p "^ltxpng/" source)
+ (org-html-encode-plain-text
+ (org-find-text-property-in-string 'org-latex-src source))
+ (file-name-nondirectory source)))
+ attributes))
+ info))
(defun org-html--textarea-block (element)
"Transcode ELEMENT into a textarea block.
@@ -1290,6 +1380,13 @@ ELEMENT is either a src block or an example block."
(or (plist-get attr :height) (org-count-lines code))
code)))
+(defun org-html--has-caption-p (element &optional info)
+ "Non-nil when ELEMENT has a caption affiliated keyword.
+INFO is a plist used as a communication channel. This function
+is meant to be used as a predicate for `org-export-get-ordinal' or
+a value to `org-html-standalone-image-predicate'."
+ (org-element-property :caption element))
+
;;;; Table
(defun org-html-htmlize-region-for-paste (beg end)
@@ -1417,28 +1514,47 @@ INFO is a plist used as a communication channel."
(cons 'plain-text org-element-all-objects)
'identity info))))))
(description (plist-get info :description))
- (keywords (plist-get info :keywords)))
+ (keywords (plist-get info :keywords))
+ (charset (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system
+ 'mime-charset))
+ "iso-8859-1")))
(concat
(format "<title>%s</title>\n" title)
(when (plist-get info :time-stamp-file)
(format-time-string
(concat "<!-- " org-html-metadata-timestamp-format " -->\n")))
(format
- "<meta http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"/>\n"
- (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get org-html-coding-system 'mime-charset))
- "iso-8859-1"))
- (format "<meta name=\"generator\" content=\"Org-mode\"/>\n")
+ (if (org-html-html5-p info)
+ (org-html-close-tag "meta" " charset=\"%s\"" info)
+ (org-html-close-tag
+ "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\""
+ info))
+ charset) "\n"
+ (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info)
+ "\n"
(and (org-string-nw-p author)
- (format "<meta name=\"author\" content=\"%s\"/>\n"
- (funcall protect-string author)))
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"author\" content=\"%s\""
+ (funcall protect-string author))
+ info)
+ "\n"))
(and (org-string-nw-p description)
- (format "<meta name=\"description\" content=\"%s\"/>\n"
- (funcall protect-string description)))
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"description\" content=\"%s\"\n"
+ (funcall protect-string description))
+ info)
+ "\n"))
(and (org-string-nw-p keywords)
- (format "<meta name=\"keywords\" content=\"%s\"/>\n"
- (funcall protect-string keywords))))))
+ (concat
+ (org-html-close-tag "meta"
+ (format " name=\"keywords\" content=\"%s\""
+ (funcall protect-string keywords))
+ info)
+ "\n")))))
(defun org-html--build-head (info)
"Return information for the <head>..</head> of the HTML output.
@@ -1451,8 +1567,10 @@ INFO is a plist used as a communication channel."
(org-element-normalize-string (plist-get info :html-head-extra))
(when (and (plist-get info :html-htmlized-css-url)
(eq org-html-htmlize-output-type 'css))
- (format "<link rel=\"stylesheet\" href=\"%s\" type=\"text/css\" />\n"
- (plist-get info :html-htmlized-css-url)))
+ (org-html-close-tag "link"
+ (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\""
+ (plist-get info :html-htmlized-css-url))
+ info))
(when (plist-get info :html-head-include-scripts) org-html-scripts))))
(defun org-html--build-mathjax-config (info)
@@ -1549,7 +1667,7 @@ communication channel."
(format-time-string org-html-metadata-timestamp-format)))
(when (plist-get info :with-creator)
(format "<p class=\"creator\">%s</p>\n" creator))
- (format "<p class=\"xhtml-validation\">%s</p>\n"
+ (format "<p class=\"validation\">%s</p>\n"
validation-link))))
(t (format-spec
(or (cadr (assoc
@@ -1589,23 +1707,29 @@ holding export options."
CONTENTS is the transcoded contents string. INFO is a plist
holding export options."
(concat
- (format
- (or (and (stringp org-html-xml-declaration)
- org-html-xml-declaration)
- (cdr (assoc (plist-get info :html-extension)
- org-html-xml-declaration))
- (cdr (assoc "html" org-html-xml-declaration))
-
- "")
- (or (and org-html-coding-system
- (fboundp 'coding-system-get)
- (coding-system-get org-html-coding-system 'mime-charset))
- "iso-8859-1"))
- "\n"
- (plist-get info :html-doctype)
+ (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info))
+ (let ((decl (or (and (stringp org-html-xml-declaration)
+ org-html-xml-declaration)
+ (cdr (assoc (plist-get info :html-extension)
+ org-html-xml-declaration))
+ (cdr (assoc "html" org-html-xml-declaration))
+
+ "")))
+ (when (not (or (eq nil decl) (string= "" decl)))
+ (format "%s\n"
+ (format decl
+ (or (and org-html-coding-system
+ (fboundp 'coding-system-get)
+ (coding-system-get org-html-coding-system 'mime-charset))
+ "iso-8859-1"))))))
+ (org-html-doctype info)
"\n"
- (format "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\">\n"
- (plist-get info :language) (plist-get info :language))
+ (concat "<html"
+ (when (org-html-xhtml-p info)
+ (format
+ " xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\" xml:lang=\"%s\""
+ (plist-get info :language) (plist-get info :language)))
+ ">\n")
"<head>\n"
(org-html--build-meta-info info)
(org-html--build-head info)
@@ -1807,9 +1931,13 @@ contents as a string, or nil if it is empty."
(mapcar (lambda (headline)
(cons (org-html--format-toc-headline headline info)
(org-export-get-relative-level headline info)))
- (org-export-collect-headlines info depth))))
+ (org-export-collect-headlines info depth)))
+ (outer-tag (if (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy))
+ "nav"
+ "div")))
(when toc-entries
- (concat "<div id=\"table-of-contents\">\n"
+ (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
(format "<h%d>%s</h%d>\n"
org-html-toplevel-hlevel
(org-html--translate "Table of Contents" info)
@@ -1817,7 +1945,7 @@ contents as a string, or nil if it is empty."
"<div id=\"text-table-of-contents\">"
(org-html--toc-text toc-entries)
"</div>\n"
- "</div>\n"))))
+ (format "</%s>\n" outer-tag)))))
(defun org-html--toc-text (toc-entries)
"Return innards of a table of contents, as a string.
@@ -1862,16 +1990,17 @@ INFO is a plist used as a communication channel."
headline-number "-"))))
;; Body.
(concat section-number
- (org-export-data-with-translations
+ (org-export-data-with-backend
(org-export-get-alt-title headline info)
- ;; Ignore any footnote-reference, link,
- ;; radio-target and target in table of contents.
- (append
- '((footnote-reference . ignore)
- (link . (lambda (link desc i) desc))
- (radio-target . (lambda (radio desc i) desc))
- (target . ignore))
- (org-export-backend-translate-table 'html))
+ ;; Create an anonymous back-end that will ignore
+ ;; any footnote-reference, link, radio-target and
+ ;; target in table of contents.
+ (org-export-create-backend
+ :parent 'html
+ :transcoders '((footnote-reference . ignore)
+ (link . (lambda (object c i) c))
+ (radio-target . (lambda (object c i) c))
+ (target . ignore)))
info)
(and tags "&#xa0;&#xa0;&#xa0;") (org-html--tags tags)))))
@@ -1888,7 +2017,8 @@ of listings as a string, or nil if it is empty."
org-html-toplevel-hlevel)
"<div id=\"text-list-of-listings\">\n<ul>\n"
(let ((count 0)
- (initial-fmt (org-html--translate "Listing %d:" info)))
+ (initial-fmt (format "<span class=\"listing-number\">%s</span>"
+ (org-html--translate "Listing %d:" info))))
(mapconcat
(lambda (entry)
(let ((label (org-element-property :name entry))
@@ -1922,7 +2052,8 @@ of tables as a string, or nil if it is empty."
org-html-toplevel-hlevel)
"<div id=\"text-list-of-tables\">\n<ul>\n"
(let ((count 0)
- (initial-fmt (org-html--translate "Table %d:" info)))
+ (initial-fmt (format "<span class=\"table-number\">%s</span>"
+ (org-html--translate "Table %d:" info))))
(mapconcat
(lambda (entry)
(let ((label (org-element-property :name entry))
@@ -2154,7 +2285,7 @@ holding contextual information."
;; Build the real contents of the sub-tree.
(let* ((type (if numberedp 'ordered 'unordered))
(itemized-body (org-html-format-list-item
- contents type nil nil full-text)))
+ contents type nil info nil full-text)))
(concat
(and (org-export-first-sibling-p headline info)
(org-html-begin-plain-list type))
@@ -2214,7 +2345,7 @@ holding contextual information."
(defun org-html-horizontal-rule (horizontal-rule contents info)
"Transcode an HORIZONTAL-RULE object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
- "<hr/>")
+ (org-html-close-tag "hr" nil info))
;;;; Inline Src Block
@@ -2250,8 +2381,9 @@ holding contextual information."
(org-html-format-headline--wrap
inlinetask info format-function :contents contents)))
;; Otherwise, use a default template.
- (t (format "<div class=\"inlinetask\">\n<b>%s</b><br/>\n%s</div>"
+ (t (format "<div class=\"inlinetask\">\n<b>%s</b>%s\n%s</div>"
(org-html-format-headline--wrap inlinetask info)
+ (org-html-close-tag "br" nil info)
contents))))
;;;; Italic
@@ -2271,11 +2403,12 @@ contextual information."
(trans "<code>[-]</code>")
(t "")))
-(defun org-html-format-list-item (contents type checkbox
+(defun org-html-format-list-item (contents type checkbox info
&optional term-counter-id
headline)
"Format a list item into HTML."
- (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " "))))
+ (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " ")))
+ (br (org-html-close-tag "br" nil info)))
(concat
(case type
(ordered
@@ -2283,13 +2416,13 @@ contextual information."
(extra (if counter (format " value=\"%s\"" counter) "")))
(concat
(format "<li%s>" extra)
- (when headline (concat headline "<br/>")))))
+ (when headline (concat headline br)))))
(unordered
(let* ((id term-counter-id)
(extra (if id (format " id=\"%s\"" id) "")))
(concat
(format "<li%s>" extra)
- (when headline (concat headline "<br/>")))))
+ (when headline (concat headline br)))))
(descriptive
(let* ((term term-counter-id))
(setq term (or term "(no term)"))
@@ -2315,7 +2448,7 @@ contextual information."
(tag (let ((tag (org-element-property :tag item)))
(and tag (org-export-data tag info)))))
(org-html-format-list-item
- contents type checkbox (or tag counter))))
+ contents type checkbox info (or tag counter))))
;;;; Keyword
@@ -2363,21 +2496,19 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(let ((processing-type (plist-get info :with-latex))
(latex-frag (org-remove-indentation
(org-element-property :value latex-environment)))
- (caption (org-export-data
- (org-export-get-caption latex-environment) info))
- (attr nil) ; FIXME
- (label (org-element-property :name latex-environment)))
- (cond
- ((memq processing-type '(t mathjax))
- (org-html-format-latex latex-frag 'mathjax))
- ((eq processing-type 'dvipng)
- (let* ((formula-link (org-html-format-latex
- latex-frag processing-type)))
- (when (and formula-link
- (string-match "file:\\([^]]*\\)" formula-link))
- (org-html-format-inline-image
- (match-string 1 formula-link) caption label attr t))))
- (t latex-frag))))
+ (attributes (org-export-read-attribute :attr_html latex-environment)))
+ (case processing-type
+ ((t mathjax)
+ (org-html-format-latex latex-frag 'mathjax))
+ ((dvipng imagemagick)
+ (let ((formula-link (org-html-format-latex latex-frag processing-type)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ ;; Do not provide a caption or a name to be consistent with
+ ;; `mathjax' handling.
+ (org-html--wrap-image
+ (org-html--format-image
+ (match-string 1 formula-link) attributes info) info))))
+ (t latex-frag))))
;;;; Latex Fragment
@@ -2389,13 +2520,10 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(case processing-type
((t mathjax)
(org-html-format-latex latex-frag 'mathjax))
- (dvipng
- (let* ((formula-link (org-html-format-latex
- latex-frag processing-type)))
- (when (and formula-link
- (string-match "file:\\([^]]*\\)" formula-link))
- (org-html-format-inline-image
- (match-string 1 formula-link)))))
+ ((dvipng imagemagick)
+ (let ((formula-link (org-html-format-latex latex-frag processing-type)))
+ (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link))
+ (org-html--format-image (match-string 1 formula-link) nil info))))
(t latex-frag))))
;;;; Line Break
@@ -2403,79 +2531,69 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(defun org-html-line-break (line-break contents info)
"Transcode a LINE-BREAK object from Org to HTML.
CONTENTS is nil. INFO is a plist holding contextual information."
- "<br/>\n")
+ (concat (org-html-close-tag "br" nil info) "\n"))
;;;; Link
-(defun org-html-link--inline-image (link desc info)
- "Return HTML code for an inline image.
-
-LINK is the link pointing to the inline image. INFO is a plist
-used as a communication channel.
-
-Inline images can have these attributes:
-
-#+ATTR_HTML: :width 100px :height 100px :alt \"Alt description\"."
- (let* ((type (org-element-property :type link))
- (raw-path (org-element-property :path link))
- (path (cond ((member type '("http" "https"))
- (concat type ":" raw-path))
- ((file-name-absolute-p raw-path)
- (expand-file-name raw-path))
- (t raw-path)))
- (parent (org-export-get-parent-element link))
- (caption (org-export-data (org-export-get-caption parent) info))
- (label (org-element-property :name parent)))
- ;; Return proper string, depending on DISPOSITION.
- (org-html-format-inline-image
- path caption label
- (org-html--make-attribute-string
- (org-export-read-attribute :attr_html parent))
- (org-html-standalone-image-p link info))))
+(defun org-html-inline-image-p (link info)
+ "Non-nil when LINK is meant to appear as an image.
+INFO is a plist used as a communication channel. LINK is an
+inline image when it has no description and targets an image
+file (see `org-html-inline-image-rules' for more information), or
+if its description is a single link targeting an image file."
+ (if (not (org-element-contents link))
+ (org-export-inline-image-p link org-html-inline-image-rules)
+ (not
+ (let ((link-count 0))
+ (org-element-map (org-element-contents link)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj)
+ (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link (if (= link-count 1) t
+ (incf link-count)
+ (not (org-export-inline-image-p
+ obj org-html-inline-image-rules))))
+ (otherwise t)))
+ info t)))))
(defvar org-html-standalone-image-predicate)
-(defun org-html-standalone-image-p (element info &optional predicate)
- "Test if ELEMENT is a standalone image for the purpose HTML export.
+(defun org-html-standalone-image-p (element info)
+ "Test if ELEMENT is a standalone image.
+
INFO is a plist holding contextual information.
-Return non-nil, if ELEMENT is of type paragraph and it's sole
-content, save for whitespaces, is a link that qualifies as an
+Return non-nil, if ELEMENT is of type paragraph and its sole
+content, save for white spaces, is a link that qualifies as an
inline image.
-Return non-nil, if ELEMENT is of type link and it's containing
-paragraph has no other content save for leading and trailing
-whitespaces.
+Return non-nil, if ELEMENT is of type link and its containing
+paragraph has no other content save white spaces.
Return nil, otherwise.
-Bind `org-html-standalone-image-predicate' to constrain
-paragraph further. For example, to check for only captioned
-standalone images, do the following.
+Bind `org-html-standalone-image-predicate' to constrain paragraph
+further. For example, to check for only captioned standalone
+images, set it to:
- \(setq org-html-standalone-image-predicate
- \(lambda \(paragraph\)
- \(org-element-property :caption paragraph\)\)\)"
+ \(lambda (paragraph) (org-element-property :caption paragraph))"
(let ((paragraph (case (org-element-type element)
(paragraph element)
- (link (and (org-export-inline-image-p
- element org-html-inline-image-rules)
- (org-export-get-parent element)))
- (t nil))))
- (when (eq (org-element-type paragraph) 'paragraph)
- (when (or (not (and (boundp 'org-html-standalone-image-predicate)
- (functionp org-html-standalone-image-predicate)))
- (funcall org-html-standalone-image-predicate paragraph))
- (let ((contents (org-element-contents paragraph)))
- (loop for x in contents
- with inline-image-count = 0
- always (cond
- ((eq (org-element-type x) 'plain-text)
- (not (org-string-nw-p x)))
- ((eq (org-element-type x) 'link)
- (when (org-export-inline-image-p
- x org-html-inline-image-rules)
- (= (incf inline-image-count) 1)))
- (t nil))))))))
+ (link (org-export-get-parent element)))))
+ (and (eq (org-element-type paragraph) 'paragraph)
+ (or (not (and (boundp 'org-html-standalone-image-predicate)
+ (functionp org-html-standalone-image-predicate)))
+ (funcall org-html-standalone-image-predicate paragraph))
+ (not (let ((link-count 0))
+ (org-element-map (org-element-contents paragraph)
+ (cons 'plain-text org-element-all-objects)
+ (lambda (obj) (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link
+ (or (> (incf link-count) 1)
+ (not (org-html-inline-image-p obj info))))
+ (otherwise t)))
+ info 'first-match 'link))))))
(defun org-html-link (link desc info)
"Transcode a LINK object from Org to HTML.
@@ -2483,7 +2601,10 @@ standalone images, do the following.
DESC is the description part of the link, or the empty string.
INFO is a plist holding contextual information. See
`org-export-data'."
- (let* ((link-org-files-as-html-maybe
+ (let* ((home (when (plist-get info :html-link-home)
+ (org-trim (plist-get info :html-link-home))))
+ (use-abs-url (plist-get info :html-link-use-abs-url))
+ (link-org-files-as-html-maybe
(function
(lambda (raw-path info)
"Treat links to `file.org' as links to `file.html', if needed.
@@ -2509,9 +2630,12 @@ INFO is a plist holding contextual information. See
(funcall link-org-files-as-html-maybe raw-path info))
;; If file path is absolute, prepend it with protocol
;; component - "file://".
- (when (file-name-absolute-p raw-path)
- (setq raw-path
- (concat "file://" (expand-file-name raw-path))))
+ (cond ((file-name-absolute-p raw-path)
+ (setq raw-path
+ (concat "file://" (expand-file-name
+ raw-path))))
+ ((and home use-abs-url)
+ (setq raw-path (concat (file-name-as-directory home) raw-path))))
;; Add search option, if any. A search option can be
;; relative to a custom-id or a headline title. Any other
;; option is ignored.
@@ -2531,25 +2655,28 @@ INFO is a plist holding contextual information. See
numbers "-"))))))
(t raw-path))))
(t raw-path)))
- ;; Extract attributes from parent's paragraph. HACK: Only do
- ;; this for the first link in parent. This is needed as long
- ;; as attributes cannot be set on a per link basis.
+ ;; Extract attributes from parent's paragraph. HACK: Only do
+ ;; this for the first link in parent (inner image link for
+ ;; inline images). This is needed as long as attributes
+ ;; cannot be set on a per link basis.
+ (attributes-plist
+ (let* ((parent (org-export-get-parent-element link))
+ (link (let ((container (org-export-get-parent link)))
+ (if (and (eq (org-element-type container) 'link)
+ (org-html-inline-image-p link info))
+ container
+ link))))
+ (and (eq (org-element-map parent 'link 'identity info t) link)
+ (org-export-read-attribute :attr_html parent))))
(attributes
- (let ((parent (org-export-get-parent-element link)))
- (if (not (eq (org-element-map parent 'link 'identity info t) link))
- ""
- (let ((att (org-html--make-attribute-string
- (org-export-read-attribute :attr_html parent))))
- (cond ((not (org-string-nw-p att)) "")
- ((and desc (string-match (regexp-quote att) desc)) "")
- (t (concat " " att)))))))
+ (let ((attr (org-html--make-attribute-string attributes-plist)))
+ (if (org-string-nw-p attr) (concat " " attr) "")))
protocol)
(cond
;; Image file.
- ((and (or (eq t org-html-inline-images)
- (and org-html-inline-images (not desc)))
+ ((and org-html-inline-images
(org-export-inline-image-p link org-html-inline-image-rules))
- (org-html-link--inline-image link desc info))
+ (org-html--format-image path attributes-plist info))
;; Radio target: Transcode target's contents and use them as
;; link's description.
((string= type "radio")
@@ -2580,8 +2707,6 @@ INFO is a plist holding contextual information. See
(or desc
(org-export-data
(org-element-property :raw-link link) info))))
- ;; Fuzzy link points to an invisible target.
- (keyword nil)
;; Link points to a headline.
(headline
(let ((href
@@ -2615,21 +2740,24 @@ INFO is a plist holding contextual information. See
:title destination) info)))))
(format "<a href=\"#%s\"%s>%s</a>"
(org-export-solidify-link-text href) attributes desc)))
- ;; Fuzzy link points to a target. Do as above.
+ ;; Fuzzy link points to a target or an element.
(t
- (let ((path (org-export-solidify-link-text path)) number)
- (unless desc
- (setq number (cond
- ((org-html-standalone-image-p destination info)
- (org-export-get-ordinal
- (assoc 'link (org-element-contents destination))
- info 'link 'org-html-standalone-image-p))
- (t (org-export-get-ordinal destination info))))
- (setq desc (when number
- (if (atom number) (number-to-string number)
- (mapconcat 'number-to-string number ".")))))
- (format "<a href=\"#%s\"%s>%s</a>"
- path attributes (or desc "No description for this link")))))))
+ (let* ((path (org-export-solidify-link-text path))
+ (org-html-standalone-image-predicate 'org-html--has-caption-p)
+ (number (cond
+ (desc nil)
+ ((org-html-standalone-image-p destination info)
+ (org-export-get-ordinal
+ (org-element-map destination 'link
+ 'identity info t)
+ info 'link 'org-html-standalone-image-p))
+ (t (org-export-get-ordinal
+ destination info nil 'org-html--has-caption-p))))
+ (desc (cond (desc)
+ ((not number) "No description for this link")
+ ((numberp number) (number-to-string number))
+ (t (mapconcat 'number-to-string number ".")))))
+ (format "<a href=\"#%s\"%s>%s</a>" path attributes desc))))))
;; Coderef: replace link with the reference name or the
;; equivalent line number.
((string= type "coderef")
@@ -2668,11 +2796,27 @@ the plist used as a communication channel."
((and (eq (org-element-type parent) 'item)
(= (org-element-property :begin paragraph)
(org-element-property :contents-begin parent)))
- ;; leading paragraph in a list item have no tags
+ ;; Leading paragraph in a list item have no tags.
contents)
((org-html-standalone-image-p paragraph info)
- ;; standalone image
- contents)
+ ;; Standalone image.
+ (let ((caption
+ (let ((raw (org-export-data
+ (org-export-get-caption paragraph) info))
+ (org-html-standalone-image-predicate
+ 'org-html--has-caption-p))
+ (if (not (org-string-nw-p raw)) raw
+ (concat
+ "<span class=\"figure-number\">"
+ (format (org-html--translate "Figure %d:" info)
+ (org-export-get-ordinal
+ (org-element-map paragraph 'link
+ 'identity info t)
+ info nil 'org-html-standalone-image-p))
+ "</span> " raw))))
+ (label (org-element-property :name paragraph)))
+ (org-html--wrap-image contents info caption label)))
+ ;; Regular paragraph.
(t (format "<p%s>\n%s</p>" extra contents)))))
;;;; Plain List
@@ -2746,7 +2890,8 @@ contextual information."
(when (plist-get info :preserve-breaks)
(setq output
(replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" "<br/>\n" output)))
+ "\\(\\\\\\\\\\)?[ \t]*\n"
+ (concat (org-html-close-tag "br" nil info) "\n") output)))
;; Return value.
output))
@@ -2846,9 +2991,25 @@ contextual information."
"Transcode a SPECIAL-BLOCK element from Org to HTML.
CONTENTS holds the contents of the block. INFO is a plist
holding contextual information."
- (format "<div class=\"%s\">\n%s\n</div>"
- (downcase (org-element-property :type special-block))
- contents))
+ (let* ((block-type (downcase
+ (org-element-property :type special-block)))
+ (contents (or contents ""))
+ (html5-fancy (and (org-html-html5-p info)
+ (plist-get info :html-html5-fancy)
+ (member block-type org-html-html5-elements)))
+ (attributes (org-export-read-attribute :attr_html special-block)))
+ (unless html5-fancy
+ (let ((class (plist-get attributes :class)))
+ (setq attributes (plist-put attributes :class
+ (if class (concat class " " block-type)
+ block-type)))))
+ (setq attributes (org-html--make-attribute-string attributes))
+ (when (not (equal attributes ""))
+ (setq attributes (concat " " attributes)))
+ (if html5-fancy
+ (format "<%s%s>\n%s</%s>" block-type attributes
+ contents block-type)
+ (format "<div%s>\n%s\n</div>" attributes contents))))
;;;; Src Block
@@ -3020,11 +3181,14 @@ contextual information."
(t
(let* ((label (org-element-property :name table))
(caption (org-export-get-caption table))
+ (number (org-export-get-ordinal
+ table info nil 'org-html--has-caption-p))
(attributes
(org-html--make-attribute-string
(org-combine-plists
(and label (list :id (org-export-solidify-link-text label)))
- (plist-get info :html-table-attributes)
+ (and (not (org-html-html5-p info))
+ (plist-get info :html-table-attributes))
(org-export-read-attribute :attr_html table))))
(alignspec
(if (and (boundp 'org-html-format-table-no-css)
@@ -3043,7 +3207,9 @@ contextual information."
table-cell info)
"\n<colgroup>")
;; Add a column. Also specify it's alignment.
- (format "\n<col %s/>" (format alignspec alignment))
+ (format "\n%s"
+ (org-html-close-tag
+ "col" (concat " " (format alignspec alignment)) info))
;; End a colgroup?
(when (org-export-table-cell-ends-colgroup-p
table-cell info)
@@ -3052,8 +3218,13 @@ contextual information."
(format "<table%s>\n%s\n%s\n%s</table>"
(if (equal attributes "") "" (concat " " attributes))
(if (not caption) ""
- (format "<caption>%s</caption>"
- (org-export-data caption info)))
+ (format (if org-html-table-caption-above
+ "<caption align=\"above\">%s</caption>"
+ "<caption align=\"bottom\">%s</caption>")
+ (concat
+ "<span class=\"table-number\">"
+ (format (org-html--translate "Table %d:" info) number)
+ "</span> " (org-export-data caption info))))
(funcall table-column-specs table info)
contents)))))
@@ -3105,9 +3276,10 @@ contextual information."
;; Replace each newline character with line break. Also replace
;; each blank line with a line break.
(setq contents (replace-regexp-in-string
- "^ *\\\\\\\\$" "<br/>\n"
+ "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info))
(replace-regexp-in-string
- "\\(\\\\\\\\\\)?[ \t]*\n" " <br/>\n" contents)))
+ "\\(\\\\\\\\\\)?[ \t]*\n"
+ (format "%s\n" (org-html-close-tag "br" nil info)) contents)))
;; Replace each white space at beginning of a line with a
;; non-breaking space.
(while (string-match "^[ \t]+" contents)
@@ -3167,23 +3339,9 @@ Export is done in a buffer named \"*Org HTML Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org HTML Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (set-auto-mode t)
- (org-export-add-to-stack (current-buffer) 'html)))
- `(org-export-as 'html ,subtreep ,visible-only ,body-only ',ext-plist))
- (let ((outbuf (org-export-to-buffer
- 'html "*Org HTML Export*"
- subtreep visible-only body-only ext-plist)))
- ;; Set major mode.
- (with-current-buffer outbuf (set-auto-mode t))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'html "*Org HTML Export*"
+ async subtreep visible-only body-only ext-plist
+ (lambda () (set-auto-mode t))))
;;;###autoload
(defun org-html-convert-region-to-html ()
@@ -3227,16 +3385,8 @@ Return output file's name."
(let* ((extension (concat "." org-html-extension))
(file (org-export-output-file-name extension subtreep))
(org-export-coding-system org-html-coding-system))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'html))
- (let ((org-export-coding-system org-html-coding-system))
- `(expand-file-name
- (org-export-to-file
- 'html ,file ,subtreep ,visible-only ,body-only ',ext-plist))))
- (let ((org-export-coding-system org-html-coding-system))
- (org-export-to-file
- 'html file subtreep visible-only body-only ext-plist)))))
+ (org-export-to-file 'html file
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-html-publish-to-html (plist filename pub-dir)
@@ -3260,7 +3410,6 @@ Return output file name."
;;;; org-format-table-table-html
;;;; org-table-number-fraction
;;;; org-table-number-regexp
-;;;; org-html-table-caption-above
;;;; org-html-inline-image-extensions
;;;; org-export-preferred-target-alist
;;;; class for anchors
diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el
index c6ab295..612fd79 100644
--- a/lisp/ox-icalendar.el
+++ b/lisp/ox-icalendar.el
@@ -826,21 +826,10 @@ Return ICS file name."
;; Export part. Since this back-end is backed up by `ascii', ensure
;; links will not be collected at the end of sections.
(let ((outfile (org-export-output-file-name ".ics" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f)
- (org-export-add-to-stack f 'icalendar)
- (run-hook-with-args 'org-icalendar-after-save-hook f))
- `(let ((org-ascii-links-to-notes nil))
- (expand-file-name
- (org-export-to-file
- 'icalendar ,outfile ,subtreep ,visible-only ,body-only
- '(:ascii-charset utf-8)))))
- (let ((org-ascii-links-to-notes nil))
- (org-export-to-file 'icalendar outfile subtreep visible-only body-only
- '(:ascii-charset utf-8)))
- (run-hook-with-args 'org-icalendar-after-save-hook outfile)
- outfile)))
+ (org-export-to-file 'icalendar outfile
+ async subtreep visible-only body-only '(:ascii-charset utf-8)
+ (lambda (file)
+ (run-hook-with-args 'org-icalendar-after-save-hook file) nil))))
;;;###autoload
(defun org-icalendar-export-agenda-files (&optional async)
diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el
index 0fffd82..e1173ef 100644
--- a/lisp/ox-latex.el
+++ b/lisp/ox-latex.el
@@ -143,7 +143,9 @@
("la" . "latin")
("ms" . "malay")
("nl" . "dutch")
- ("no-no" . "nynorsk")
+ ("nb" . "norsk")
+ ("nn" . "nynorsk")
+ ("no" . "norsk")
("pl" . "polish")
("pt" . "portuguese")
("ro" . "romanian")
@@ -255,12 +257,17 @@ to \\providecommand, and then place \\usepackage commands based
on the content of `org-latex-packages-alist'.
If your header, `org-latex-default-packages-alist' or
-`org-latex-packages-alist' inserts
-\"\\usepackage[AUTO]{inputenc}\", AUTO will automatically be
-replaced with a coding system derived from
-`buffer-file-coding-system'. See also the variable
+`org-latex-packages-alist' inserts \"\\usepackage[AUTO]{inputenc}\",
+AUTO will automatically be replaced with a coding system derived
+from `buffer-file-coding-system'. See also the variable
`org-latex-inputenc-alist' for a way to influence this mechanism.
+Likewise, if your header contains \"\\usepackage[AUTO]{babel}\",
+AUTO will be replaced with the language related to the language
+code specified by `org-export-default-language', which see. Note
+that constructions such as \"\\usepackage[french,AUTO,english]{babel}\"
+are permitted.
+
The sectioning structure
------------------------
@@ -337,7 +344,6 @@ the toc:nil option, not to those generated with #+TOC keyword."
:group 'org-export-latex
:type 'boolean)
-
;;;; Headline
(defcustom org-latex-format-headline-function
@@ -420,7 +426,7 @@ environment."
:type 'string)
(defcustom org-latex-inline-image-rules
- '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\)\\'"))
+ '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'"))
"Rules characterizing image files that can be inlined into LaTeX.
A rule consists in an association whose key is the type of link
@@ -658,7 +664,7 @@ into previewing problems, please consult
(fortran "fortran")
(perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby")
(html "HTML") (xml "XML")
- (tex "TeX") (latex "TeX")
+ (tex "TeX") (latex "[LaTeX]TeX")
(shell-script "bash")
(gnuplot "Gnuplot")
(ocaml "Caml") (caml "Caml")
@@ -745,20 +751,6 @@ options will be applied to blocks of all languages."
(string :tag "Minted option name ")
(string :tag "Minted option value"))))
-(defcustom org-latex-long-listings nil
- "When non-nil no listing will be wrapped within a float.
-
-Removing floats may break some functionalities. For example, it
-will be impossible to use cross-references to listings when using
-`minted' set-up when this variable is non-nil.
-
-This value can be locally ignored with \":long-listing t\" and
-\":long-listing nil\" LaTeX attributes."
- :group 'org-export-latex
- :version "24.4"
- :package-version '(Org . "8.0")
- :type 'boolean)
-
(defvar org-latex-custom-lang-environments nil
"Alist mapping languages to language-specific LaTeX environments.
@@ -800,8 +792,12 @@ the infamous egrep/locale bug:
http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html
-then `texi2dvi' is the superior choice. Org does offer it as one
-of the customize options.
+then `texi2dvi' is the superior choice as it automates the LaTeX
+build process by calling the \"correct\" combinations of
+auxiliary programs. Org does offer `texi2dvi' as one of the
+customize options. Alternatively, `rubber' and `latexmk' also
+provide similar functionality. The latter supports `biber' out
+of the box.
Alternatively, this may be a Lisp function that does the
processing, so you could use this to apply the machinery of
@@ -839,6 +835,8 @@ file name as its single argument."
("texi2dvi -p -b -V %f"))
(const :tag "rubber"
("rubber -d --into %o %f"))
+ (const :tag "latexmk"
+ ("latexmk -g -pdf %f"))
(function)))
(defcustom org-latex-logfiles-extensions
@@ -891,8 +889,11 @@ For non-floats, see `org-latex--wrap-label'."
(format "\\label{%s}"
(org-export-solidify-link-text label))))
(main (org-export-get-caption element))
- (short (org-export-get-caption element t)))
+ (short (org-export-get-caption element t))
+ (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption)))
(cond
+ ((org-string-nw-p caption-from-attr-latex)
+ (concat caption-from-attr-latex "\n"))
((and (not main) (equal label-str "")) "")
((not main) (concat label-str "\n"))
;; Option caption format with short name.
@@ -931,6 +932,10 @@ Insertion of guessed language only happens when Babel package has
explicitly been loaded. Then it is added to the rest of
package's options.
+The argument to Babel may be \"AUTO\" which is then replaced with
+the language of the document or `org-export-default-language'
+unless language in question is already loaded.
+
Return the new header."
(let ((language-code (plist-get info :language)))
;; If no language is set or Babel package is not loaded, return
@@ -939,16 +944,19 @@ Return the new header."
(not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header)))
header
(let ((options (save-match-data
- (org-split-string (match-string 1 header) ",")))
+ (org-split-string (match-string 1 header) ",[ \t]*")))
(language (cdr (assoc language-code
org-latex-babel-language-alist))))
- ;; If LANGUAGE is already loaded, return header. Otherwise,
- ;; append LANGUAGE to other options.
- (if (member language options) header
- (replace-match (mapconcat 'identity
- (append options (list language))
- ",")
- nil nil header 1))))))
+ ;; If LANGUAGE is already loaded, return header without AUTO.
+ ;; Otherwise, replace AUTO with language or append language if
+ ;; AUTO is not present.
+ (replace-match
+ (mapconcat (lambda (option) (if (equal "AUTO" option) language option))
+ (cond ((member language options) (delete "AUTO" options))
+ ((member "AUTO" options) options)
+ (t (append options (list language))))
+ ", ")
+ t nil header 1)))))
(defun org-latex--find-verb-separator (s)
"Return a character not used in string S.
@@ -1553,7 +1561,7 @@ contextual information."
(1- count)))))
(checkbox (case (org-element-property :checkbox item)
(on "$\\boxtimes$ ")
- (off "$\\Box$ ")
+ (off "$\\square$ ")
(trans "$\\boxminus$ ")))
(tag (let ((tag (org-element-property :tag item)))
;; Check-boxes must belong to the tag.
@@ -1656,10 +1664,12 @@ used as a communication channel."
;; Retrieve latex attributes from the element around.
(attr (org-export-read-attribute :attr_latex parent))
(float (let ((float (plist-get attr :float)))
- (cond ((string= float "wrap") 'wrap)
+ (cond ((and (not float) (plist-member attr :float)) nil)
+ ((string= float "wrap") 'wrap)
((string= float "multicolumn") 'multicolumn)
- ((or (string= float "figure")
- (org-element-property :caption parent))
+ ((or float
+ (org-element-property :caption parent)
+ (org-string-nw-p (plist-get attr :caption)))
'figure))))
(placement
(let ((place (plist-get attr :placement)))
@@ -1684,7 +1694,7 @@ used as a communication channel."
(if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt
(match-string 1 opt))))
image-code)
- (if (equal filetype "tikz")
+ (if (member filetype '("tikz" "pgf"))
;; For tikz images:
;; - use \input to read in image file.
;; - if options are present, wrap in a tikzpicture environment.
@@ -1715,7 +1725,16 @@ used as a communication channel."
((= (aref options 0) ?,)
(format "[%s]"(substring options 1)))
(t (format "[%s]" options)))
- path)))
+ path))
+ (when (equal filetype "svg")
+ (setq image-code (replace-regexp-in-string "^\\\\includegraphics"
+ "\\includesvg"
+ image-code
+ nil t))
+ (setq image-code (replace-regexp-in-string "\\.svg}"
+ "}"
+ image-code
+ nil t))))
;; Return proper string, depending on FLOAT.
(case float
(wrap (format "\\begin{wrapfigure}%s
@@ -2018,21 +2037,24 @@ contextual information."
(continued (org-export-get-loc src-block info))
(new 0)))
(retain-labels (org-element-property :retain-labels src-block))
- (long-listing
- (let ((attr (org-export-read-attribute :attr_latex src-block)))
- (if (plist-member attr :long-listing)
- (plist-get attr :long-listing)
- org-latex-long-listings))))
+ (attributes (org-export-read-attribute :attr_latex src-block))
+ (float (plist-get attributes :float)))
(cond
;; Case 1. No source fontification.
((not org-latex-listings)
(let* ((caption-str (org-latex--caption/label-string src-block info))
- (float-env (and (not long-listing)
- (or label caption)
- (format "\\begin{figure}[H]\n%s%%s\n\\end{figure}"
- caption-str))))
+ (float-env
+ (cond ((and (not float) (plist-member attributes :float)) "%s")
+ ((string= "multicolumn" float)
+ (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}"
+ org-latex-default-figure-position
+ caption-str))
+ ((or caption float)
+ (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}"
+ caption-str))
+ (t "%s"))))
(format
- (or float-env "%s")
+ float-env
(concat (format "\\begin{verbatim}\n%s\\end{verbatim}"
(org-export-format-code-default src-block info))))))
;; Case 2. Custom environment.
@@ -2042,46 +2064,52 @@ contextual information."
custom-env))
;; Case 3. Use minted package.
((eq org-latex-listings 'minted)
- (let ((float-env
- (and (not long-listing)
- (or label caption)
- (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
- (org-latex--caption/label-string src-block info))))
- (body
- (format
- "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
- ;; Options.
- (org-latex--make-option-string
- (if (or (not num-start)
- (assoc "linenos" org-latex-minted-options))
- org-latex-minted-options
- (append `(("linenos")
- ("firstnumber" ,(number-to-string (1+ num-start))))
- org-latex-minted-options)))
- ;; Language.
- (or (cadr (assq (intern lang) org-latex-minted-langs)) lang)
- ;; Source code.
- (let* ((code-info (org-export-unravel-code src-block))
- (max-width
- (apply 'max
- (mapcar 'length
- (org-split-string (car code-info)
- "\n")))))
- (org-export-format-code
- (car code-info)
- (lambda (loc num ref)
- (concat
- loc
- (when ref
- ;; Ensure references are flushed to the right,
- ;; separated with 6 spaces from the widest line
- ;; of code.
- (concat (make-string (+ (- max-width (length loc)) 6)
- ?\s)
- (format "(%s)" ref)))))
- nil (and retain-labels (cdr code-info)))))))
+ (let* ((caption-str (org-latex--caption/label-string src-block info))
+ (float-env
+ (cond ((and (not float) (plist-member attributes :float)) "%s")
+ ((string= "multicolumn" float)
+ (format "\\begin{listing*}\n%%s\n%s\\end{listing*}"
+ caption-str))
+ ((or caption float)
+ (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}"
+ caption-str))
+ (t "%s")))
+ (body
+ (format
+ "\\begin{minted}[%s]{%s}\n%s\\end{minted}"
+ ;; Options.
+ (org-latex--make-option-string
+ (if (or (not num-start)
+ (assoc "linenos" org-latex-minted-options))
+ org-latex-minted-options
+ (append
+ `(("linenos")
+ ("firstnumber" ,(number-to-string (1+ num-start))))
+ org-latex-minted-options)))
+ ;; Language.
+ (or (cadr (assq (intern lang) org-latex-minted-langs)) lang)
+ ;; Source code.
+ (let* ((code-info (org-export-unravel-code src-block))
+ (max-width
+ (apply 'max
+ (mapcar 'length
+ (org-split-string (car code-info)
+ "\n")))))
+ (org-export-format-code
+ (car code-info)
+ (lambda (loc num ref)
+ (concat
+ loc
+ (when ref
+ ;; Ensure references are flushed to the right,
+ ;; separated with 6 spaces from the widest line
+ ;; of code.
+ (concat (make-string (+ (- max-width (length loc)) 6)
+ ?\s)
+ (format "(%s)" ref)))))
+ nil (and retain-labels (cdr code-info)))))))
;; Return value.
- (if float-env (format float-env body) body)))
+ (format float-env body)))
;; Case 4. Use listings package.
(t
(let ((lst-lang
@@ -2097,19 +2125,25 @@ contextual information."
(org-export-data main info)))))))
(concat
;; Options.
- (format "\\lstset{%s}\n"
- (org-latex--make-option-string
- (append
- org-latex-listings-options
- `(("language" ,lst-lang))
- (when label `(("label" ,label)))
- (when caption-str `(("caption" ,caption-str)))
- (cond ((assoc "numbers" org-latex-listings-options) nil)
- ((not num-start) '(("numbers" "none")))
- ((zerop num-start) '(("numbers" "left")))
- (t `(("numbers" "left")
- ("firstnumber"
- ,(number-to-string (1+ num-start)))))))))
+ (format
+ "\\lstset{%s}\n"
+ (org-latex--make-option-string
+ (append
+ org-latex-listings-options
+ (cond
+ ((and (not float) (plist-member attributes :float)) nil)
+ ((string= "multicolumn" float) '(("float" "*")))
+ ((and float (not (assoc "float" org-latex-listings-options)))
+ `(("float" ,org-latex-default-figure-position))))
+ `(("language" ,lst-lang))
+ (when label `(("label" ,label)))
+ (when caption-str `(("caption" ,caption-str)))
+ (cond ((assoc "numbers" org-latex-listings-options) nil)
+ ((not num-start) '(("numbers" "none")))
+ ((zerop num-start) '(("numbers" "left")))
+ (t `(("numbers" "left")
+ ("firstnumber"
+ ,(number-to-string (1+ num-start)))))))))
;; Source code.
(format
"\\begin{lstlisting}\n%s\\end{lstlisting}"
@@ -2319,10 +2353,12 @@ This function assumes TABLE has `org' as its `:type' property and
(float-env (unless (member table-env '("longtable" "longtabu"))
(let ((float (plist-get attr :float)))
(cond
+ ((and (not float) (plist-member attr :float)) nil)
((string= float "sidewaystable") "sidewaystable")
((string= float "multicolumn") "table*")
- ((or (string= float "table")
- (org-element-property :caption table))
+ ((or float
+ (org-element-property :caption table)
+ (org-string-nw-p (plist-get attr :caption)))
"table")))))
;; Extract others display options.
(fontsize (let ((font (plist-get attr :font)))
@@ -2683,23 +2719,8 @@ Export is done in a buffer named \"*Org LATEX Export*\", which
will be displayed when `org-export-show-temporary-export-buffer'
is non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org LATEX Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (LaTeX-mode)
- (org-export-add-to-stack (current-buffer) 'latex)))
- `(org-export-as 'latex ,subtreep ,visible-only ,body-only
- ',ext-plist))
- (let ((outbuf
- (org-export-to-buffer 'latex "*Org LATEX Export*"
- subtreep visible-only body-only ext-plist)))
- (with-current-buffer outbuf (LaTeX-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'latex "*Org LATEX Export*"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
;;;###autoload
(defun org-latex-convert-region-to-latex ()
@@ -2736,19 +2757,11 @@ between \"\\begin{document}\" and \"\\end{document}\".
EXT-PLIST, when provided, is a property list with external
parameters overriding Org default settings, but still inferior to
-file-local settings.
-
-Return output file's name."
+file-local settings."
(interactive)
(let ((outfile (org-export-output-file-name ".tex" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'latex))
- `(expand-file-name
- (org-export-to-file
- 'latex ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))
- (org-export-to-file
- 'latex outfile subtreep visible-only body-only ext-plist))))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist)))
;;;###autoload
(defun org-latex-export-to-pdf
@@ -2780,18 +2793,10 @@ file-local settings.
Return PDF file's name."
(interactive)
- (if async
- (let ((outfile (org-export-output-file-name ".tex" subtreep)))
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'latex))
- `(expand-file-name
- (org-latex-compile
- (org-export-to-file
- 'latex ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))))
- (org-latex-compile
- (org-latex-export-to-latex
- nil subtreep visible-only body-only ext-plist))))
+ (let ((outfile (org-export-output-file-name ".tex" subtreep)))
+ (org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
(defun org-latex-compile (texfile &optional snippet)
"Compile a TeX file.
diff --git a/lisp/ox-man.el b/lisp/ox-man.el
index b99a464..a160e4c 100644
--- a/lisp/ox-man.el
+++ b/lisp/ox-man.el
@@ -1144,14 +1144,8 @@ file-local settings.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".man" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'man))
- `(expand-file-name
- (org-export-to-file
- 'man ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))
- (org-export-to-file
- 'man outfile subtreep visible-only body-only ext-plist))))
+ (org-export-to-file 'man outfile
+ async subtreep visible-only body-only ext-plist)))
(defun org-man-export-to-pdf
(&optional async subtreep visible-only body-only ext-plist)
@@ -1182,17 +1176,10 @@ file-local settings.
Return PDF file's name."
(interactive)
- (if async
- (let ((outfile (org-export-output-file-name ".man" subtreep)))
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'man))
- `(expand-file-name
- (org-man-compile
- (org-export-to-file
- 'man ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist)))))
- (org-man-compile
- (org-man-export-to-man nil subtreep visible-only body-only ext-plist))))
+ (let ((outfile (org-export-output-file-name ".man" subtreep)))
+ (org-export-to-file 'man outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-latex-compile file)))))
(defun org-man-compile (file)
"Compile a Groff file.
diff --git a/lisp/ox-md.el b/lisp/ox-md.el
index 52ed42b..f7e4875 100644
--- a/lisp/ox-md.el
+++ b/lisp/ox-md.el
@@ -438,21 +438,8 @@ Export is done in a buffer named \"*Org MD Export*\", which will
be displayed when `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org MD Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (text-mode)
- (org-export-add-to-stack (current-buffer) 'md)))
- `(org-export-as 'md ,subtreep ,visible-only))
- (let ((outbuf (org-export-to-buffer
- 'md "*Org MD Export*" subtreep visible-only)))
- (with-current-buffer outbuf (text-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'md "*Org MD Export*"
+ async subtreep visible-only nil nil (lambda () (text-mode))))
;;;###autoload
(defun org-md-convert-region-to-md ()
@@ -487,12 +474,7 @@ contents of hidden elements.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".md" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'md))
- `(expand-file-name
- (org-export-to-file 'md ,outfile ,subtreep ,visible-only)))
- (org-export-to-file 'md outfile subtreep visible-only))))
+ (org-export-to-file 'md outfile async subtreep visible-only)))
(provide 'ox-md)
diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el
index 768af3c..ae9e473 100644
--- a/lisp/ox-odt.el
+++ b/lisp/ox-odt.el
@@ -27,7 +27,7 @@
(eval-when-compile
(require 'cl)
- (require 'table))
+ (require 'table nil 'noerror))
(require 'format-spec)
(require 'ox)
(require 'org-compat)
@@ -288,38 +288,37 @@ according to the default face identified by the `htmlfontify'.")
("category-and-value" "%e %n: %c" "category-and-value" "%e %n")
("value" "%e %n: %c" "value" "%n"))
"Specify how labels are applied and referenced.
-This is an alist where each element is of the
-form (LABEL-STYLE-NAME LABEL-ATTACH-FMT LABEL-REF-MODE
-LABEL-REF-FMT).
-LABEL-ATTACH-FMT controls how labels and captions are attached to
-an entity. It may contain following specifiers - %e, %n and %c.
-%e is replaced with the CATEGORY-NAME. %n is replaced with
+This is an alist where each element is of the form:
+
+ \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT)
+
+ATTACH-FMT controls how labels and captions are attached to an
+entity. It may contain following specifiers - %e and %c. %e is
+replaced with the CATEGORY-NAME. %n is replaced with
\"<text:sequence ...> SEQNO </text:sequence>\". %c is replaced
-with CAPTION. See `org-odt-format-label-definition'.
+with CAPTION.
-LABEL-REF-MODE and LABEL-REF-FMT controls how label references
-are generated. The following XML is generated for a label
-reference - \"<text:sequence-ref
-text:reference-format=\"LABEL-REF-MODE\" ...> LABEL-REF-FMT
-</text:sequence-ref>\". LABEL-REF-FMT may contain following
+REF-MODE and REF-FMT controls how label references are generated.
+The following XML is generated for a label reference -
+\"<text:sequence-ref text:reference-format=\"REF-MODE\" ...>
+REF-FMT </text:sequence-ref>\". REF-FMT may contain following
specifiers - %e and %n. %e is replaced with the CATEGORY-NAME.
-%n is replaced with SEQNO. See
-`org-odt-format-label-reference'.")
+%n is replaced with SEQNO.
+
+See also `org-odt-format-label'.")
(defvar org-odt-category-map-alist
'(("__Table__" "Table" "value" "Table" org-odt--enumerable-p)
("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p)
("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p)
("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p)
- ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p)
- ;; ("__Table__" "Table" "category-and-value")
- ;; ("__Figure__" "Figure" "category-and-value")
- ;; ("__DvipngImage__" "Equation" "category-and-value")
- )
+ ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p))
"Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE.
-This is a list where each entry is of the form \\(CATEGORY-HANDLE
-OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE\\).
+
+This is a list where each entry is of the form:
+
+ \(CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE)
CATEGORY_HANDLE identifies the captionable entity in question.
@@ -331,15 +330,7 @@ the entity. These counters are declared within
LABEL-STYLE is a key into `org-odt-label-styles' and specifies
how a given entity should be captioned and referenced.
-CATEGORY-NAME is used for qualifying captions on export. You can
-modify the CATEGORY-NAME used in the exported document by
-modifying `org-export-dictionary'. For example, an embedded
-image in an English document is captioned as \"Figure 1: Orgmode
-Logo\", by default. If you want the image to be captioned as
-\"Illustration 1: Orgmode Logo\" instead, install an entry in
-`org-export-dictionary' which translates \"Figure\" to
-\"Illustration\" when the language is \"en\" and encoding is
-`:utf-8'.
+CATEGORY-NAME is used for qualifying captions on export.
ENUMERATOR-PREDICATE is used for assigning a sequence number to
the entity. See `org-odt--enumerate'.")
@@ -455,7 +446,8 @@ The exporter embeds the exported content just before
If unspecified, the file named \"OrgOdtContentTemplate.xml\"
under `org-odt-styles-dir' is used."
- :type 'file
+ :type '(choice (const nil)
+ (file))
:group 'org-export-odt
:version "24.1")
@@ -1046,20 +1038,6 @@ See `org-odt--build-date-styles' for implementation details."
(error "Extraction failed"))))
members))
-(defun org-odt--suppress-some-translators (info types)
- ;; See comments in `org-odt-format-label' and `org-odt-toc'.
- (org-combine-plists
- info (list
- ;; Override translators.
- :translate-alist
- (nconc (mapcar (lambda (type) (cons type (lambda (data contents info)
- contents))) types)
- (plist-get info :translate-alist))
- ;; Reset data translation cache. FIXME.
- ;; :exported-data nil
- )))
-
-
;;;; Target
(defun org-odt--target (text id)
@@ -1175,20 +1153,19 @@ See `org-odt--build-date-styles' for implementation details."
(let* ((title (org-export-translate "Table of Contents" :utf-8 info))
(headlines (org-export-collect-headlines
info (and (wholenump depth) depth)))
- (translations (nconc (mapcar
- (lambda (type)
- (cons type (lambda (data contents info)
- contents)))
- (list 'radio-target))
- (plist-get info :translate-alist))))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders (mapcar
+ (lambda (type) (cons type (lambda (d c i) c)))
+ (list 'radio-target)))))
(when headlines
(concat
(org-odt-begin-toc title depth)
(mapconcat
(lambda (headline)
(let* ((entry (org-odt-format-headline--wrap
- headline translations info
- 'org-odt-format-toc-headline))
+ headline backend info 'org-odt-format-toc-headline))
(level (org-export-get-relative-level headline info))
(style (format "Contents_20_%d" level)))
(format "\n<text:p text:style-name=\"%s\">%s</text:p>"
@@ -1754,18 +1731,22 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(t
(let* ((raw (org-export-get-footnote-definition
footnote-reference info))
- (translations
- (cons (cons 'paragraph
- (lambda (p c i)
- (org-odt--format-paragraph
- p c "Footnote" "OrgFootnoteCenter"
- "OrgFootnoteQuotations")))
- (org-export-backend-translate-table 'odt)))
- (def (let ((def (org-trim (org-export-data-with-translations
- raw translations info))))
- (if (eq (org-element-type raw) 'org-data) def
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
- "Footnote" def)))))
+ (def
+ (let ((def (org-trim
+ (org-export-data-with-backend
+ raw
+ (org-export-create-backend
+ :parent 'odt
+ :transcoders
+ '((paragraph . (lambda (p c i)
+ (org-odt--format-paragraph
+ p c "Footnote"
+ "OrgFootnoteCenter"
+ "OrgFootnoteQuotations")))))
+ info))))
+ (if (eq (org-element-type raw) 'org-data) def
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ "Footnote" def)))))
(funcall --format-footnote-definition n def))))))))
@@ -1798,13 +1779,12 @@ CONTENTS is nil. INFO is a plist holding contextual information."
"<text:span text:style-name=\"%s\">%s</text:span>"
"OrgTag" tag)) tags " : "))))))
-(defun org-odt-format-headline--wrap (headline translations info
- &optional format-function
- &rest extra-keys)
- "Transcode a HEADLINE element from Org to ODT.
-CONTENTS holds the contents of the headline. INFO is a plist
-holding contextual information."
- (setq translations (or translations (plist-get info :translate-alist)))
+(defun org-odt-format-headline--wrap (headline backend info
+ &optional format-function
+ &rest extra-keys)
+ "Transcode a HEADLINE element using BACKEND.
+INFO is a plist holding contextual information."
+ (setq backend (or backend (plist-get info :back-end)))
(let* ((level (+ (org-export-get-relative-level headline info)))
(headline-number (org-export-get-headline-number headline info))
(section-number (and (org-export-numbered-headline-p headline info)
@@ -1812,13 +1792,13 @@ holding contextual information."
headline-number ".")))
(todo (and (plist-get info :with-todo-keywords)
(let ((todo (org-element-property :todo-keyword headline)))
- (and todo (org-export-data-with-translations
- todo translations info)))))
+ (and todo
+ (org-export-data-with-backend todo backend info)))))
(todo-type (and todo (org-element-property :todo-type headline)))
(priority (and (plist-get info :with-priority)
(org-element-property :priority headline)))
- (text (org-export-data-with-translations
- (org-element-property :title headline) translations info))
+ (text (org-export-data-with-backend
+ (org-element-property :title headline) backend info))
(tags (and (plist-get info :with-tags)
(org-export-get-tags headline info)))
(headline-label (concat "sec-" (mapconcat 'number-to-string
@@ -1828,7 +1808,7 @@ holding contextual information."
((functionp org-odt-format-headline-function)
(function*
(lambda (todo todo-type priority text tags
- &allow-other-keys)
+ &allow-other-keys)
(funcall org-odt-format-headline-function
todo todo-type priority text tags))))
(t 'org-odt-format-headline))))
@@ -1957,7 +1937,7 @@ holding contextual information."
(let ((format-function
(function*
(lambda (todo todo-type priority text tags
- &key contents &allow-other-keys)
+ &key contents &allow-other-keys)
(funcall org-odt-format-inlinetask-function
todo todo-type priority text tags contents)))))
(org-odt-format-headline--wrap
@@ -2123,6 +2103,16 @@ CONTENTS is nil. INFO is a plist holding contextual information."
tag))
(defun org-odt-format-label (element info op)
+ "Return a label for ELEMENT.
+
+ELEMENT is a `link', `table', `src-block' or `paragraph' type
+element. INFO is a plist used as a communication channel. OP is
+either `definition' or `reference', depending on the purpose of
+the generated string.
+
+Return value is a string if OP is set to `reference' or a cons
+cell like CAPTION . SHORT-CAPTION) where CAPTION and
+SHORT-CAPTION are strings."
(assert (memq (org-element-type element) '(link table src-block paragraph)))
(let* ((caption-from
(case (org-element-type element)
@@ -2162,15 +2152,14 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; will do.
(short-caption
(let ((short-caption (or short-caption caption))
- (translations (nconc (mapcar
- (lambda (type)
- (cons type (lambda (data contents info)
- contents)))
- org-element-all-objects)
- (plist-get info :translate-alist))))
+ (backend (org-export-create-backend
+ :parent (org-export-backend-name
+ (plist-get info :back-end))
+ :transcoders
+ (mapcar (lambda (type) (cons type (lambda (o c i) c)))
+ org-element-all-objects))))
(when short-caption
- (org-export-data-with-translations short-caption
- translations info)))))
+ (org-export-data-with-backend short-caption backend info)))))
(when (or label caption)
(let* ((default-category
(case (org-element-type element)
@@ -2200,8 +2189,8 @@ CONTENTS is nil. INFO is a plist holding contextual information."
;; Case 1: Handle Label definition.
(definition
;; Assign an internal label, if user has not provided one
- (setq label (or label (format "%s-%s" default-category seqno)))
- (setq label (org-export-solidify-link-text label))
+ (setq label (org-export-solidify-link-text
+ (or label (format "%s-%s" default-category seqno))))
(cons
(concat
;; Sneak in a bookmark. The bookmark is used when the
@@ -2210,8 +2199,11 @@ CONTENTS is nil. INFO is a plist holding contextual information."
(format "\n<text:bookmark text:name=\"%s\"/>" label)
;; Label definition: Typically formatted as below:
;; CATEGORY SEQ-NO: LONG CAPTION
+ ;; with translation for correct punctuation.
(format-spec
- (cadr (assoc-string label-style org-odt-label-styles t))
+ (org-export-translate
+ (cadr (assoc-string label-style org-odt-label-styles t))
+ :utf-8 info)
`((?e . ,category)
(?n . ,(format
"<text:sequence text:ref-name=\"%s\" text:name=\"%s\" text:formula=\"ooow:%s+1\" style:num-format=\"1\">%s</text:sequence>"
@@ -3780,9 +3772,10 @@ contextual information."
(setq processing-type 'mathml)
(message "LaTeX to MathML converter not available.")
(setq processing-type 'verbatim)))
- (dvipng
+ ((dvipng imagemagick)
(unless (and (org-check-external-command "latex" "" t)
- (org-check-external-command "dvipng" "" t))
+ (org-check-external-command
+ (if (eq processing-type 'dvipng) "dvipng" "convert") "" t))
(message "LaTeX to PNG converter not available.")
(setq processing-type 'verbatim)))
(otherwise
@@ -3795,7 +3788,7 @@ contextual information."
(message "Formatting LaTeX using %s" processing-type)
;; Convert `latex-fragment's and `latex-environment's.
- (when (memq processing-type '(mathml dvipng))
+ (when (memq processing-type '(mathml dvipng imagemagick))
(org-element-map tree '(latex-fragment latex-environment)
(lambda (latex-*)
(incf count)
@@ -3804,13 +3797,13 @@ contextual information."
(cache-dir (file-name-directory input-file))
(cache-subdir (concat
(case processing-type
- (dvipng "ltxpng/")
+ ((dvipng imagemagick) "ltxpng/")
(mathml "ltxmathml/"))
(file-name-sans-extension
(file-name-nondirectory input-file))))
(display-msg
(case processing-type
- (dvipng (format "Creating LaTeX Image %d..." count))
+ ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count))
(mathml (format "Creating MathML snippet %d..." count))))
;; Get an Org-style link to PNG image or the MathML
;; file.
@@ -4262,9 +4255,12 @@ Return output file's name."
(require 'nxml-mode)
(let ((nxml-auto-insert-xml-declaration-flag nil))
(find-file-noselect
- (concat org-odt-zip-dir "content.xml") t)))))
- (org-export-to-buffer
- 'odt out-buf ,subtreep ,visible-only nil ',ext-plist))))))
+ (concat org-odt-zip-dir "content.xml") t))))
+ (output (org-export-as
+ 'odt ,subtreep ,visible-only nil ,ext-plist)))
+ (with-current-buffer out-buf
+ (erase-buffer)
+ (insert output)))))))
(org-odt--export-wrap
outfile
(let* ((org-odt-embedded-images-count 0)
@@ -4275,13 +4271,13 @@ Return output file's name."
;; styles.
(hfy-user-sheet-assoc nil))
;; Initialize content.xml and kick-off the export process.
- (let ((out-buf (progn
+ (let ((output (org-export-as 'odt subtreep visible-only nil ext-plist))
+ (out-buf (progn
(require 'nxml-mode)
(let ((nxml-auto-insert-xml-declaration-flag nil))
(find-file-noselect
(concat org-odt-zip-dir "content.xml") t)))))
- (org-export-to-buffer
- 'odt out-buf subtreep visible-only nil ext-plist)))))))
+ (with-current-buffer out-buf (erase-buffer) (insert output))))))))
;;;; Convert between OpenDocument and other formats
diff --git a/lisp/ox-org.el b/lisp/ox-org.el
index 7539317..644cc0d 100644
--- a/lisp/ox-org.el
+++ b/lisp/ox-org.el
@@ -172,22 +172,8 @@ Export is done in a buffer named \"*Org ORG Export*\", which will
be displayed when `org-export-show-temporary-export-buffer' is
non-nil."
(interactive)
- (if async
- (org-export-async-start
- (lambda (output)
- (with-current-buffer (get-buffer-create "*Org ORG Export*")
- (erase-buffer)
- (insert output)
- (goto-char (point-min))
- (org-mode)
- (org-export-add-to-stack (current-buffer) 'org)))
- `(org-export-as 'org ,subtreep ,visible-only nil ',ext-plist))
- (let ((outbuf
- (org-export-to-buffer
- 'org "*Org ORG Export*" subtreep visible-only nil ext-plist)))
- (with-current-buffer outbuf (org-mode))
- (when org-export-show-temporary-export-buffer
- (switch-to-buffer-other-window outbuf)))))
+ (org-export-to-buffer 'org "*Org ORG Export*"
+ async subtreep visible-only nil ext-plist (lambda () (org-mode))))
;;;###autoload
(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist)
@@ -216,13 +202,8 @@ file-local settings.
Return output file name."
(interactive)
(let ((outfile (org-export-output-file-name ".org" subtreep)))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'org))
- `(expand-file-name
- (org-export-to-file
- 'org ,outfile ,subtreep ,visible-only nil ',ext-plist)))
- (org-export-to-file 'org outfile subtreep visible-only nil ext-plist))))
+ (org-export-to-file 'org outfile
+ async subtreep visible-only nil ext-plist)))
;;;###autoload
(defun org-org-publish-to-org (plist filename pub-dir)
diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el
index d5f4dfe..906c819 100644
--- a/lisp/ox-publish.el
+++ b/lisp/ox-publish.el
@@ -383,19 +383,19 @@ This splices all the components into the list."
(push p rtn)))
(nreverse (delete-dups (delq nil rtn)))))
-(defvar org-sitemap-sort-files)
-(defvar org-sitemap-sort-folders)
-(defvar org-sitemap-ignore-case)
-(defvar org-sitemap-requested)
-(defvar org-sitemap-date-format)
-(defvar org-sitemap-file-entry-format)
+(defvar org-publish-sitemap-sort-files)
+(defvar org-publish-sitemap-sort-folders)
+(defvar org-publish-sitemap-ignore-case)
+(defvar org-publish-sitemap-requested)
+(defvar org-publish-sitemap-date-format)
+(defvar org-publish-sitemap-file-entry-format)
(defun org-publish-compare-directory-files (a b)
"Predicate for `sort', that sorts folders and files for sitemap."
(let ((retval t))
- (when (or org-sitemap-sort-files org-sitemap-sort-folders)
+ (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders)
;; First we sort files:
- (when org-sitemap-sort-files
- (case org-sitemap-sort-files
+ (when org-publish-sitemap-sort-files
+ (case org-publish-sitemap-sort-files
(alphabetically
(let* ((adir (file-directory-p a))
(aorg (and (string-match "\\.org$" a) (not adir)))
@@ -405,7 +405,7 @@ This splices all the components into the list."
(org-publish-find-title a)) a))
(B (if borg (concat (file-name-directory b)
(org-publish-find-title b)) b)))
- (setq retval (if org-sitemap-ignore-case
+ (setq retval (if org-publish-sitemap-ignore-case
(not (string-lessp (upcase B) (upcase A)))
(not (string-lessp B A))))))
((anti-chronologically chronologically)
@@ -414,17 +414,17 @@ This splices all the components into the list."
(A (+ (lsh (car adate) 16) (cadr adate)))
(B (+ (lsh (car bdate) 16) (cadr bdate))))
(setq retval
- (if (eq org-sitemap-sort-files 'chronologically) (<= A B)
+ (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B)
(>= A B)))))))
;; Directory-wise wins:
- (when org-sitemap-sort-folders
+ (when org-publish-sitemap-sort-folders
;; a is directory, b not:
(cond
((and (file-directory-p a) (not (file-directory-p b)))
- (setq retval (equal org-sitemap-sort-folders 'first)))
+ (setq retval (equal org-publish-sitemap-sort-folders 'first)))
;; a is not a directory, but b is:
((and (not (file-directory-p a)) (file-directory-p b))
- (setq retval (equal org-sitemap-sort-folders 'last))))))
+ (setq retval (equal org-publish-sitemap-sort-folders 'last))))))
retval))
(defun org-publish-get-base-files-1
@@ -457,7 +457,7 @@ matching the regexp SKIP-DIR when recursing through BASE-DIR."
(or (file-directory-p file)
(and match (string-match match file))))
(directory-files base-dir t)))))
- (if (not org-sitemap-requested) all-files
+ (if (not org-publish-sitemap-requested) all-files
(sort all-files 'org-publish-compare-directory-files)))))
(defun org-publish-get-base-files (project &optional exclude-regexp)
@@ -472,15 +472,15 @@ matching filenames."
(extension (or (plist-get project-plist :base-extension) "org"))
;; sitemap-... variables are dynamically scoped for
;; org-publish-compare-directory-files:
- (org-sitemap-requested
+ (org-publish-sitemap-requested
(plist-get project-plist :auto-sitemap))
(sitemap-filename
(or (plist-get project-plist :sitemap-filename) "sitemap.org"))
- (org-sitemap-sort-folders
+ (org-publish-sitemap-sort-folders
(if (plist-member project-plist :sitemap-sort-folders)
(plist-get project-plist :sitemap-sort-folders)
org-publish-sitemap-sort-folders))
- (org-sitemap-sort-files
+ (org-publish-sitemap-sort-files
(cond ((plist-member project-plist :sitemap-sort-files)
(plist-get project-plist :sitemap-sort-files))
;; For backward compatibility:
@@ -488,18 +488,19 @@ matching filenames."
(if (plist-get project-plist :sitemap-alphabetically)
'alphabetically nil))
(t org-publish-sitemap-sort-files)))
- (org-sitemap-ignore-case
+ (org-publish-sitemap-ignore-case
(if (plist-member project-plist :sitemap-ignore-case)
(plist-get project-plist :sitemap-ignore-case)
org-publish-sitemap-sort-ignore-case))
(match (if (eq extension 'any) "^[^\\.]"
(concat "^[^\\.].*\\.\\(" extension "\\)$"))))
- ;; Make sure `org-sitemap-sort-folders' has an accepted value
- (unless (memq org-sitemap-sort-folders '(first last))
- (setq org-sitemap-sort-folders nil))
+ ;; Make sure `org-publish-sitemap-sort-folders' has an accepted
+ ;; value.
+ (unless (memq org-publish-sitemap-sort-folders '(first last))
+ (setq org-publish-sitemap-sort-folders nil))
(setq org-publish-temp-files nil)
- (if org-sitemap-requested
+ (if org-publish-sitemap-requested
(pushnew (expand-file-name (concat base-dir sitemap-filename))
org-publish-temp-files))
(org-publish-get-base-files-1 base-dir recurse match
@@ -572,24 +573,22 @@ Return output file name."
(let ((output-file
(org-export-output-file-name extension nil pub-dir))
(body-p (plist-get plist :body-only)))
- (org-export-to-file
- backend output-file nil nil body-p
- ;; Add `org-publish-collect-numbering' and
- ;; `org-publish-collect-index' to final output
- ;; filters. The latter isn't dependent on
- ;; `:makeindex', since we want to keep it up-to-date
- ;; in cache anyway.
- (org-combine-plists
- plist
- `(:filter-final-output
- ,(cons 'org-publish-collect-numbering
- (cons 'org-publish-collect-index
- (plist-get plist :filter-final-output))))))))
+ (org-export-to-file backend output-file
+ nil nil nil body-p
+ ;; Add `org-publish-collect-numbering' and
+ ;; `org-publish-collect-index' to final output
+ ;; filters. The latter isn't dependent on
+ ;; `:makeindex', since we want to keep it up-to-date
+ ;; in cache anyway.
+ (org-combine-plists
+ plist
+ `(:filter-final-output
+ ,(cons 'org-publish-collect-numbering
+ (cons 'org-publish-collect-index
+ (plist-get plist :filter-final-output))))))))
;; Remove opened buffer in the process.
(unless visitingp (kill-buffer work-buffer)))))
-(defvar project-plist)
-
(defun org-publish-attachment (plist filename pub-dir)
"Publish a file with no transformation of any kind.
@@ -678,10 +677,10 @@ If `:auto-sitemap' is set, publish the sitemap too. If
"sitemap.org"))
(sitemap-function (or (plist-get project-plist :sitemap-function)
'org-publish-org-sitemap))
- (org-sitemap-date-format
+ (org-publish-sitemap-date-format
(or (plist-get project-plist :sitemap-date-format)
org-publish-sitemap-date-format))
- (org-sitemap-file-entry-format
+ (org-publish-sitemap-file-entry-format
(or (plist-get project-plist :sitemap-file-entry-format)
org-publish-sitemap-file-entry-format))
(preparation-function
@@ -775,7 +774,7 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
;; This is common to 'flat and 'tree
(let ((entry
(org-publish-format-file-entry
- org-sitemap-file-entry-format file project-plist))
+ org-publish-sitemap-file-entry-format file project-plist))
(regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)"))
(cond ((string-match-p regexp entry)
(string-match regexp entry)
@@ -791,11 +790,12 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(or visiting (kill-buffer sitemap-buffer))))
(defun org-publish-format-file-entry (fmt file project-plist)
- (format-spec fmt
- `((?t . ,(org-publish-find-title file t))
- (?d . ,(format-time-string org-sitemap-date-format
- (org-publish-find-date file)))
- (?a . ,(or (plist-get project-plist :author) user-full-name)))))
+ (format-spec
+ fmt
+ `((?t . ,(org-publish-find-title file t))
+ (?d . ,(format-time-string org-publish-sitemap-date-format
+ (org-publish-find-date file)))
+ (?a . ,(or (plist-get project-plist :author) user-full-name)))))
(defun org-publish-find-title (file &optional reset)
"Find the title of FILE in project."
@@ -803,17 +803,16 @@ Default for SITEMAP-FILENAME is 'sitemap.org'."
(and (not reset) (org-publish-cache-get-file-property file :title nil t))
(let* ((org-inhibit-startup t)
(visiting (find-buffer-visiting file))
- (buffer (or visiting (find-file-noselect file)))
- title)
+ (buffer (or visiting (find-file-noselect file))))
(with-current-buffer buffer
(org-mode)
- (setq title
- (or (org-element-interpret-data
- (plist-get (org-export-get-environment) :title))
- (file-name-nondirectory (file-name-sans-extension file)))))
- (unless visiting (kill-buffer buffer))
- (org-publish-cache-set-file-property file :title title)
- title)))
+ (let ((title
+ (let ((property (plist-get (org-export-get-environment) :title)))
+ (if property (org-element-interpret-data property)
+ (file-name-nondirectory (file-name-sans-extension file))))))
+ (unless visiting (kill-buffer buffer))
+ (org-publish-cache-set-file-property file :title title)
+ title)))))
(defun org-publish-find-date (file)
"Find the date of FILE in project.
diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el
index e7ec635..29fbc07 100644
--- a/lisp/ox-texinfo.el
+++ b/lisp/ox-texinfo.el
@@ -149,7 +149,9 @@
:type '(string :tag "Export Filename"))
(defcustom org-texinfo-coding-system nil
- "Default document encoding for Texinfo output."
+ "Default document encoding for Texinfo output.
+
+If `nil' it will default to `buffer-file-coding-system'."
:group 'org-export-texinfo
:type 'coding-system)
@@ -693,7 +695,9 @@ holding export options."
;; `.' in text.
(dirspacing (- 29 (length dirtitle)))
(menu (org-texinfo-make-menu info 'main))
- (detail-menu (org-texinfo-make-menu info 'detailed)))
+ (detail-menu (org-texinfo-make-menu info 'detailed))
+ (coding-system (or org-texinfo-coding-system
+ buffer-file-coding-system)))
(concat
;; Header
header "\n"
@@ -701,9 +705,8 @@ holding export options."
;; Filename and Title
"@setfilename " info-filename "\n"
"@settitle " title "\n"
- (if org-texinfo-coding-system
- (format "@documentencoding %s\n"
- (upcase (symbol-name org-texinfo-coding-system))) "\n")
+ (format "@documentencoding %s\n"
+ (upcase (symbol-name coding-system))) "\n"
(format "@documentlanguage %s\n" lang)
"\n\n"
"@c Version and Contact Info\n"
@@ -1547,7 +1550,7 @@ a communication channel."
(nth count item))) counts)
(mapconcat (lambda (size)
(make-string size ?a)) (mapcar (lambda (ref)
- (apply 'max `,@ref)) (car counts))
+ (apply 'max `(,@ref))) (car counts))
"} {")))
(defun org-texinfo-table--org-table (table contents info)
@@ -1707,18 +1710,9 @@ file-local settings.
Return output file's name."
(interactive)
(let ((outfile (org-export-output-file-name ".texi" subtreep))
- (org-export-coding-system org-texinfo-coding-system))
- (if async
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'texinfo))
- (let ((org-export-coding-system org-texinfo-coding-system))
- `(expand-file-name
- (org-export-to-file
- 'texinfo ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist))))
- (let ((org-export-coding-system org-texinfo-coding-system))
- (org-export-to-file
- 'texinfo outfile subtreep visible-only body-only ext-plist)))))
+ (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-to-file 'texinfo outfile
+ async subtreep visible-only body-only ext-plist)))
(defun org-texinfo-export-to-info
(&optional async subtreep visible-only body-only ext-plist)
@@ -1752,21 +1746,11 @@ directory.
Return INFO file's name."
(interactive)
- (if async
- (let ((outfile (org-export-output-file-name ".texi" subtreep))
- (org-export-coding-system org-texinfo-coding-system))
- (org-export-async-start
- (lambda (f) (org-export-add-to-stack f 'texinfo))
- (let ((org-export-coding-system org-texinfo-coding-system))
- `(expand-file-name
- (org-texinfo-compile
- (org-export-to-file
- 'texinfo ,outfile ,subtreep ,visible-only ,body-only
- ',ext-plist))))))
- (org-texinfo-compile
- (let ((org-export-coding-system org-texinfo-coding-system))
- (org-texinfo-export-to-texinfo
- nil subtreep visible-only body-only ext-plist)))))
+ (let ((outfile (org-export-output-file-name ".texi" subtreep))
+ (org-export-coding-system `,org-texinfo-coding-system))
+ (org-export-to-file 'texinfo outfile
+ async subtreep visible-only body-only ext-plist
+ (lambda (file) (org-texinfo-compile file)))))
;;;###autoload
(defun org-texinfo-publish-to-texinfo (plist filename pub-dir)
diff --git a/lisp/ox.el b/lisp/ox.el
index abdc636..07239a0 100644
--- a/lisp/ox.el
+++ b/lisp/ox.el
@@ -47,15 +47,10 @@
;; The core function is `org-export-as'. It returns the transcoded
;; buffer as a string.
;;
-;; An export back-end is defined with `org-export-define-backend',
-;; which defines one mandatory information: his translation table.
-;; Its value is an alist whose keys are elements and objects types and
-;; values translator functions. See function's docstring for more
-;; information about translators.
-;;
-;; Optionally, `org-export-define-backend' can also support specific
-;; buffer keywords, OPTION keyword's items and filters. Also refer to
-;; function documentation for more information.
+;; An export back-end is defined with `org-export-define-backend'.
+;; This function can also support specific buffer keywords, OPTION
+;; keyword's items and filters. Refer to function's documentation for
+;; more information.
;;
;; If the new back-end shares most properties with another one,
;; `org-export-define-derived-backend' can be used to simplify the
@@ -117,7 +112,7 @@
(:section-numbers nil "num" org-export-with-section-numbers)
(:select-tags "SELECT_TAGS" nil org-export-select-tags split)
(:time-stamp-file nil "timestamp" org-export-time-stamp-file)
- (:title "TITLE" nil org-export--default-title space)
+ (:title "TITLE" nil nil space)
(:with-archived-trees nil "arch" org-export-with-archived-trees)
(:with-author nil "author" org-export-with-author)
(:with-clocks nil "c" org-export-with-clocks)
@@ -280,14 +275,8 @@ containing the back-end used, as a symbol, and either a process
or the time at which it finished. It is used to build the menu
from `org-export-stack'.")
-(defvar org-export-registered-backends nil
+(defvar org-export--registered-backends nil
"List of backends currently available in the exporter.
-
-A backend is stored as a list where CAR is its name, as a symbol,
-and CDR is a plist with the following properties:
-`:filters-alist', `:menu-entry', `:options-alist' and
-`:translate-alist'.
-
This variable is set with `org-export-define-backend' and
`org-export-define-derived-backend' functions.")
@@ -301,6 +290,17 @@ and its CDR is a list of export options.")
This marker will be used with `C-u C-c C-e' to make sure export repetition
uses the same subtree if the previous command was restricted to a subtree.")
+;; For compatibility with Org < 8
+(defvar org-export-current-backend nil
+ "Name, if any, of the back-end used during an export process.
+
+Its value is a symbol such as `html', `latex', `ascii', or nil if
+the back-end is anonymous (see `org-export-create-backend') or if
+there is no export process in progress.
+
+It can be used to teach Babel blocks how to act differently
+according to the back-end used.")
+
;;; User-configurable Variables
;;
@@ -333,7 +333,7 @@ e.g. \"arch:nil\"."
:group 'org-export-general
:type '(choice
(const :tag "Not at all" nil)
- (const :tag "Headline only" 'headline)
+ (const :tag "Headline only" headline)
(const :tag "Entirely" t)))
(defcustom org-export-with-author t
@@ -501,8 +501,9 @@ e.g. \"H:2\"."
(defcustom org-export-default-language "en"
"The default language for export and clocktable translations, as a string.
This may have an association in
-`org-clock-clocktable-language-setup'. This option can also be
-set with the LANGUAGE keyword."
+`org-clock-clocktable-language-setup',
+`org-export-smart-quotes-alist' and `org-export-dictionary'.
+This option can also be set with the LANGUAGE keyword."
:group 'org-export-general
:type '(string :tag "Language"))
@@ -797,8 +798,8 @@ HTML code while every other back-end will ignore it."
This variable can be either set to `buffer' or `subtree'."
:group 'org-export-general
:type '(choice
- (const :tag "Export current buffer" 'buffer)
- (const :tag "Export current subtree" 'subtree)))
+ (const :tag "Export current buffer" buffer)
+ (const :tag "Export current subtree" subtree)))
(defcustom org-export-show-temporary-export-buffer t
"Non-nil means show buffer after exporting to temp buffer.
@@ -829,20 +830,6 @@ process faster and the export more portable."
:package-version '(Org . "8.0")
:type '(file :must-match t))
-(defcustom org-export-invisible-backends nil
- "List of back-ends that shouldn't appear in the dispatcher.
-
-Any back-end belonging to this list or derived from a back-end
-belonging to it will not appear in the dispatcher menu.
-
-Indeed, Org may require some export back-ends without notice. If
-these modules are never to be used interactively, adding them
-here will avoid cluttering the dispatcher menu."
- :group 'org-export-general
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(repeat (symbol :tag "Back-End")))
-
(defcustom org-export-dispatch-use-expert-ui nil
"Non-nil means using a non-intrusive `org-export-dispatch'.
In that case, no help buffer is displayed. Though, an indicator
@@ -862,25 +849,147 @@ mode."
;;; Defining Back-ends
;;
-;; `org-export-define-backend' is the standard way to define an export
-;; back-end. It allows to specify translators, filters, buffer
-;; options and a menu entry. If the new back-end shares translators
-;; with another back-end, `org-export-define-derived-backend' may be
-;; used instead.
+;; An export back-end is a structure with `org-export-backend' type
+;; and `name', `parent', `transcoders', `options', `filters', `blocks'
+;; and `menu' slots.
+;;
+;; At the lowest level, a back-end is created with
+;; `org-export-create-backend' function.
+;;
+;; A named back-end can be registered with
+;; `org-export-register-backend' function. A registered back-end can
+;; later be referred to by its name, with `org-export-get-backend'
+;; function. Also, such a back-end can become the parent of a derived
+;; back-end from which slot values will be inherited by default.
+;; `org-export-derived-backend-p' can check if a given back-end is
+;; derived from a list of back-end names.
+;;
+;; `org-export-get-all-transcoders', `org-export-get-all-options' and
+;; `org-export-get-all-filters' return the full alist of transcoders,
+;; options and filters, including those inherited from ancestors.
;;
-;; Internally, a back-end is stored as a list, of which CAR is the
-;; name of the back-end, as a symbol, and CDR a plist. Accessors to
-;; properties of a given back-end are: `org-export-backend-filters',
-;; `org-export-backend-menu', `org-export-backend-options' and
-;; `org-export-backend-translate-table'.
+;; At a higher level, `org-export-define-backend' is the standard way
+;; to define an export back-end. If the new back-end is similar to
+;; a registered back-end, `org-export-define-derived-backend' may be
+;; used instead.
;;
;; Eventually `org-export-barf-if-invalid-backend' returns an error
;; when a given back-end hasn't been registered yet.
-(defun org-export-define-backend (backend translators &rest body)
+(defstruct (org-export-backend (:constructor org-export-create-backend)
+ (:copier nil))
+ name parent transcoders options filters blocks menu)
+
+(defun org-export-get-backend (name)
+ "Return export back-end named after NAME.
+NAME is a symbol. Return nil if no such back-end is found."
+ (catch 'found
+ (dolist (b org-export--registered-backends)
+ (when (eq (org-export-backend-name b) name)
+ (throw 'found b)))))
+
+(defun org-export-register-backend (backend)
+ "Register BACKEND as a known export back-end.
+BACKEND is a structure with `org-export-backend' type."
+ ;; Refuse to register an unnamed back-end.
+ (unless (org-export-backend-name backend)
+ (error "Cannot register a unnamed export back-end"))
+ ;; Refuse to register a back-end with an unknown parent.
+ (let ((parent (org-export-backend-parent backend)))
+ (when (and parent (not (org-export-get-backend parent)))
+ (error "Cannot use unknown \"%s\" back-end as a parent" parent)))
+ ;; Register dedicated export blocks in the parser.
+ (dolist (name (org-export-backend-blocks backend))
+ (add-to-list 'org-element-block-name-alist
+ (cons name 'org-element-export-block-parser)))
+ ;; If a back-end with the same name as BACKEND is already
+ ;; registered, replace it with BACKEND. Otherwise, simply add
+ ;; BACKEND to the list of registered back-ends.
+ (let ((old (org-export-get-backend (org-export-backend-name backend))))
+ (if old (setcar (memq old org-export--registered-backends) backend)
+ (push backend org-export--registered-backends))))
+
+(defun org-export-barf-if-invalid-backend (backend)
+ "Signal an error if BACKEND isn't defined."
+ (unless (org-export-backend-p backend)
+ (error "Unknown \"%s\" back-end: Aborting export" backend)))
+
+(defun org-export-derived-backend-p (backend &rest backends)
+ "Non-nil if BACKEND is derived from one of BACKENDS.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. BACKENDS is constituted of symbols."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (catch 'exit
+ (while (org-export-backend-parent backend)
+ (when (memq (org-export-backend-name backend) backends)
+ (throw 'exit t))
+ (setq backend
+ (org-export-get-backend (org-export-backend-parent backend))))
+ (memq (org-export-backend-name backend) backends))))
+
+(defun org-export-get-all-transcoders (backend)
+ "Return full translation table for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are element or object types, as symbols, and values are
+transcoders.
+
+Unlike to `org-export-backend-transcoders', this function
+also returns transcoders inherited from parent back-ends,
+if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((transcoders (org-export-backend-transcoders backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq transcoders
+ (append transcoders (org-export-backend-transcoders backend))))
+ transcoders)))
+
+(defun org-export-get-all-options (backend)
+ "Return export options for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. See `org-export-options-alist'
+for the shape of the return value.
+
+Unlike to `org-export-backend-options', this function also
+returns options inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((options (org-export-backend-options backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq options (append options (org-export-backend-options backend))))
+ options)))
+
+(defun org-export-get-all-filters (backend)
+ "Return complete list of filters for BACKEND.
+
+BACKEND is an export back-end, as return by, e.g,,
+`org-export-create-backend'. Return value is an alist where
+keys are symbols and values lists of functions.
+
+Unlike to `org-export-backend-filters', this function also
+returns filters inherited from parent back-ends, if any."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (when backend
+ (let ((filters (org-export-backend-filters backend))
+ parent)
+ (while (setq parent (org-export-backend-parent backend))
+ (setq backend (org-export-get-backend parent))
+ (setq filters (append filters (org-export-backend-filters backend))))
+ filters)))
+
+(defun org-export-define-backend (backend transcoders &rest body)
"Define a new back-end BACKEND.
-TRANSLATORS is an alist between object or element types and
+TRANSCODERS is an alist between object or element types and
functions handling them.
These functions should return a string without any trailing
@@ -996,32 +1105,23 @@ keywords are understood:
`org-export-options-alist' for more information about
structure of the values."
(declare (indent 1))
- (let (export-block filters menu-entry options contents)
+ (let (blocks filters menu-entry options contents)
(while (keywordp (car body))
(case (pop body)
(:export-block (let ((names (pop body)))
- (setq export-block
- (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
(:filters-alist (setq filters (pop body)))
(:menu-entry (setq menu-entry (pop body)))
(:options-alist (setq options (pop body)))
(t (pop body))))
- (setq contents (append (list :translate-alist translators)
- (and filters (list :filters-alist filters))
- (and options (list :options-alist options))
- (and menu-entry (list :menu-entry menu-entry))))
- ;; Register back-end.
- (let ((registeredp (assq backend org-export-registered-backends)))
- (if registeredp (setcdr registeredp contents)
- (push (cons backend contents) org-export-registered-backends)))
- ;; Tell parser to not parse EXPORT-BLOCK blocks.
- (when export-block
- (mapc
- (lambda (name)
- (add-to-list 'org-element-block-name-alist
- `(,name . org-element-export-block-parser)))
- export-block))))
+ (org-export-register-backend
+ (org-export-create-backend :name backend
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
(defun org-export-define-derived-backend (child parent &rest body)
"Create a new back-end as a variant of an existing one.
@@ -1076,75 +1176,25 @@ The back-end could then be called with, for example:
\(org-export-to-buffer 'my-latex \"*Test my-latex*\")"
(declare (indent 2))
- (let (export-block filters menu-entry options translators contents)
+ (let (blocks filters menu-entry options transcoders contents)
(while (keywordp (car body))
(case (pop body)
(:export-block (let ((names (pop body)))
- (setq export-block
- (if (consp names) (mapcar 'upcase names)
- (list (upcase names))))))
+ (setq blocks (if (consp names) (mapcar 'upcase names)
+ (list (upcase names))))))
(:filters-alist (setq filters (pop body)))
(:menu-entry (setq menu-entry (pop body)))
(:options-alist (setq options (pop body)))
- (:translate-alist (setq translators (pop body)))
+ (:translate-alist (setq transcoders (pop body)))
(t (pop body))))
- (setq contents (append
- (list :parent parent)
- (let ((p-table (org-export-backend-translate-table parent)))
- (list :translate-alist (append translators p-table)))
- (let ((p-filters (org-export-backend-filters parent)))
- (list :filters-alist (append filters p-filters)))
- (let ((p-options (org-export-backend-options parent)))
- (list :options-alist (append options p-options)))
- (and menu-entry (list :menu-entry menu-entry))))
- (org-export-barf-if-invalid-backend parent)
- ;; Register back-end.
- (let ((registeredp (assq child org-export-registered-backends)))
- (if registeredp (setcdr registeredp contents)
- (push (cons child contents) org-export-registered-backends)))
- ;; Tell parser to not parse EXPORT-BLOCK blocks.
- (when export-block
- (mapc
- (lambda (name)
- (add-to-list 'org-element-block-name-alist
- `(,name . org-element-export-block-parser)))
- export-block))))
-
-(defun org-export-backend-parent (backend)
- "Return back-end from which BACKEND is derived, or nil."
- (plist-get (cdr (assq backend org-export-registered-backends)) :parent))
-
-(defun org-export-backend-filters (backend)
- "Return filters for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :filters-alist))
-
-(defun org-export-backend-menu (backend)
- "Return menu entry for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :menu-entry))
-
-(defun org-export-backend-options (backend)
- "Return export options for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :options-alist))
-
-(defun org-export-backend-translate-table (backend)
- "Return translate table for BACKEND."
- (plist-get (cdr (assq backend org-export-registered-backends))
- :translate-alist))
-
-(defun org-export-barf-if-invalid-backend (backend)
- "Signal an error if BACKEND isn't defined."
- (unless (org-export-backend-translate-table backend)
- (error "Unknown \"%s\" back-end: Aborting export" backend)))
-
-(defun org-export-derived-backend-p (backend &rest backends)
- "Non-nil if BACKEND is derived from one of BACKENDS."
- (let ((parent backend))
- (while (and (not (memq parent backends))
- (setq parent (org-export-backend-parent parent))))
- parent))
+ (org-export-register-backend
+ (org-export-create-backend :name child
+ :parent parent
+ :transcoders transcoders
+ :options options
+ :filters filters
+ :blocks blocks
+ :menu menu-entry))))
@@ -1447,14 +1497,15 @@ The back-end could then be called with, for example:
;; `org-export--get-subtree-options' and
;; `org-export--get-inbuffer-options'
;;
-;; Also, `org-export--install-letbind-maybe' takes care of the part
-;; relative to "#+BIND:" keywords.
+;; Also, `org-export--list-bound-variables' collects bound variables
+;; along with their value in order to set them as buffer local
+;; variables later in the process.
(defun org-export-get-environment (&optional backend subtreep ext-plist)
"Collect export options from the current buffer.
-Optional argument BACKEND is a symbol specifying which back-end
-specific options to read, if any.
+Optional argument BACKEND is an export back-end, as returned by
+`org-export-create-backend'.
When optional argument SUBTREEP is non-nil, assume the export is
done against the current sub-tree.
@@ -1480,8 +1531,7 @@ inferior to file-local settings."
(list
:back-end
backend
- :translate-alist
- (org-export-backend-translate-table backend)
+ :translate-alist (org-export-get-all-transcoders backend)
:footnote-definition-alist
;; Footnotes definitions must be collected in the original
;; buffer, as there's no insurance that they will still be in
@@ -1517,11 +1567,12 @@ inferior to file-local settings."
(defun org-export--parse-option-keyword (options &optional backend)
"Parse an OPTIONS line and return values as a plist.
-Optional argument BACKEND is a symbol specifying which back-end
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies which back-end
specific items to read, if any."
(let* ((all
;; Priority is given to back-end specific options.
- (append (and backend (org-export-backend-options backend))
+ (append (and backend (org-export-get-all-options backend))
org-export-options-alist))
plist)
(dolist (option all)
@@ -1541,7 +1592,8 @@ specific items to read, if any."
(defun org-export--get-subtree-options (&optional backend)
"Get export options in subtree at point.
-Optional argument BACKEND is a symbol specifying back-end used
+Optional argument BACKEND is an export back-end, as returned by,
+e.g., `org-export-create-backend'. It specifies back-end used
for export. Return options as a plist."
;; For each buffer keyword, create a headline property setting the
;; same property in communication channel. The name for the property
@@ -1593,7 +1645,7 @@ for export. Return options as a plist."
(t value)))))))))
;; Look for both general keywords and back-end specific
;; options, with priority given to the latter.
- (append (and backend (org-export-backend-options backend))
+ (append (and backend (org-export-get-all-options backend))
org-export-options-alist)))
;; Return value.
plist)))
@@ -1601,7 +1653,8 @@ for export. Return options as a plist."
(defun org-export--get-inbuffer-options (&optional backend)
"Return current buffer export options, as a plist.
-Optional argument BACKEND, when non-nil, is a symbol specifying
+Optional argument BACKEND, when non-nil, is an export back-end,
+as returned by, e.g., `org-export-create-backend'. It specifies
which back-end specific options should also be read in the
process.
@@ -1611,19 +1664,18 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(case-fold-search t)
(options (append
;; Priority is given to back-end specific options.
- (and backend (org-export-backend-options backend))
+ (and backend (org-export-get-all-options backend))
org-export-options-alist))
(regexp (format "^[ \t]*#\\+%s:"
(regexp-opt (nconc (delq nil (mapcar 'cadr options))
org-export-special-keywords))))
- (find-opt
+ (find-properties
(lambda (keyword)
- ;; Return property name associated to KEYWORD.
- (catch 'exit
- (mapc (lambda (option)
- (when (equal (nth 1 option) keyword)
- (throw 'exit (car option))))
- options))))
+ ;; Return all properties associated to KEYWORD.
+ (let (properties)
+ (dolist (option options properties)
+ (when (equal (nth 1 option) keyword)
+ (pushnew (car option) properties))))))
(get-options
(lambda (&optional files plist)
;; Recursively read keywords in buffer. FILES is a list
@@ -1663,77 +1715,70 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored."
(plist-get plist :filetags)))))))
(t
;; Options in `org-export-options-alist'.
- (let* ((prop (funcall find-opt key))
- (behaviour (nth 4 (assq prop options))))
- (setq plist
- (plist-put
- plist prop
- ;; Handle value depending on specified
- ;; BEHAVIOUR.
- (case behaviour
- (space
- (if (not (plist-get plist prop))
- (org-trim val)
- (concat (plist-get plist prop)
- " "
- (org-trim val))))
- (newline
- (org-trim (concat (plist-get plist prop)
- "\n"
- (org-trim val))))
- (split `(,@(plist-get plist prop)
- ,@(org-split-string val)))
- ('t val)
- (otherwise
- (if (not (plist-member plist prop)) val
- (plist-get plist prop)))))))))))))
+ (dolist (property (funcall find-properties key))
+ (let ((behaviour (nth 4 (assq property options))))
+ (setq plist
+ (plist-put
+ plist property
+ ;; Handle value depending on specified
+ ;; BEHAVIOUR.
+ (case behaviour
+ (space
+ (if (not (plist-get plist property))
+ (org-trim val)
+ (concat (plist-get plist property)
+ " "
+ (org-trim val))))
+ (newline
+ (org-trim
+ (concat (plist-get plist property)
+ "\n"
+ (org-trim val))))
+ (split `(,@(plist-get plist property)
+ ,@(org-split-string val)))
+ ('t val)
+ (otherwise
+ (if (not (plist-member plist property)) val
+ (plist-get plist property))))))))))))))
;; Return final value.
plist))))
;; Read options in the current buffer.
- (setq plist (funcall get-options buffer-file-name nil))
- ;; Parse keywords specified in `org-element-document-properties'.
- (mapc (lambda (keyword)
- ;; Find the property associated to the keyword.
- (let* ((prop (funcall find-opt keyword))
- (value (and prop (plist-get plist prop))))
- (when (stringp value)
- (setq plist
- (plist-put plist prop
- (org-element-parse-secondary-string
- value (org-element-restriction 'keyword)))))))
- org-element-document-properties)
- ;; Return value.
- plist))
+ (setq plist (funcall get-options
+ (and buffer-file-name (list buffer-file-name)) nil))
+ ;; Parse keywords specified in `org-element-document-properties'
+ ;; and return PLIST.
+ (dolist (keyword org-element-document-properties plist)
+ (dolist (property (funcall find-properties keyword))
+ (let ((value (plist-get plist property)))
+ (when (stringp value)
+ (setq plist
+ (plist-put plist property
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))))))))))
(defun org-export--get-buffer-attributes ()
"Return properties related to buffer attributes, as a plist."
;; Store full path of input file name, or nil. For internal use.
- (list :input-file (buffer-file-name (buffer-base-buffer))))
-
-(defvar org-export--default-title nil) ; Dynamically scoped.
-(defun org-export-store-default-title ()
- "Return default title for current document, as a string.
-Title is extracted from associated file name, if any, or buffer's
-name."
- (setq org-export--default-title
- (or (let ((visited-file (buffer-file-name (buffer-base-buffer))))
- (and visited-file
+ (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+ (list :input-file visited-file
+ :title (if (not visited-file) (buffer-name (buffer-base-buffer))
(file-name-sans-extension
- (file-name-nondirectory visited-file))))
- (buffer-name (buffer-base-buffer)))))
+ (file-name-nondirectory visited-file))))))
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
-Optional argument BACKEND, if non-nil, is a symbol specifying
+Optional argument BACKEND, if non-nil, is an export back-end, as
+returned by, e.g., `org-export-create-backend'. It specifies
which back-end specific export options should also be read in the
process."
(let (plist
;; Priority is given to back-end specific options.
- (all (append (and backend (org-export-backend-options backend))
+ (all (append (and backend (org-export-get-all-options backend))
org-export-options-alist)))
(dolist (cell all plist)
- (let ((prop (car cell)))
- (unless (plist-member plist prop)
+ (let ((prop (car cell))
+ (default-value (nth 3 cell)))
+ (unless (or (not default-value) (plist-member plist prop))
(setq plist
(plist-put
plist
@@ -2057,11 +2102,10 @@ a tree with a select tag."
;; back-end output. It takes care of filtering out elements or
;; objects according to export options and organizing the output blank
;; lines and white space are preserved. The function memoizes its
-;; results, so it is cheap to call it within translators.
+;; results, so it is cheap to call it within transcoders.
;;
;; It is possible to modify locally the back-end used by
;; `org-export-data' or even use a temporary back-end by using
-;; `org-export-data-with-translations' and
;; `org-export-data-with-backend'.
;;
;; Internally, three functions handle the filtering of objects and
@@ -2189,24 +2233,6 @@ Return transcoded string."
results)))
(plist-get info :exported-data))))))
-(defun org-export-data-with-translations (data translations info)
- "Convert DATA into another format using a given translation table.
-DATA is an element, an object, a secondary string or a string.
-TRANSLATIONS is an alist between element or object types and
-a functions handling them. See `org-export-define-backend' for
-more information. INFO is a plist used as a communication
-channel."
- (org-export-data
- data
- ;; Set-up a new communication channel with TRANSLATIONS as the
- ;; translate table and a new hash table for memoization.
- (org-combine-plists
- info
- (list :translate-alist translations
- ;; Size of the hash table is reduced since this function
- ;; will probably be used on short trees.
- :exported-data (make-hash-table :test 'eq :size 401)))))
-
(defun org-export-data-with-backend (data backend info)
"Convert DATA into BACKEND format.
@@ -2216,9 +2242,19 @@ channel.
Unlike to `org-export-with-backend', this function will
recursively convert DATA using BACKEND translation table."
- (org-export-barf-if-invalid-backend backend)
- (org-export-data-with-translations
- data (org-export-backend-translate-table backend) info))
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-data
+ data
+ ;; Set-up a new communication channel with translations defined in
+ ;; BACKEND as the translate table and a new hash table for
+ ;; memoization.
+ (org-combine-plists
+ info
+ (list :back-end backend
+ :translate-alist (org-export-get-all-transcoders backend)
+ ;; Size of the hash table is reduced since this function
+ ;; will probably be used on small trees.
+ :exported-data (make-hash-table :test 'eq :size 401)))))
(defun org-export--interpret-p (blob info)
"Non-nil if element or object BLOB should be interpreted during export.
@@ -2712,18 +2748,20 @@ channel, as a plist. It must return a string or nil.")
"Call every function in FILTERS.
Functions are called with arguments VALUE, current export
-back-end and INFO. A function returning a nil value will be
-skipped. If it returns the empty string, the process ends and
+back-end's name and INFO. A function returning a nil value will
+be skipped. If it returns the empty string, the process ends and
VALUE is ignored.
Call is done in a LIFO fashion, to be sure that developer
specified filters, if any, are called first."
(catch 'exit
- (dolist (filter filters value)
- (let ((result (funcall filter value (plist-get info :back-end) info)))
- (cond ((not result) value)
- ((equal value "") (throw 'exit nil))
- (t (setq value result)))))))
+ (let* ((backend (plist-get info :back-end))
+ (backend-name (and backend (org-export-backend-name backend))))
+ (dolist (filter filters value)
+ (let ((result (funcall filter value backend-name info)))
+ (cond ((not result) value)
+ ((equal value "") (throw 'exit nil))
+ (t (setq value result))))))))
(defun org-export-install-filters (info)
"Install filters properties in communication channel.
@@ -2754,7 +2792,7 @@ Return the updated communication channel."
plist key
(if (atom value) (cons value (plist-get plist key))
(append value (plist-get plist key))))))))
- (org-export-backend-filters (plist-get info :back-end)))
+ (org-export-get-all-filters (plist-get info :back-end)))
;; Return new communication channel.
(org-combine-plists info plist)))
@@ -2763,15 +2801,9 @@ Return the updated communication channel."
;;; Core functions
;;
;; This is the room for the main function, `org-export-as', along with
-;; its derivatives, `org-export-to-buffer', `org-export-to-file' and
-;; `org-export-string-as'. They differ either by the way they output
-;; the resulting code (for the first two) or by the input type (for
-;; the latter). `org-export--copy-to-kill-ring-p' determines if
-;; output of these function should be added to kill ring.
-;;
-;; `org-export-output-file-name' is an auxiliary function meant to be
-;; used with `org-export-to-file'. With a given extension, it tries
-;; to provide a canonical file name to write export output to.
+;; its derivative, `org-export-string-as'.
+;; `org-export--copy-to-kill-ring-p' determines if output of these
+;; function should be added to kill ring.
;;
;; Note that `org-export-as' doesn't really parse the current buffer,
;; but a copy of it (with the same buffer-local variables and
@@ -2890,6 +2922,10 @@ The function assumes BUFFER's major mode is `org-mode'."
(backend &optional subtreep visible-only body-only ext-plist)
"Transcode current Org buffer into BACKEND code.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
If narrowing is active in the current buffer, only transcode its
narrowed part.
@@ -2910,6 +2946,7 @@ with external parameters overriding Org default settings, but
still inferior to file-local settings.
Return code as a string."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
(org-export-barf-if-invalid-backend backend)
(save-excursion
(save-restriction
@@ -2925,7 +2962,8 @@ Return code as a string."
(narrow-to-region (point) (point-max))))
;; Initialize communication channel with original buffer
;; attributes, unavailable in its copy.
- (let* ((info (org-combine-plists
+ (let* ((org-export-current-backend (org-export-backend-name backend))
+ (info (org-combine-plists
(list :export-options
(delq nil
(list (and subtreep 'subtree)
@@ -2933,17 +2971,14 @@ Return code as a string."
(and body-only 'body-only))))
(org-export--get-buffer-attributes)))
tree)
- ;; Store default title in `org-export--default-title' so that
- ;; `org-export-get-environment' can access it from buffer's
- ;; copy and then add it properly to communication channel.
- (org-export-store-default-title)
;; Update communication channel and get parse tree. Buffer
;; isn't parsed directly. Instead, a temporary copy is
;; created, where include keywords, macros are expanded and
;; code blocks are evaluated.
(org-export-with-buffer-copy
- ;; Run first hook with current back-end as argument.
- (run-hook-with-args 'org-export-before-processing-hook backend)
+ ;; Run first hook with current back-end's name as argument.
+ (run-hook-with-args 'org-export-before-processing-hook
+ (org-export-backend-name backend))
(org-export-expand-include-keyword)
;; Update macro templates since #+INCLUDE keywords might have
;; added some new ones.
@@ -2953,10 +2988,11 @@ Return code as a string."
;; Update radio targets since keyword inclusion might have
;; added some more.
(org-update-radio-target-regexp)
- ;; Run last hook with current back-end as argument.
+ ;; Run last hook with current back-end's name as argument.
(goto-char (point-min))
(save-excursion
- (run-hook-with-args 'org-export-before-parsing-hook backend))
+ (run-hook-with-args 'org-export-before-parsing-hook
+ (org-export-backend-name backend)))
;; Update communication channel with environment. Also
;; install user's and developer's filters.
(setq info
@@ -2979,9 +3015,10 @@ Return code as a string."
;; Call options filters and update export options. We do not
;; use `org-export-filter-apply-functions' here since the
;; arity of such filters is different.
- (dolist (filter (plist-get info :filter-options))
- (let ((result (funcall filter info backend)))
- (when result (setq info result))))
+ (let ((backend-name (org-export-backend-name backend)))
+ (dolist (filter (plist-get info :filter-options))
+ (let ((result (funcall filter info backend-name)))
+ (when result (setq info result)))))
;; Parse buffer and call parse-tree filter on it.
(setq tree
(org-export-filter-apply-functions
@@ -3013,67 +3050,13 @@ Return code as a string."
info))))))))
;;;###autoload
-(defun org-export-to-buffer
- (backend buffer &optional subtreep visible-only body-only ext-plist)
- "Call `org-export-as' with output to a specified buffer.
-
-BACKEND is the back-end used for transcoding, as a symbol.
-
-BUFFER is the output buffer. If it already exists, it will be
-erased first, otherwise, it will be created.
-
-Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
-EXT-PLIST are similar to those used in `org-export-as', which
-see.
-
-Depending on `org-export-copy-to-kill-ring', add buffer contents
-to kill ring. Return buffer."
- (let ((out (org-export-as backend subtreep visible-only body-only ext-plist))
- (buffer (get-buffer-create buffer)))
- (with-current-buffer buffer
- (erase-buffer)
- (insert out)
- (goto-char (point-min)))
- ;; Maybe add buffer contents to kill ring.
- (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out))
- (org-kill-new out))
- ;; Return buffer.
- buffer))
-
-;;;###autoload
-(defun org-export-to-file
- (backend file &optional subtreep visible-only body-only ext-plist)
- "Call `org-export-as' with output to a specified file.
-
-BACKEND is the back-end used for transcoding, as a symbol. FILE
-is the name of the output file, as a string.
-
-Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
-EXT-PLIST are similar to those used in `org-export-as', which
-see.
-
-Depending on `org-export-copy-to-kill-ring', add file contents
-to kill ring. Return output file's name."
- ;; Checks for FILE permissions. `write-file' would do the same, but
- ;; we'd rather avoid needless transcoding of parse tree.
- (unless (file-writable-p file) (error "Output file not writable"))
- ;; Insert contents to a temporary buffer and write it to FILE.
- (let ((coding buffer-file-coding-system)
- (out (org-export-as backend subtreep visible-only body-only ext-plist)))
- (with-temp-buffer
- (insert out)
- (let ((coding-system-for-write (or org-export-coding-system coding)))
- (write-file file)))
- ;; Maybe add file contents to kill ring.
- (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p out))
- (org-kill-new out)))
- ;; Return full path.
- file)
-
-;;;###autoload
(defun org-export-string-as (string backend &optional body-only ext-plist)
"Transcode STRING into BACKEND code.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
When optional argument BODY-ONLY is non-nil, only return body
code, without preamble nor postamble.
@@ -3089,7 +3072,10 @@ Return code as a string."
;;;###autoload
(defun org-export-replace-region-by (backend)
- "Replace the active region by its export to BACKEND."
+ "Replace the active region by its export to BACKEND.
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end."
(if (not (org-region-active-p))
(user-error "No active region to replace")
(let* ((beg (region-beginning))
@@ -3103,10 +3089,10 @@ Return code as a string."
(defun org-export-insert-default-template (&optional backend subtreep)
"Insert all export keywords with default values at beginning of line.
-BACKEND is a symbol representing the export back-end for which
-specific export options should be added to the template, or
-`default' for default template. When it is nil, the user will be
-prompted for a category.
+BACKEND is a symbol referring to the name of a registered export
+back-end, for which specific export options should be added to
+the template, or `default' for default template. When it is nil,
+the user will be prompted for a category.
If SUBTREEP is non-nil, export configuration will be set up
locally for the subtree through node properties."
@@ -3115,17 +3101,22 @@ locally for the subtree through node properties."
(when (and subtreep (org-before-first-heading-p))
(user-error "No subtree to set export options for"))
(let ((node (and subtreep (save-excursion (org-back-to-heading t) (point))))
- (backend (or backend
- (intern
- (org-completing-read
- "Options category: "
- (cons "default"
- (mapcar (lambda (b) (symbol-name (car b)))
- org-export-registered-backends))))))
+ (backend
+ (or backend
+ (intern
+ (org-completing-read
+ "Options category: "
+ (cons "default"
+ (mapcar (lambda (b)
+ (symbol-name (org-export-backend-name b)))
+ org-export--registered-backends))))))
options keywords)
;; Populate OPTIONS and KEYWORDS.
- (dolist (entry (if (eq backend 'default) org-export-options-alist
- (org-export-backend-options backend)))
+ (dolist (entry (cond ((eq backend 'default) org-export-options-alist)
+ ((org-export-backend-p backend)
+ (org-export-get-all-options backend))
+ (t (org-export-get-all-options
+ (org-export-get-backend backend)))))
(let ((keyword (nth 1 entry))
(option (nth 2 entry)))
(cond
@@ -3197,61 +3188,6 @@ locally for the subtree through node properties."
(car key)
(if (org-string-nw-p val) (format " %s" val) "")))))))))
-(defun org-export-output-file-name (extension &optional subtreep pub-dir)
- "Return output file's name according to buffer specifications.
-
-EXTENSION is a string representing the output file extension,
-with the leading dot.
-
-With a non-nil optional argument SUBTREEP, try to determine
-output file's name by looking for \"EXPORT_FILE_NAME\" property
-of subtree at point.
-
-When optional argument PUB-DIR is set, use it as the publishing
-directory.
-
-When optional argument VISIBLE-ONLY is non-nil, don't export
-contents of hidden elements.
-
-Return file name as a string."
- (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
- (base-name
- ;; File name may come from EXPORT_FILE_NAME subtree
- ;; property, assuming point is at beginning of said
- ;; sub-tree.
- (file-name-sans-extension
- (or (and subtreep
- (org-entry-get
- (save-excursion
- (ignore-errors (org-back-to-heading) (point)))
- "EXPORT_FILE_NAME" t))
- ;; File name may be extracted from buffer's associated
- ;; file, if any.
- (and visited-file (file-name-nondirectory visited-file))
- ;; Can't determine file name on our own: Ask user.
- (let ((read-file-name-function
- (and org-completion-use-ido 'ido-read-file-name)))
- (read-file-name
- "Output file: " pub-dir nil nil nil
- (lambda (name)
- (string= (file-name-extension name t) extension)))))))
- (output-file
- ;; Build file name. Enforce EXTENSION over whatever user
- ;; may have come up with. PUB-DIR, if defined, always has
- ;; precedence over any provided path.
- (cond
- (pub-dir
- (concat (file-name-as-directory pub-dir)
- (file-name-nondirectory base-name)
- extension))
- ((file-name-absolute-p base-name) (concat base-name extension))
- (t (concat (file-name-as-directory ".") base-name extension)))))
- ;; If writing to OUTPUT-FILE would overwrite original file, append
- ;; EXTENSION another time to final name.
- (if (and visited-file (org-file-equal-p visited-file output-file))
- (concat output-file extension)
- output-file)))
-
(defun org-export-expand-include-keyword (&optional included dir)
"Expand every include keyword in buffer.
Optional argument INCLUDED is a list of included file names along
@@ -3502,16 +3438,20 @@ Caption lines are separated by a white space."
;; back-end, it may be used as a fall-back function once all specific
;; cases have been treated.
-(defun org-export-with-backend (back-end data &optional contents info)
- "Call a transcoder from BACK-END on DATA.
-CONTENTS, when non-nil, is the transcoded contents of DATA
-element, as a string. INFO, when non-nil, is the communication
-channel used for export, as a plist.."
- (org-export-barf-if-invalid-backend back-end)
+(defun org-export-with-backend (backend data &optional contents info)
+ "Call a transcoder from BACKEND on DATA.
+BACKEND is an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. DATA is an Org element, object, secondary
+string or string. CONTENTS, when non-nil, is the transcoded
+contents of DATA element, as a string. INFO, when non-nil, is
+the communication channel used for export, as a plist."
+ (when (symbolp backend) (setq backend (org-export-get-backend backend)))
+ (org-export-barf-if-invalid-backend backend)
(let ((type (org-element-type data)))
(if (memq type '(nil org-data)) (error "No foreign transcoder available")
(let ((transcoder
- (cdr (assq type (org-export-backend-translate-table back-end)))))
+ (cdr (assq type (org-export-get-all-transcoders backend)))))
(if (functionp transcoder) (funcall transcoder data contents info)
(error "No foreign transcoder available"))))))
@@ -4472,19 +4412,21 @@ Return value is the width given by the last width cookie in the
same column as TABLE-CELL, or nil."
(let* ((row (org-export-get-parent table-cell))
(table (org-export-get-parent row))
- (column (let ((cells (org-element-contents row)))
- (- (length cells) (length (memq table-cell cells)))))
+ (cells (org-element-contents row))
+ (columns (length cells))
+ (column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-width-cache)
(plist-get (setq info
(plist-put info :table-cell-width-cache
- (make-hash-table :test 'equal)))
+ (make-hash-table :test 'eq)))
:table-cell-width-cache)))
- (key (cons table column))
- (value (gethash key cache 'no-result)))
- (if (not (eq value 'no-result)) value
+ (width-vector (or (gethash table cache)
+ (puthash table (make-vector columns 'empty) cache)))
+ (value (aref width-vector column)))
+ (if (not (eq value 'empty)) value
(let (cookie-width)
(dolist (row (org-element-contents table)
- (puthash key cookie-width cache))
+ (aset width-vector column cookie-width))
(when (org-export-table-row-is-special-p row info)
;; In a special row, try to find a width cookie at COLUMN.
(let* ((value (org-element-contents
@@ -4510,16 +4452,21 @@ same column as TABLE-CELL. If no such cookie is found, a default
alignment value will be deduced from fraction of numbers in the
column (see `org-table-number-fraction' for more information).
Possible values are `left', `right' and `center'."
+ ;; Load `org-table-number-fraction' and `org-table-number-regexp'.
+ (require 'org-table)
(let* ((row (org-export-get-parent table-cell))
(table (org-export-get-parent row))
- (column (let ((cells (org-element-contents row)))
- (- (length cells) (length (memq table-cell cells)))))
+ (cells (org-element-contents row))
+ (columns (length cells))
+ (column (- columns (length (memq table-cell cells))))
(cache (or (plist-get info :table-cell-alignment-cache)
(plist-get (setq info
(plist-put info :table-cell-alignment-cache
- (make-hash-table :test 'equal)))
- :table-cell-alignment-cache))))
- (or (gethash (cons table column) cache)
+ (make-hash-table :test 'eq)))
+ :table-cell-alignment-cache)))
+ (align-vector (or (gethash table cache)
+ (puthash table (make-vector columns nil) cache))))
+ (or (aref align-vector column)
(let ((number-cells 0)
(total-cells 0)
cookie-align
@@ -4562,15 +4509,15 @@ Possible values are `left', `right' and `center'."
(incf number-cells))))))
;; Return value. Alignment specified by cookies has
;; precedence over alignment deduced from cell's contents.
- (puthash (cons table column)
- (cond ((equal cookie-align "l") 'left)
- ((equal cookie-align "r") 'right)
- ((equal cookie-align "c") 'center)
- ((>= (/ (float number-cells) total-cells)
- org-table-number-fraction)
- 'right)
- (t 'left))
- cache)))))
+ (aset align-vector
+ column
+ (cond ((equal cookie-align "l") 'left)
+ ((equal cookie-align "r") 'right)
+ ((equal cookie-align "c") 'center)
+ ((>= (/ (float number-cells) total-cells)
+ org-table-number-fraction)
+ 'right)
+ (t 'left)))))))
(defun org-export-table-cell-borders (table-cell info)
"Return TABLE-CELL borders.
@@ -4819,14 +4766,14 @@ information.
Return a list of all exportable headlines as parsed elements.
Footnote sections, if any, will be ignored."
- (unless (wholenump n) (setq n (plist-get info :headline-levels)))
- (org-element-map (plist-get info :parse-tree) 'headline
- (lambda (headline)
- (unless (org-element-property :footnote-section-p headline)
- ;; Strip contents from HEADLINE.
- (let ((relative-level (org-export-get-relative-level headline info)))
- (unless (> relative-level n) headline))))
- info))
+ (let ((limit (plist-get info :headline-levels)))
+ (setq n (if (wholenump n) (min n limit) limit))
+ (org-element-map (plist-get info :parse-tree) 'headline
+ #'(lambda (headline)
+ (unless (org-element-property :footnote-section-p headline)
+ (let ((level (org-export-get-relative-level headline info)))
+ (and (<= level n) headline))))
+ info)))
(defun org-export-collect-elements (type info &optional predicate)
"Collect referenceable elements of a determined type.
@@ -4893,7 +4840,20 @@ Return a list of src-block elements with a caption."
;; `org-export-smart-quotes-regexps'.
(defconst org-export-smart-quotes-alist
- '(("de"
+ '(("da"
+ ;; one may use: »...«, "...", ›...‹, or '...'.
+ ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/
+ ;; LaTeX quotes require Babel!
+ (opening-double-quote :utf-8 "»" :html "&raquo;" :latex ">>"
+ :texinfo "@guillemetright{}")
+ (closing-double-quote :utf-8 "«" :html "&laquo;" :latex "<<"
+ :texinfo "@guillemetleft{}")
+ (opening-single-quote :utf-8 "›" :html "&rsaquo;" :latex "\\frq{}"
+ :texinfo "@guilsinglright{}")
+ (closing-single-quote :utf-8 "‹" :html "&lsaquo;" :latex "\\flq{}"
+ :texinfo "@guilsingleft{}")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("de"
(opening-double-quote :utf-8 "„" :html "&bdquo;" :latex "\"`"
:texinfo "@quotedblbase{}")
(closing-double-quote :utf-8 "“" :html "&ldquo;" :latex "\"'"
@@ -4926,7 +4886,42 @@ Return a list of src-block elements with a caption."
:texinfo "@guillemetleft{}@tie{}")
(closing-single-quote :utf-8 " »" :html "&nbsp;&raquo;" :latex "\\fg{}"
:texinfo "@tie{}@guillemetright{}")
- (apostrophe :utf-8 "’" :html "&rsquo;")))
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("no"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("nb"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("nn"
+ ;; https://nn.wikipedia.org/wiki/Sitatteikn
+ (opening-double-quote :utf-8 "«" :html "&laquo;" :latex "\\guillemotleft{}"
+ :texinfo "@guillemetleft{}")
+ (closing-double-quote :utf-8 "»" :html "&raquo;" :latex "\\guillemotright{}"
+ :texinfo "@guillemetright{}")
+ (opening-single-quote :utf-8 "‘" :html "&lsquo;" :latex "`" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "'" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ ("sv"
+ ;; based on https://sv.wikipedia.org/wiki/Citattecken
+ (opening-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (closing-double-quote :utf-8 "”" :html "&rdquo;" :latex "’’" :texinfo "’’")
+ (opening-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "`")
+ (closing-single-quote :utf-8 "’" :html "&rsquo;" :latex "’" :texinfo "'")
+ (apostrophe :utf-8 "’" :html "&rsquo;"))
+ )
"Smart quotes translations.
Alist whose CAR is a language string and CDR is an alist with
@@ -5214,10 +5209,12 @@ them."
;; the dictionary used for the translation.
(defconst org-export-dictionary
- '(("Author"
+ '(("%e %n: %c"
+ ("fr" :default "%e %n : %c" :html "%e&nbsp;%n&nbsp;: %c"))
+ ("Author"
("ca" :default "Autor")
("cs" :default "Autor")
- ("da" :default "Ophavsmand")
+ ("da" :default "Forfatter")
("de" :default "Autor")
("eo" :html "A&#365;toro")
("es" :default "Autor")
@@ -5260,12 +5257,36 @@ them."
("zh-CN" :html "&#26085;&#26399;" :utf-8 "日期")
("zh-TW" :html "&#26085;&#26399;" :utf-8 "日期"))
("Equation"
+ ("da" :default "Ligning")
("de" :default "Gleichung")
("es" :html "Ecuaci&oacute;n" :default "Ecuación")
- ("fr" :ascii "Equation" :default "Équation"))
+ ("fr" :ascii "Equation" :default "Équation")
+ ("no" :default "Ligning")
+ ("nb" :default "Ligning")
+ ("nn" :default "Likning")
+ ("sv" :default "Ekvation")
+ ("zh-CN" :html "&#26041;&#31243;" :utf-8 "方程"))
("Figure"
+ ("da" :default "Figur")
("de" :default "Abbildung")
- ("es" :default "Figura"))
+ ("es" :default "Figura")
+ ("ja" :html "&#22259;" :utf-8 "図")
+ ("no" :default "Illustrasjon")
+ ("nb" :default "Illustrasjon")
+ ("nn" :default "Illustrasjon")
+ ("sv" :default "Illustration")
+ ("zh-CN" :html "&#22270;" :utf-8 "图"))
+ ("Figure %d:"
+ ("da" :default "Figur %d")
+ ("de" :default "Abbildung %d:")
+ ("es" :default "Figura %d:")
+ ("fr" :default "Figure %d :" :html "Figure&nbsp;%d&nbsp;:")
+ ("ja" :html "&#22259;%d: " :utf-8 "図%d: ")
+ ("no" :default "Illustrasjon %d")
+ ("nb" :default "Illustrasjon %d")
+ ("nn" :default "Illustrasjon %d")
+ ("sv" :default "Illustration %d")
+ ("zh-CN" :html "&#22270;%d&nbsp;" :utf-8 "图%d "))
("Footnotes"
("ca" :html "Peus de p&agrave;gina")
("cs" :default "Pozn\xe1mky pod carou")
@@ -5291,28 +5312,54 @@ them."
("zh-CN" :html "&#33050;&#27880;" :utf-8 "脚注")
("zh-TW" :html "&#33139;&#35387;" :utf-8 "腳註"))
("List of Listings"
+ ("da" :default "Programmer")
("de" :default "Programmauflistungsverzeichnis")
("es" :default "Indice de Listados de programas")
- ("fr" :default "Liste des programmes"))
+ ("fr" :default "Liste des programmes")
+ ("no" :default "Dataprogrammer")
+ ("nb" :default "Dataprogrammer")
+ ("zh-CN" :html "&#20195;&#30721;&#30446;&#24405;" :utf-8 "代码目录"))
("List of Tables"
+ ("da" :default "Tabeller")
("de" :default "Tabellenverzeichnis")
("es" :default "Indice de tablas")
- ("fr" :default "Liste des tableaux"))
+ ("fr" :default "Liste des tableaux")
+ ("no" :default "Tabeller")
+ ("nb" :default "Tabeller")
+ ("nn" :default "Tabeller")
+ ("sv" :default "Tabeller")
+ ("zh-CN" :html "&#34920;&#26684;&#30446;&#24405;" :utf-8 "表格目录"))
("Listing %d:"
+ ("da" :default "Program %d")
("de" :default "Programmlisting %d")
("es" :default "Listado de programa %d")
- ("fr"
- :ascii "Programme %d :" :default "Programme nº %d :"
- :latin1 "Programme %d :"))
+ ("fr" :default "Programme %d :" :html "Programme&nbsp;%d&nbsp;:")
+ ("no" :default "Dataprogram")
+ ("nb" :default "Dataprogram")
+ ("zh-CN" :html "&#20195;&#30721;%d&nbsp;" :utf-8 "代码%d "))
("See section %s"
+ ("da" :default "jævnfør afsnit %s")
("de" :default "siehe Abschnitt %s")
("es" :default "vea seccion %s")
- ("fr" :default "cf. section %s"))
+ ("fr" :default "cf. section %s")
+ ("zh-CN" :html "&#21442;&#35265;&#31532;%d&#33410;" :utf-8 "参见第%s节"))
+ ("Table"
+ ("de" :default "Tabelle")
+ ("es" :default "Tabla")
+ ("fr" :default "Tableau")
+ ("ja" :html "&#34920;" :utf-8 "表")
+ ("zh-CN" :html "&#34920;" :utf-8 "表"))
("Table %d:"
+ ("da" :default "Tabel %d")
("de" :default "Tabelle %d")
("es" :default "Tabla %d")
- ("fr"
- :ascii "Tableau %d :" :default "Tableau nº %d :" :latin1 "Tableau %d :"))
+ ("fr" :default "Tableau %d :")
+ ("ja" :html "&#34920;%d:" :utf-8 "表%d:")
+ ("no" :default "Tabell %d")
+ ("nb" :default "Tabell %d")
+ ("nn" :default "Tabell %d")
+ ("sv" :default "Tabell %d")
+ ("zh-CN" :html "&#34920;%d&nbsp;" :utf-8 "表%d "))
("Table of Contents"
("ca" :html "&Iacute;ndex")
("cs" :default "Obsah")
@@ -5338,9 +5385,11 @@ them."
("zh-CN" :html "&#30446;&#24405;" :utf-8 "目录")
("zh-TW" :html "&#30446;&#37636;" :utf-8 "目錄"))
("Unknown reference"
+ ("da" :default "ukendt reference")
("de" :default "Unbekannter Verweis")
("es" :default "referencia desconocida")
- ("fr" :ascii "Destination inconnue" :default "Référence inconnue")))
+ ("fr" :ascii "Destination inconnue" :default "Référence inconnue")
+ ("zh-CN" :html "&#26410;&#30693;&#24341;&#29992;" :utf-8 "未知引用")))
"Dictionary for export engine.
Alist whose CAR is the string to translate and CDR is an alist
@@ -5378,6 +5427,13 @@ to `:default' encoding. If it fails, return S."
;; evaluates a command there. It then applies a function on the
;; returned results in the current process.
;;
+;; At a higher level, `org-export-to-buffer' and `org-export-to-file'
+;; allow to export to a buffer or a file, asynchronously or not.
+;;
+;; `org-export-output-file-name' is an auxiliary function meant to be
+;; used with `org-export-to-file'. With a given extension, it tries
+;; to provide a canonical file name to write export output to.
+;;
;; Asynchronously generated results are never displayed directly.
;; Instead, they are stored in `org-export-stack-contents'. They can
;; then be retrieved by calling `org-export-stack'.
@@ -5388,7 +5444,7 @@ to `:default' encoding. If it fails, return S."
;;`org-export-stack-clear'.
;;
;; For back-ends, `org-export-add-to-stack' add a new source to stack.
-;; It should used whenever `org-export-async-start' is called.
+;; It should be used whenever `org-export-async-start' is called.
(defmacro org-export-async-start (fun &rest body)
"Call function FUN on the results returned by BODY evaluation.
@@ -5397,93 +5453,260 @@ BODY evaluation happens in an asynchronous process, from a buffer
which is an exact copy of the current one.
Use `org-export-add-to-stack' in FUN in order to register results
-in the stack. Examples for, respectively a temporary buffer and
-a file are:
-
- \(org-export-async-start
- \(lambda (output)
- \(with-current-buffer (get-buffer-create \"*Org BACKEND Export*\")
- \(erase-buffer)
- \(insert output)
- \(goto-char (point-min))
- \(org-export-add-to-stack (current-buffer) 'backend)))
- `(org-export-as 'backend ,subtreep ,visible-only ,body-only ',ext-plist))
-
-and
-
- \(org-export-async-start
- \(lambda (f) (org-export-add-to-stack f 'backend))
- `(expand-file-name
- \(org-export-to-file
- 'backend ,outfile ,subtreep ,visible-only ,body-only ',ext-plist)))"
+in the stack.
+
+This is a low level function. See also `org-export-to-buffer'
+and `org-export-to-file' for more specialized functions."
(declare (indent 1) (debug t))
- (org-with-gensyms (process temp-file copy-fun proc-buffer handler coding)
+ (org-with-gensyms (process temp-file copy-fun proc-buffer coding)
;; Write the full sexp evaluating BODY in a copy of the current
;; buffer to a temporary file, as it may be too long for program
;; args in `start-process'.
`(with-temp-message "Initializing asynchronous export process"
(let ((,copy-fun (org-export--generate-copy-script (current-buffer)))
- (,temp-file (make-temp-file "org-export-process"))
- (,coding buffer-file-coding-system))
- (with-temp-file ,temp-file
- (insert
- ;; Null characters (from variable values) are inserted
- ;; within the file. As a consequence, coding system for
- ;; buffer contents will not be recognized properly. So,
- ;; we make sure it is the same as the one used to display
- ;; the original buffer.
- (format ";; -*- coding: %s; -*-\n%S"
- ,coding
- `(with-temp-buffer
- ,(when org-export-async-debug '(setq debug-on-error t))
- ;; Ignore `kill-emacs-hook' and code evaluation
- ;; queries from Babel as we need a truly
- ;; non-interactive process.
- (setq kill-emacs-hook nil
- org-babel-confirm-evaluate-answer-no t)
- ;; Initialize export framework.
- (require 'ox)
- ;; Re-create current buffer there.
- (funcall ,,copy-fun)
- (restore-buffer-modified-p nil)
- ;; Sexp to evaluate in the buffer.
- (print (progn ,,@body))))))
- ;; Start external process.
- (let* ((process-connection-type nil)
- (,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
- (,process
- (start-process
- "org-export-process" ,proc-buffer
- (expand-file-name invocation-name invocation-directory)
- "-Q" "--batch"
- "-l" org-export-async-init-file
- "-l" ,temp-file)))
- ;; Register running process in stack.
- (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
- ;; Set-up sentinel in order to catch results.
- (set-process-sentinel
- ,process
- (let ((handler ',fun))
- `(lambda (p status)
- (let ((proc-buffer (process-buffer p)))
- (when (eq (process-status p) 'exit)
- (unwind-protect
- (if (zerop (process-exit-status p))
- (unwind-protect
- (let ((results
- (with-current-buffer proc-buffer
- (goto-char (point-max))
- (backward-sexp)
- (read (current-buffer)))))
- (funcall ,handler results))
- (unless org-export-async-debug
- (and (get-buffer proc-buffer)
- (kill-buffer proc-buffer))))
- (org-export-add-to-stack proc-buffer nil p)
- (ding)
- (message "Process '%s' exited abnormally" p))
- (unless org-export-async-debug
- (delete-file ,,temp-file)))))))))))))
+ (,temp-file (make-temp-file "org-export-process"))
+ (,coding buffer-file-coding-system))
+ (with-temp-file ,temp-file
+ (insert
+ ;; Null characters (from variable values) are inserted
+ ;; within the file. As a consequence, coding system for
+ ;; buffer contents will not be recognized properly. So,
+ ;; we make sure it is the same as the one used to display
+ ;; the original buffer.
+ (format ";; -*- coding: %s; -*-\n%S"
+ ,coding
+ `(with-temp-buffer
+ (when org-export-async-debug '(setq debug-on-error t))
+ ;; Ignore `kill-emacs-hook' and code evaluation
+ ;; queries from Babel as we need a truly
+ ;; non-interactive process.
+ (setq kill-emacs-hook nil
+ org-babel-confirm-evaluate-answer-no t)
+ ;; Initialize export framework.
+ (require 'ox)
+ ;; Re-create current buffer there.
+ (funcall ,,copy-fun)
+ (restore-buffer-modified-p nil)
+ ;; Sexp to evaluate in the buffer.
+ (print (progn ,,@body))))))
+ ;; Start external process.
+ (let* ((process-connection-type nil)
+ (,proc-buffer (generate-new-buffer-name "*Org Export Process*"))
+ (,process
+ (start-process
+ "org-export-process" ,proc-buffer
+ (expand-file-name invocation-name invocation-directory)
+ "-Q" "--batch"
+ "-l" org-export-async-init-file
+ "-l" ,temp-file)))
+ ;; Register running process in stack.
+ (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process)
+ ;; Set-up sentinel in order to catch results.
+ (let ((handler ,fun))
+ (set-process-sentinel
+ ,process
+ `(lambda (p status)
+ (let ((proc-buffer (process-buffer p)))
+ (when (eq (process-status p) 'exit)
+ (unwind-protect
+ (if (zerop (process-exit-status p))
+ (unwind-protect
+ (let ((results
+ (with-current-buffer proc-buffer
+ (goto-char (point-max))
+ (backward-sexp)
+ (read (current-buffer)))))
+ (funcall ,handler results))
+ (unless org-export-async-debug
+ (and (get-buffer proc-buffer)
+ (kill-buffer proc-buffer))))
+ (org-export-add-to-stack proc-buffer nil p)
+ (ding)
+ (message "Process '%s' exited abnormally" p))
+ (unless org-export-async-debug
+ (delete-file ,,temp-file)))))))))))))
+
+;;;###autoload
+(defun org-export-to-buffer
+ (backend buffer
+ &optional async subtreep visible-only body-only ext-plist
+ post-process)
+ "Call `org-export-as' with output to a specified buffer.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end.
+
+BUFFER is the name of the output buffer. If it already exists,
+it will be erased first, otherwise, it will be created.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer should then be accessible
+through the `org-export-stack' interface. When ASYNC is nil, the
+buffer is displayed if `org-export-show-temporary-export-buffer'
+is non-nil.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is a function which should accept
+no argument. It is always called within the current process,
+from BUFFER, with point at its beginning. Export back-ends can
+use it to set a major mode there, e.g,
+
+ \(defun org-latex-export-as-latex
+ \(&optional async subtreep visible-only body-only ext-plist)
+ \(interactive)
+ \(org-export-to-buffer 'latex \"*Org LATEX Export*\"
+ async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode))))
+
+This function returns BUFFER."
+ (declare (indent 2))
+ (if async
+ (org-export-async-start
+ `(lambda (output)
+ (with-current-buffer (get-buffer-create ,buffer)
+ (erase-buffer)
+ (setq buffer-file-coding-system ',buffer-file-coding-system)
+ (insert output)
+ (goto-char (point-min))
+ (org-export-add-to-stack (current-buffer) ',backend)
+ (ignore-errors (funcall ,post-process))))
+ `(org-export-as
+ ',backend ,subtreep ,visible-only ,body-only ',ext-plist))
+ (let ((output
+ (org-export-as backend subtreep visible-only body-only ext-plist))
+ (buffer (get-buffer-create buffer))
+ (encoding buffer-file-coding-system))
+ (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p))
+ (org-kill-new output))
+ (with-current-buffer buffer
+ (erase-buffer)
+ (setq buffer-file-coding-system encoding)
+ (insert output)
+ (goto-char (point-min))
+ (and (functionp post-process) (funcall post-process)))
+ (when org-export-show-temporary-export-buffer
+ (switch-to-buffer-other-window buffer))
+ buffer)))
+
+;;;###autoload
+(defun org-export-to-file
+ (backend file &optional async subtreep visible-only body-only ext-plist
+ post-process)
+ "Call `org-export-as' with output to a specified file.
+
+BACKEND is either an export back-end, as returned by, e.g.,
+`org-export-create-backend', or a symbol referring to
+a registered back-end. FILE is the name of the output file, as
+a string.
+
+A non-nil optional argument ASYNC means the process should happen
+asynchronously. The resulting buffer file then be accessible
+through the `org-export-stack' interface.
+
+Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and
+EXT-PLIST are similar to those used in `org-export-as', which
+see.
+
+Optional argument POST-PROCESS is called with FILE as its
+argument and happens asynchronously when ASYNC is non-nil. It
+has to return a file name, or nil. Export back-ends can use this
+to send the output file through additional processing, e.g,
+
+ \(defun org-latex-export-to-latex
+ \(&optional async subtreep visible-only body-only ext-plist)
+ \(interactive)
+ \(let ((outfile (org-export-output-file-name \".tex\" subtreep)))
+ \(org-export-to-file 'latex outfile
+ async subtreep visible-only body-only ext-plist
+ \(lambda (file) (org-latex-compile file)))
+
+The function returns either a file name returned by POST-PROCESS,
+or FILE."
+ (declare (indent 2))
+ (if (not (file-writable-p file)) (error "Output file not writable")
+ (let ((encoding (or org-export-coding-system buffer-file-coding-system)))
+ (if async
+ (org-export-async-start
+ `(lambda (file)
+ (org-export-add-to-stack (expand-file-name file) ',backend))
+ `(let ((output
+ (org-export-as
+ ',backend ,subtreep ,visible-only ,body-only
+ ',ext-plist)))
+ (with-temp-buffer
+ (insert output)
+ (let ((coding-system-for-write ',encoding))
+ (write-file ,file)))
+ (or (ignore-errors (funcall ',post-process ,file)) ,file)))
+ (let ((output (org-export-as
+ backend subtreep visible-only body-only ext-plist)))
+ (with-temp-buffer
+ (insert output)
+ (let ((coding-system-for-write encoding))
+ (write-file file)))
+ (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output))
+ (org-kill-new output))
+ ;; Get proper return value.
+ (or (and (functionp post-process) (funcall post-process file))
+ file))))))
+
+(defun org-export-output-file-name (extension &optional subtreep pub-dir)
+ "Return output file's name according to buffer specifications.
+
+EXTENSION is a string representing the output file extension,
+with the leading dot.
+
+With a non-nil optional argument SUBTREEP, try to determine
+output file's name by looking for \"EXPORT_FILE_NAME\" property
+of subtree at point.
+
+When optional argument PUB-DIR is set, use it as the publishing
+directory.
+
+When optional argument VISIBLE-ONLY is non-nil, don't export
+contents of hidden elements.
+
+Return file name as a string."
+ (let* ((visited-file (buffer-file-name (buffer-base-buffer)))
+ (base-name
+ ;; File name may come from EXPORT_FILE_NAME subtree
+ ;; property, assuming point is at beginning of said
+ ;; sub-tree.
+ (file-name-sans-extension
+ (or (and subtreep
+ (org-entry-get
+ (save-excursion
+ (ignore-errors (org-back-to-heading) (point)))
+ "EXPORT_FILE_NAME" t))
+ ;; File name may be extracted from buffer's associated
+ ;; file, if any.
+ (and visited-file (file-name-nondirectory visited-file))
+ ;; Can't determine file name on our own: Ask user.
+ (let ((read-file-name-function
+ (and org-completion-use-ido 'ido-read-file-name)))
+ (read-file-name
+ "Output file: " pub-dir nil nil nil
+ (lambda (name)
+ (string= (file-name-extension name t) extension)))))))
+ (output-file
+ ;; Build file name. Enforce EXTENSION over whatever user
+ ;; may have come up with. PUB-DIR, if defined, always has
+ ;; precedence over any provided path.
+ (cond
+ (pub-dir
+ (concat (file-name-as-directory pub-dir)
+ (file-name-nondirectory base-name)
+ extension))
+ ((file-name-absolute-p base-name) (concat base-name extension))
+ (t (concat (file-name-as-directory ".") base-name extension)))))
+ ;; If writing to OUTPUT-FILE would overwrite original file, append
+ ;; EXTENSION another time to final name.
+ (if (and visited-file (org-file-equal-p visited-file output-file))
+ (concat output-file extension)
+ output-file)))
(defun org-export-add-to-stack (source backend &optional process)
"Add a new result to export stack if not present already.
@@ -5746,43 +5969,31 @@ back to standard interface."
(lambda (value)
;; Fontify VALUE string.
(org-propertize value 'face 'font-lock-variable-name-face)))
- ;; Prepare menu entries by extracting them from
- ;; `org-export-registered-backends', and sorting them by
- ;; access key and by ordinal, if any.
- (backends
- (sort
- (sort
- (delq nil
- (mapcar
- (lambda (b)
- (let ((name (car b)))
- (catch 'ignored
- ;; Ignore any back-end belonging to
- ;; `org-export-invisible-backends' or derived
- ;; from one of them.
- (dolist (ignored org-export-invisible-backends)
- (when (org-export-derived-backend-p name ignored)
- (throw 'ignored nil)))
- (org-export-backend-menu name))))
- org-export-registered-backends))
- (lambda (a b)
- (let ((key-a (nth 1 a))
- (key-b (nth 1 b)))
- (cond ((and (numberp key-a) (numberp key-b))
- (< key-a key-b))
- ((numberp key-b) t)))))
- (lambda (a b) (< (car a) (car b)))))
+ ;; Prepare menu entries by extracting them from registered
+ ;; back-ends and sorting them by access key and by ordinal,
+ ;; if any.
+ (entries
+ (sort (sort (delq nil
+ (mapcar 'org-export-backend-menu
+ org-export--registered-backends))
+ (lambda (a b)
+ (let ((key-a (nth 1 a))
+ (key-b (nth 1 b)))
+ (cond ((and (numberp key-a) (numberp key-b))
+ (< key-a key-b))
+ ((numberp key-b) t)))))
+ 'car-less-than-car))
;; Compute a list of allowed keys based on the first key
;; pressed, if any. Some keys
;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always
;; available.
(allowed-keys
(nconc (list 2 22 19 6 1)
- (if (not first-key) (org-uniquify (mapcar 'car backends))
+ (if (not first-key) (org-uniquify (mapcar 'car entries))
(let (sub-menu)
- (dolist (backend backends (sort (mapcar 'car sub-menu) '<))
- (when (eq (car backend) first-key)
- (setq sub-menu (append (nth 2 backend) sub-menu))))))
+ (dolist (entry entries (sort (mapcar 'car sub-menu) '<))
+ (when (eq (car entry) first-key)
+ (setq sub-menu (append (nth 2 entry) sub-menu))))))
(cond ((eq first-key ?P) (list ?f ?p ?x ?a))
((not first-key) (list ?P)))
(list ?& ?#)
@@ -5841,7 +6052,7 @@ back to standard interface."
(nth 1 sub-entry)))
sub-menu "")
(when (zerop (mod index 2)) "\n"))))))))
- backends ""))
+ entries ""))
;; Publishing menu is hard-coded.
(format "\n[%s] Publish
[%s] Current file [%s] Current project
@@ -5876,7 +6087,7 @@ back to standard interface."
;; UI, display an intrusive help buffer.
(if expertp
(org-export--dispatch-action
- expert-prompt allowed-keys backends options first-key expertp)
+ expert-prompt allowed-keys entries options first-key expertp)
;; At first call, create frame layout in order to display menu.
(unless (get-buffer "*Org Export Dispatcher*")
(delete-other-windows)
@@ -5899,15 +6110,15 @@ back to standard interface."
(set-window-start nil pos)))
(org-fit-window-to-buffer)
(org-export--dispatch-action
- standard-prompt allowed-keys backends options first-key expertp))))
+ standard-prompt allowed-keys entries options first-key expertp))))
(defun org-export--dispatch-action
- (prompt allowed-keys backends options first-key expertp)
+ (prompt allowed-keys entries options first-key expertp)
"Read a character from command input and act accordingly.
PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is
a list of characters available at a given step in the process.
-BACKENDS is a list of menu entries. OPTIONS, FIRST-KEY and
+ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and
EXPERTP are the same as defined in `org-export--dispatch-ui',
which see.
@@ -5964,9 +6175,9 @@ options as CDR."
first-key expertp))
;; Action selected: Send key and options back to
;; `org-export-dispatch'.
- ((or first-key (functionp (nth 2 (assq key backends))))
+ ((or first-key (functionp (nth 2 (assq key entries))))
(cons (cond
- ((not first-key) (nth 2 (assq key backends)))
+ ((not first-key) (nth 2 (assq key entries)))
;; Publishing actions are hard-coded. Send a special
;; signal to `org-export-dispatch'.
((eq first-key ?P)
@@ -5979,10 +6190,10 @@ options as CDR."
;; path. Indeed, derived backends can share the same
;; FIRST-KEY.
(t (catch 'found
- (mapc (lambda (backend)
- (let ((match (assq key (nth 2 backend))))
+ (mapc (lambda (entry)
+ (let ((match (assq key (nth 2 entry))))
(when match (throw 'found (nth 2 match)))))
- (member (assq first-key backends) backends)))))
+ (member (assq first-key entries) entries)))))
options))
;; Otherwise, enter sub-menu.
(t (org-export--dispatch-ui options key expertp)))))
diff --git a/mk/default.mk b/mk/default.mk
index 1bafecb..eb7fac7 100644
--- a/mk/default.mk
+++ b/mk/default.mk
@@ -39,7 +39,7 @@ BTEST_POST =
# -L <path-to>/ert # needed for Emacs23, Emacs24 has ert built in
# -L <path-to>/ess # needed for running R tests
# -L <path-to>/htmlize # need at least version 1.34 for source code formatting
-BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave python sh
+BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave python sh perl
# R # requires ESS to be installed and configured
# extra packages to require for testing
BTEST_EXTRA =
diff --git a/mk/version.mk b/mk/version.mk
index f24ea79..e379fd0 100644
--- a/mk/version.mk
+++ b/mk/version.mk
@@ -1,2 +1,2 @@
-ORGVERSION ?= 8.0.7
-GITVERSION ?= 8.0.7-dist
+ORGVERSION ?= 8.2.1
+GITVERSION ?= 8.2.1-dist