From 40ce6b75e6245659a3a14622356e32e7dd1125dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Sun, 13 Jul 2014 13:35:29 +0200 Subject: Imported Upstream version 8.2.1 --- contrib/README | 1 + contrib/lisp/htmlize.el | 10 +- contrib/lisp/org-contacts.el | 222 ++++-- contrib/lisp/org-mac-link-grabber.el | 466 ------------ contrib/lisp/org-mac-link.el | 863 ++++++++++++++++++++++ contrib/lisp/org-mac-message.el | 217 ------ contrib/lisp/org-mime.el | 4 +- contrib/lisp/org-screenshot.el | 530 ++++++++++++++ contrib/lisp/org-wl.el | 2 +- contrib/lisp/ox-bibtex.el | 293 ++++++++ contrib/lisp/ox-confluence.el | 21 +- contrib/lisp/ox-deck.el | 47 +- contrib/lisp/ox-freemind.el | 28 +- contrib/lisp/ox-groff.el | 35 +- contrib/lisp/ox-koma-letter.el | 568 ++++++++++++--- contrib/lisp/ox-rss.el | 33 +- contrib/lisp/ox-s5.el | 33 +- contrib/lisp/ox-taskjuggler.el | 237 ++++-- etc/ORG-NEWS | 163 +++++ lisp/ob-C.el | 98 ++- lisp/ob-R.el | 64 +- lisp/ob-comint.el | 2 +- lisp/ob-core.el | 285 +++++--- lisp/ob-ditaa.el | 8 +- lisp/ob-eval.el | 1 + lisp/ob-exp.el | 38 +- lisp/ob-fortran.el | 7 + lisp/ob-gnuplot.el | 104 ++- lisp/ob-haskell.el | 5 +- lisp/ob-latex.el | 51 +- lisp/ob-lob.el | 37 +- lisp/ob-ocaml.el | 29 +- lisp/ob-octave.el | 3 +- lisp/ob-org.el | 5 +- lisp/ob-python.el | 25 +- lisp/ob-ref.el | 5 +- lisp/ob-ruby.el | 28 +- lisp/ob-scheme.el | 205 ++++-- lisp/ob-sh.el | 2 +- lisp/ob-shen.el | 1 + lisp/ob-table.el | 8 +- lisp/ob-tangle.el | 46 +- lisp/ob.el | 2 + lisp/org-agenda.el | 47 +- lisp/org-attach.el | 11 +- lisp/org-bibtex.el | 4 +- lisp/org-capture.el | 19 +- lisp/org-clock.el | 15 +- lisp/org-colview.el | 8 +- lisp/org-compat.el | 54 +- lisp/org-ctags.el | 9 +- lisp/org-element.el | 540 ++++++++------ lisp/org-entities.el | 58 +- lisp/org-faces.el | 8 +- lisp/org-footnote.el | 1 + lisp/org-habit.el | 11 +- lisp/org-id.el | 5 +- lisp/org-list.el | 100 +-- lisp/org-loaddefs.el | 200 ++++-- lisp/org-macro.el | 2 + lisp/org-macs.el | 4 +- lisp/org-mhe.el | 1 + lisp/org-mobile.el | 35 +- lisp/org-pcomplete.el | 14 +- lisp/org-protocol.el | 2 +- lisp/org-src.el | 4 +- lisp/org-table.el | 126 ++-- lisp/org-timer.el | 4 +- lisp/org-version.el | 4 +- lisp/org.el | 1275 +++++++++++++++++++------------- lisp/ox-ascii.el | 34 +- lisp/ox-beamer.el | 81 +-- lisp/ox-html.el | 663 ++++++++++------- lisp/ox-icalendar.el | 19 +- lisp/ox-latex.el | 291 ++++---- lisp/ox-man.el | 25 +- lisp/ox-md.el | 24 +- lisp/ox-odt.el | 198 +++-- lisp/ox-org.el | 27 +- lisp/ox-publish.el | 109 ++- lisp/ox-texinfo.el | 50 +- lisp/ox.el | 1319 ++++++++++++++++++++-------------- mk/default.mk | 2 +- mk/version.mk | 4 +- 84 files changed, 6522 insertions(+), 3717 deletions(-) delete mode 100644 contrib/lisp/org-mac-link-grabber.el create mode 100644 contrib/lisp/org-mac-link.el delete mode 100644 contrib/lisp/org-mac-message.el create mode 100644 contrib/lisp/org-screenshot.el create mode 100644 contrib/lisp/ox-bibtex.el 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 "" - (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 "" + (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 . 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 . 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 -;; 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 . -;; -;;; 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 ::split::" - (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 +;; John Wiegley +;; Christopher Suckling +;; Daniil Frumin +;; +;; +;; Version: 1.1 +;; Keywords: org, mac, hyperlink +;; +;; Version: 1.2 +;; Keywords: outlook +;; Author: Mike McLean +;; 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 . +;; +;;; 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 ::split::" + (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 -;; Christopher Suckling - -;; 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 . - -;;; 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 +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; 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 +;; Nicolas Goaziou +;; 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 "[%s]" + 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 "[%s]" + 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 "
\n

References

\n") + (insert-file-contents (concat file ".html")) + (insert "\n
") + ;; 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 ;; Alan Schmitt +;; Viktor Rosenfeld +;; Rasmus Pank Roulund ;; 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 "" (plist-get info :language) (plist-get info :language)) "" @@ -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/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 "#") + (string= result "#")) + 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 . ;;; 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 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 "ℜ" "R" "R" "ℜ") ("image" "\\Im" t "ℑ" "I" "I" "ℑ") ("weierp" "\\wp" t "℘" "P" "P" "℘") + ("ell" "\\ell" t "ℓ" "ell" "ell" "ℓ") + ("imath" "\\imath" t "ı" "[dotless i]" "dotless i" "ı") + ("jmath" "\\jmath" t "ȷ" "[dotless j]" "dotless j" "ȷ") "** Greek" ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") @@ -203,6 +206,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") ("phi" "\\phi" t "φ" "phi" "phi" "φ") + ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "ɸ") ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") ("chi" "\\chi" t "χ" "chi" "chi" "χ") ("acutex" "\\acute x" t "´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" t "ω" "omega" "omega" "ω") ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("varpi" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") "** Hebrew" ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("aleph" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("gimel" "\\gimel" t "ℷ" "gimel" "gimel" "ℷ") + ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") + ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") "** Dead languages" ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") @@ -226,6 +235,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." "* Punctuation" "** Dots and Marks" ("dots" "\\dots{}" nil "…" "..." "..." "…") + ("cdots" "\\cdots{}" t "⋯" "..." "..." "⋯") ("hellip" "\\dots{}" nil "…" "..." "..." "…") ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") ("iexcl" "!`" nil "¡" "!" "¡" "¡") @@ -253,20 +263,23 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." "* Other" "** Misc. (often used)" ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") - ("vert" "\\vert{}" t "|" "|" "|" "|") + ("vert" "\\vert{}" t "|" "|" "|" "|") ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("S" "\\S" nil "§" "paragraph" "§" "§") ("sect" "\\S" nil "§" "paragraph" "§" "§") ("amp" "\\&" nil "&" "&" "&" "&") ("lt" "\\textless{}" nil "<" "<" "<" "<") ("gt" "\\textgreater{}" nil ">" ">" ">" ">") - ("tilde" "\\~{}" nil "˜" "~" "~" "~") + ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~") ("slash" "/" nil "/" "/" "/" "/") ("plus" "+" nil "+" "+" "+" "+") ("under" "\\_" nil "_" "_" "_" "_") ("equal" "=" nil "=" "=" "=" "=") ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("dag" "\\dag{}" nil "†" "[dagger]" "[dagger]" "†") ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") "** Whitespace" ("nbsp" "~" nil " " " " " " " ") @@ -297,6 +310,7 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") ("times" "\\texttimes{}" nil "×" "*" "×" "×") ("frasl" "/" nil "⁄" "/" "/" "⁄") + ("colon" "\\colon" t ":" ":" ":" ":") ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") @@ -326,7 +340,9 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") + ("therefore" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("because" "\\because" t "∵" "[because]" "[because]" "∵") ("sim" "\\sim" t "∼" "~" "~" "∼") ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") ("simeq" "\\simeq" t "≅" "[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 "≠" "[not equal to]" "[not equal to]" "≠") ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") + + ("triangleq" "\\triangleq" t "≜" "[defined to]" "[defined to]" "≜") ("le" "\\le" t "≤" "<=" "<=" "≤") + ("leq" "\\le" t "≤" "<=" "<=" "≤") ("ge" "\\ge" t "≥" ">=" ">=" "≥") + ("geq" "\\ge" t "≥" ">=" ">=" "≥") + ("lessgtr" "\\lessgtr" t "≶" "[less than or greater than]" "[less than or greater than]" "≶") + ("lesseqgtr" "\\lesseqgtr" t "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚") + ("ll" "\\ll" t "≪" "<<" "<<" "≪") + ("Ll" "\lll" t "⋘" "<<<" "<<<" "⋘") + ("lll" "\lll" t "⋘" "<<<" "<<<" "⋘") + ("gg" "\\gg" t "≫" ">>" ">>" "≫") + ("Gg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("ggg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("prec" "\\prec" t "≺" "[precedes]" "[precedes]" "≺") + ("preceq" "\\preceq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("preccurlyeq" "\\preccurlyeq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("succ" "\\succ" t "≻" "[succeeds]" "[succeeds]" "≻") + ("succeq" "\\succeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") + ("succcurlyeq" "\\succcurlyeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") @@ -345,9 +379,12 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") + ("setminus" "\\setminus" t "∖" "\" "\" "⧵") ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("nexist" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") + ("nexists" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") @@ -366,6 +403,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") ("lang" "\\langle" t "⟨" "<" "<" "⟨") ("rang" "\\rangle" t "⟩" ">" ">" "⟩") + ("hbar" "\\hbar" t "ℏ" "hbar" "hbar" "ℏ") + ("mho" "\\mho" t "℧" "mho" "mho" "℧") "** Arrows" ("larr" "\\leftarrow" t "←" "<-" "<-" "←") @@ -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 "⊕" "[circled plus]" "[circled plus]" "⊕") ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") - ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("check" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") "** Miscellaneous (seldom used)" ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") @@ -451,7 +491,8 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("rlm" "" nil "‏" "" "" "‏") "** Smilies" - ("smile" "\\smile" t "☺" ":-)" ":-)" "⌣") + ("smile" "\\smile" t "⌣" ":-)" ":-)" "⌣") + ("frown" "\\frown" t "⌢" ":-(" ":-(" "⌢") ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") @@ -463,10 +504,11 @@ packages to be loaded, add these packages to `org-latex-packages-alist'." ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "♦") - ("Diamond" "\\diamond" t "⋄" "[diamond]" "[diamond]" "⋄") - ("loz" "\\diamond" t "◊" "[lozenge]" "[lozenge]" "◊") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("Diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("loz" "\\lozenge" t "◊" "[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 '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (org-split-string x "[ \t]*|[ \t]*"))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it - nil) - (t x))) - lines))) - ;; there is a special marking column - (setq org-table-clean-did-remove-column t) + (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 '("<" "<")) :start) - ((member x '(">" ">")) :end) - ((member x '("<>" "<>")) :startend))) - (cdr (org-split-string x "[ \t]*|[ \t]*")))) - nil) - ((org-table-cookie-line-p x) - ;; This line contains formatting cookies, discard it + ((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") - ("" . "RET") - ("" . "ESC") - ("" . "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") + ("" . "RET") + ("" . "ESC") + ("" . "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" . "") + ("html4-transitional" . "") + ("html4-frameset" . "") + + ("xhtml-strict" . "") + ("xhtml-transitional" . "") + ("xhtml-framset" . "") + ("xhtml-11" . "") + + ("html5" . "") + ("xhtml5" . "")) + "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. + +
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 '(("\\\\-" . "­") ; shy ("---\\([^-]\\)" . "—\\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 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 - "" +(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 - " +