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 +++++++--- 18 files changed, 2573 insertions(+), 1037 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 (limited to 'contrib') 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) -- cgit v1.2.3