;; - not much in the way of error feedback
;;; Code:
+(eval-when-compile
+ (require 'cl))
(require 'ob)
(require 'cc-mode)
(defun org-babel-R-assign-elisp (name value colnames-p rownames-p)
"Construct R code assigning the elisp VALUE to a variable named NAME."
(if (listp value)
- (let ((max (apply #'max (mapcar #'length (org-remove-if-not
- #'sequencep value))))
- (min (apply #'min (mapcar #'length (org-remove-if-not
- #'sequencep value))))
- (transition-file (org-babel-temp-file "R-import-")))
- ;; ensure VALUE has an orgtbl structure (depth of at least 2)
+ (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value)))
+ (max (if lengths (apply 'max lengths) 0))
+ (min (if lengths (apply 'min lengths) 0))
+ (transition-file (org-babel-temp-file "R-import-")))
+ ;; Ensure VALUE has an orgtbl structure (depth of at least 2).
(unless (listp (car value)) (setq value (list value)))
(with-temp-file transition-file
(insert
(defvar org-src-lang-modes)
(defvar org-babel-library-of-babel)
(declare-function show-all "outline" ())
+(declare-function org-every "org" (pred seq))
(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS))
(declare-function org-mark-ring-push "org" (&optional pos buffer))
(declare-function tramp-compat-make-temp-file "tramp-compat"
(org-entry-get org-babel-current-src-block-location
(concat "header-args:" lang) 'inherit))))))
-(defvar org-src-preserve-indentation)
+(defvar org-src-preserve-indentation) ;; declare defcustom from org-src
(defun org-babel-parse-src-block-match ()
"Parse the results from a match of the `org-babel-src-block-regexp'."
(let* ((block-indentation (length (match-string 1)))
((funcall proper-list-p result)
(goto-char beg)
(insert (concat (orgtbl-to-orgtbl
- (if (or (eq 'hline (car result))
- (and (listp (car result))
- (listp (cdr (car result)))))
+ (if (org-every
+ (lambda (el) (or (listp el) (eq el 'hline)))
+ result)
result (list result))
'(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
(goto-char beg) (when (org-at-table-p) (org-table-align)))
;;; Code:
(require 'ob-core)
+(require 'org-src)
(eval-when-compile
(require 'cl))
(concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]")
(format "%S" var)))
-(defvar org-src-preserve-indentation)
(defvar org-export-copy-to-kill-ring)
(declare-function org-export-to-file "ox"
(backend file
:package-version '(Org . "8.0")
:type 'symbol)
-(defvar org-src-preserve-indentation)
-
(defcustom org-babel-python-hline-to "None"
"Replace hlines in incoming tables with this when translating to python."
:group 'org-babel
(defun org-babel-screen-session-write-temp-file (session body)
"Save BODY in a temp file that is named after SESSION."
- (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session)))
+ (let ((tmpfile (org-babel-temp-file "screen-")))
(with-temp-file tmpfile
(insert body)
(interactive)
(let* ((session "org-babel-testing")
(random-string (format "%s" (random 99999)))
- (tmpfile "/tmp/org-babel-screen.test")
+ (tmpfile (org-babel-temp-file "ob-screen-test-"))
(body (concat "echo '" random-string "' > " tmpfile "\nexit\n"))
process tmp-string)
(org-babel-execute:screen body org-babel-default-header-args:screen)
(concat base-name "." ext) base-name))))
(when file-name
;; Possibly create the parent directories for file.
- (when (let ((m (funcall get-spec :mkdirp)))
- (and m (not (string= m "no"))))
- (make-directory (file-name-directory file-name) 'parents))
+ (let ((m (funcall get-spec :mkdirp))
+ (fnd (file-name-directory file-name)))
+ (and m fnd (not (string= m "no"))
+ (make-directory fnd 'parents)))
;; delete any old versions of file
- (when (and (file-exists-p file-name)
- (not (member file-name (mapcar #'car path-collector))))
- (delete-file file-name))
+ (and (file-exists-p file-name)
+ (not (member file-name (mapcar #'car path-collector)))
+ (delete-file file-name))
;; drop source-block to file
(with-temp-buffer
(when (fboundp lang-f) (ignore-errors (funcall lang-f)))
(repeat :inline t :tag "Conditions for skipping"
(choice
:tag "Condition type"
- (list :tag "Regexp matches" :inline t (const :format "" regexp) (regexp))
- (list :tag "Regexp does not match" :inline t (const :format "" notregexp) (regexp))
+ (list :tag "Regexp matches" :inline t
+ (const :format "" 'regexp)
+ (regexp))
+ (list :tag "Regexp does not match" :inline t
+ (const :format "" 'notregexp)
+ (regexp))
(list :tag "TODO state is" :inline t
- (const todo)
+ (const 'todo)
(choice
- (const :tag "any not-done state" todo)
- (const :tag "any done state" done)
- (const :tag "any state" any)
+ (const :tag "Any not-done state" 'todo)
+ (const :tag "Any done state" 'done)
+ (const :tag "Any state" 'any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
(list :tag "TODO state is not" :inline t
- (const nottodo)
+ (const 'nottodo)
(choice
- (const :tag "any not-done state" todo)
- (const :tag "any done state" done)
- (const :tag "any state" any)
+ (const :tag "Any not-done state" 'todo)
+ (const :tag "Any done state" 'done)
+ (const :tag "Any state" 'any)
(list :tag "Keyword list"
(const :format "" quote)
(repeat (string :tag "Keyword")))))
- (const :tag "scheduled" scheduled)
- (const :tag "not scheduled" notscheduled)
- (const :tag "deadline" deadline)
- (const :tag "no deadline" notdeadline)
- (const :tag "timestamp" timestamp)
- (const :tag "no timestamp" nottimestamp))))))
+ (const :tag "scheduled" 'scheduled)
+ (const :tag "not scheduled" 'notscheduled)
+ (const :tag "deadline" 'deadline)
+ (const :tag "no deadline" 'notdeadline)
+ (const :tag "timestamp" 'timestamp)
+ (const :tag "no timestamp" 'nottimestamp))))))
(list :tag "Non-standard skipping condition"
:value (org-agenda-skip-function)
(const org-agenda-skip-function)
:tag "Org Agenda Match View"
:group 'org-agenda)
(defgroup org-agenda-search-view nil
- "Options concerning the general tags/property/todo match agenda view."
+ "Options concerning the search agenda view."
:tag "Org Agenda Search View"
:group 'org-agenda)
org-agenda-info
org-agenda-pre-window-conf
org-agenda-columns-active
- org-agenda-tag-filter-overlays
org-agenda-tag-filter
- org-agenda-cat-filter-overlays
org-agenda-category-filter
- org-agenda-re-filter-overlays
+ org-agenda-top-headline-filter
org-agenda-regexp-filter
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
nil t)
(unless org-agenda-keep-modes
(setq org-agenda-follow-mode org-agenda-start-with-follow-mode
- org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
- org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
- org-agenda-show-log org-agenda-start-with-log-mode))
-
+ org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode))
+ (setq org-agenda-show-log org-agenda-start-with-log-mode)
+ (setq org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode)
+ (add-to-invisibility-spec '(org-filtered))
+ (add-to-invisibility-spec '(org-link))
(easy-menu-change
'("Agenda") "Agenda Files"
(append
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
+ (integer :tag "Max number of TODOs")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const tags)
(const search)
(const timeline))
- (integer :tag "Max number of entries")))))
+ (integer :tag "Max number of TODOs")))))
(defcustom org-agenda-max-tags nil
"Maximum number of tagged entries to display in an agenda.
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
+ (integer :tag "Max number of tagged entries")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const tags)
(const search)
(const timeline))
- (integer :tag "Max number of entries")))))
+ (integer :tag "Max number of tagged entries")))))
(defcustom org-agenda-max-effort nil
"Maximum cumulated effort duration for the agenda.
:package-version '(Org . "8.0")
:group 'org-agenda-custom-commands
:type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
+ (integer :tag "Max number of minutes")
(repeat
(cons (choice :tag "Agenda type"
(const agenda)
(const tags)
(const search)
(const timeline))
- (integer :tag "Max number of entries")))))
+ (integer :tag "Max number of minutes")))))
(defvar org-keys nil)
(defvar org-match nil)
(org-let (if nosettings nil org-agenda-exporter-settings)
'(save-excursion
(save-window-excursion
- (org-agenda-mark-filtered-text)
(let ((bs (copy-sequence (buffer-string))) beg content)
- (org-agenda-unmark-filtered-text)
(with-temp-buffer
(rename-buffer org-agenda-write-buffer-name t)
(set-buffer-modified-p nil)
(insert bs)
(org-agenda-remove-marked-text 'org-filtered)
- (while (setq beg (text-property-any (point-min) (point-max)
- 'org-filtered t))
- (delete-region
- beg (or (next-single-property-change beg 'org-filtered)
- (point-max))))
(run-hooks 'org-agenda-before-write-hook)
(cond
((org-bound-and-true-p org-mobile-creating-agendas)
org-agenda-buffer-name)))
(when open (org-open-file file)))
-(defvar org-agenda-tag-filter-overlays nil)
-(defvar org-agenda-cat-filter-overlays nil)
-(defvar org-agenda-re-filter-overlays nil)
-
-(defun org-agenda-mark-filtered-text ()
- "Mark all text hidden by filtering with a text property."
- (let ((inhibit-read-only t))
- (mapc
- (lambda (o)
- (when (equal (overlay-buffer o) (current-buffer))
- (put-text-property
- (overlay-start o) (overlay-end o)
- 'org-filtered t)))
- (append org-agenda-tag-filter-overlays
- org-agenda-cat-filter-overlays
- org-agenda-re-filter-overlays))))
-
-(defun org-agenda-unmark-filtered-text ()
- "Remove the filtering text property."
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max) '(org-filtered t))))
-
(defun org-agenda-remove-marked-text (property &optional value)
"Delete all text marked with VALUE of PROPERTY.
VALUE defaults to t."
(while (setq beg (text-property-any (point-min) (point-max)
property value))
(delete-region
- beg (or (next-single-property-change beg 'org-filtered)
+ beg (or (next-single-property-change beg property)
(point-max))))))
(defun org-agenda-add-entry-text ()
(defvar org-agenda-category-filter nil)
(defvar org-agenda-regexp-filter nil)
(defvar org-agenda-top-headline-filter nil)
-(defvar org-agenda-tag-filter-while-redo nil)
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
;; does not have org variables local
org-agenda-this-buffer-is-sticky))))
-(defun org-agenda-prepare-window (abuf)
- "Setup agenda buffer in the window."
- (let* ((awin (get-buffer-window abuf))
- wconf)
+(defun org-agenda-prepare-window (abuf filter-alist)
+ "Setup agenda buffer in the window.
+ABUF is the buffer for the agenda window.
+FILTER-ALIST is an alist of filters we need to apply when
+`org-agenda-persistent-filter' is non-nil."
+ (let* ((awin (get-buffer-window abuf)) wconf)
(cond
((equal (current-buffer) abuf) nil)
(awin (select-window awin))
((equal org-agenda-window-setup 'reorganize-frame)
(delete-other-windows)
(org-switch-to-buffer-other-window abuf)))
- ;; additional test in case agenda is invoked from within agenda
- ;; buffer via elisp link
+ (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist)))
+ (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist)))
+ (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist)))
+ ;; Additional test in case agenda is invoked from within agenda
+ ;; buffer via elisp link.
(unless (equal (current-buffer) abuf)
(org-pop-to-buffer-same-window abuf))
(setq org-agenda-pre-window-conf
(or org-agenda-pre-window-conf wconf))))
(defun org-agenda-prepare (&optional name)
- (if (org-agenda-use-sticky-p)
- (progn
- ;; Popup existing buffer
- (org-agenda-prepare-window (get-buffer org-agenda-buffer-name))
- (message "Sticky Agenda buffer, use `r' to refresh")
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
- (setq org-todo-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
- (unless org-agenda-persistent-filter
- (setq org-agenda-tag-filter nil
- org-agenda-category-filter nil
- org-agenda-regexp-filter nil))
- (put 'org-agenda-tag-filter :preset-filter
- org-agenda-tag-filter-preset)
- (put 'org-agenda-category-filter :preset-filter
- org-agenda-category-filter-preset)
- (put 'org-agenda-regexp-filter :preset-filter
- org-agenda-regexp-filter-preset)
- (if org-agenda-multi
+ (let ((filter-alist (if org-agenda-persistent-filter
+ (list `(tag . ,org-agenda-tag-filter)
+ `(re . ,org-agenda-regexp-filter)
+ `(car . ,org-agenda-category-filter)))))
+ (if (org-agenda-use-sticky-p)
(progn
- (setq buffer-read-only nil)
- (goto-char (point-max))
- (unless (or (bobp) org-agenda-compact-blocks
- (not org-agenda-block-separator))
- (insert "\n"
- (if (stringp org-agenda-block-separator)
- org-agenda-block-separator
- (make-string (window-width) org-agenda-block-separator))
- "\n"))
- (narrow-to-region (point) (point-max)))
- (setq org-done-keywords-for-agenda nil)
-
- ;; Setting any org variables that are in org-agenda-local-vars
- ;; list need to be done after the prepare call
- (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name))
- (setq buffer-read-only nil)
- (org-agenda-reset-markers)
- (let ((inhibit-read-only t)) (erase-buffer))
- (org-agenda-mode)
- (setq org-agenda-buffer (current-buffer))
- (setq org-agenda-contributing-files nil)
- (setq org-agenda-columns-active nil)
- (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
- (setq org-todo-keywords-for-agenda
- (org-uniquify org-todo-keywords-for-agenda))
- (setq org-done-keywords-for-agenda
- (org-uniquify org-done-keywords-for-agenda))
- (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
- (setq org-agenda-last-prefix-arg current-prefix-arg)
- (setq org-agenda-this-buffer-name org-agenda-buffer-name)
- (and name (not org-agenda-name)
- (org-set-local 'org-agenda-name name)))
- (setq buffer-read-only nil)))
+ (put 'org-agenda-tag-filter :preset-filter nil)
+ (put 'org-agenda-category-filter :preset-filter nil)
+ (put 'org-agenda-regexp-filter :preset-filter nil)
+ ;; Popup existing buffer
+ (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
+ filter-alist)
+ (message "Sticky Agenda buffer, use `r' to refresh")
+ (or org-agenda-multi (org-agenda-fit-window-to-buffer))
+ (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
+ (setq org-todo-keywords-for-agenda nil)
+ (setq org-drawers-for-agenda nil)
+ (put 'org-agenda-tag-filter :preset-filter
+ org-agenda-tag-filter-preset)
+ (put 'org-agenda-category-filter :preset-filter
+ org-agenda-category-filter-preset)
+ (put 'org-agenda-regexp-filter :preset-filter
+ org-agenda-regexp-filter-preset)
+ (if org-agenda-multi
+ (progn
+ (setq buffer-read-only nil)
+ (goto-char (point-max))
+ (unless (or (bobp) org-agenda-compact-blocks
+ (not org-agenda-block-separator))
+ (insert "\n"
+ (if (stringp org-agenda-block-separator)
+ org-agenda-block-separator
+ (make-string (window-width) org-agenda-block-separator))
+ "\n"))
+ (narrow-to-region (point) (point-max)))
+ (setq org-done-keywords-for-agenda nil)
+
+ ;; Setting any org variables that are in org-agenda-local-vars
+ ;; list need to be done after the prepare call
+ (org-agenda-prepare-window
+ (get-buffer-create org-agenda-buffer-name) filter-alist)
+ (setq buffer-read-only nil)
+ (org-agenda-reset-markers)
+ (let ((inhibit-read-only t)) (erase-buffer))
+ (org-agenda-mode)
+ (setq org-agenda-buffer (current-buffer))
+ (setq org-agenda-contributing-files nil)
+ (setq org-agenda-columns-active nil)
+ (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
+ (setq org-todo-keywords-for-agenda
+ (org-uniquify org-todo-keywords-for-agenda))
+ (setq org-done-keywords-for-agenda
+ (org-uniquify org-done-keywords-for-agenda))
+ (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
+ (setq org-agenda-last-prefix-arg current-prefix-arg)
+ (setq org-agenda-this-buffer-name org-agenda-buffer-name)
+ (and name (not org-agenda-name)
+ (org-set-local 'org-agenda-name name)))
+ (setq buffer-read-only nil))))
(defvar org-agenda-overriding-columns-format) ; From org-colview.el
(defun org-agenda-finalize ()
(save-excursion
(goto-char (point-min))
(while (equal (forward-line) 0)
- (when (setq mrk (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-hd-marker)))
+ (when (setq mrk (get-text-property (point) 'org-hd-marker))
(put-text-property (point-at-bol) (point-at-eol)
'tags (org-with-point-at mrk
(delete-dups
(mapcar 'downcase (org-get-tags-at))))))))))
(run-hooks 'org-agenda-finalize-hook)
+ (when org-agenda-top-headline-filter
+ (org-agenda-filter-top-headline-apply
+ org-agenda-top-headline-filter))
(when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
(when (get 'org-agenda-tag-filter :preset-filter)
(setq p (plist-put p :tstart clocktable-start))
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
- (when (and (eq org-agenda-clockreport-mode 'with-filter)
- (setq filter (or org-agenda-tag-filter-while-redo
- (get 'org-agenda-tag-filter :preset-filter))))
- (setq p (plist-put p :tags (mapconcat (lambda (x)
- (if (string-match "[<>=]" x)
- ""
- x))
- filter ""))))
(setq tbl (apply 'org-clock-get-clocktable p))
(insert tbl)))
(goto-char (point-min))
(setq txt (org-agenda-format-item extra txt level category tags 'time))
(org-add-props txt props 'org-marker marker
'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos 'tags tags
+ 'org-category-position category-pos
'level level
'type "sexp" 'warntime warntime)
(push txt ee)))))
HH:MM."
(save-match-data
(when
- (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
- (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (and
+ (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
+ (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
+ (not (eq (get-text-property 1 'face s) 'org-link)))
(let* ((h (string-to-number (match-string 1 s)))
(m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
(ampm (if (match-end 4) (downcase (match-string 4 s))))
(cond ((< ta tb) -1)
((< tb ta) +1))))
-(defsubst org-cmp-ts (a b &optional type)
+(defsubst org-cmp-ts (a b type)
"Compare the timestamps values of entries A and B.
When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
\"timestamp_ia\", compare within each of these type. When TYPE
their type."
(let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
(ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
- (get-text-property 1 'ts-date a)) def))
+ (get-text-property 1 'ts-date a))
+ def))
(tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
- (get-text-property 1 'ts-date b)) def)))
+ (get-text-property 1 'ts-date b))
+ def)))
(cond ((< ta tb) -1)
((< tb ta) +1))))
(org-cmp-ts a b "deadline")))
(deadline-down (if deadline-up (- deadline-up) nil))
(tsia-up (and (org-em 'tsia-up 'tsia-down ss)
- (org-cmp-ts a b "iatimestamp_ia")))
+ (org-cmp-ts a b "timestamp_ia")))
(tsia-down (if tsia-up (- tsia-up) nil))
(ts-up (and (org-em 'ts-up 'ts-down ss)
(org-cmp-ts a b "timestamp")))
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(re-filter org-agenda-regexp-filter)
(re-preset (get 'org-agenda-regexp-filter :preset-filter))
- (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
(put 'org-agenda-regexp-filter :preset-filter re-preset)
- (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
- (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
- (and (or re-filter re-preset) (org-agenda-filter-apply re-filter 'regexp))
+ (let ((tag (or tag-filter tag-preset))
+ (cat (or cat-filter cat-preset))
+ (re (or re-filter re-preset)))
+ (when tag (org-agenda-filter-apply tag 'tag))
+ (when cat (org-agenda-filter-apply cat 'category))
+ (when re (org-agenda-filter-apply re 'regexp)))
(and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(org-agenda-filter-apply
(setq org-agenda-category-filter
(list (concat "+" cat))) 'category))
- ((error "No category at point"))))))
+ (t (error "No category at point"))))))
(defun org-find-top-headline (&optional pos)
"Find the topmost parent headline and return it."
(progn
(setq org-agenda-filtered-by-top-headline nil
org-agenda-top-headline-filter nil)
- (org-agenda-filter-show-all-cat))
- (let ((cat (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
- (if cat (org-agenda-filter-top-headline-apply cat strip)
- (error "No top-level category at point")))))
+ (org-agenda-filter-show-all-top-filter))
+ (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
+ (if toph (org-agenda-filter-top-headline-apply toph strip)
+ (error "No top-level headline at point")))))
(defvar org-agenda-regexp-filter nil)
(defun org-agenda-filter-by-regexp (strip)
(when org-agenda-category-filter
(org-agenda-filter-show-all-cat))
(when org-agenda-regexp-filter
- (org-agenda-filter-show-all-re)))
+ (org-agenda-filter-show-all-re))
+ (when org-agenda-top-headline-filter
+ (org-agenda-filter-show-all-top-filter))
+ (org-agenda-finalize))
(defun org-agenda-filter-by-tag (strip &optional char narrow)
"Keep only those lines in the agenda buffer that have a specific tag.
(org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
- (when (and maybe-refresh
- (eq org-agenda-clockreport-mode 'with-filter))
+ (when maybe-refresh
(org-agenda-redo))))
(defun org-agenda-get-represented-tags ()
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form
- (org-agenda-filter-make-matcher filter type))
- (if (and (eq type 'category)
- (not (equal (substring (car filter) 0 1) "-")))
- ;; Only set `org-agenda-filtered-by-category' to t
- ;; when a unique category is used as the filter
- (setq org-agenda-filtered-by-category t))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ ;; Only set `org-agenda-filtered-by-category' to t when a unique
+ ;; category is used as the filter:
+ (setq org-agenda-filtered-by-category
+ (and (eq type 'category)
+ (not (equal (substring (car filter) 0 1) "-"))))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(tophl (and pos (org-find-top-headline pos))))
(if (and tophl (funcall (if negative 'identity 'not)
(string= hl tophl)))
- (org-agenda-filter-hide-line 'category)))
+ (org-agenda-filter-hide-line 'top-headline)))
(beginning-of-line 2)))
(if (get-char-property (point) 'invisible)
(org-agenda-previous-line))
(defun org-agenda-filter-hide-line (type)
"Hide lines with TYPE in the agenda buffer."
(let* ((b (max (point-min) (1- (point-at-bol))))
- (e (point-at-eol))
- (ov (make-overlay b e)))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'intangible t)
- (overlay-put ov 'type type)
- (cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays))
- ((eq type 'category) (push ov org-agenda-cat-filter-overlays))
- ((eq type 'regexp) (push ov org-agenda-re-filter-overlays)))))
-
-(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
- (setq pos (or pos (point)))
+ (e (point-at-eol)))
+ (let ((inhibit-read-only t))
+ (add-text-properties
+ b e `(invisible org-filtered org-filter-type ,type)))))
+
+(defun org-agenda-remove-filter (type)
+ (interactive)
+ "Remove filter of type TYPE from the agenda buffer."
(save-excursion
- (dolist (ov (overlays-at pos))
- (when (and (overlay-get ov 'invisible)
- (eq (overlay-get ov 'type) 'tag))
+ (goto-char (point-min))
+ (let ((inhibit-read-only t) pos)
+ (while (setq pos (text-property-any (point) (point-max) 'org-filter-type type))
(goto-char pos)
- (if (< (overlay-start ov) (point-at-eol))
- (move-overlay ov (point-at-eol)
- (overlay-end ov)))))))
+ (remove-text-properties
+ (point) (next-single-property-change (point) 'org-filter-type)
+ `(invisible org-filtered org-filter-type ,type))))
+ (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
+ (setq org-agenda-filter-form nil)
+ (org-agenda-set-mode-name)
+ (org-agenda-finalize)))
(defun org-agenda-filter-show-all-tag nil
- "Remove tag filter overlays from the agenda buffer."
- (mapc 'delete-overlay org-agenda-tag-filter-overlays)
- (setq org-agenda-tag-filter-overlays nil
- org-agenda-tag-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
-
+ (org-agenda-remove-filter 'tag))
(defun org-agenda-filter-show-all-re nil
- "Remove regexp filter overlays from the agenda buffer."
- (mapc 'delete-overlay org-agenda-re-filter-overlays)
- (setq org-agenda-re-filter-overlays nil
- org-agenda-regexp-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
-
+ (org-agenda-remove-filter 'regexp))
(defun org-agenda-filter-show-all-cat nil
- "Remove category filter overlays from the agenda buffer."
- (mapc 'delete-overlay org-agenda-cat-filter-overlays)
- (setq org-agenda-cat-filter-overlays nil
- org-agenda-filtered-by-category nil
- org-agenda-category-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
+ (org-agenda-remove-filter 'category))
+(defun org-agenda-filter-show-all-top-filter nil
+ (org-agenda-remove-filter 'top-headline))
(defun org-agenda-manipulate-query-add ()
"Manipulate the query by adding a search term with positive selection.
(format " (maximum number of lines is %d)"
(if (integerp arg) arg org-agenda-entry-text-maxlines))))))
-(defun org-agenda-clockreport-mode (&optional with-filter)
- "Toggle clocktable mode in an agenda buffer.
-With prefix arg WITH-FILTER, make the clocktable respect the current
-agenda filter."
- (interactive "P")
+(defun org-agenda-clockreport-mode ()
+ "Toggle clocktable mode in an agenda buffer."
+ (interactive)
(org-agenda-check-type t 'agenda)
- (if with-filter
- (setq org-agenda-clockreport-mode 'with-filter)
- (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)))
+ (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))
+ (setq org-agenda-start-with-clockreport-mode org-agenda-clockreport-mode)
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Clocktable mode is %s"
nil 'clockcheck))
(special '(closed clock state))
(t (not org-agenda-show-log))))
+ (setq org-agenda-start-with-log-mode org-agenda-show-log)
(org-agenda-set-mode-name)
(org-agenda-redo)
(message "Log mode is %s"
" Archives"
(format " :%s:" org-archive-tag))
"")
- (if org-agenda-clockreport-mode
- (if (eq org-agenda-clockreport-mode 'with-filter)
- " Clock{}" " Clock")
- "")))
+ (if org-agenda-clockreport-mode " Clock" "")))
(force-mode-line-update))
(define-obsolete-function-alias
(interactive "p")
(let ((win (selected-window)))
(org-agenda-goto t)
- (org-recenter-heading 1)
+ (org-back-to-heading)
+ (set-window-start (selected-window) (point-at-bol))
(cond
((= more 0)
(hide-subtree)
(message "Remote: SUBTREE AND ALL DRAWERS")))
(select-window win)))
-(defun org-recenter-heading (n)
- (save-excursion
- (org-back-to-heading)
- (recenter n)))
-
(defvar org-agenda-cycle-counter nil)
(defun org-agenda-cycle-show (&optional n)
"Show the current entry in another window, with default settings.
(when (equal marker (org-get-at-bol 'org-marker))
(remove-text-properties (point-at-bol) (point-at-eol) '(display))
(org-move-to-column (- (window-width) (length stamp)) t)
-
- (org-agenda-fix-tags-filter-overlays-at (point))
(if (featurep 'xemacs)
;; Use `duplicable' property to trigger undo recording
(let ((ex (make-extent nil nil))
(add-text-properties
(1- (point)) (point-at-eol)
(list 'display (org-add-props stamp nil
- 'face 'secondary-selection))))
+ 'face '(secondary-selection default)))))
(beginning-of-line 1))
(beginning-of-line 0)))))
(if org-adapt-indentation (org-indent-to-column 2)))
(defun org-agenda-insert-diary-make-new-entry (text)
- "Make new entry as last child of current entry.
-Add TEXT as headline, and position the cursor in the second line so that
-a timestamp can be added there."
+ "Make a new entry with TEXT as the first child of the current subtree.
+Position the point in the line right after the new heading so
+that a timestamp can be added there."
(let ((org-show-following-heading t)
(org-show-siblings t)
(org-show-hierarchy-above t)
;;; org-annotate-file.el --- Annotate a file with org syntax
-;; Copyright (C) 2008-2013 Philip Jackson
+;; Copyright (C) 2008-2014 Philip Jackson
;; Author: Philip Jackson <phil@shellarchive.co.uk>
;; Version: 0.2
(save-excursion
(save-restriction
(widen)
- (goto-char org-entry-property-inherited-from)
+ (if (marker-position org-entry-property-inherited-from)
+ (goto-char org-entry-property-inherited-from)
+ (org-back-to-heading t))
(let (org-attach-allow-inheritance)
(org-attach-dir create-if-not-exists-p)))))
(org-attach-check-absolute-path attach-dir)
(defun org-bbdb-complete-link ()
"Read a bbdb link with name completion."
(require 'bbdb-com)
- (concat "bbdb:"
- (bbdb-record-name (car (bbdb-completing-read-record "Name: ")))))
+ (let ((rec (bbdb-completing-read-record "Name: ")))
+ (concat "bbdb:"
+ (bbdb-record-name (if (listp rec)
+ (car rec)
+ rec)))))
(defun org-bbdb-anniv-export-ical ()
"Extract anniversaries from BBDB and convert them to icalendar format."
;;; org-bibtex-extras --- extras for working with org-bibtex entries
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte <eric dot schulte at gmx dot com>
;; Keywords: outlines, hypermedia, bibtex, d3
(:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).")
(:publisher . "The publisher’s name.")
(:school . "The name of the school where a thesis was written.")
- (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
+ (:series . "The name of a series or set of books. When citing an entire book, the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.")
(:title . "The work’s title, typed as explained in the LaTeX book.")
(:type . "The type of a technical report for example, 'Research Note'.")
(:volume . "The volume of a journal or multi-volume book.")
;;; org-bookmark.el - Support for links to bookmark
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp>
;; Version: 1.0
(v-x (or (org-get-x-clipboard 'PRIMARY)
(org-get-x-clipboard 'CLIPBOARD)
(org-get-x-clipboard 'SECONDARY)))
- (v-t (format-time-string (car org-time-stamp-formats) ct))
- (v-T (format-time-string (cdr org-time-stamp-formats) ct))
+ (v-t (format-time-string (car org-time-stamp-formats) ct1))
+ (v-T (format-time-string (cdr org-time-stamp-formats) ct1))
(v-u (concat "[" (substring v-t 1 -1) "]"))
(v-U (concat "[" (substring v-T 1 -1) "]"))
;; `initial' and `annotation' might habe been passed.
(insert template)
(goto-char (point-min))
(org-capture-steal-local-variables buffer)
- (setq buffer-file-name nil)
+ (setq buffer-file-name nil mark-active nil)
;; %[] Insert contents of a file.
(goto-char (point-min))
(or (equal (char-before) ?:) (insert ":"))
(insert ins)
(or (equal (char-after) ?:) (insert ":"))
- (and (org-at-heading-p) (org-set-tags nil 'align)))))
+ (and (org-at-heading-p)
+ (let ((org-ignore-region t))
+ (org-set-tags nil 'align))))))
((equal char "C")
(cond ((= (length clipboards) 1) (insert (car clipboards)))
((> (length clipboards) 1)
;;; org-choose.el --- decision management for org-mode
-;; Copyright (C) 2009-2013 Tom Breton (Tehom)
+;; Copyright (C) 2009-2014 Tom Breton (Tehom)
;; This file is not part of GNU Emacs.
total-time))
(defun org-clocktable-indent-string (level)
- (if (= level 1)
- ""
- (let ((str "\\__"))
- (while (> level 2)
- (setq level (1- level)
- str (concat str "___")))
- (concat str " "))))
+ (if (= level 1) ""
+ (let ((str " "))
+ (dotimes (k (1- level) str)
+ (setq str (concat "\\emsp" str))))))
(defun org-clocktable-steps (params)
"Step through the range to make a number of clock tables."
;;; org-collector --- collect properties into tables
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Eric Schulte <schulte dot eric at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp, experimentation,
;;; org-colview-xemacs.el --- Column View in Org-mode, XEmacs-specific version
-;; Copyright (C) 2004-2013
+;; Copyright (C) 2004-2014
;; Carsten Dominik
;; Author: Carsten Dominik <carsten at orgmode dot org>
(defvar org-colview-initial-truncate-line-value nil
"Remember the value of `truncate-lines' across colview.")
+;;;###autoload
(defun org-columns-remove-overlays ()
"Remove all currently active column overlays."
(interactive)
(let ((value (get-char-property (point) 'org-columns-value)))
(org-open-link-from-string value arg)))
+;;;###autoload
(defun org-columns-get-format-and-top-level ()
(let (fmt)
(when (condition-case nil (org-back-to-heading) (error nil))
(org-overlay-display ov (format fmt val))))))
org-columns-overlays))))
+;;;###autoload
(defun org-columns-compute (property)
"Sum the values of property PROPERTY hierarchically, for the entire buffer."
(interactive)
(setq sum (+ (string-to-number (pop l)) (/ sum 60))))
sum)))
+;;;###autoload
(defun org-columns-number-to-string (n fmt &optional printf)
"Convert a computed column number to a string value, according to FMT."
(cond
(defun org-in-invisibility-spec-p (arg)
"Is ARG a member of `buffer-invisibility-spec'?"
(if (consp buffer-invisibility-spec)
- (member arg buffer-invisibility-spec)
- nil))
+ (member arg buffer-invisibility-spec)))
(defmacro org-xemacs-without-invisibility (&rest body)
"Turn off extents with invisibility while executing BODY."
"Move to column COLUMN.
Pass COLUMN and FORCE to `move-to-column'.
Pass BUFFER to the XEmacs version of `move-to-column'."
- (let* ((with-bracket-link
- (save-excursion
- (forward-line 0)
- (looking-at (concat "^.*" org-bracket-link-regexp))))
- (buffer-invisibility-spec
- (cond
- ((or (not (derived-mode-p 'org-mode))
- (and with-bracket-link (org-invisible-p2)))
- (remove '(org-link) buffer-invisibility-spec))
- (with-bracket-link
- (remove t buffer-invisibility-spec))
- (t buffer-invisibility-spec))))
+ (let ((buffer-invisibility-spec
+ (remove '(org-filtered) buffer-invisibility-spec)))
(if (featurep 'xemacs)
(org-xemacs-without-invisibility
(move-to-column column force buffer))
;;; org-contacts.el --- Contacts management
-;; Copyright (C) 2010-2013 Julien Danjou <julien@danjou.info>
+;; Copyright (C) 2010-2014 Julien Danjou <julien@danjou.info>
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: outlines, hypermedia, calendar
;; 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")
;; :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
: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.
(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)
(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."
(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)
(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))
(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.
(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)
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
;; Grab the first email of the contact
- for email = (car (split-string
+ for email = (org-contacts-strip-link (car (org-contacts-split-property
(or
(cdr (assoc-string org-contacts-email-property
(caddr contact)))
- "")))
+ ""))))
;; If the user has an email address, append USER <EMAIL>.
if email collect (org-contacts-format-email contact-name email))
", ")))
(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)
;; The contact name is always the car of the assoc-list
;; returned by `org-contacts-filter'.
for contact-name = (car contact)
+
+ ;; Build the list of the email addresses which has
+ ;; been expired
+ for ignore-list = (org-contacts-split-property
+ (or (cdr (assoc-string org-contacts-ignore-property
+ (caddr contact))) ""))
;; Build the list of the user email addresses.
- for email-list = (split-string (or
- (cdr (assoc-string org-contacts-email-property
- (caddr contact))) ""))
+ for email-list = (org-contacts-remove-ignored-property-values
+ ignore-list
+ (org-contacts-split-property
+ (or (cdr (assoc-string org-contacts-email-property
+ (caddr contact))) "")))
;; If the user has email addresses…
if email-list
;; … append a list of USER <EMAIL>.
nconc (loop for email in email-list
- collect (org-contacts-format-email contact-name email))))
+ collect (org-contacts-format-email contact-name (org-contacts-strip-link email)))))
(completion-list (org-contacts-all-completions-prefix
string
(org-uniquify completion-list))))
(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 "$")))))))
(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.
(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)."
(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))))
(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
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)
;;; org-contribdir.el --- Mark the location of the contrib directory
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;;; org-depend.el --- TODO dependencies for Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
but a warning message is printed when each leech item is
presented."
:group 'org-drill
- :type '(choice (const 'warn) (const 'skip) (const nil)))
+ :type '(choice (const warn) (const skip) (const nil)))
(defface org-drill-visible-cloze-face
'((t (:foreground "darkseagreen")))
;; 'file-no-restriction' means current file/buffer, ignoring restrictions
;; 'directory' means all *.org files in current directory
:group 'org-drill
- :type '(choice (const 'file) (const 'tree) (const 'file-no-restriction)
- (const 'file-with-archives) (const 'agenda)
- (const 'agenda-with-archives) (const 'directory)
- list))
+ :type '(choice (const :tag "The current buffer, respecting the restriction if any." file)
+ (const :tag "The subtree started with the entry at point" tree)
+ (const :tag "The current buffer, without restriction" file-no-restriction)
+ (const :tag "The current buffer, and any archives associated with it." file-with-archives)
+ (const :tag "All agenda files" agenda)
+ (const :tag "All agenda files with any archive files associated with them." agenda-with-archives)
+ (const :tag "All files with the extension '.org' in the same directory as the current file (includes the current file if it is an .org file.)" directory)
+ (repeat :tag "List of files to scan for drill items." file)))
(defcustom org-drill-save-buffers-after-drill-sessions-p t
"If non-nil, prompt to save all modified buffers after a drill session
adjusting intervals when items are reviewed early or late has been taken
from SM11, a later version of the algorithm, and included in Simple8."
:group 'org-drill
- :type '(choice (const 'sm2) (const 'sm5) (const 'simple8)))
+ :type '(choice (const sm2) (const sm5) (const simple8)))
(defcustom org-drill-optimal-factor-matrix nil
"DO NOT CHANGE THE VALUE OF THIS VARIABLE.
(footnote-reference . :inline-definition))
"Alist between element types and location of secondary value.")
-(defconst org-element-object-variables '(org-link-abbrev-alist-local)
- "List of buffer-local variables used when parsing objects.
-These variables are copied to the temporary buffer created by
-`org-export-secondary-string'.")
-
\f
;;; Accessors and Setters
(cond
;; File type.
((or (file-name-absolute-p raw-link)
- (string-match "^\\.\\.?/" raw-link))
+ (string-match "\\`\\.\\.?/" raw-link))
(setq type "file" path raw-link))
;; Explicit type (http, irc, bbdb...). See `org-link-types'.
- ((string-match org-link-re-with-space3 raw-link)
- (setq type (match-string 1 raw-link) path (match-string 2 raw-link)))
+ ((string-match org-link-types-re raw-link)
+ (setq type (match-string 1 raw-link)
+ ;; According to RFC 3986, extra whitespace should be
+ ;; ignored when a URI is extracted.
+ path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0)))))
;; Id type: PATH is the id.
- ((string-match "^id:\\([-a-f0-9]+\\)" raw-link)
+ ((string-match "\\`id:\\([-a-f0-9]+\\)" raw-link)
(setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((string-match "^(\\(.*\\))$" raw-link)
+ ((string-match "\\`(\\(.*\\))\\'" raw-link)
(setq type "coderef" path (match-string 1 raw-link)))
;; Custom-id type: PATH is the name of the custom id.
((= (aref raw-link 0) ?#)
`:month-end', `:day-end', `:hour-end', `:minute-end',
`:repeater-type', `:repeater-value', `:repeater-unit',
`:warning-type', `:warning-value', `:warning-unit', `:begin',
-`:end', `:value' and `:post-blank' keywords.
+`:end' and `:post-blank' keywords.
Assume point is at the beginning of the timestamp."
(save-excursion
(goto-char (car affiliated))
(org-element-keyword-parser limit nil))
;; LaTeX Environment.
- ((looking-at
- "[ \t]*\\\\begin{[A-Za-z0-9*]+}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
(org-element-latex-environment-parser limit affiliated))
;; Drawer and Property Drawer.
((looking-at org-drawer-regexp)
Optional argument PARENT, when non-nil, is the element or object
containing the secondary string. It is used to set correctly
`:parent' property within the string."
- ;; Copy buffer-local variables listed in
- ;; `org-element-object-variables' into temporary buffer. This is
- ;; required since object parsing is dependent on these variables.
- (let ((pairs (delq nil (mapcar (lambda (var)
- (when (boundp var)
- (cons var (symbol-value var))))
- org-element-object-variables))))
+ (let ((local-variables (buffer-local-variables)))
(with-temp-buffer
- (mapc (lambda (pair) (org-set-local (car pair) (cdr pair))) pairs)
+ (dolist (v local-variables)
+ (ignore-errors
+ (if (symbolp v) (makunbound v)
+ (org-set-local (car v) (cdr v)))))
(insert string)
+ (restore-buffer-modified-p nil)
(let ((secondary (org-element--parse-objects
(point-min) (point-max) nil restriction)))
(when parent
- (mapc (lambda (obj) (org-element-put-property obj :parent parent))
- secondary))
+ (dolist (o secondary) (org-element-put-property o :parent parent)))
secondary))))
(defun org-element-map
;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols
;;
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry
;; Version: 0.2
;;; Code:
-(require 'org-macs)
-
-(declare-function org-table-align "org-table" ())
+(declare-function org-toggle-pretty-entities "org" ())
+(declare-function org-table-align "org-table" ())
(eval-when-compile
(require 'cl))
(goto-char pos)
(org-table-align)))
+(defvar org-pretty-entities) ;; declare defcustom from org
(defun org-entities-help ()
"Create a Help buffer with all available entities."
(interactive)
;;; org-eval-light.el --- Display result of evaluating code in various languages (light)
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>,
;; Eric Schulte <schulte dot eric at gmail dot com>
;;; org-eval.el --- Display result of evaluating code in various languages
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;;; org-expiry.el --- expiry mechanism for Org entries
;;
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Bastien Guerry
;; Version: 0.2
;;; org-favtable.el --- Lookup table of favorite references and links\r
\r
-;; Copyright (C) 2011-2013 Free Software Foundation, Inc.\r
+;; Copyright (C) 2011-2014 Free Software Foundation, Inc.\r
\r
;; Author: Marc-Oliver Ihm <org-favtable@ferntreffer.de>\r
;; Keywords: hypermedia, matching\r
(let ((inhibit-read-only t) l c
(buffer-invisibility-spec '(org-link))
(moment (time-subtract (current-time)
- (list 0 (* 3600 org-extend-today-until) 0)))
- disabled-overlays)
- ;; Disable filters; this helps with alignment if there are links.
- (mapc (lambda (ol)
- (when (overlay-get ol 'invisible)
- (overlay-put ol 'invisible nil)
- (setq disabled-overlays (cons ol disabled-overlays))))
- (overlays-in (point-min) (point-max)))
+ (list 0 (* 3600 org-extend-today-until) 0))))
(save-excursion
(goto-char (if line (point-at-bol) (point-min)))
(while (not (eobp))
(time-subtract moment (days-to-time org-habit-preceding-days))
moment
(time-add moment (days-to-time org-habit-following-days))))))
- (forward-line)))
- (mapc (lambda (ol) (overlay-put ol 'invisible t))
- disabled-overlays)))
+ (forward-line)))))
(defun org-habit-toggle-habits ()
"Toggle display of habits in an agenda buffer."
;;; org-interactive-query.el --- Interactive modification of agenda query
;;
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
;; Author: Christopher League <league at contrapunctus dot net>
;; Version: 1.0
;;; org-invoice.el --- Help manage client invoices in OrgMode
;;
-;; Copyright (C) 2008-2013 pmade inc. (Peter Jones pjones@pmade.com)
+;; Copyright (C) 2008-2014 pmade inc. (Peter Jones pjones@pmade.com)
;;
;; This file is not part of GNU Emacs.
;;
;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm
-;; Copyright (C) 2009-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
;; Author: John Wiegley <johnw at gnu dot org>
;; Keywords: outlines, hypermedia, calendar, wp
If POS is before first character after bullet of the item, the
new item will be created before the current one.
-STRUCT is the list structure. PREVS is the the alist of previous
+STRUCT is the list structure. PREVS is the alist of previous
items, as returned by `org-list-prevs-alist'.
Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
t)))))
(defun org-list-repair ()
- "Fix indentation, bullets and checkboxes is the list at point."
+ "Fix indentation, bullets and checkboxes in the list at point."
(interactive)
(unless (org-at-item-p) (error "This is not a list"))
(let* ((struct (org-list-struct))
;;
;;; Code:
\f
-;;;### (autoloads nil "ob-core" "ob-core.el" (21333 63965 0 0))
+;;;### (autoloads nil "ob-core" "ob-core.el" (21464 32404 0 0))
;;; Generated autoloads from ob-core.el
(autoload 'org-babel-execute-safely-maybe "ob-core" "\
;;;***
\f
-;;;### (autoloads nil "ob-keys" "ob-keys.el" (21333 63965 0 0))
+;;;### (autoloads nil "ob-keys" "ob-keys.el" (21464 32404 0 0))
;;; Generated autoloads from ob-keys.el
(autoload 'org-babel-describe-bindings "ob-keys" "\
;;;***
\f
-;;;### (autoloads nil "ob-lob" "ob-lob.el" (21333 63965 0 0))
+;;;### (autoloads nil "ob-lob" "ob-lob.el" (21464 32404 0 0))
;;; Generated autoloads from ob-lob.el
(autoload 'org-babel-lob-execute-maybe "ob-lob" "\
;;;***
\f
-;;;### (autoloads nil "ob-tangle" "ob-tangle.el" (21333 63965 0 0))
+;;;### (autoloads nil "ob-tangle" "ob-tangle.el" (21464 32404 0 0))
;;; Generated autoloads from ob-tangle.el
(autoload 'org-babel-tangle-file "ob-tangle" "\
;;;***
\f
-;;;### (autoloads nil "org-agenda" "org-agenda.el" (21333 63965 0
+;;;### (autoloads nil "org-agenda" "org-agenda.el" (21464 32404 0
;;;;;; 0))
;;; Generated autoloads from org-agenda.el
;;;***
\f
-;;;### (autoloads nil "org-archive" "org-archive.el" (21333 63965
+;;;### (autoloads nil "org-archive" "org-archive.el" (21464 32404
;;;;;; 0 0))
;;; Generated autoloads from org-archive.el
;;;***
\f
-;;;### (autoloads nil "org-attach" "org-attach.el" (21333 63965 0
+;;;### (autoloads nil "org-attach" "org-attach.el" (21464 32404 0
;;;;;; 0))
;;; Generated autoloads from org-attach.el
;;;***
\f
-;;;### (autoloads nil "org-bbdb" "org-bbdb.el" (21196 60375 0 0))
+;;;### (autoloads nil "org-bbdb" "org-bbdb.el" (21344 34285 0 0))
;;; Generated autoloads from org-bbdb.el
(autoload 'org-bbdb-anniversaries "org-bbdb" "\
;;;***
\f
-;;;### (autoloads nil "org-capture" "org-capture.el" (21333 63965
+;;;### (autoloads nil "org-capture" "org-capture.el" (21464 32404
;;;;;; 0 0))
;;; Generated autoloads from org-capture.el
;;;***
\f
-;;;### (autoloads nil "org-clock" "org-clock.el" (21333 63965 0 0))
+;;;### (autoloads nil "org-clock" "org-clock.el" (21464 32404 0 0))
;;; Generated autoloads from org-clock.el
(autoload 'org-resolve-clocks "org-clock" "\
;;;***
\f
-;;;### (autoloads nil "org-colview" "org-colview.el" (21333 63965
+;;;### (autoloads nil "org-colview-xemacs" "org-colview-xemacs.el"
+;;;;;; (21196 60374 0 0))
+;;; Generated autoloads from org-colview-xemacs.el
+
+(autoload 'org-columns-remove-overlays "org-colview-xemacs" "\
+Remove all currently active column overlays.
+
+\(fn)" t nil)
+
+(autoload 'org-columns-get-format-and-top-level "org-colview-xemacs" "\
+
+
+\(fn)" nil nil)
+
+(autoload 'org-columns-compute "org-colview-xemacs" "\
+Sum the values of property PROPERTY hierarchically, for the entire buffer.
+
+\(fn PROPERTY)" t nil)
+
+(autoload 'org-columns-number-to-string "org-colview-xemacs" "\
+Convert a computed column number to a string value, according to FMT.
+
+\(fn N FMT &optional PRINTF)" nil nil)
+
+;;;***
+\f
+;;;### (autoloads nil "org-colview" "org-colview.el" (21464 32404
;;;;;; 0 0))
;;; Generated autoloads from org-colview.el
;;;***
\f
-;;;### (autoloads nil "org-compat" "org-compat.el" (21298 24953 0
+;;;### (autoloads nil "org-compat" "org-compat.el" (21464 32404 0
;;;;;; 0))
;;; Generated autoloads from org-compat.el
;;;***
\f
+;;;### (autoloads nil "org-contacts" "org-contacts.el" (21464 32403
+;;;;;; 0 0))
+;;; Generated autoloads from org-contacts.el
+
+(autoload 'org-contacts "org-contacts" "\
+Create agenda view for contacts matching NAME.
+
+\(fn NAME)" t nil)
+
+;;;***
+\f
;;;### (autoloads nil "org-datetree" "org-datetree.el" (21196 60375
;;;;;; 0 0))
;;; Generated autoloads from org-datetree.el
;;;***
\f
-;;;### (autoloads nil "org-element" "org-element.el" (21333 63965
+;;;### (autoloads nil "org-element" "org-element.el" (21464 32404
;;;;;; 0 0))
;;; Generated autoloads from org-element.el
;;;***
\f
-;;;### (autoloads nil "org-feed" "org-feed.el" (21333 63965 0 0))
+;;;### (autoloads nil "org-feed" "org-feed.el" (21464 32404 0 0))
;;; Generated autoloads from org-feed.el
(autoload 'org-feed-update-all "org-feed" "\
;;;***
\f
-;;;### (autoloads nil "org-footnote" "org-footnote.el" (21333 63965
+;;;### (autoloads nil "org-footnote" "org-footnote.el" (21464 32404
;;;;;; 0 0))
;;; Generated autoloads from org-footnote.el
;;;***
\f
-;;;### (autoloads nil "org-macs" "org-macs.el" (21196 60375 0 0))
+;;;### (autoloads nil "org-macs" "org-macs.el" (21464 32404 0 0))
;;; Generated autoloads from org-macs.el
(autoload 'org-load-noerror-mustsuffix "org-macs" "\
;;;***
\f
-;;;### (autoloads nil "org-mobile" "org-mobile.el" (21333 63965 0
+;;;### (autoloads nil "org-mobile" "org-mobile.el" (21464 32404 0
;;;;;; 0))
;;; Generated autoloads from org-mobile.el
;;;***
\f
-;;;### (autoloads nil "org-table" "org-table.el" (21333 63965 0 0))
+;;;### (autoloads nil "org-registry" "org-registry.el" (21196 60374
+;;;;;; 0 0))
+;;; Generated autoloads from org-registry.el
+
+(autoload 'org-registry-show "org-registry" "\
+Show Org files where there are links pointing to the current
+buffer.
+
+\(fn &optional VISIT)" t nil)
+
+(autoload 'org-registry-visit "org-registry" "\
+If an Org file contains a link to the current location, visit
+this file.
+
+\(fn)" t nil)
+
+(autoload 'org-registry-initialize "org-registry" "\
+Initialize `org-registry-alist'.
+If FROM-SCRATCH is non-nil or the registry does not exist yet,
+create a new registry from scratch and eval it. If the registry
+exists, eval `org-registry-file' and make it the new value for
+`org-registry-alist'.
+
+\(fn &optional FROM-SCRATCH)" t nil)
+
+(autoload 'org-registry-insinuate "org-registry" "\
+Call `org-registry-update' after saving in Org-mode.
+Use with caution. This could slow down things a bit.
+
+\(fn)" t nil)
+
+(autoload 'org-registry-update "org-registry" "\
+Update the registry for the current Org file.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "org-screenshot" "org-screenshot.el" (21196
+;;;;;; 60374 0 0))
+;;; Generated autoloads from org-screenshot.el
+
+(autoload 'org-screenshot-take "org-screenshot" "\
+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
+
+\(fn &optional DELAY)" t nil)
+
+(autoload 'org-screenshot-rotate-prev "org-screenshot" "\
+Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, rotate
+in the other direction
+
+\(fn DIR)" t nil)
+
+(autoload 'org-screenshot-rotate-next "org-screenshot" "\
+Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, rotate
+in the other direction
+
+\(fn DIR)" t nil)
+
+(autoload 'org-screenshot-show-unused "org-screenshot" "\
+Open A Dired buffer with unused screenshots marked
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "org-table" "org-table.el" (21464 32404 0 0))
;;; Generated autoloads from org-table.el
(autoload 'org-table-create-with-table\.el "org-table" "\
;;;***
\f
-;;;### (autoloads nil "org-timer" "org-timer.el" (21333 63965 0 0))
+;;;### (autoloads nil "org-timer" "org-timer.el" (21464 32404 0 0))
;;; Generated autoloads from org-timer.el
(autoload 'org-timer-start "org-timer" "\
;;;***
\f
-;;;### (autoloads nil "org-version" "org-version.el" (21371 47877
-;;;;;; 100658 408000))
+;;;### (autoloads nil "org-toc" "org-toc.el" (21196 60374 0 0))
+;;; Generated autoloads from org-toc.el
+
+(autoload 'org-toc-show "org-toc" "\
+Show the table of contents of the current Org-mode buffer.
+
+\(fn &optional DEPTH POSITION)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "org-track" "org-track.el" (21196 60374 0 0))
+;;; Generated autoloads from org-track.el
+
+(autoload 'org-track-fetch-package "org-track" "\
+Fetch Org package depending on `org-track-fetch-package-extension'.
+If DIRECTORY is defined, unpack the package there, i.e. add the
+subdirectory org-mode/ to DIRECTORY.
+
+\(fn &optional DIRECTORY)" t nil)
+
+(autoload 'org-track-compile-org "org-track" "\
+Compile all *.el files that come with org-mode.
+Generate the autoloads file `org-loaddefs.el'.
+
+DIRECTORY is where the directory org-mode/ lives (i.e. the
+ parent directory of your local repo.
+
+\(fn &optional DIRECTORY)" t nil)
+
+;;;***
+\f
+;;;### (autoloads nil "org-version" "org-version.el" (21518 3457
+;;;;;; 490642 228000))
;;; Generated autoloads from org-version.el
(autoload 'org-release "org-version" "\
;;;***
\f
-;;;### (autoloads nil "org" "org.el" (21334 16446 0 0))
+;;;### (autoloads nil "org" "org.el" (21464 32405 0 0))
;;; Generated autoloads from org.el
(autoload 'org-babel-do-load-languages "org" "\
;;;***
\f
-;;;### (autoloads nil "ox-ascii" "ox-ascii.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-ascii" "ox-ascii.el" (21464 32404 0 0))
;;; Generated autoloads from ox-ascii.el
(autoload 'org-ascii-export-as-ascii "ox-ascii" "\
;;;***
\f
-;;;### (autoloads nil "ox-beamer" "ox-beamer.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-beamer" "ox-beamer.el" (21464 32404 0 0))
;;; Generated autoloads from ox-beamer.el
(autoload 'org-beamer-mode "ox-beamer" "\
;;;***
\f
-;;;### (autoloads nil "ox-html" "ox-html.el" (21334 16446 0 0))
+;;;### (autoloads nil "ox-html" "ox-html.el" (21464 32404 0 0))
;;; Generated autoloads from ox-html.el
(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp)
;;;***
\f
-;;;### (autoloads nil "ox-icalendar" "ox-icalendar.el" (21192 63299
+;;;### (autoloads nil "ox-icalendar" "ox-icalendar.el" (21464 32404
;;;;;; 0 0))
;;; Generated autoloads from ox-icalendar.el
;;;***
\f
-;;;### (autoloads nil "ox-koma-letter" "ox-koma-letter.el" (21333
-;;;;;; 63965 0 0))
+;;;### (autoloads nil "ox-koma-letter" "ox-koma-letter.el" (21464
+;;;;;; 32403 0 0))
;;; Generated autoloads from ox-koma-letter.el
(autoload 'org-koma-letter-export-as-latex "ox-koma-letter" "\
;;;***
\f
-;;;### (autoloads nil "ox-latex" "ox-latex.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-latex" "ox-latex.el" (21464 32404 0 0))
;;; Generated autoloads from ox-latex.el
(autoload 'org-latex-export-as-latex "ox-latex" "\
;;;***
\f
-;;;### (autoloads nil "ox-md" "ox-md.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-md" "ox-md.el" (21464 32404 0 0))
;;; Generated autoloads from ox-md.el
(autoload 'org-md-export-as-markdown "ox-md" "\
;;;***
\f
-;;;### (autoloads nil "ox-odt" "ox-odt.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-odt" "ox-odt.el" (21464 32404 0 0))
;;; Generated autoloads from ox-odt.el
(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp)
;;;***
\f
-;;;### (autoloads nil "ox-org" "ox-org.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-org" "ox-org.el" (21464 32404 0 0))
;;; Generated autoloads from ox-org.el
(autoload 'org-org-export-as-org "ox-org" "\
;;;***
\f
-;;;### (autoloads nil "ox-publish" "ox-publish.el" (21333 63965 0
+;;;### (autoloads nil "ox-publish" "ox-publish.el" (21464 32405 0
;;;;;; 0))
;;; Generated autoloads from ox-publish.el
;;;***
\f
-;;;### (autoloads nil "ox-rss" "ox-rss.el" (21333 63965 0 0))
+;;;### (autoloads nil "ox-rss" "ox-rss.el" (21464 32403 0 0))
;;; Generated autoloads from ox-rss.el
(autoload 'org-rss-export-as-rss "ox-rss" "\
;;;***
\f
-;;;### (autoloads nil "ox-taskjuggler" "ox-taskjuggler.el" (21196
-;;;;;; 60374 0 0))
+;;;### (autoloads nil "ox-taskjuggler" "ox-taskjuggler.el" (21464
+;;;;;; 32403 0 0))
;;; Generated autoloads from ox-taskjuggler.el
(autoload 'org-taskjuggler-export "ox-taskjuggler" "\
;;;***
\f
-;;;### (autoloads nil "ox-texinfo" "ox-texinfo.el" (21333 63965 0
+;;;### (autoloads nil "ox-texinfo" "ox-texinfo.el" (21464 32404 0
;;;;;; 0))
;;; Generated autoloads from ox-texinfo.el
;;;***
\f
-;;;### (autoloads nil "ox" "ox.el" (21333 63966 0 0))
+;;;### (autoloads nil "ox" "ox.el" (21464 32404 0 0))
;;; Generated autoloads from ox.el
(autoload 'org-export-as "ox" "\
;;; org-mac-iCal.el --- Imports events from iCal.app to the Emacs diary
-;; Copyright (C) 2009-2013 Christopher Suckling
+;; Copyright (C) 2009-2014 Christopher Suckling
;; Author: Christopher Suckling <suckling at gmail dot com>
;; Version: 0.1057.104
+++ /dev/null
-;;; org-mac-link-grabber.el --- Grab links and url from various mac
-;; Application and insert them as links into org-mode documents
-;;
-;; Copyright (c) 2010-2013 Free Software Foundation, Inc.
-;;
-;; Author: Anthony Lander <anthony.lander@gmail.com>
-;; Version: 1.0.1
-;; Keywords: org, mac, hyperlink
-;;
-;; This file is not part of GNU Emacs.
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;
-;;; Commentary:
-;;
-;; This code allows you to grab either the current selected items, or
-;; the frontmost url in various mac appliations, and insert them as
-;; hyperlinks into the current org-mode document at point.
-;;
-;; This code is heavily based on, and indeed requires,
-;; org-mac-message.el written by John Weigley and Christopher
-;; Suckling.
-;;
-;; Detailed comments for each application interface are inlined with
-;; the code. Here is a brief overview of how the code interacts with
-;; each application:
-;;
-;; Finder.app - grab links to the selected files in the frontmost window
-;; Mail.app - grab links to the selected messages in the message list
-;; AddressBook.app - Grab links to the selected addressbook Cards
-;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
-;; Safari.app - Grab the url of the frontmost tab in the frontmost window
-;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
-;; Together.app - Grab links to the selected items in the library list
-;;
-;;
-;; Installation:
-;;
-;; add (require 'org-mac-link-grabber) to your .emacs, and optionally
-;; bind a key to activate the link grabber menu, like this:
-;;
-;; (add-hook 'org-mode-hook (lambda ()
-;; (define-key org-mode-map (kbd "C-c g") 'omlg-grab-link)))
-;;
-;;
-;; Usage:
-;;
-;; Type C-c g (or whatever key you defined, as above), or type M-x
-;; omlg-grab-link RET to activate the link grabber. This will present
-;; you with a menu to choose an application from which to grab a link
-;; to insert at point. You may also type C-g to abort.
-;;
-;; Customizing:
-;;
-;; You may customize which applications appear in the grab menu by
-;; customizing the group org-mac-link-grabber. Changes take effect
-;; immediately.
-;;
-;;
-;;; Code:
-
-(require 'org)
-(require 'org-mac-message)
-
-(defgroup org-mac-link-grabber nil
- "Options concerning grabbing links from external Mac
-applications and inserting them in org documents"
- :tag "Org Mac link grabber"
- :group 'org-link)
-
-(defcustom org-mac-grab-Finder-app-p t
- "Enable menu option [F]inder to grab links from the Finder"
- :tag "Grab Finder.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Mail-app-p t
- "Enable menu option [m]ail to grab links from Mail.app"
- :tag "Grab Mail.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Addressbook-app-p t
- "Enable menu option [a]ddressbook to grab links from AddressBook.app"
- :tag "Grab AddressBook.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Safari-app-p t
- "Enable menu option [s]afari to grab links from Safari.app"
- :tag "Grab Safari.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Firefox-app-p t
- "Enable menu option [f]irefox to grab links from Firefox.app"
- :tag "Grab Firefox.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Firefox+Vimperator-p nil
- "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
- :tag "Grab Vimperator/Firefox.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Chrome-app-p t
- "Enable menu option [f]irefox to grab links from Google Chrome.app"
- :tag "Grab Google Chrome.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-(defcustom org-mac-grab-Together-app-p nil
- "Enable menu option [t]ogether to grab links from Together.app"
- :tag "Grab Together.app links"
- :group 'org-mac-link-grabber
- :type 'boolean)
-
-\f
-(defun omlg-grab-link ()
- "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
- (interactive)
- (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
- ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
- ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
- ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
- ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
- ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
- ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
- ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)))
- (menu-string (make-string 0 ?x))
- input)
-
- ;; Create the menu string for the keymap
- (mapc '(lambda (descriptor)
- (when (elt descriptor 3)
- (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
- descriptors)
- (setf (elt menu-string (- (length menu-string) 1)) ?:)
-
- ;; Prompt the user, and grab the link
- (message menu-string)
- (setq input (read-char-exclusive))
- (mapc '(lambda (descriptor)
- (let ((key (elt (elt descriptor 0) 0))
- (active (elt descriptor 3))
- (grab-function (elt descriptor 2)))
- (when (and active (eq input key))
- (call-interactively grab-function))))
- descriptors)))
-
-(defalias 'omgl-grab-link 'omlg-grab-link
- "Renamed, and this alias will be obsolete next revision.")
-
-(defun org-mac-paste-applescript-links (as-link-list)
- "Paste in a list of links from an applescript handler. The
- links are of the form <link>::split::<name>"
- (let* ((link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-\f
-
-;; 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)))
-
-\f
-;; 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)))
-
-\f
-;; 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)))
-
-\f
-;; 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)))
-
-\f
-;;
-;;
-;; 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)))
-\f
-
-;;
-;;
-;; 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)))
-
-\f
-;;
-;;
-;; 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)))
-
-\f
-(provide 'org-mac-link-grabber)
-
-;;; org-mac-link-grabber.el ends here
--- /dev/null
+;;; org-mac-link.el --- Grab links and url from various mac
+;; Application and insert them as links into org-mode documents
+;;
+;; Copyright (c) 2010-2014 Free Software Foundation, Inc.
+;;
+;; Authors:
+;; Anthony Lander <anthony.lander@gmail.com>
+;; John Wiegley <johnw@gnu.org>
+;; Christopher Suckling <suckling at gmail dot com>
+;; Daniil Frumin <difrumin@gmail.com>
+;;
+;;
+;; Version: 1.1
+;; Keywords: org, mac, hyperlink
+;;
+;; Version: 1.2
+;; Keywords: outlook
+;; Author: Mike McLean <mike.mclean@pobox.com>
+;; Add support for Microsoft Outlook for Mac as Org mode links
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Commentary:
+;;
+;; This code allows you to grab either the current selected items, or
+;; the frontmost url in various mac appliations, and insert them as
+;; hyperlinks into the current org-mode document at point.
+;;
+;; This code is heavily based on, and indeed incorporates,
+;; org-mac-message.el written by John Wiegley and Christopher
+;; Suckling.
+;;
+;; Detailed comments for each application interface are inlined with
+;; the code. Here is a brief overview of how the code interacts with
+;; each application:
+;;
+;; Finder.app - grab links to the selected files in the frontmost window
+;; Mail.app - grab links to the selected messages in the message list
+;; AddressBook.app - Grab links to the selected addressbook Cards
+;; Firefox.app - Grab the url of the frontmost tab in the frontmost window
+;; Vimperator/Firefox.app - Grab the url of the frontmost tab in the frontmost window
+;; Safari.app - Grab the url of the frontmost tab in the frontmost window
+;; Google Chrome.app - Grab the url of the frontmost tab in the frontmost window
+;; Together.app - Grab links to the selected items in the library list
+;; Skim.app - Grab a link to the selected page in the topmost pdf document
+;; Microsoft Outlook.app - Grab a link to the selected message in the message list
+;;
+;;
+;; Installation:
+;;
+;; add (require 'org-mac-link) to your .emacs, and optionally bind a
+;; key to activate the link grabber menu, like this:
+;;
+;; (add-hook 'org-mode-hook (lambda ()
+;; (define-key org-mode-map (kbd "C-c g") 'org-mac-grab-link)))
+;;
+;; Usage:
+;;
+;; Type C-c g (or whatever key you defined, as above), or type M-x
+;; org-mac-grab-link RET to activate the link grabber. This will present
+;; you with a menu to choose an application from which to grab a link
+;; to insert at point. You may also type C-g to abort.
+;;
+;; Customizing:
+;;
+;; You may customize which applications appear in the grab menu by
+;; customizing the group `org-mac-link'. Changes take effect
+;; immediately.
+;;
+;;
+;;; Code:
+
+(require 'org)
+
+(defgroup org-mac-link nil
+ "Options concerning grabbing links from external Mac
+applications and inserting them in org documents"
+ :tag "Org Mac link"
+ :group 'org-link)
+
+(defcustom org-mac-grab-Finder-app-p t
+ "Enable menu option [F]inder to grab links from the Finder"
+ :tag "Grab Finder.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Mail-app-p t
+ "Enable menu option [m]ail to grab links from Mail.app"
+ :tag "Grab Mail.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Outlook-app-p t
+ "Enable menu option [o]utlook to grab links from Microsoft Outlook.app"
+ :tag "Grab Microsoft Outlook.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Addressbook-app-p t
+ "Enable menu option [a]ddressbook to grab links from AddressBook.app"
+ :tag "Grab AddressBook.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Safari-app-p t
+ "Enable menu option [s]afari to grab links from Safari.app"
+ :tag "Grab Safari.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Firefox-app-p t
+ "Enable menu option [f]irefox to grab links from Firefox.app"
+ :tag "Grab Firefox.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Firefox+Vimperator-p nil
+ "Enable menu option [v]imperator to grab links from Firefox.app running the Vimperator plugin"
+ :tag "Grab Vimperator/Firefox.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Chrome-app-p t
+ "Enable menu option [f]irefox to grab links from Google Chrome.app"
+ :tag "Grab Google Chrome.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Together-app-p nil
+ "Enable menu option [t]ogether to grab links from Together.app"
+ :tag "Grab Together.app links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-grab-Skim-app-p
+ (< 0 (length (shell-command-to-string
+ "mdfind kMDItemCFBundleIdentifier == 'net.sourceforge.skim-app.skim'")))
+ "Enable menu option [S]kim to grab page links from Skim.app"
+ :tag "Grab Skim.app page links"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defcustom org-mac-Skim-highlight-selection-p nil
+ "Highlight (using notes) the selection (if present) when grabbing the a link from Skim.app"
+ :tag "Highlight selection in Skim.app"
+ :group 'org-mac-link
+ :type 'boolean)
+
+(defgroup org-mac-flagged-mail nil
+ "Options concerning linking to flagged Mail.app messages."
+ :tag "Org Mail.app"
+ :group 'org-link)
+
+(defcustom org-mac-mail-account "customize"
+ "The Mail.app account in which to search for flagged messages."
+ :group 'org-mac-flagged-mail
+ :type 'string)
+
+\f
+;; 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) "\""))))
+
+\f
+(defun org-mac-grab-link ()
+ "Prompt the user for an application to grab a link from, then go grab the link, and insert it at point"
+ (interactive)
+ (let* ((descriptors `(("F" "inder" org-mac-finder-insert-selected ,org-mac-grab-Finder-app-p)
+ ("m" "ail" org-mac-message-insert-selected ,org-mac-grab-Mail-app-p)
+ ("o" "utlook" org-mac-outlook-message-insert-selected ,org-mac-grab-Outlook-app-p)
+ ("a" "ddressbook" org-mac-addressbook-insert-selected ,org-mac-grab-Addressbook-app-p)
+ ("s" "afari" org-mac-safari-insert-frontmost-url ,org-mac-grab-Safari-app-p)
+ ("f" "irefox" org-mac-firefox-insert-frontmost-url ,org-mac-grab-Firefox-app-p)
+ ("v" "imperator" org-mac-vimperator-insert-frontmost-url ,org-mac-grab-Firefox+Vimperator-p)
+ ("c" "hrome" org-mac-chrome-insert-frontmost-url ,org-mac-grab-Chrome-app-p)
+ ("t" "ogether" org-mac-together-insert-selected ,org-mac-grab-Together-app-p)
+ ("S" "kim" org-mac-skim-insert-page ,org-mac-grab-Skim-app-p)))
+ (menu-string (make-string 0 ?x))
+ input)
+
+ ;; Create the menu string for the keymap
+ (mapc '(lambda (descriptor)
+ (when (elt descriptor 3)
+ (setf menu-string (concat menu-string "[" (elt descriptor 0) "]" (elt descriptor 1) " "))))
+ descriptors)
+ (setf (elt menu-string (- (length menu-string) 1)) ?:)
+
+ ;; Prompt the user, and grab the link
+ (message menu-string)
+ (setq input (read-char-exclusive))
+ (mapc '(lambda (descriptor)
+ (let ((key (elt (elt descriptor 0) 0))
+ (active (elt descriptor 3))
+ (grab-function (elt descriptor 2)))
+ (when (and active (eq input key))
+ (call-interactively grab-function))))
+ descriptors)))
+
+(defun org-mac-paste-applescript-links (as-link-list)
+ "Paste in a list of links from an applescript handler. The
+ links are of the form <link>::split::<name>"
+ (let* ((link-list
+ (mapcar
+ (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
+ (split-string as-link-list "[\r\n]+")))
+ split-link URL description orglink orglink-insert rtn orglink-list)
+ (while link-list
+ (setq split-link (split-string (pop link-list) "::split::"))
+ (setq URL (car split-link))
+ (setq description (cadr split-link))
+ (when (not (string= URL ""))
+ (setq orglink (org-make-link-string URL description))
+ (push orglink orglink-list)))
+ (setq rtn (mapconcat 'identity orglink-list "\n"))
+ (kill-new rtn)
+ rtn))
+
+\f
+
+;; 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)))
+
+\f
+;; 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)))
+
+\f
+;; 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"))))
+ (substring (car (split-string result "[\r\n]+" t)) 1 -1)))
+
+(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)))
+
+\f
+;; 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)))
+
+\f
+;;
+;;
+;; 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)))
+\f
+
+;;
+;;
+;; 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)))
+
+\f
+;;
+;;
+;; 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)))
+
+
+\f
+;;
+;;
+;; 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"))))))
+
+
+\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"))))))
+
+\f
+(provide 'org-mac-link)
+
+;;; org-mac-link.el ends here
+++ /dev/null
-;;; org-mac-message.el --- Links to Apple Mail.app messages from within Org-mode
-
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
-
-;; Authors: John Wiegley <johnw@gnu.org>
-;; Christopher Suckling <suckling at gmail dot com>
-
-;; Keywords: outlines, hypermedia, calendar, wp
-
-;; This file is not part of GNU Emacs.
-
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;; This file implements links to Apple Mail.app messages from within
-;; Org-mode. Org-mode does not load this module by default - if you
-;; would actually like this to happen then configure the variable
-;; `org-modules' and add Org's contrib/ directory to your `load-path'.
-
-;; If you would like to create links to all flagged messages in an
-;; Apple Mail.app account, please customize the variable
-;; `org-mac-mail-account' and then call one of the following functions:
-
-;; (org-mac-message-insert-selected) copies a formatted list of links to
-;; the kill ring.
-
-;; (org-mac-message-insert-selected) inserts at point links to any
-;; messages selected in Mail.app.
-
-;; (org-mac-message-insert-flagged) searches within an org-mode buffer
-;; for a specific heading, creating it if it doesn't exist. Any
-;; message:// links within the first level of the heading are deleted
-;; and replaced with links to flagged messages.
-
-;;; Code:
-
-(require 'org)
-
-(defgroup org-mac-flagged-mail nil
- "Options concerning linking to flagged Mail.app messages."
- :tag "Org Mail.app"
- :group 'org-link)
-
-(defcustom org-mac-mail-account "customize"
- "The Mail.app account in which to search for flagged messages."
- :group 'org-mac-flagged-mail
- :type 'string)
-
-(org-add-link-type "message" 'org-mac-message-open)
-
-;; In mac.c, removed in Emacs 23.
-(declare-function do-applescript "org-mac-message" (script))
-(unless (fboundp 'do-applescript)
- ;; Need to fake this using shell-command-to-string
- (defun do-applescript (script)
- (let (start cmd return)
- (while (string-match "\n" script)
- (setq script (replace-match "\r" t t script)))
- (while (string-match "'" script start)
- (setq start (+ 2 (match-beginning 0))
- script (replace-match "\\'" t t script)))
- (setq cmd (concat "osascript -e '" script "'"))
- (setq return (shell-command-to-string cmd))
- (concat "\"" (org-trim return) "\""))))
-
-(defun org-mac-message-open (message-id)
- "Visit the message with the given MESSAGE-ID.
-This will use the command `open' with the message URL."
- (start-process (concat "open message:" message-id) nil
- "open" (concat "message://<" (substring message-id 2) ">")))
-
-(defun as-get-selected-mail ()
- "AppleScript to create links to selected messages in Mail.app."
- (do-applescript
- (concat
- "tell application \"Mail\"\n"
- "set theLinkList to {}\n"
- "set theSelection to selection\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun as-get-flagged-mail ()
- "AppleScript to create links to flagged messages in Mail.app."
- (do-applescript
- (concat
- ;; Is Growl installed?
- "tell application \"System Events\"\n"
- "set growlHelpers to the name of every process whose creator type contains \"GRRR\"\n"
- "if (count of growlHelpers) > 0 then\n"
- "set growlHelperApp to item 1 of growlHelpers\n"
- "else\n"
- "set growlHelperApp to \"\"\n"
- "end if\n"
- "end tell\n"
-
- ;; Get links
- "tell application \"Mail\"\n"
- "set theMailboxes to every mailbox of account \"" org-mac-mail-account "\"\n"
- "set theLinkList to {}\n"
- "repeat with aMailbox in theMailboxes\n"
- "set theSelection to (every message in aMailbox whose flagged status = true)\n"
- "repeat with theMessage in theSelection\n"
- "set theID to message id of theMessage\n"
- "set theSubject to subject of theMessage\n"
- "set theLink to \"message://\" & theID & \"::split::\" & theSubject & \"\n\"\n"
- "copy theLink to end of theLinkList\n"
-
- ;; Report progress through Growl
- ;; This "double tell" idiom is described in detail at
- ;; http://macscripter.net/viewtopic.php?id=24570 The
- ;; script compiler needs static knowledge of the
- ;; growlHelperApp. Hmm, since we're compiling
- ;; on-the-fly here, this is likely to be way less
- ;; portable than I'd hoped. It'll work when the name
- ;; is still "GrowlHelperApp", though.
- "if growlHelperApp is not \"\" then\n"
- "tell application \"GrowlHelperApp\"\n"
- "tell application growlHelperApp\n"
- "set the allNotificationsList to {\"FlaggedMail\"}\n"
- "set the enabledNotificationsList to allNotificationsList\n"
- "register as application \"FlaggedMail\" all notifications allNotificationsList default notifications enabledNotificationsList icon of application \"Mail\"\n"
- "notify with name \"FlaggedMail\" title \"Importing flagged message\" description theSubject application name \"FlaggedMail\"\n"
- "end tell\n"
- "end tell\n"
- "end if\n"
- "end repeat\n"
- "end repeat\n"
- "return theLinkList as string\n"
- "end tell")))
-
-(defun org-mac-message-get-links (&optional select-or-flag)
- "Create links to the messages currently selected or flagged in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-messages in Mail.app and make a link out of it.
-When SELECT-OR-FLAG is \"s\", get the selected messages (this is also
-the default). When SELECT-OR-FLAG is \"f\", get the flagged messages.
-The Org-syntax text will be pushed to the kill ring, and also returned."
- (interactive "sLink to (s)elected or (f)lagged messages: ")
- (setq select-or-flag (or select-or-flag "s"))
- (message "AppleScript: searching mailboxes...")
- (let* ((as-link-list
- (if (string= select-or-flag "s")
- (as-get-selected-mail)
- (if (string= select-or-flag "f")
- (as-get-flagged-mail)
- (error "Please select \"s\" or \"f\""))))
- (link-list
- (mapcar
- (lambda (x) (if (string-match "\\`\"\\(.*\\)\"\\'" x) (setq x (match-string 1 x))) x)
- (split-string as-link-list "[\r\n]+")))
- split-link URL description orglink orglink-insert rtn orglink-list)
- (while link-list
- (setq split-link (split-string (pop link-list) "::split::"))
- (setq URL (car split-link))
- (setq description (cadr split-link))
- (when (not (string= URL ""))
- (setq orglink (org-make-link-string URL description))
- (push orglink orglink-list)))
- (setq rtn (mapconcat 'identity orglink-list "\n"))
- (kill-new rtn)
- rtn))
-
-(defun org-mac-message-insert-selected ()
- "Insert a link to the messages currently selected in Mail.app.
-This will use AppleScript to get the message-id and the subject of the
-active mail in Mail.app and make a link out of it."
- (interactive)
- (insert (org-mac-message-get-links "s")))
-
-;; The following line is for backward compatibility
-(defalias 'org-mac-message-insert-link 'org-mac-message-insert-selected)
-
-(defun org-mac-message-insert-flagged (org-buffer org-heading)
- "Asks for an org buffer and a heading within it, and replace message links.
-If heading exists, delete all message:// links within heading's first
-level. If heading doesn't exist, create it at point-max. Insert
-list of message:// links to flagged mail after heading."
- (interactive "bBuffer in which to insert links: \nsHeading after which to insert links: ")
- (with-current-buffer org-buffer
- (goto-char (point-min))
- (let ((isearch-forward t)
- (message-re "\\[\\[\\(message:\\)\\([^]]+\\)\\]\\(\\[\\([^]]+\\)\\]\\)?\\]"))
- (if (org-goto-local-search-headings org-heading nil t)
- (if (not (eobp))
- (progn
- (save-excursion
- (while (re-search-forward
- message-re (save-excursion (outline-next-heading)) t)
- (delete-region (match-beginning 0) (match-end 0)))
- (insert "\n" (org-mac-message-get-links "f")))
- (flush-lines "^$" (point) (outline-next-heading)))
- (insert "\n" (org-mac-message-get-links "f")))
- (goto-char (point-max))
- (insert "\n")
- (org-insert-heading nil t)
- (insert org-heading "\n" (org-mac-message-get-links "f"))))))
-
-(provide 'org-mac-message)
-
-;;; org-mac-message.el ends here
`(let ((,mpom ,pom))
(save-excursion
(if (markerp ,mpom) (set-buffer (marker-buffer ,mpom)))
- (save-excursion
- (goto-char (or ,mpom (point)))
- ,@body)))))
+ (org-with-wide-buffer
+ (goto-char (or ,mpom (point)))
+ ,@body)))))
(def-edebug-spec org-with-point-at (form body))
(put 'org-with-point-at 'lisp-indent-function 1)
;;; org-mairix.el - Support for hooking mairix search into Org for different MUAs
;;
-;; Copyright (C) 2007-2013 Georg C. F. Greve
+;; Copyright (C) 2007-2014 Georg C. F. Greve
;; mutt support by Adam Spiers <orgmode at adamspiers dot org>
;;
;; This file is not part of GNU Emacs.
;;; org-mew.el --- Support for links to Mew messages from within Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; Keywords: outlines, hypermedia, calendar, wp
;;; org-mime.el --- org html export for text/html MIME emails
-;; Copyright (C) 2010-2013 Eric Schulte
+;; Copyright (C) 2010-2014 Eric Schulte
;; Author: Eric Schulte
;; Keywords: mime, mail, email, html
('semi (concat
"--" "<<alternative>>-{\n"
"--" "[[text/plain]]\n" plain
- (when images (concat "--" "<<alternative>>-{\n"))
- "--" "[[text/html]]\n" html
- images
- (when images (concat "--" "}-<<alternative>>\n"))
+ (if (and images (> (length images) 0))
+ (concat "--" "<<related>>-{\n"
+ "--" "[[text/html]]\n" html
+ images
+ "--" "}-<<related>>\n")
+ (concat "--" "[[text/html]]\n" html
+ images))
"--" "}-<<alternative>>\n"))
('vm "?")))
(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
(defun org-mime-send-buffer (&optional fmt)
(run-hooks 'org-mime-send-buffer-hook)
(let* ((region-p (org-region-active-p))
- (subject (org-export-grab-title-from-buffer))
- (file (buffer-file-name (current-buffer)))
+ (file (buffer-file-name (current-buffer)))
+ (subject (if (not file) (buffer-name (buffer-base-buffer))
+ (file-name-sans-extension
+ (file-name-nondirectory file))))
(body-start (or (and region-p (region-beginning))
(save-excursion (goto-char (point-min)))))
(body-end (or (and region-p (region-end)) (point-max)))
;; which prevents correct insertion when point is invisible
(org-show-subtree)
(end-of-line 1)
- (org-insert-heading-respect-content '(16) t)
+ (org-insert-heading-respect-content t)
(org-demote))
(beginning-of-line)
(insert "* "))
(point)
(save-excursion (goto-char start)
(org-back-to-heading) (point))))
- (outline-end-of-subtree)
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char)))
(end-of-line)
(if (eobp) (newline) (forward-char)))
(when (looking-at org-outline-regexp)
(let ((level (- (match-end 0) (match-beginning 0))))
(when (> end (match-end 0))
- (outline-end-of-subtree)
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char)))
(end-of-line)
(if (eobp) (newline) (forward-char))
(setq level (1+ level)))
(org-paste-subtree level)
(save-excursion
- (outline-end-of-subtree)
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char)))
(when (bolp) (delete-char -1))))))))))
(org-mouse-main-buffer (current-buffer)))
(when (eq (with-current-buffer buffer major-mode) 'org-mode)
(let ((endmarker (with-current-buffer buffer
- (outline-end-of-subtree)
- (forward-char 1)
+ (org-end-of-subtree nil t)
+ (unless (eobp) (forward-char 1))
(copy-marker (point)))))
(org-with-remote-undo buffer
(with-current-buffer buffer
;;; org-mtags.el --- Muse-like tags in Org-mode
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;;; org-notify.el --- Notifications for Org-mode
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
;; Author: Peter Münster <pmrb@free.fr>
;; Keywords: notification, todo-list, alarm, reminder, pop-up
;;; org-registry.el --- a registry for Org links
;;
-;; Copyright 2007-2013 Bastien Guerry
+;; Copyright 2007-2014 Bastien Guerry
;;
;; Emacs Lisp Archive Entry
;; Filename: org-registry.el
;; Version: 0.1a
-;; Author: Bastien Guerry <bzg AT gnu DOT org>
-;; Maintainer: Bastien Guerry <bzg AT gnu DOT org>
+;; Author: Bastien Guerry <bzg@gnu.org>
+;; Maintainer: Bastien Guerry <bzg@gnu.org>
;; Keywords: org, wp, registry
;; Description: Shows Org files where the current buffer is linked
;; URL: http://www.cognition.ens.fr/~guerry/u/org-registry.el
;;; org-screen.el --- Integreate Org-mode with screen.
-;; Copyright (c) 2008-2013 Andrew Hyatt
+;; Copyright (c) 2008-2014 Andrew Hyatt
;;
;; Author: Andrew Hyatt <ahyatt at gmail dot com>
;; Maintainer: Carsten Dominik <carsten at orgmode dot org>
--- /dev/null
+;;; org-screenshot.el --- Take and manage screenshots in Org-mode files
+;;
+;; Copyright (C) 2009-2014
+;; Free Software Foundation, Inc.
+;;
+;; Author: Max Mikhanosha <max@openchat.com>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 8.0
+;;
+;; Released under the GNU General Public License version 3
+;; see: http://www.gnu.org/licenses/gpl-3.0.html
+;;
+;; This file is not part of GNU Emacs.
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+;;
+;; NOTE: This library requires external screenshot taking executable "scrot",
+;; which is available as a package from all major Linux distribution. If your
+;; distribution does not have it, source can be found at:
+;;
+;; http://freecode.com/projects/scrot
+;;
+;; org-screenshot.el have been tested with scrot version 0.8.
+;;
+;; Usage:
+;;
+;; (require 'org-screenshot)
+;;
+;; Available commands with default bindings
+;;
+;; `org-screenshot-take' C-c M-s M-t and C-c M-s M-s
+;;
+;; Take the screenshot, C-u argument delays 1 second, double C-u 2 seconds
+;; triple C-u 3 seconds, and subsequent C-u add 2 seconds to the delay.
+;;
+;; Screenshot area is selected with the mouse, or left-click on the window
+;; for an entire window.
+;;
+;; `org-screenshot-rotate-prev' C-c M-s M-p and C-c M-s C-p
+;;
+;; Rotate screenshot before the point to one before it (sorted by date)
+;;
+;; `org-screenshot-rotate-next' C-c M-s M-n and C-c M-s C-n
+;;
+;; Rotate screenshot before the point to one after it
+;;
+;; `org-screenshot-show-unused' C-c M-s M-u and C-c M-s u
+;;
+;; Open dired buffer with screenshots that are not used in current
+;; Org buffer marked
+;;
+;; The screenshot take and rotate commands will update the inline images
+;; if they are already shown, if you are inserting first screenshot in the Org
+;; Buffer (and there are no other images shown), you need to manually display
+;; inline images with C-c C-x C-v
+;;
+;; Screenshot take and rotate commands offer user to continue by by using single
+;; keys, in a manner similar to to "repeat-char" of keyboard macros, user can
+;; continue rotating screenshots by pressing just the last key of the binding
+;;
+;; For example: C-c M-s M-t creates the screenshot and then user can
+;; repeatedly press M-p or M-n to rotate it back and forth with
+;; previously taken ones.
+;;
+
+(require 'org)
+(require 'dired)
+
+(defgroup org-screenshot nil
+ "Options for taking and managing screen-shots"
+ :group 'org-link)
+
+(defcustom org-screenshot-image-directory "./images/"
+ "Directory in which screenshot image files will be stored, it
+be automatically created if it does't already exist."
+ :type 'string
+ :group 'org-screenshot)
+
+(defcustom org-screenshot-file-name-format "screenshot-%2.2d.png"
+ "The string used to generate screenshot file name.
+
+Any %d format string recipe will be expanded with `format'
+function with the argument of a screenshot sequence number.
+
+A sequence like %XXXX will be replaced with string of the same
+length as there are X's, consisting of random characters in the
+range of [A-Za-z]."
+ :type 'string
+ :group 'org-screenshot)
+
+(defcustom org-screenshot-max-tries 200
+ "Number of times we will try to generate generate filename that
+does not exist. With default `org-screenshot-name-format' its the
+limit for number of screenshots, before `org-screenshot-take' is
+unable to come up with a unique name."
+ :type 'integer
+ :group 'org-screenshot)
+
+(defvar org-screenshot-map (make-sparse-keymap)
+ "Map for OrgMode screenshot related commands")
+
+;; prefix
+(org-defkey org-mode-map (kbd "C-c M-s") org-screenshot-map)
+
+;; Mnemonic is Control-C Meta "Screenshot" "Take"
+(org-defkey org-screenshot-map (kbd "M-t") 'org-screenshot-take)
+(org-defkey org-screenshot-map (kbd "M-s") 'org-screenshot-take)
+
+;; No reason to require meta key, since its our own keymap
+(org-defkey org-screenshot-map "s" 'org-screenshot-take)
+(org-defkey org-screenshot-map "t" 'org-screenshot-take)
+
+;; Rotations, the fast rotation user hint, would prefer the modifier
+;; used by the original command that started the rotation
+(org-defkey org-screenshot-map (kbd "M-n") 'org-screenshot-rotate-next)
+(org-defkey org-screenshot-map (kbd "M-p") 'org-screenshot-rotate-prev)
+(org-defkey org-screenshot-map (kbd "C-n") 'org-screenshot-rotate-next)
+(org-defkey org-screenshot-map (kbd "C-p") 'org-screenshot-rotate-prev)
+
+;; Show unused image files in Dired
+(org-defkey org-screenshot-map (kbd "M-u") 'org-screenshot-show-unused)
+(org-defkey org-screenshot-map (kbd "u") 'org-screenshot-show-unused)
+
+
+(random t)
+
+(defun org-screenshot-random-string (length)
+ "Generate a random string of LENGTH consisting of random upper
+case and lower case letters."
+ (let ((name (make-string length ?x)))
+ (dotimes (i length)
+ (let ((n (random 52)))
+ (aset name i (if (< n 26)
+ (+ ?a n)
+ (+ ?A n -26)))))
+ name))
+
+(defvar org-screenshot-process nil
+ "Currently running screenshot process")
+
+(defvar org-screenshot-directory-seq-numbers (make-hash-table :test 'equal))
+
+(defun org-screenshot-update-seq-number (directory &optional reset)
+ "Set `org-screenshot-file-name-format' sequence number for the directory.
+When RESET is NIL, increments the number stored, otherwise sets
+RESET as a new number. Intended to be called if screenshot was
+successful. Updating of sequence number is done in two steps, so
+aborted/canceled screenshot attempts don't increase the number"
+
+ (setq directory (file-name-as-directory directory))
+ (puthash directory (if reset
+ (if (numberp reset) reset 1)
+ (1+ (gethash directory
+ org-screenshot-directory-seq-numbers
+ 0)))
+ org-screenshot-directory-seq-numbers))
+
+(defun org-screenshot-generate-file-name (directory)
+ "Use `org-screenshot-name-format' to generate new screenshot
+file name for a specific directory. Keeps re-generating name if
+it already exists, up to `org-screenshot-max-tries'
+times. Returns just the file, without directory part"
+ (setq directory (file-name-as-directory directory))
+ (when (file-exists-p directory)
+ (let ((tries 0)
+ name
+ had-seq
+ (case-fold-search nil))
+ (while (and (< tries org-screenshot-max-tries)
+ (not name))
+ (incf tries)
+ (let ((tmp org-screenshot-file-name-format)
+ (seq-re "%[-0-9.]*d")
+ (rand-re "%X+"))
+ (when (string-match seq-re tmp)
+ (let ((seq (gethash
+ directory
+ org-screenshot-directory-seq-numbers 1)))
+ (setq tmp
+ (replace-regexp-in-string
+ seq-re (format (match-string 0 tmp) seq)
+ tmp)
+ had-seq t)))
+ (when (string-match rand-re tmp)
+ (setq tmp
+ (replace-regexp-in-string
+ rand-re (org-screenshot-random-string
+ (1- (length (match-string 0 tmp))))
+ tmp t)))
+ (let ((fullname (concat directory tmp)))
+ (if (file-exists-p fullname)
+ (when had-seq (org-screenshot-update-seq-number directory))
+ (setq name tmp)))))
+ name)))
+
+(defun org-screenshot-image-directory ()
+ "Return the `org-screenshot-image-directory', ensuring there is
+trailing slash, and that it exists"
+ (let ((dir (file-name-as-directory org-screenshot-image-directory)))
+ (if (file-exists-p dir)
+ dir
+ (make-directory dir t)
+ dir)))
+
+(defvar org-screenshot-last-file nil
+ "File name of the last taken or rotated screenshot file,
+without directory")
+
+(defun org-screenshot-process-done (process event file
+ orig-buffer
+ orig-delay
+ orig-event)
+ "Called when \"scrot\" process exits. PROCESS and EVENT are
+same arguments as in `set-process-sentinel'. ORIG-BUFFER,
+ORIG-DELAY and ORIG-EVENT are Org Buffer, the screenshot delay
+used, and LAST-INPUT-EVENT values from when screenshot was
+initiated.
+"
+ (setq org-screenshot-process nil)
+ (with-current-buffer (process-buffer process)
+ (if (not (equal event "finished\n"))
+ (progn
+ (insert event)
+ (cond ((save-excursion
+ (goto-char (point-min))
+ (re-search-forward "Key was pressed" nil t))
+ (ding)
+ (message "Key was pressed, screenshot aborted"))
+ (t
+ (display-buffer (process-buffer process))
+ (message "Error running \"scrot\" program")
+ (ding))))
+ (with-current-buffer orig-buffer
+ (let ((link (format "[[file:%s]]" file)))
+ (setq org-screenshot-last-file (file-name-nondirectory file))
+ (let ((beg (point)))
+ (insert link)
+ (when org-inline-image-overlays
+ (org-display-inline-images nil t beg (point))))
+ (unless (< orig-delay 3)
+ (ding))
+ (org-screenshot-rotate-continue t orig-event))))))
+
+
+;;;###autoload
+(defun org-screenshot-take (&optional delay)
+ "Take a screenshot and insert link to it at point, if image
+display is already on (see \\[org-toggle-inline-images])
+screenshot will be displayed as an image
+
+Screen area for the screenshot is selected with the mouse, left
+click on a window screenshots that window, while left click and
+drag selects a region. Pressing any key cancels the screen shot
+
+With `C-u' universal argument waits one second after target is
+selected before taking the screenshot. With double `C-u' wait two
+seconds.
+
+With triple `C-u' wait 3 seconds, and also rings the bell when
+screenshot is done, any more `C-u' after that increases delay by
+2 seconds
+"
+ (interactive "P")
+
+ ;; probably easier way to count number of C-u C-u out there
+ (setq delay
+ (cond ((null delay) 0)
+ ((integerp delay) delay)
+ ((and (consp delay)
+ (integerp (car delay))
+ (plusp (car delay)))
+ (let ((num 1)
+ (limit (car delay))
+ (cnt 0))
+ (while (< num limit)
+ (setq num (* num 4)
+ cnt (+ cnt (if (< cnt 3) 1 2))))
+ cnt))
+ (t (error "Invald delay"))))
+ (when (and org-screenshot-process
+ (member (process-status org-screenshot-process)
+ '(run stop)))
+ (error "scrot process is still running"))
+ (let* ((name (org-screenshot-generate-file-name (org-screenshot-image-directory)))
+ (file (format "%s%s" (org-screenshot-image-directory)
+ name))
+ (path (expand-file-name file)))
+ (when (get-buffer "*scrot*")
+ (with-current-buffer (get-buffer "*scrot*")
+ (erase-buffer)))
+ (setq org-screenshot-process
+ (or
+ (apply 'start-process
+ (append
+ (list "scrot" "*scrot*" "scrot" "-s" path)
+ (when (plusp delay)
+ (list "-d" (format "%d" delay)))))
+ (error "Unable to start scrot process")))
+ (when org-screenshot-process
+ (if (plusp delay)
+ (message "Click on a window, or select a rectangle (delay is %d sec)..."
+ delay)
+ (message "Click on a window, or select a rectangle..."))
+ (set-process-sentinel
+ org-screenshot-process
+ `(lambda (process event)
+ (org-screenshot-process-done
+ process event ,file ,(current-buffer) ,delay ',last-input-event))))))
+
+(defvar org-screenshot-file-list nil
+ "List of files in `org-screenshot-image-directory' used by
+`org-screenshot-rotate-prev' and `org-screenshot-rotate-next'")
+
+(defvar org-screenshot-rotation-index -1)
+
+(make-variable-buffer-local 'org-screenshot-file-list)
+(make-variable-buffer-local 'org-screenshot-rotation-index)
+
+(defun org-screenshot-rotation-init (lastfile)
+ "Initialize variable `org-screenshot-file-list' variabel with
+the list of PNG files in `org-screenshot-image-directory' sorted
+by most recent first"
+ (setq
+ org-screenshot-rotation-index -1
+ org-screenshot-file-list
+ (let ((files (directory-files org-screenshot-image-directory
+ t (org-image-file-name-regexp) t)))
+ (mapcar 'file-name-nondirectory
+ (sort files
+ (lambda (file1 file2)
+ (let ((mtime1 (nth 5 (file-attributes file1)))
+ (mtime2 (nth 5 (file-attributes file2))))
+ (setq mtime1 (+ (ash (first mtime1) 16)
+ (second mtime1)))
+ (setq mtime2 (+ (ash (first mtime2) 16)
+ (second mtime2)))
+ (> mtime1 mtime2)))))))
+ (let ((n -1) (list org-screenshot-file-list))
+ (while (and list (not (equal (pop list) lastfile)))
+ (incf n))
+ (setq org-screenshot-rotation-index n)))
+
+(defun org-screenshot-do-rotate (dir from-continue-rotating)
+ "Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, in the
+other direction"
+ (setq org-screenshot-last-file nil)
+ (let* ((ourdir (file-name-as-directory (org-screenshot-image-directory)))
+ done
+ (link-re
+ ;; taken from `org-display-inline-images'
+ (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]"))
+ newfile oldfile)
+ (save-excursion
+ ;; Search for link to image file in the same directory before the point
+ (while (not done)
+ (if (not (re-search-backward link-re (point-min) t))
+ (error "Unable to find link to image from %S directory before point" ourdir)
+ (let ((file (concat (or (match-string 3) "") (match-string 4))))
+ (when (equal (file-name-directory file)
+ ourdir)
+ (setq done t
+ oldfile (file-name-nondirectory file))))))
+ (when (or (null org-screenshot-file-list)
+ (and (not from-continue-rotating)
+ (not (member last-command
+ '(org-screenshot-rotate-prev
+ org-screenshot-rotate-next)))))
+ (org-screenshot-rotation-init oldfile))
+ (unless (> (length org-screenshot-file-list) 1)
+ (error "Can't rotate a single image file"))
+ (replace-match "" nil nil nil 1)
+
+ (setq org-screenshot-rotation-index
+ (mod (+ org-screenshot-rotation-index dir)
+ (length org-screenshot-file-list))
+ newfile (nth org-screenshot-rotation-index
+ org-screenshot-file-list))
+ ;; in case we started rotating from the file we just inserted,
+ ;; advance one more time
+ (when (equal oldfile newfile)
+ (setq org-screenshot-rotation-index
+ (mod (+ org-screenshot-rotation-index (if (plusp dir) 1 -1))
+ (length org-screenshot-file-list))
+ newfile (nth org-screenshot-rotation-index
+ org-screenshot-file-list)))
+ (replace-match (concat "file:" ourdir
+ newfile)
+ t t nil 4))
+ ;; out of save-excursion
+ (setq org-screenshot-last-file newfile)
+ (when org-inline-image-overlays
+ (org-display-inline-images nil t (match-beginning 0) (point)))))
+
+;;;###autoload
+(defun org-screenshot-rotate-prev (dir)
+ "Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, rotate
+in the other direction"
+ (interactive "p")
+ (org-screenshot-do-rotate dir nil)
+ (when org-screenshot-last-file
+ (org-screenshot-rotate-continue nil nil)))
+
+;;;###autoload
+(defun org-screenshot-rotate-next (dir)
+ "Rotate last screenshot with one of the previously taken
+screenshots from the same directory. If DIR is negative, rotate
+in the other direction"
+ (interactive "p")
+ (org-screenshot-do-rotate (- dir) nil)
+ (when org-screenshot-last-file
+ (org-screenshot-rotate-continue nil nil)))
+
+(defun org-screenshot-prefer-same-modifiers (list event)
+ (if (not (eventp nil)) (car list)
+ (let (ret (keys list))
+ (while (and (null ret) keys)
+ (let ((key (car keys)))
+ (if (and (= 1 (length key))
+ (equal (event-modifiers event)
+ (event-modifiers (elt key 0))))
+ (setq ret (car keys))
+ (setq keys (cdr keys)))))
+ (or ret (car list)))))
+
+(defun org-screenshot-rotate-continue (from-take-screenshot orig-event)
+ "Display the message with the name of the last changed
+image-file and inform user that they can rotate by pressing keys
+bound to `org-screenshot-rotate-next' and
+`org-screenshot-rotate-prev' in `org-screenshot-map'
+
+This works similarly to `kmacro-end-or-call-macro' so that user
+can press a long key sequence to invoke the first command, and
+then uses single keys to rotate, until unregognized key is
+entered, at which point event will be unread"
+
+ (let* ((event (if from-take-screenshot orig-event
+ last-input-event))
+ done
+ (prev-key
+ (org-screenshot-prefer-same-modifiers
+ (where-is-internal 'org-screenshot-rotate-prev
+ org-screenshot-map nil)
+ event))
+ (next-key
+ (org-screenshot-prefer-same-modifiers
+ (where-is-internal 'org-screenshot-rotate-next
+ org-screenshot-map nil)
+ event))
+ prev-key-str next-key-str)
+ (when (and (= (length prev-key) 1)
+ (= (length next-key) 1))
+ (setq
+ prev-key-str (format-kbd-macro prev-key nil)
+ next-key-str (format-kbd-macro next-key nil)
+ prev-key (elt prev-key 0)
+ next-key (elt next-key 0))
+ (while (not done)
+ (message "%S - '%s' and '%s' to rotate"
+ org-screenshot-last-file prev-key-str next-key-str)
+ (setq event (read-event))
+ (cond ((equal event prev-key)
+ (clear-this-command-keys t)
+ (org-screenshot-do-rotate 1 t)
+ (setq last-input-event nil))
+ ((equal event next-key)
+ (clear-this-command-keys t)
+ (org-screenshot-do-rotate -1 t)
+ (setq last-input-event nil))
+ (t (setq done t))))
+ (when last-input-event
+ (clear-this-command-keys t)
+ (setq unread-command-events (list last-input-event))))))
+
+;;;###autoload
+(defun org-screenshot-show-unused ()
+ "Open A Dired buffer with unused screenshots marked"
+ (interactive)
+ (let ((files-in-buffer)
+ dired-buffer
+ had-any
+ (image-re (org-image-file-name-regexp))
+ beg end)
+ (save-excursion
+ (save-restriction
+ (widen)
+ (setq beg (or beg (point-min)) end (or end (point-max)))
+ (goto-char beg)
+ (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?"
+ (substring (org-image-file-name-regexp) 0 -2)
+ "\\)\\]"))
+ (case-fold-search t)
+ old file ov img type attrwidth width)
+ (while (re-search-forward re end t)
+ (setq file (concat (or (match-string 3) "") (match-string 4)))
+ (when (and (file-exists-p file)
+ (equal (file-name-directory file)
+ (org-screenshot-image-directory)))
+ (push (file-name-nondirectory file)
+ files-in-buffer))))))
+ (setq dired-buffer (dired-noselect (org-screenshot-image-directory)))
+ (with-current-buffer dired-buffer
+ (dired-unmark-all-files ?\r)
+ (dired-mark-if
+ (let ((file (dired-get-filename 'no-dir t)))
+ (and file (string-match image-re file)
+ (not (member file files-in-buffer))
+ (setq had-any t)))
+ "Unused screenshot"))
+ (when had-any (pop-to-buffer dired-buffer))))
+
+(provide 'org-screenshot)
;;; org-secretary.el --- Team management with org-mode
-;; Copyright (C) 2010-2013 Juan Reyero
+;; Copyright (C) 2010-2014 Juan Reyero
;;
;; Author: Juan Reyero <juan _at_ juanreyero _dot_ com>
;; Keywords: outlines, tasks, team, management
;;; org-sudoku.el --- Greate and solve SUDOKU games in Org tables
-;; Copyright (C) 2012, 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2012, 2013, 2014 Free Software Foundation, Inc.
;;
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp, games
"[ \t]*|[ \t]*")))))))
(defvar org-table-clean-did-remove-column nil) ; dynamically scoped
-(defun org-table-clean-before-export (lines &optional maybe-quoted)
+(defun org-table-clean-before-export (lines)
"Check if the table has a marking column.
If yes remove the column and the special lines."
- (let ((special (if maybe-quoted
- "^[ \t]*| *\\\\?[\#!$*_^/ ] *|"
- "^[ \t]*| *[\#!$*_^/ ] *|"))
- (ignore (if maybe-quoted
- "^[ \t]*| *\\\\?[!$_^/] *|"
- "^[ \t]*| *[!$_^/] *|")))
+ (let ((special "^[ \t]*| *[#!$*_^/] *|")
+ (ignore "^[ \t]*| *[!$_^/] *|"))
(setq org-table-clean-did-remove-column
(not (memq nil
(mapcar
(or (fboundp 'calc-eval)
(user-error "Calc does not seem to be installed, and is needed to evaluate the formula"))
;; Use <...> time-stamps so that Calc can handle them
- (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form))
+ (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form)
+ (setq form (replace-match "<\\1>" nil nil form)))
;; I18n-ize local time-stamps by setting (system-time-locale "C")
(when (string-match org-ts-regexp2 form)
(let* ((ts (match-string 0 form))
(push org-table-current-begin-pos org-show-positions)
(let ((min (apply 'min org-show-positions))
(max (apply 'max org-show-positions)))
- (goto-char min) (recenter 0)
+ (set-window-start (selected-window) min)
(goto-char max)
- (or (pos-visible-in-window-p max) (recenter -1))))
+ (or (pos-visible-in-window-p max)
+ (set-window-start (selected-window) max))))
(select-window win))))
(defun org-table-force-dataline ()
(insert (org-timer-value-string))))
(defun org-timer-value-string ()
- (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds)))))
+ "Set the timer string."
+ (format org-timer-format
+ (org-timer-secs-to-hms
+ (abs (floor (org-timer-seconds))))))
(defvar org-timer-timer-is-countdown nil)
(defun org-timer-seconds ()
;;; org-toc.el --- Table of contents for Org-mode buffer
-;; Copyright 2007-2013 Free Software Foundation, Inc.
+;; Copyright 2007-2014 Free Software Foundation, Inc.
;;
-;; Author: Bastien Guerry <bzg AT gnu DOT org>
+;; Author: Bastien Guerry <bzg@gnu.org>
;; Keywords: Org table of contents
;; Homepage: http://www.cognition.ens.fr/~guerry/u/org-toc.el
;; Version: 0.8
;;; org-track.el --- Track the most recent Org-mode version available.
;;
-;; Copyright (C) 2009-2013
+;; Copyright (C) 2009-2014
;; Free Software Foundation, Inc.
;;
-;; Author: Bastien Guerry <bzg at altern dot org>
+;; Author: Bastien Guerry <bzg@gnu.org>
;; Eric S Fraga <e.fraga at ucl.ac dot uk>
;; Sebastian Rose <sebastian_rose at gmx dot de>
;; The Worg people http://orgmode.org/worg/
;;; org-velocity.el --- something like Notational Velocity for Org.
-;; Copyright (C) 2010-2013 Paul M. Rodriguez
+;; Copyright (C) 2010-2014 Paul M. Rodriguez
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
(defun org-release ()
"The release version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-release "8.2.6"))
+ (let ((org-release "8.2.7c"))
org-release))
;;;###autoload
(defun org-git-version ()
"The Git version of org-mode.
Inserted by installing org-mode or when a release is made."
- (let ((org-git-version "8.2.6-dist"))
+ (let ((org-git-version "8.2.7c-dist"))
org-git-version))
;;;###autoload
(defvar org-odt-data-dir "/home/joerg/.emacs.d/etc/org"
;;; org-vm.el --- Support for links to VM messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes
-;; Copyright (C) 2010-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2010-2014 Free Software Foundation, Inc.
;; Author: Carsten Dominik <carsten at orgmode dot org>
;; Keywords: outlines, hypermedia, calendar, wp
;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode
-;; Copyright (C) 2004-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2004-2014 Free Software Foundation, Inc.
;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp>
;; David Maus <dmaus at ictsoc dot de>
(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
(unless (boundp 'diary-fancy-buffer)
(org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))
+(declare-function org-add-archive-files "org-archive" (files))
+
(declare-function org-inlinetask-at-task-p "org-inlinetask" ())
(declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ())
(declare-function org-clock-get-last-clock-out-time "org-clock" ())
(declare-function org-clock-timestamps-up "org-clock" (&optional n))
(declare-function org-clock-timestamps-down "org-clock" (&optional n))
+(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove))
(declare-function org-clock-sum-current-item "org-clock" (&optional tstart))
+(declare-function org-clock-update-time-maybe "org-clock" ())
+(declare-function org-clocktable-shift "org-clock" (dir n))
(declare-function orgtbl-mode "org-table" (&optional arg))
(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time))
(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
(declare-function org-agenda-redo "org-agenda" (&optional all))
(declare-function org-table-align "org-table" ())
+(declare-function org-table-begin "org-table" (&optional table-type))
+(declare-function org-table-blank-field "org-table" ())
+(declare-function org-table-end "org-table" (&optional table-type))
+(declare-function org-table-insert-row "org-table" (&optional arg))
(declare-function org-table-paste-rectangle "org-table" ())
(declare-function org-table-maybe-eval-formula "org-table" ())
(declare-function org-table-maybe-recalculate-line "org-table" ())
(intern (concat "org-babel-expand-body:" lang)))))))
org-babel-load-languages))
+(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang))
;;;###autoload
(defun org-babel-load-file (file &optional compile)
"Load Emacs Lisp source code blocks in the Org-mode FILE.
"\\(?: +\\(\\[#.\\]\\)\\)?"
"\\(?: +"
;; Stats cookies can be stuck to body.
- "\\(?:\\[[0-9%%/]+\\] *\\)?"
+ "\\(?:\\[[0-9%%/]+\\] *\\)*"
"\\(%s\\)"
- "\\(?: *\\[[0-9%%/]+\\]\\)?"
+ "\\(?: *\\[[0-9%%/]+\\]\\)*"
"\\)"
(org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?")
"[ \t]*$")
(org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local)
;; Emacs 22 deals with this through a special variable
(org-set-local 'outline-isearch-open-invisible-function
- (lambda (&rest ignore) (org-show-context 'isearch)))
- (org-add-hook 'isearch-mode-end-hook 'org-fix-ellipsis-at-bol 'append 'local))
+ (lambda (&rest ignore) (org-show-context 'isearch))))
;; Setup the pcomplete hooks
(set (make-local-variable 'pcomplete-command-completion-function)
(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify)
-(defsubst org-fix-ellipsis-at-bol ()
- (save-excursion (goto-char (window-start)) (recenter 0)))
-
(defun org-find-invisible-foreground ()
(let ((candidates (remove
"unspecified-bg"
((member dc1 '("+title:" "+author:" "+email:" "+date:"))
(add-text-properties
beg (match-end 3)
- (if (member (intern (substring dc1 0 -1)) org-hidden-keywords)
+ (if (member (intern (substring dc1 1 -1)) org-hidden-keywords)
'(font-lock-fontified t invisible t)
'(font-lock-fontified t face org-document-info-keyword)))
(add-text-properties
(defvar org-font-lock-keywords nil)
-(defsubst org-re-property (property &optional literal)
- "Return a regexp matching a PROPERTY line.
-Match group 3 will be set to the value if it exists."
- (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:"
- (if literal property (regexp-quote property))
- "\\):\\)[ \t]+\\(?3:[^ \t\r\n].*?\\)\\(?5:[ \t]*\\)$"))
+(defsubst org-re-property (property &optional literal allow-null)
+ "Return a regexp matching a PROPERTY line.
+ Match group 3 will be set to the value if it exists."
+ (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:"
+ (if literal property (regexp-quote property))
+ "\\):\\)[ \t]+\\(?3:[^ \t\r\n]"
+ (if allow-null "*")
+ ".*?\\)\\(?5:[ \t]*\\)$"))
(defconst org-property-re
- (org-re-property ".*?" 'literal)
+ (org-re-property ".*?" 'literal t)
"Regular expression matching a property line.
There are four matching groups:
1: :PROPKEY: including the leading and trailing colon,
(setq has-children (org-list-has-child-p (point) struct)))
(org-back-to-heading)
(setq eoh (save-excursion (outline-end-of-heading) (point)))
- (setq eos (save-excursion (1- (org-end-of-subtree t t))))
+ (setq eos (save-excursion (org-end-of-subtree t t)
+ (when (bolp) (backward-char)) (point)))
(setq has-children
(or (save-excursion
(let ((level (funcall outline-level)))
;; buffers, where outline-regexp is needed.
(defun org-overview ()
"Switch to overview mode, showing only top-level headlines.
-Really, this shows all headlines with level equal or greater than the level
+This shows all headlines with a level equal or greater than the level
of the first headline in the buffer. This is important, because if the
first headline is not level one, then (hide-sublevels 1) gives confusing
results."
(interactive)
- (let ((pos (point))
- (level (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (concat "^" outline-regexp) nil t)
- (progn
- (goto-char (match-beginning 0))
- (funcall outline-level))))))
- (and level (hide-sublevels level))
- (recenter '(4))
- (goto-char pos)))
+ (save-excursion
+ (let ((level
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" outline-regexp) nil t)
+ (progn
+ (goto-char (match-beginning 0))
+ (funcall outline-level))))))
+ (and level (hide-sublevels level)))))
(defun org-content (&optional arg)
"Show all headlines in the buffer, like a table of contents.
(pos-visible-in-window-p
(save-excursion (org-end-of-subtree t) (point))))
-(defun org-first-headline-recenter (&optional N)
- "Move cursor to the first headline and recenter the headline.
-Optional argument N means put the headline into the Nth line of the window."
+(defun org-first-headline-recenter ()
+ "Move cursor to the first headline and recenter the headline."
(goto-char (point-min))
(when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t)
- (beginning-of-line)
- (recenter (prefix-numeric-value N))))
+ (set-window-start (selected-window) (point-at-bol))))
;;; Saving and restoring visibility
(looking-at "[ \t]*$")))))
(defun org-insert-heading (&optional arg invisible-ok)
- "Insert a new heading or item with same depth at point.
+ "Insert a new heading or an item with the same depth at point.
If point is at the beginning of a heading or a list item, insert
-a heading or a list item before it.
-
-If point is at the beginning of a normal line, turn this line
-into a heading.
+a new heading or a new item above the current one. If point is
+at the beginning of a normal line, turn the line into a heading.
If point is in the middle of a headline or a list item, split the
headline or the item and create a new headline/item with the text
in the current line after point \(see `org-M-RET-may-split-line'
on how to modify this behavior).
-With one universal prefix argument: If point is within a list,
-insert a heading instead of a list item. Otherwise, set the
-value of `org-insert-heading-respect-content' to `t' for the
-duration of the command.
+With one universal prefirx argument, set the user option
+`org-insert-heading-respect-content' to t for the duration of
+the command. This modifies the behavior described above in this
+ways: on list items and at the beginning of normal lines, force
+the insertion of a heading after the current subtree.
With two universal prefix arguments, insert the heading at the
end of the grandparent subtree. For example, if point is within
(or arg (not itemp))))
;; At beginning of buffer or so high up that only a heading
;; makes sense.
- (insert
- (if (or (bobp) (org-previous-line-empty-p)) "" "\n")
- (if (org-in-src-block-p) ",* " "* "))
+ (cond ((and (bolp) (not respect-content)) (insert "* "))
+ ((not respect-content)
+ (unless may-split (end-of-line))
+ (insert "\n* "))
+ ((re-search-forward org-outline-regexp-bol nil t)
+ (beginning-of-line)
+ (insert "* \n")
+ (backward-char))
+ (t (goto-char (point-max))
+ (insert "\n* ")))
(run-hooks 'org-insert-heading-hook))
- ((and itemp (not (equal arg '(4))))
+ ((and itemp (not (member arg '((4) (16)))))
;; Insert an item
(org-insert-item))
nil))
;; Get a level string to fall back on
(fix-level
- (save-excursion
- (org-back-to-heading t)
- (if (org-previous-line-empty-p) (setq empty-line-p t))
- (looking-at org-outline-regexp)
- (make-string (1- (length (match-string 0))) ?*)))
+ (if (org-before-first-heading-p) "*"
+ (save-excursion
+ (org-back-to-heading t)
+ (if (org-previous-line-empty-p) (setq empty-line-p t))
+ (looking-at org-outline-regexp)
+ (make-string (1- (length (match-string 0))) ?*))))
(stars
(save-excursion
(condition-case nil
pos hide-previous previous-pos)
;; If we insert after content, move there and clean up whitespace
- (when (and respect-content (not (org-on-heading-p)))
- (org-end-of-subtree nil t)
+ (when (and respect-content
+ (not (org-looking-at-p org-outline-regexp-bol)))
+ (if (not (org-before-first-heading-p))
+ (org-end-of-subtree nil t)
+ (re-search-forward org-outline-regexp-bol)
+ (beginning-of-line 0))
(skip-chars-backward " \r\n")
(and (not (looking-back "^\*+"))
(looking-at "[ \t]+") (replace-match ""))
(setq initial-content (org-trim initial-content)))
(goto-char pos))
;; a normal line
- (unless (bolp)
- (setq initial-content (buffer-substring (point) (point-at-eol)))
- (delete-region (point) (point-at-eol))
- (setq initial-content (org-trim initial-content)))))
+ (setq initial-content
+ (org-trim (buffer-substring (point) (point-at-eol))))
+ (delete-region (point) (point-at-eol))))
;; If we are at the beginning of the line, insert before it. Else after
(cond
(org-move-subtree-down)
(end-of-line 1))
-(defun org-insert-heading-respect-content (&optional arg invisible-ok)
+(defun org-insert-heading-respect-content (&optional invisible-ok)
"Insert heading with `org-insert-heading-respect-content' set to t."
- (interactive "P")
- (let ((org-insert-heading-respect-content t))
- (org-insert-heading '(4) invisible-ok)))
+ (interactive)
+ (org-insert-heading '(4) invisible-ok))
(defun org-insert-todo-heading-respect-content (&optional force-state)
"Insert TODO heading with `org-insert-heading-respect-content' set to t."
- (interactive "P")
- (let ((org-insert-heading-respect-content t))
- (org-insert-todo-heading force-state '(4))))
+ (interactive)
+ (org-insert-todo-heading force-state '(4)))
(defun org-insert-todo-heading (arg &optional force-heading)
"Insert a new heading with the same level and TODO state as current heading.
(save-match-data
(save-excursion (outline-end-of-heading)
(setq folded (outline-invisible-p)))
- (outline-end-of-subtree))
+ (progn (org-end-of-subtree nil t)
+ (unless (eobp) (backward-char))))
(outline-next-heading)
(setq ne-end (org-back-over-empty-lines))
(setq end (point))
(string-match
"^\\*+$" (buffer-substring
(point-at-bol) (point))))
- (- (match-end 1) (match-beginning 1)))
+ (- (match-end 0) (match-beginning 0)))
((and (bolp)
(looking-at org-outline-regexp))
(- (match-end 0) (point) 1))))
(move-marker org-open-link-marker nil)
(run-hook-with-args 'org-follow-link-hook)))
+(defsubst org-uniquify (list)
+ "Non-destructively remove duplicate elements from LIST."
+ (let ((res (copy-sequence list))) (delete-dups res)))
+
(defun org-offer-links-in-entry (buffer marker &optional nth zero)
"Offer links in the current entry and return the selected link.
If there is only one link, return it.
(error nil))
(not (bobp)))
(org-flag-heading nil)
- (when siblings-p (org-show-siblings)))))
- (unless (eq key 'agenda) (org-fix-ellipsis-at-bol))))
+ (when siblings-p (org-show-siblings)))))))
(defvar org-reveal-start-hook nil
"Hook run before revealing a location.")
as N.")
(defun org-scan-tags (action matcher todo-only &optional start-level)
- "Sca headline tags with inheritance and produce output ACTION.
+ "Scan headline tags with inheritance and produce output ACTION.
ACTION can be `sparse-tree' to produce a sparse tree in the current buffer,
or `agenda' to produce an entry list for an agenda view. It can also be
(if expert
(set-buffer (get-buffer-create " *Org tags*"))
(delete-other-windows)
- (split-window-vertically)
- (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
+ (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*"))
+ (org-switch-to-buffer-other-window " *Org tags*"))
(erase-buffer)
(org-set-local 'org-done-keywords done-keywords)
(org-fast-tag-insert "Inherited" inherited i-face "\n")
'("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED"
"TIMESTAMP" "TIMESTAMP_IA")))
(catch 'match
- (while (re-search-forward org-maybe-keyword-time-regexp end t)
+ (while (and (re-search-forward org-maybe-keyword-time-regexp end t)
+ (not (text-property-any 0 (length (match-string 0))
+ 'face 'font-lock-comment-face
+ (match-string 0))))
(setq key (if (match-end 1)
(substring (org-match-string-no-properties 1)
0 -1))
(if (and range
(goto-char (car range))
(re-search-forward
- (org-re-property property)
+ (org-re-property property nil t)
(cdr range) t))
(progn
(delete-region (match-beginning 0) (1+ (point-at-eol)))
(setq range (org-get-property-block beg end 'force))
(goto-char (car range))
(if (re-search-forward
- (org-re-property property) (cdr range) t)
+ (org-re-property property nil t) (cdr range) t)
(progn
(delete-region (match-beginning 0) (match-end 0))
(goto-char (match-beginning 0)))
(funcall set-function prompt
(mapcar 'list (org-property-values property))
nil nil "" nil cur)))))
- (if (equal val "")
- cur
- val)))
+ (org-trim val)))
(defvar org-last-set-property nil)
(defvar org-last-set-property-value nil)
(org-icompleting-read "Property: " props nil t)
(caar props))))
(list prop)))
- (if (org-entry-delete nil property delete-empty-drawer)
- (message "Property %s deleted" property)))
+ (if (not property)
+ (message "No property to delete in this entry")
+ (org-entry-delete nil property delete-empty-drawer)
+ (message "Property \"%s\" deleted" property)))
(defun org-delete-property-globally (property)
"Remove PROPERTY globally, from all entries."
(defcustom org-agenda-inhibit-startup nil
"Inhibit startup when preparing agenda buffers.
-When this variable is `t' (the default), the initialization of
-the Org agenda buffers is inhibited: e.g. the visibility state
-is not set, the tables are not re-aligned, etc."
+When this variable is `t', the initialization of the Org agenda
+buffers is inhibited: e.g. the visibility state is not set, the
+tables are not re-aligned, etc."
:type 'boolean
:version "24.3"
:group 'org-agenda)
"Return the reverse of STRING."
(apply 'string (reverse (string-to-list string))))
-(defsubst org-uniquify (list)
- "Non-destructively remove duplicate elements from LIST."
- (let ((res (copy-sequence list))) (delete-dups res)))
+;; defsubst org-uniquify must be defined before first use
(defun org-uniquify-alist (alist)
"Merge elements of ALIST with the same key.
(forward-char -1))))))
(point))
-(defadvice outline-end-of-subtree (around prefer-org-version activate compile)
- "Use Org version in org-mode, for dramatic speed-up."
- (if (derived-mode-p 'org-mode)
- (progn
- (org-end-of-subtree nil t)
- (unless (eobp) (backward-char 1)))
- ad-do-it))
-
(defun org-end-of-meta-data-and-drawers ()
"Jump to the first text after meta data and drawers in the current entry.
This will move over empty lines, lines with planning time stamps,
isearch-mode-end-hook-quit)
;; Only when the isearch was not quitted.
(org-add-hook 'post-command-hook 'org-isearch-post-command
- 'append 'local)))
- (org-fix-ellipsis-at-bol)))
+ 'append 'local)))))
(defun org-isearch-post-command ()
"Remove self from hook, and show context."
;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements.
-;; Copyright (C) 2008-2013 Free Software Foundation
+;; Copyright (C) 2008-2014 Free Software Foundation
;; Author: Jason Riedy <jason@acm.org>
;; Keywords: org, tables, sql
(*orgtbl-default-fmt* 'orgtbl-sql-strip-and-quote)
(params2
(list
- :sqlname name
+ :sqlname (plist-get params :sqlname)
:tstart (lambda () (concat (if nowebname
(format "<<%s>>= \n" nowebname)
"")
"BEGIN TRANSACTION;"))
:tend (lambda () (concat "COMMIT;" (if nowebname "\n@ " "")))
- :hfmt (lambda (f) (progn (if firstheader (push f hdrlist)) ""))
- :hlfmt (lambda (lst) (setq firstheader nil))
+ :hfmt (lambda (f) (progn (if firstheader (push f hdrlist) "")))
+ :hlfmt (lambda (&rest cells) (setq firstheader nil))
:lstart (lambda () (concat "INSERT INTO "
sqlname "( "
(mapconcat 'identity (reverse hdrlist)
(defcustom org-ascii-indented-line-width 'auto
"Additional indentation width for the first line in a paragraph.
If the value is an integer, indent the first line of each
-paragraph by this number. If it is the symbol `auto' preserve
-indentation from original document."
+paragraph by this width, unless it is located at the beginning of
+a section, in which case indentation is removed from that line.
+If it is the symbol `auto' preserve indentation from original
+document."
:group 'org-export-ascii
:version "24.4"
:package-version '(Org . "8.0")
Empty lines are not indented."
(when (stringp s)
(replace-regexp-in-string
- "\\(^\\)\\(?:.*\\S-\\)" (make-string width ? ) s nil nil 1)))
+ "\\(^\\)[ \t]*\\S-" (make-string width ?\s) s nil nil 1)))
(defun org-ascii--box-string (s info)
"Return string S with a partial box to its left.
(case (org-element-type element)
;; Elements with an absolute width: `headline' and `inlinetask'.
(inlinetask org-ascii-inlinetask-width)
- ('headline
+ (headline
(- org-ascii-text-width
(let ((low-level-rank (org-export-low-level-p element info)))
(if low-level-rank (* low-level-rank 2) org-ascii-global-margin))))
"Transcode a PARAGRAPH element from Org to ASCII.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
- (let ((contents (if (not (wholenump org-ascii-indented-line-width)) contents
- (concat
- (make-string org-ascii-indented-line-width ? )
- (replace-regexp-in-string "\\`[ \t]+" "" contents)))))
- (org-ascii--fill-string
- contents (org-ascii--current-text-width paragraph info) info)))
+ (org-ascii--fill-string
+ (if (not (wholenump org-ascii-indented-line-width)) contents
+ (concat
+ ;; Do not indent first paragraph in a section.
+ (unless (and (not (org-export-get-previous-element paragraph info))
+ (eq (org-element-type (org-export-get-parent paragraph))
+ 'section))
+ (make-string org-ascii-indented-line-width ?\s))
+ (replace-regexp-in-string "\\`[ \t]+" "" contents)))
+ (org-ascii--current-text-width paragraph info) info))
;;;; Plain List
CONTENTS is the contents of the object. INFO is a plist holding
contextual information."
(if (org-element-property :use-brackets-p superscript)
- (format "_{%s}" contents)
- (format "_%s" contents)))
+ (format "^{%s}" contents)
+ (format "^%s" contents)))
;;;; Strike-through
(or (gethash key cache)
(puthash
key
- (or (and (not org-ascii-table-widen-columns)
- (org-export-table-cell-width table-cell info))
- (let* ((max-width 0))
- (org-element-map table 'table-row
- (lambda (row)
- (setq max-width
- (max (string-width
- (org-export-data
- (org-element-contents
- (elt (org-element-contents row) col))
- info))
- max-width)))
- info)
- max-width))
+ (let ((cookie-width (org-export-table-cell-width table-cell info)))
+ (or (and (not org-ascii-table-widen-columns) cookie-width)
+ (let ((contents-width
+ (let ((max-width 0))
+ (org-element-map table 'table-row
+ (lambda (row)
+ (setq max-width
+ (max (string-width
+ (org-export-data
+ (org-element-contents
+ (elt (org-element-contents row) col))
+ info))
+ max-width)))
+ info)
+ max-width)))
+ (cond ((not cookie-width) contents-width)
+ (org-ascii-table-widen-columns
+ (max cookie-width contents-width))
+ (t cookie-width)))))
cache))))
(defun org-ascii-table-cell (table-cell contents info)
envs)
'((:endgroup))
'(("BMCOL" . ?|))))
+ (org-tag-persistent-alist nil)
(org-use-fast-tag-selection t)
(org-fast-tag-selection-single-key t))
(org-set-tags)
(defvar org-html-standalone-image-predicate)
(defun org-html-standalone-image-p (element info)
- "Test if ELEMENT is a standalone image.
+ "Non-nil if ELEMENT is a standalone image.
INFO is a plist holding contextual information.
-Return non-nil, if ELEMENT is of type paragraph and its sole
-content, save for white spaces, is a link that qualifies as an
-inline image.
+An element or object is a standalone image when
-Return non-nil, if ELEMENT is of type link and its containing
-paragraph has no other content save white spaces.
+ - its type is `paragraph' and its sole content, save for white
+ spaces, is a link that qualifies as an inline image;
-Return nil, otherwise.
+ - its type is `link' and its containing paragraph has no other
+ content save white spaces.
Bind `org-html-standalone-image-predicate' to constrain paragraph
further. For example, to check for only captioned standalone
(paragraph element)
(link (org-export-get-parent element)))))
(and (eq (org-element-type paragraph) 'paragraph)
- (or (not (and (boundp 'org-html-standalone-image-predicate)
- (functionp org-html-standalone-image-predicate)))
+ (or (not (fboundp 'org-html-standalone-image-predicate))
(funcall org-html-standalone-image-predicate paragraph))
- (not (let ((link-count 0))
- (org-element-map (org-element-contents paragraph)
- (cons 'plain-text org-element-all-objects)
- (lambda (obj) (case (org-element-type obj)
- (plain-text (org-string-nw-p obj))
- (link
- (or (> (incf link-count) 1)
- (not (org-html-inline-image-p obj info))))
- (otherwise t)))
- info 'first-match 'link))))))
+ (catch 'exit
+ (let ((link-count 0))
+ (org-element-map (org-element-contents paragraph)
+ (cons 'plain-text org-element-all-objects)
+ #'(lambda (obj)
+ (when (case (org-element-type obj)
+ (plain-text (org-string-nw-p obj))
+ (link (or (> (incf link-count) 1)
+ (not (org-html-inline-image-p obj info))))
+ (otherwise t))
+ (throw 'exit nil)))
+ info nil 'link)
+ (= link-count 1))))))
(defun org-html-link (link desc info)
"Transcode a LINK object from Org to HTML.
(defcustom org-icalendar-include-sexps t
"Non-nil means export to iCalendar files should also cover sexp entries.
-These are entries like in the diary, but directly in an Org mode
-file."
+These are entries like in the diary, but directly in an Org file."
:group 'org-export-icalendar
:type 'boolean)
INFO is a plist used as a communication channel.
-a headline is blocked when either:
+A headline is blocked when either
- - It has children which are not all in a completed state.
+ - it has children which are not all in a completed state;
- - It has a parent with the property :ORDERED:, and there are
- siblings prior to it with incomplete status.
+ - it has a parent with the property :ORDERED:, and there are
+ siblings prior to it with incomplete status;
- - Its parent is blocked because it has siblings that should be
+ - its parent is blocked because it has siblings that should be
done first or is a child of a blocked grandparent entry."
(or
;; Check if any child is not done.
;;; Filters
(defun org-icalendar-clear-blank-lines (headline back-end info)
- "Remove trailing blank lines in HEADLINE export.
+ "Remove blank lines in HEADLINE export.
HEADLINE is a string representing a transcoded headline.
BACK-END and INFO are ignored."
- (replace-regexp-in-string "^\\(?:[ \t]*\n\\)*" "" headline))
+ (replace-regexp-in-string "^\\(?:[ \t]*\n\\)+" "" headline))
\f
;; happen once ENTRY is one of them.
(let ((counter 0))
(mapconcat
- 'identity
+ #'identity
(org-element-map (cons (org-element-property :title entry)
(org-element-contents inside))
'timestamp
(lambda (ts)
- (let ((uid (format "TS%d-%s" (incf counter) uid)))
- (org-icalendar--vevent entry ts uid summary loc desc cat)))
+ (when (let ((type (org-element-property :type ts)))
+ (case (plist-get info :with-timestamps)
+ (active (memq type '(active active-range)))
+ (inactive (memq type '(inactive inactive-range)))
+ ((t) t)))
+ (let ((uid (format "TS%d-%s" (incf counter) uid)))
+ (org-icalendar--vevent
+ entry ts uid summary loc desc cat))))
info nil (and (eq type 'headline) 'inlinetask))
""))
;; Task: First check if it is appropriate to export it.
(and (eq type 'headline)
(not (org-icalendar-blocked-headline-p
entry info))))
- ('t (eq todo-type 'todo))))
+ ((t) (eq todo-type 'todo))))
(org-icalendar--vtodo entry uid summary loc desc cat))
;; Diary-sexp: Collect every diary-sexp element within
;; ENTRY and its title, and transcode them. If ENTRY is
;; separately.
(when org-icalendar-include-sexps
(let ((counter 0))
- (mapconcat 'identity
+ (mapconcat #'identity
(org-element-map
(cons (org-element-property :title entry)
(org-element-contents inside))
;; inlinetask within it. In agenda export, this is independent
;; from the mark (or lack thereof) on the entry.
(when (eq type 'headline)
- (mapconcat 'identity
+ (mapconcat #'identity
(org-element-map inside 'inlinetask
(lambda (task) (org-icalendar-entry task nil info))
info) ""))
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)
+ (:from-address "FROM_ADDRESS" nil org-koma-letter-from-address newline)
(:phone-number "PHONE_NUMBER" nil org-koma-letter-phone-number)
(:email "EMAIL" nil (org-koma-letter--get-value org-koma-letter-email) t)
(:email-changed-in-buffer-p "EMAIL" nil nil t)
:package-version '(Org . "8.0")
:type '(choice
(string :tag "Format string")
- (const :tag "No formatting")))
+ (const :tag "No formatting" nil)))
;;;; Text markup
a list containing two strings: the name of the option, and the
value. For example,
- (setq org-latex-listings-options
+ \(setq org-latex-listings-options
'((\"basicstyle\" \"\\\\small\")
- (\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\")))
+ \(\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\")))
will typeset the code in a small size font with underlined, bold
black keywords.
(when priority (format "\\framebox{\\#%c} " priority))
title
(when tags (format "\\hfill{}\\textsc{:%s:}"
- (mapconcat 'identity tags ":"))))))
- (format (concat "\\begin{center}\n"
- "\\fbox{\n"
- "\\begin{minipage}[c]{.6\\textwidth}\n"
- "%s\n\n"
- "\\rule[.8em]{\\textwidth}{2pt}\n\n"
- "%s"
- "\\end{minipage}\n"
- "}\n"
- "\\end{center}")
- full-title contents))))))
+ (mapconcat #'identity tags ":"))))))
+ (concat "\\begin{center}\n"
+ "\\fbox{\n"
+ "\\begin{minipage}[c]{.6\\textwidth}\n"
+ full-title "\n\n"
+ (and (org-string-nw-p contents)
+ (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents))
+ "\\end{minipage}\n"
+ "}\n"
+ "\\end{center}"))))))
;;;; Italic
(and (plist-get info :with-priority)
(let ((char (org-element-property :priority headline)))
(and char (format "[#%c] " char)))))
+ (anchor
+ (when (plist-get info :with-toc)
+ (org-html--anchor
+ (or (org-element-property :CUSTOM_ID headline)
+ (concat "sec-"
+ (mapconcat 'number-to-string
+ (org-export-get-headline-number
+ headline info) "-"))))))
;; Headline text without tags.
(heading (concat todo priority title)))
(cond
(replace-regexp-in-string "^" " " contents)))))
;; Use "Setext" style.
((eq org-md-headline-style 'setext)
- (concat heading tags "\n"
+ (concat heading tags anchor "\n"
(make-string (length heading) (if (= level 1) ?= ?-))
"\n\n"
contents))
;; Use "atx" style.
- (t (concat (make-string level ?#) " " heading tags "\n\n" contents))))))
+ (t (concat (make-string level ?#) " " heading tags anchor "\n\n" contents))))))
;;;; Horizontal Rule
:transcoders
'((paragraph . (lambda (p c i)
(org-odt--format-paragraph
- p c "Footnote"
+ p c i
+ "Footnote"
"OrgFootnoteCenter"
"OrgFootnoteQuotations")))))
info))))
;;;; Paragraph
-(defun org-odt--format-paragraph (paragraph contents default center quote)
+(defun org-odt--paragraph-style (paragraph)
+ "Return style of PARAGRAPH.
+Style is a symbol among `quoted', `centered' and nil."
+ (let ((up paragraph))
+ (while (and (setq up (org-element-property :parent up))
+ (not (memq (org-element-type up)
+ '(center-block quote-block section)))))
+ (case (org-element-type up)
+ (center-block 'centered)
+ (quote-block 'quoted))))
+
+(defun org-odt--format-paragraph (paragraph contents info default center quote)
"Format paragraph according to given styles.
PARAGRAPH is a paragraph type element. CONTENTS is the
-transcoded contents of that paragraph, as a string. DEFAULT,
-CENTER and QUOTE are, respectively, style to use when paragraph
-belongs to no special environment, a center block, or a quote
-block."
- (let* ((parent (org-export-get-parent paragraph))
- (parent-type (org-element-type parent))
- (style (case parent-type
- (quote-block quote)
- (center-block center)
- (t default))))
- ;; If this paragraph is a leading paragraph in an item and the
- ;; item has a checkbox, splice the checkbox and paragraph contents
- ;; together.
- (when (and (eq (org-element-type parent) 'item)
- (eq paragraph (car (org-element-contents parent))))
- (setq contents (concat (org-odt--checkbox parent) contents)))
- (format "\n<text:p text:style-name=\"%s\">%s</text:p>" style contents)))
+transcoded contents of that paragraph, as a string. INFO is
+a plist used as a communication channel. DEFAULT, CENTER and
+QUOTE are, respectively, style to use when paragraph belongs to
+no special environment, a center block, or a quote block."
+ (format "\n<text:p text:style-name=\"%s\">%s</text:p>"
+ (case (org-odt--paragraph-style paragraph)
+ (quoted quote)
+ (centered center)
+ (otherwise default))
+ ;; If PARAGRAPH is a leading paragraph in an item that has
+ ;; a checkbox, splice checkbox and paragraph contents
+ ;; together.
+ (concat (let ((parent (org-element-property :parent paragraph)))
+ (and (eq (org-element-type parent) 'item)
+ (not (org-export-get-previous-element paragraph info))
+ (org-odt--checkbox parent)))
+ contents)))
(defun org-odt-paragraph (paragraph contents info)
"Transcode a PARAGRAPH element from Org to ODT.
CONTENTS is the contents of the paragraph, as a string. INFO is
the plist used as a communication channel."
(org-odt--format-paragraph
- paragraph contents
+ paragraph contents info
(or (org-element-property :style paragraph) "Text_20_body")
"OrgCenter"
"Quotations"))
(entity . org-org-identity)
(example-block . org-org-identity)
(fixed-width . org-org-identity)
- (footnote-definition . org-org-identity)
+ (footnote-definition . ignore)
(footnote-reference . org-org-identity)
(headline . org-org-headline)
(horizontal-rule . org-org-identity)
(quote-block . org-org-identity)
(quote-section . org-org-identity)
(radio-target . org-org-identity)
- (section . org-org-identity)
+ (section . org-org-section)
(special-block . org-org-identity)
(src-block . org-org-identity)
(statistics-cookie . org-org-identity)
(defun org-org-headline (headline contents info)
"Transcode HEADLINE element back into Org syntax.
CONTENTS is its contents, as a string or nil. INFO is ignored."
- (unless (plist-get info :with-todo-keywords)
- (org-element-put-property headline :todo-keyword nil))
- (unless (plist-get info :with-tags)
- (org-element-put-property headline :tags nil))
- (unless (plist-get info :with-priority)
- (org-element-put-property headline :priority nil))
- (org-element-put-property headline :level
- (org-export-get-relative-level headline info))
- (org-element-headline-interpreter headline contents))
+ (unless (org-element-property :footnote-section-p headline)
+ (unless (plist-get info :with-todo-keywords)
+ (org-element-put-property headline :todo-keyword nil))
+ (unless (plist-get info :with-tags)
+ (org-element-put-property headline :tags nil))
+ (unless (plist-get info :with-priority)
+ (org-element-put-property headline :priority nil))
+ (org-element-put-property headline :level
+ (org-export-get-relative-level headline info))
+ (org-element-headline-interpreter headline contents)))
(defun org-org-keyword (keyword contents info)
"Transcode KEYWORD element back into Org syntax.
org-element-block-name-alist))
(org-element-keyword-interpreter keyword nil)))
+(defun org-org-section (section contents info)
+ "Transcode SECTION element back into Org syntax.
+CONTENTS is the contents of the section. INFO is a plist used as
+a communication channel."
+ (concat
+ (org-element-normalize-string contents)
+ ;; Insert footnote definitions appearing for the first time in this
+ ;; section. Indeed, some of them may not be available to narrowing
+ ;; so we make sure all of them are included in the result.
+ (let ((footnotes-alist
+ (org-element-map section 'footnote-reference
+ (lambda (fn)
+ (and (eq (org-element-property :type fn) 'standard)
+ (org-export-footnote-first-reference-p fn info)
+ (cons (org-element-property :label fn)
+ (org-export-get-footnote-definition fn info))))
+ info)))
+ (and footnotes-alist
+ (concat "\n"
+ (mapconcat
+ (lambda (d)
+ (org-element-normalize-string
+ (concat (format "[%s] "(car d))
+ (org-export-data (cdr d) info))))
+ footnotes-alist "\n"))))
+ (make-string (or (org-element-property :post-blank section) 0) ?\n)))
+
;;;###autoload
(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist)
"Export current buffer to an Org buffer.
(visiting (find-buffer-visiting file))
(buffer (or visiting (find-file-noselect file))))
(with-current-buffer buffer
- (org-mode)
(let ((title
- (let ((property (plist-get (org-export-get-environment) :title)))
+ (let ((property
+ (plist-get
+ ;; protect local variables in open buffers
+ (if visiting
+ (org-export-with-buffer-copy (org-export-get-environment))
+ (org-export-get-environment))
+ :title)))
(if property
(org-no-properties (org-element-interpret-data property))
(file-name-nondirectory (file-name-sans-extension file))))))
any other case use the file system's modification time. Return
time in `current-time' format."
(if (file-directory-p file) (nth 5 (file-attributes file))
- (let* ((visiting (find-buffer-visiting file))
+ (let* ((org-inhibit-startup t)
+ (visiting (find-buffer-visiting file))
(file-buf (or visiting (find-file-noselect file nil)))
(date (plist-get
(with-current-buffer file-buf
- (let ((org-inhibit-startup t)) (org-mode))
- (org-export-get-environment))
+ (if visiting
+ (org-export-with-buffer-copy (org-export-get-environment))
+ (org-export-get-environment)))
:date)))
(unless visiting (kill-buffer file-buf))
;; DATE is either a timestamp object or a secondary string. If it
;; - category :: tree
;; - type :: list of elements and objects
;;
+;; + `:input-buffer' :: Name of input buffer.
+;; - category :: option
+;; - type :: string
+;;
;; + `:input-file' :: Full path to input file, if any.
;; - category :: option
;; - type :: string or nil
(when (stringp value)
(setq plist
(plist-put plist property
- (org-element-parse-secondary-string
- value (org-element-restriction 'keyword))))))))))
+ (or (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))
+ ;; When TITLE keyword sets an empty
+ ;; string, make sure it doesn't
+ ;; appear as nil in the plist.
+ (and (eq property :title) ""))))))))))
(defun org-export--get-buffer-attributes ()
"Return properties related to buffer attributes, as a plist."
;; Store full path of input file name, or nil. For internal use.
(let ((visited-file (buffer-file-name (buffer-base-buffer))))
(list :input-file visited-file
- :title (if (not visited-file) (buffer-name (buffer-base-buffer))
- (file-name-sans-extension
- (file-name-nondirectory visited-file))))))
+ :input-buffer (buffer-name (buffer-base-buffer)))))
(defun org-export--get-global-options (&optional backend)
"Return global export options as a plist.
(all (append (and backend (org-export-get-all-options backend))
org-export-options-alist)))
(dolist (cell all plist)
- (let ((prop (car cell))
- (default-value (nth 3 cell)))
- (unless (or (not default-value) (plist-member plist prop))
+ (let ((prop (car cell)))
+ (unless (plist-member plist prop)
(setq plist
(plist-put
plist
prop
- ;; Eval default value provided. If keyword is
+ ;; Evaluate default value provided. If keyword is
;; a member of `org-element-document-properties',
;; parse it as a secondary string before storing it.
(let ((value (eval (nth 3 cell))))
- (if (not (stringp value)) value
- (let ((keyword (nth 1 cell)))
- (if (member keyword org-element-document-properties)
- (org-element-parse-secondary-string
- value (org-element-restriction 'keyword))
- value)))))))))))
+ (if (and (stringp value)
+ (member (nth 1 cell)
+ org-element-document-properties))
+ (org-element-parse-secondary-string
+ value (org-element-restriction 'keyword))
+ value)))))))))
(defun org-export--list-bound-variables ()
"Return variables bound from BIND keywords in current buffer.
;; Return value in appropriate order of appearance.
(nreverse (funcall collect-bind nil nil)))))
+;; defsubst org-export-get-parent must be defined before first use,
+;; was originally defined in the topology section
+
+(defsubst org-export-get-parent (blob)
+ "Return BLOB parent or nil.
+BLOB is the element or object considered."
+ (org-element-property :parent blob))
;;;; Tree Properties
;;
DATA is a parse tree, an element or an object or a secondary
string. INFO is a plist holding export options.
-Return transcoded string."
- (let ((memo (gethash data (plist-get info :exported-data) 'no-memo)))
- (if (not (eq memo 'no-memo)) memo
+Return a string."
+ (or (gethash data (plist-get info :exported-data))
(let* ((type (org-element-type data))
(results
(cond
;; Secondary string.
((not type)
(mapconcat (lambda (obj) (org-export-data obj info)) data ""))
- ;; Element/Object without contents or, as a special case,
- ;; headline with archive tag and archived trees restricted
- ;; to title only.
+ ;; Element/Object without contents or, as a special
+ ;; case, headline with archive tag and archived trees
+ ;; restricted to title only.
((or (not (org-element-contents data))
(and (eq type 'headline)
(eq (plist-get info :with-archived-trees) 'headline)
(lambda (element) (org-export-data element info))
(org-element-contents
(if (or greaterp objectp) data
- ;; Elements directly containing objects
- ;; must have their indentation normalized
- ;; first.
+ ;; Elements directly containing
+ ;; objects must have their indentation
+ ;; normalized first.
(org-element-normalize-contents
data
- ;; When normalizing contents of the first
- ;; paragraph in an item or a footnote
- ;; definition, ignore first line's
- ;; indentation: there is none and it
- ;; might be misleading.
+ ;; When normalizing contents of the
+ ;; first paragraph in an item or
+ ;; a footnote definition, ignore
+ ;; first line's indentation: there is
+ ;; none and it might be misleading.
(when (eq type 'paragraph)
(let ((parent (org-export-get-parent data)))
(and
(puthash
data
(cond
- ((not results) nil)
+ ((not results) "")
((memq type '(org-data plain-text nil)) results)
- ;; Append the same white space between elements or objects as in
- ;; the original buffer, and call appropriate filters.
+ ;; Append the same white space between elements or objects
+ ;; as in the original buffer, and call appropriate filters.
(t
(let ((results
(org-export-filter-apply-functions
(if (memq type org-element-all-elements)
(concat (org-element-normalize-string results)
(make-string post-blank ?\n))
- (concat results (make-string post-blank ? ))))
+ (concat results (make-string post-blank ?\s))))
info)))
results)))
- (plist-get info :exported-data))))))
+ (plist-get info :exported-data)))))
(defun org-export-data-with-backend (data backend info)
"Convert DATA into BACKEND format.
(org-export-install-filters
(org-combine-plists
info (org-export-get-environment backend subtreep ext-plist))))
+ ;; Special case: provide original file name or buffer name as
+ ;; default value for :title property.
+ (unless (plist-get info :title)
+ (plist-put
+ info :title
+ (let ((file (plist-get info :input-file)))
+ (if file (file-name-sans-extension (file-name-nondirectory file))
+ (plist-get info :input-buffer)))))
;; Expand export-specific set of macros: {{{author}}},
;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done
;; once regular macros have been expanded, since document
((funcall predicate el info) (incf counter) nil)))
info 'first-match)))))
+;;;; For Special Blocks
+;;
+;; `org-export-raw-special-block-p' check if current special block is
+;; an "export block", i.e., a block whose contents should be inserted
+;; as-is in the output. This should generally be the first check to
+;; do when handling special blocks in the export back-end.
+
+(defun org-export-raw-special-block-p (element info &optional no-inheritance)
+ "Non-nil if ELEMENT is an export block relatively to current back-end.
+An export block is a special block whose contents should be
+included as-is in the final output. Such blocks are defined
+through :export-block property in `org-export-define-backend',
+which see."
+ (and (eq (org-element-type element) 'special-block)
+ (let ((type (org-element-property :type element))
+ (b (plist-get info :back-end)))
+ (if no-inheritance (member type (org-export-backend-blocks b))
+ (while (and b (not (member type (org-export-backend-blocks b))))
+ (setq b (org-export-get-backend (org-export-backend-parent b))))
+ b))))
-;;;; For Src-Blocks
+
+;;;; For Src Blocks
;;
;; `org-export-get-loc' counts number of code lines accumulated in
;; src-block or example-block elements with a "+n" switch until
;; `org-export-get-genealogy' returns the full genealogy of a given
;; element or object, from closest parent to full parse tree.
-(defsubst org-export-get-parent (blob)
- "Return BLOB parent or nil.
-BLOB is the element or object considered."
- (org-element-property :parent blob))
-
+;; defsubst org-export-get-parent must be defined before first use
(defun org-export-get-genealogy (blob)
"Return full genealogy relative to a given element or object.
projects / emacs.git / commitdiff