diff options
161 files changed, 3027 insertions, 2635 deletions
diff --git a/contrib/lisp/ob-csharp.el b/contrib/lisp/ob-csharp.el index 5ecac23..c4aa046 100644 --- a/contrib/lisp/ob-csharp.el +++ b/contrib/lisp/ob-csharp.el @@ -1,6 +1,6 @@ ;;; ob-csharp.el --- org-babel functions for csharp evaluation -;; Copyright (C) 2011-2015 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/contrib/lisp/ob-eukleides.el b/contrib/lisp/ob-eukleides.el index e4fc298..d3ad993 100644 --- a/contrib/lisp/ob-eukleides.el +++ b/contrib/lisp/ob-eukleides.el @@ -1,6 +1,6 @@ ;;; ob-eukleides.el --- Org-babel functions for eukleides evaluation -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Luis Anaya ;; Keywords: literate programming, reproducible research diff --git a/contrib/lisp/ob-mathomatic.el b/contrib/lisp/ob-mathomatic.el index fc08d9f..c62e181 100644 --- a/contrib/lisp/ob-mathomatic.el +++ b/contrib/lisp/ob-mathomatic.el @@ -1,6 +1,6 @@ ;;; ob-mathomatic.el --- Org-babel functions for mathomatic evaluation -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric S Fraga ;; Eric Schulte diff --git a/contrib/lisp/ob-tcl.el b/contrib/lisp/ob-tcl.el index 5373069..c76b138 100644 --- a/contrib/lisp/ob-tcl.el +++ b/contrib/lisp/ob-tcl.el @@ -1,6 +1,6 @@ ;;; ob-tcl.el --- Org-babel functions for tcl evaluation -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Dan Davison ;; Eric Schulte diff --git a/contrib/lisp/ob-vbnet.el b/contrib/lisp/ob-vbnet.el index 8b27494..b0f2688 100644 --- a/contrib/lisp/ob-vbnet.el +++ b/contrib/lisp/ob-vbnet.el @@ -1,6 +1,6 @@ ;;; ob-vbnet.el --- org-babel functions for VB.Net evaluation -;; Copyright (C) 2011-2015 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: thomas "at" friendlyvillagers.com based on ob-java.el by Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index 587aa67..c5b521a 100644 --- a/contrib/lisp/org-bibtex-extras.el +++ b/contrib/lisp/org-bibtex-extras.el @@ -1,6 +1,6 @@ ;;; org-bibtex-extras --- extras for working with org-bibtex entries -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte <eric dot schulte at gmx dot com> ;; Keywords: outlines, hypermedia, bibtex, d3 diff --git a/contrib/lisp/org-bookmark.el b/contrib/lisp/org-bookmark.el index f042467..04a473b 100644 --- a/contrib/lisp/org-bookmark.el +++ b/contrib/lisp/org-bookmark.el @@ -1,5 +1,5 @@ ;;; org-bookmark.el - Support for links to bookmark -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Author: Tokuya Kameshima <kames AT fa2.so-net.ne.jp> ;; Version: 1.0 diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el index 3e2b3c4..10ec0cb 100644 --- a/contrib/lisp/org-collector.el +++ b/contrib/lisp/org-collector.el @@ -1,6 +1,6 @@ ;;; org-collector --- collect properties into tables -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp, experimentation, diff --git a/contrib/lisp/org-contribdir.el b/contrib/lisp/org-contribdir.el index d0bd951..4ad3116 100644 --- a/contrib/lisp/org-contribdir.el +++ b/contrib/lisp/org-contribdir.el @@ -1,5 +1,5 @@ ;;; org-contribdir.el --- Mark the location of the contrib directory -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-depend.el b/contrib/lisp/org-depend.el index 5e49b6c..b6f3d27 100644 --- a/contrib/lisp/org-depend.el +++ b/contrib/lisp/org-depend.el @@ -1,5 +1,5 @@ ;;; org-depend.el --- TODO dependencies for Org-mode -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index a78b806..fb578ab 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -1455,7 +1455,7 @@ How well did you do? %s" ;; (save-excursion ;; (org-map-entries ;; (lambda () -;; (when (and (not (outline-invisible-p)) +;; (when (and (not (org-invisible-p)) ;; (> (org-current-level) drill-entry-level)) ;; (setq drill-heading (org-get-heading t)) ;; (unless (and (= (org-current-level) (1+ drill-entry-level)) @@ -1480,7 +1480,7 @@ the current topic." (save-excursion (org-map-entries (lambda () - (when (and (not (outline-invisible-p)) + (when (and (not (org-invisible-p)) (> (org-current-level) drill-entry-level)) (when (or (/= (org-current-level) (1+ drill-entry-level)) (funcall test)) diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el index 8d179fc..a07084c 100644 --- a/contrib/lisp/org-effectiveness.el +++ b/contrib/lisp/org-effectiveness.el @@ -1,6 +1,6 @@ ;;; org-effectiveness.el --- Measuring the personal effectiveness -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: David Arroyo Menéndez <davidam@es.gnu.org> ;; Keywords: effectiveness, plot diff --git a/contrib/lisp/org-eldoc.el b/contrib/lisp/org-eldoc.el index 046918d..74dc69b 100644 --- a/contrib/lisp/org-eldoc.el +++ b/contrib/lisp/org-eldoc.el @@ -1,6 +1,6 @@ ;;; org-eldoc.el --- display org header and src block info using eldoc -;; Copyright (c) 2014-2016 Free Software Foundation, Inc. +;; Copyright (c) 2014-2017 Free Software Foundation, Inc. ;; Author: Łukasz Gruner <lukasz@gruner.lu> ;; Maintainer: Łukasz Gruner <lukasz@gruner.lu> diff --git a/contrib/lisp/org-elisp-symbol.el b/contrib/lisp/org-elisp-symbol.el index 7c98962..a089914 100644 --- a/contrib/lisp/org-elisp-symbol.el +++ b/contrib/lisp/org-elisp-symbol.el @@ -1,6 +1,6 @@ ;;; org-elisp-symbol.el --- Org links to emacs-lisp symbols ;; -;; Copyright 2007-2016 Free Software Foundation, Inc. +;; Copyright 2007-2017 Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry ;; Version: 0.2 diff --git a/contrib/lisp/org-eval-light.el b/contrib/lisp/org-eval-light.el index 1449b24..57ac290 100644 --- a/contrib/lisp/org-eval-light.el +++ b/contrib/lisp/org-eval-light.el @@ -1,6 +1,6 @@ ;;; org-eval-light.el --- Display result of evaluating code in various languages (light) -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org>, ;; Eric Schulte <schulte dot eric at gmail dot com> diff --git a/contrib/lisp/org-eval.el b/contrib/lisp/org-eval.el index 92a4a19..ecea46a 100644 --- a/contrib/lisp/org-eval.el +++ b/contrib/lisp/org-eval.el @@ -1,5 +1,5 @@ ;;; org-eval.el --- Display result of evaluating code in various languages -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-expiry.el b/contrib/lisp/org-expiry.el index 45f59a2..2b8c050 100644 --- a/contrib/lisp/org-expiry.el +++ b/contrib/lisp/org-expiry.el @@ -1,6 +1,6 @@ ;;; org-expiry.el --- expiry mechanism for Org entries ;; -;; Copyright 2007-2016 Free Software Foundation, Inc. +;; Copyright 2007-2017 Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry ;; Version: 0.2 diff --git a/contrib/lisp/org-git-link.el b/contrib/lisp/org-git-link.el index 9d3ff32..0028daf 100644 --- a/contrib/lisp/org-git-link.el +++ b/contrib/lisp/org-git-link.el @@ -73,8 +73,8 @@ (defun org-gitbare-open (str) (let* ((strlist (org-git-split-string str)) - (gitdir (first strlist)) - (object (second strlist))) + (gitdir (nth 0 strlist)) + (object (nth 1 strlist))) (org-git-open-file-internal gitdir object))) @@ -96,14 +96,18 @@ (defun org-git-open (str) (let* ((strlist (org-git-split-string str)) - (filepath (first strlist)) - (commit (second strlist)) - (line (third strlist)) + (filepath (nth 0 strlist)) + (commit (nth 1 strlist)) + (line (nth 2 strlist)) (dirlist (org-git-find-gitdir (file-truename filepath))) - (gitdir (first dirlist)) - (relpath (second dirlist))) + (gitdir (nth 0 dirlist)) + (relpath (nth 1 dirlist))) (org-git-open-file-internal gitdir (concat commit ":" relpath)) - (when line (goto-line (string-to-int line))))) + (when line + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- (string-to-number line))))))) ;; Utility functions (file names etc) @@ -122,15 +126,15 @@ the path. Example: (org-git-find-gitdir \"~/gitrepos/foo/bar.txt\") returns '(\"/home/user/gitrepos/.git\" \"foo/bar.txt\"). When not in a git repository, return nil." - (let ((dir (file-name-directory path)) + (let ((dir (expand-file-name (file-name-directory path))) (relpath (file-name-nondirectory path))) (catch 'toplevel (while (not (file-exists-p (expand-file-name ".git" dir))) (let ((dirlist (org-git-split-dirpath dir))) - (when (string= (second dirlist) "") ; at top level + (when (string= (nth 1 dirlist) "") ; at top level (throw 'toplevel nil)) - (setq dir (first dirlist) - relpath (concat (file-name-as-directory (second dirlist)) relpath)))) + (setq dir (nth 0 dirlist) + relpath (concat (file-name-as-directory (nth 1 dirlist)) relpath)))) (list (expand-file-name ".git" dir) relpath)))) @@ -174,7 +178,7 @@ than two double colons, str2 and/or str3 may be set the empty string." (defun org-git-create-git-link (file &optional line) "Create git link part to file at specific time" (interactive "FFile: ") - (let* ((gitdir (first (org-git-find-gitdir (file-truename file)))) + (let* ((gitdir (nth 0 (org-git-find-gitdir (file-truename file)))) (branchname (org-git-get-current-branch gitdir)) (timestring (format-time-string "%Y-%m-%d" (current-time)))) (concat "git:" file "::" (org-git-create-searchstring branchname timestring) diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el index 31b675e..9efa510 100644 --- a/contrib/lisp/org-index.el +++ b/contrib/lisp/org-index.el @@ -1,6 +1,6 @@ ;;; org-index.el --- A personal adaptive index for org -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Marc Ihm <org-index@2484.de> ;; Version: 5.1.3 diff --git a/contrib/lisp/org-interactive-query.el b/contrib/lisp/org-interactive-query.el index 928c801..147ddae 100644 --- a/contrib/lisp/org-interactive-query.el +++ b/contrib/lisp/org-interactive-query.el @@ -1,6 +1,6 @@ ;;; org-interactive-query.el --- Interactive modification of agenda query ;; -;; Copyright 2007-2016 Free Software Foundation, Inc. +;; Copyright 2007-2017 Free Software Foundation, Inc. ;; ;; Author: Christopher League <league at contrapunctus dot net> ;; Version: 1.0 diff --git a/contrib/lisp/org-learn.el b/contrib/lisp/org-learn.el index e47c8f8..db9580f 100644 --- a/contrib/lisp/org-learn.el +++ b/contrib/lisp/org-learn.el @@ -1,6 +1,6 @@ ;;; org-learn.el --- Implements SuperMemo's incremental learning algorithm -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el index dc1d797..2fad68f 100644 --- a/contrib/lisp/org-license.el +++ b/contrib/lisp/org-license.el @@ -1,6 +1,6 @@ ;;; org-license.el --- Add a license to your org files -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: David Arroyo Menéndez <davidam@es.gnu.org> ;; Keywords: licenses, creative commons diff --git a/contrib/lisp/org-link-edit.el b/contrib/lisp/org-link-edit.el index 431c934..000dd1c 100644 --- a/contrib/lisp/org-link-edit.el +++ b/contrib/lisp/org-link-edit.el @@ -1,12 +1,12 @@ ;;; org-link-edit.el --- Slurp and barf with Org links -*- lexical-binding: t; -*- -;; Copyright (C) 2015 Kyle Meyer <kyle@kyleam.com> +;; Copyright (C) 2015-2017 Kyle Meyer <kyle@kyleam.com> ;; Author: Kyle Meyer <kyle@kyleam.com> -;; URL: https://github.com/kyleam/org-link-edit +;; URL: https://gitlab.com/kyleam/org-link-edit ;; Keywords: convenience -;; Version: 1.0.1 -;; Package-Requires: ((cl-lib "0.5") (org "8.2")) +;; Version: 1.1.1 +;; Package-Requires: ((cl-lib "0.5") (org "8.2.10")) ;; 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 @@ -26,8 +26,8 @@ ;; Org Link Edit provides Paredit-inspired slurping and barfing ;; commands for Org link descriptions. ;; -;; There are four commands, all which operate when point is on an Org -;; link. +;; There are four slurp and barf commands, all which operate when +;; point is on an Org link. ;; ;; - org-link-edit-forward-slurp ;; - org-link-edit-backward-slurp @@ -53,6 +53,11 @@ ;; ("i" org-link-edit-backward-barf "backward barf") ;; ("q" nil "cancel"))) ;; +;; In addition to the slurp and barf commands, the command +;; `org-link-edit-transport-next-link' searches for the next (or +;; previous) link and moves it to point, using the word at point or +;; the selected region as the link's description. +;; ;; [1] https://github.com/abo-abo/hydra ;;; Code: @@ -61,7 +66,15 @@ (require 'org-element) (require 'cl-lib) -(defun org-link-edit--get-link-data () +(defun org-link-edit--on-link-p (&optional element) + (let ((el (or element (org-element-context)))) + ;; Don't use `org-element-lineage' because it isn't available + ;; until Org version 8.3. + (while (and el (not (memq (car el) '(link)))) + (setq el (org-element-property :parent el))) + (eq (car el) 'link))) + +(defun org-link-edit--link-data () "Return list with information about the link at point. The list includes - the position at the start of the link @@ -69,11 +82,7 @@ The list includes - the link text - the link description (nil when on a plain link)" (let ((el (org-element-context))) - ;; Don't use `org-element-lineage' because it isn't available - ;; until Org version 8.3. - (while (and el (not (memq (car el) '(link)))) - (setq el (org-element-property :parent el))) - (unless (eq (car el) 'link) + (unless (org-link-edit--on-link-p el) (user-error "Point is not on a link")) (save-excursion (goto-char (org-element-property :begin el)) @@ -84,7 +93,8 @@ The list includes ((looking-at org-bracket-link-regexp) (list (match-beginning 0) (match-end 0) - (org-link-unescape (match-string-no-properties 1)) + (save-match-data + (org-link-unescape (match-string-no-properties 1))) (or (and (match-end 3) (match-string-no-properties 3)) ""))) @@ -148,7 +158,7 @@ If N is negative, slurp leading blobs instead of trailing blobs." ((< n 0) (org-link-edit-backward-slurp (- n))) (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) (goto-char (save-excursion (goto-char end) (or (org-link-edit--forward-blob n 'no-punctuation) @@ -190,7 +200,7 @@ If N is negative, slurp trailing blobs instead of leading blobs." ((< n 0) (org-link-edit-forward-slurp (- n))) (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) (goto-char (save-excursion (goto-char beg) (or (org-link-edit--forward-blob (- n)) @@ -266,20 +276,17 @@ If N is negative, barf leading blobs instead of trailing blobs." ((< n 0) (org-link-edit-backward-barf (- n))) (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) (when (= (length desc) 0) (user-error "Link has no description")) (pcase-let ((`(,new-desc . ,barfed) (org-link-edit--split-last-blobs desc n))) (unless new-desc (user-error "Not enough blobs in description")) + (goto-char beg) (delete-region beg end) (insert (org-make-link-string link new-desc)) - (if (string= new-desc "") - ;; Two brackets are dropped when an empty description is - ;; passed to `org-make-link-string'. - (progn (goto-char (- end (+ 2 (length desc)))) - (setq barfed (concat " " barfed))) - (goto-char (- end (- (length desc) (length new-desc))))) + (when (string= new-desc "") + (setq barfed (concat " " barfed))) (insert barfed) (goto-char beg) barfed))))) @@ -308,20 +315,76 @@ If N is negative, barf trailing blobs instead of leading blobs." ((< n 0) (org-link-edit-forward-barf (- n))) (t - (cl-multiple-value-bind (beg end link desc) (org-link-edit--get-link-data) + (cl-multiple-value-bind (beg end link desc) (org-link-edit--link-data) (when (= (length desc) 0) (user-error "Link has no description")) (pcase-let ((`(,barfed . ,new-desc) (org-link-edit--split-first-blobs desc n))) (unless new-desc (user-error "Not enough blobs in description")) + (goto-char beg) (delete-region beg end) (insert (org-make-link-string link new-desc)) (when (string= new-desc "") (setq barfed (concat barfed " "))) (goto-char beg) (insert barfed) - (goto-char (+ beg (length barfed))) barfed))))) +(defun org-link-edit--next-link-data (&optional previous) + (save-excursion + (if (funcall (if previous #'re-search-backward #'re-search-forward) + org-any-link-re nil t) + (org-link-edit--link-data) + (user-error "No %s link found" (if previous "previous" "next"))))) + +;;;###autoload +(defun org-link-edit-transport-next-link (&optional previous beg end) + "Move the next link to point. + +If the region is active, use the selected text as the link's +description. Otherwise, use the word at point. + +With prefix argument PREVIOUS, move the previous link instead of +the next link. + +Non-interactively, use the text between BEG and END as the +description, moving the next (or previous) link relative BEG and +END." + (interactive (cons current-prefix-arg + (and (use-region-p) + (list (region-beginning) (region-end))))) + (let ((pt (point)) + (desc-bounds (cond + ((and beg end) + (cons (progn (goto-char beg) + (point-marker)) + (progn (goto-char end) + (point-marker)))) + ((not (looking-at-p "\\s-")) + (progn (skip-syntax-backward "w") + (let ((beg (point-marker))) + (skip-syntax-forward "w") + (cons beg (point-marker)))))))) + (when (or (and desc-bounds + (or (progn (goto-char (car desc-bounds)) + (org-link-edit--on-link-p)) + (progn (goto-char (cdr desc-bounds)) + (org-link-edit--on-link-p)))) + (progn (goto-char pt) + (org-link-edit--on-link-p))) + (user-error "Cannot transport next link with point on a link")) + (goto-char (or (car desc-bounds) pt)) + (cl-multiple-value-bind (link-beg link-end link orig-desc) + (org-link-edit--next-link-data previous) + (unless (or (not desc-bounds) (= (length orig-desc) 0)) + (user-error "Link already has a description")) + (delete-region link-beg link-end) + (insert (org-make-link-string + link + (if desc-bounds + (delete-and-extract-region (car desc-bounds) + (cdr desc-bounds)) + orig-desc)))))) + (provide 'org-link-edit) ;;; org-link-edit.el ends here diff --git a/contrib/lisp/org-mac-link.el b/contrib/lisp/org-mac-link.el index ae2def3..7f4af30 100644 --- a/contrib/lisp/org-mac-link.el +++ b/contrib/lisp/org-mac-link.el @@ -1,6 +1,6 @@ ;;; org-mac-link.el --- Insert org-mode links to items selected in various Mac apps ;; -;; Copyright (c) 2010-2016 Free Software Foundation, Inc. +;; Copyright (c) 2010-2017 Free Software Foundation, Inc. ;; ;; Author: Anthony Lander <anthony.lander@gmail.com> ;; John Wiegley <johnw@gnu.org> diff --git a/contrib/lisp/org-mew.el b/contrib/lisp/org-mew.el index 2c2bdcc..6dbc67c 100644 --- a/contrib/lisp/org-mew.el +++ b/contrib/lisp/org-mew.el @@ -1,6 +1,6 @@ ;;; org-mew.el --- Support for links to Mew messages from within Org-mode -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-notify.el b/contrib/lisp/org-notify.el index d0acdec..1a1d557 100644 --- a/contrib/lisp/org-notify.el +++ b/contrib/lisp/org-notify.el @@ -1,6 +1,6 @@ ;;; org-notify.el --- Notifications for Org-mode -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Peter Münster <pmrb@free.fr> ;; Keywords: notification, todo-list, alarm, reminder, pop-up diff --git a/contrib/lisp/org-screenshot.el b/contrib/lisp/org-screenshot.el index 3716020..1cf6911 100644 --- a/contrib/lisp/org-screenshot.el +++ b/contrib/lisp/org-screenshot.el @@ -1,6 +1,6 @@ ;;; org-screenshot.el --- Take and manage screenshots in Org-mode files ;; -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Max Mikhanosha <max@openchat.com> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-sudoku.el b/contrib/lisp/org-sudoku.el index c6a64e1..baa9fcd 100644 --- a/contrib/lisp/org-sudoku.el +++ b/contrib/lisp/org-sudoku.el @@ -1,6 +1,6 @@ ;;; org-sudoku.el --- Greate and solve SUDOKU games in Org tables -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp, games diff --git a/contrib/lisp/org-toc.el b/contrib/lisp/org-toc.el index a692d85..1c14a4f 100644 --- a/contrib/lisp/org-toc.el +++ b/contrib/lisp/org-toc.el @@ -1,6 +1,6 @@ ;;; org-toc.el --- Table of contents for Org-mode buffer -;; Copyright 2007-2016 Free Software Foundation, Inc. +;; Copyright 2007-2017 Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry <bzg@gnu.org> ;; Keywords: Org table of contents @@ -354,7 +354,7 @@ If DELETE is non-nil, delete other windows when in the Org buffer." (defun org-toc-quit () "Quit the current Org TOC buffer." (interactive) - (kill-this-buffer) + (kill-buffer) (other-window 1) (delete-other-windows)) diff --git a/contrib/lisp/org-track.el b/contrib/lisp/org-track.el index 50f10cd..36724de 100644 --- a/contrib/lisp/org-track.el +++ b/contrib/lisp/org-track.el @@ -1,6 +1,6 @@ ;;; org-track.el --- Track the most recent Org-mode version available. ;; -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Bastien Guerry <bzg@gnu.org> ;; Eric S Fraga <e.fraga at ucl.ac dot uk> diff --git a/contrib/lisp/org-vm.el b/contrib/lisp/org-vm.el index 070d2f8..4deca8f 100644 --- a/contrib/lisp/org-vm.el +++ b/contrib/lisp/org-vm.el @@ -1,6 +1,6 @@ ;;; org-vm.el --- Support for links to VM messages from within Org-mode -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el index 02c170d..35242db 100644 --- a/contrib/lisp/org-wikinodes.el +++ b/contrib/lisp/org-wikinodes.el @@ -1,6 +1,6 @@ ;;; org-wikinodes.el --- Wiki-like CamelCase links to outline nodes -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -252,7 +252,7 @@ If there is no such wiki target, return nil." (defvar target-alist) (defvar last-section-target) (defvar org-export-target-aliases) -(defun org-wikinodes-set-wiki-targets-during-export () +(defun org-wikinodes-set-wiki-targets-during-export (_) (let ((line (buffer-substring (point-at-bol) (point-at-eol))) (case-fold-search nil) wtarget a) @@ -268,9 +268,8 @@ If there is no such wiki target, return nil." (car org-export-target-aliases)))) (push (caar target-alist) (cdr a))))) -(defun org-wikinodes-process-links-for-export () +(defun org-wikinodes-process-links-for-export (_) "Process Wiki links in the export preprocess buffer. - Try to find target matches in the wiki scope and replace CamelCase words with working links." (let ((re org-wikinodes-camel-regexp) @@ -289,7 +288,7 @@ with working links." (cond ((org-find-exact-headline-in-buffer link (current-buffer)) ;; Found in current buffer - (insert (format "[[#%s][%s]]" link link))) + (insert (format "[[*%s][%s]]" link link))) ((eq org-wikinodes-scope 'file) ;; No match in file, and other files are not allowed (insert (format "%s" link))) @@ -305,19 +304,18 @@ with working links." (add-hook 'org-ctrl-c-ctrl-c-hook 'org-wikinodes-clear-cache-when-on-target) ;; Make Wiki haeding create additional link names for headlines -(add-hook 'org-export-define-heading-targets-headline-hook +(add-hook 'org-export-before-parsing-hook 'org-wikinodes-set-wiki-targets-during-export) ;; Turn Wiki links into links the exporter will treat correctly -(add-hook 'org-export-preprocess-after-radio-targets-hook +(add-hook 'org-export-before-parsing-hook 'org-wikinodes-process-links-for-export) ;; Activate CamelCase words as part of Org mode font lock (defun org-wikinodes-add-to-font-lock-keywords () "Add wikinode CamelCase highlighting to `org-font-lock-extra-keywords'." - (let ((m (member '(org-activate-plain-links (0 'org-link t)) - org-font-lock-extra-keywords))) + (let ((m (member '(org-activate-links) org-font-lock-extra-keywords))) (if m (push '(org-wikinodes-activate-links) (cdr m)) (message "Failed to add wikinodes to `org-font-lock-extra-keywords'.")))) diff --git a/contrib/lisp/org-wl.el b/contrib/lisp/org-wl.el index 01eee13..4f74d47 100644 --- a/contrib/lisp/org-wl.el +++ b/contrib/lisp/org-wl.el @@ -1,6 +1,6 @@ ;;; org-wl.el --- Support for links to Wanderlust messages from within Org-mode -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Tokuya Kameshima <kames at fa2 dot so-net dot ne dot jp> ;; David Maus <dmaus at ictsoc dot de> diff --git a/contrib/lisp/orgtbl-sqlinsert.el b/contrib/lisp/orgtbl-sqlinsert.el index c8a39af..8fba18f 100644 --- a/contrib/lisp/orgtbl-sqlinsert.el +++ b/contrib/lisp/orgtbl-sqlinsert.el @@ -1,6 +1,6 @@ ;;; orgtbl-sqlinsert.el --- orgtbl to SQL insert statements. -;; Copyright (C) 2008-2016 Free Software Foundation +;; Copyright (C) 2008-2017 Free Software Foundation ;; Author: Jason Riedy <jason@acm.org> ;; Keywords: org, tables, sql diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el index 56dec38..fb34a5e 100644 --- a/contrib/lisp/ox-bibtex.el +++ b/contrib/lisp/ox-bibtex.el @@ -235,7 +235,7 @@ Return new parse tree." ;; Update `org-bibtex-html-entries-alist'. (goto-char (point-min)) (while (re-search-forward - "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\(\\w+\\)" nil t) + "a name=\"\\([-_a-zA-Z0-9:]+\\)\">\\([^<]+\\)" nil t) (push (cons (match-string 1) (match-string 2)) org-bibtex-html-entries-alist))) ;; Open produced HTML file, wrap references within a block and diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el index 48bc5ea..9de6ce7 100644 --- a/contrib/lisp/ox-confluence.el +++ b/contrib/lisp/ox-confluence.el @@ -56,6 +56,7 @@ (table-cell . org-confluence-table-cell) (table-row . org-confluence-table-row) (template . org-confluence-template) + (timestamp . org-confluence-timestamp) (underline . org-confluence-underline))) (defcustom org-confluence-lang-alist @@ -87,14 +88,19 @@ (format "\{\{%s\}\}" contents)) (defun org-confluence-headline (headline contents info) - (let ((low-level-rank (org-export-low-level-p headline info)) - (text (org-export-data (org-element-property :title headline) - info)) - (level (org-export-get-relative-level headline info))) + (let* ((low-level-rank (org-export-low-level-p headline info)) + (text (org-export-data (org-element-property :title headline) + info)) + (todo (org-export-data (org-element-property :todo-keyword headline) + info)) + (level (org-export-get-relative-level headline info)) + (todo-text (if (or (not (plist-get info :with-todo-keywords)) + (string= todo "")) + "" + (format "*{{%s}}* " todo)))) ;; Else: Standard headline. - (format "h%s. %s\n%s" level text - (if (org-string-nw-p contents) contents - "")))) + (format "h%s. %s%s\n%s" level todo-text text + (if (org-string-nw-p contents) contents "")))) (defun org-confluence-link (link desc info) (let ((raw-link (org-element-property :raw-link link))) @@ -142,15 +148,22 @@ a communication channel." (defun org-confluence-table-cell (table-cell contents info) (let ((table-row (org-export-get-parent table-cell))) - (concat - (when (org-export-table-row-starts-header-p table-row info) - "|") - contents "|"))) + (concat (and (org-export-table-row-starts-header-p table-row info) "|") + (if (= (length contents) 0) " " contents) + "|"))) (defun org-confluence-template (contents info) (let ((depth (plist-get info :with-toc))) (concat (when depth "\{toc\}\n\n") contents))) +(defun org-confluence-timestamp (timestamp _contents _info) + "Transcode a TIMESTAMP object from Org to Confluence. +CONTENTS and INFO are ignored." + (let ((translated (org-timestamp-translate timestamp))) + (if (string-prefix-p "[" translated) + (concat "(" (substring translated 1 -1) ")") + translated))) + (defun org-confluence-underline (underline contents info) (format "+%s+" contents)) diff --git a/contrib/lisp/ox-extra.el b/contrib/lisp/ox-extra.el index 85dae47..9cd6980 100644 --- a/contrib/lisp/ox-extra.el +++ b/contrib/lisp/ox-extra.el @@ -56,7 +56,7 @@ ;;; Code: (require 'ox) -(eval-when-compile (require 'cl)) +(require 'cl-lib) (defun org-latex-header-blocks-filter (backend) (when (org-export-derived-backend-p backend 'latex) @@ -72,8 +72,10 @@ (org-element-property :post-affiliated block))))))) (mapc (lambda (pos) (goto-char (nth 2 pos)) - (destructuring-bind + (cl-destructuring-bind (beg end &rest ignore) + ;; FIXME: `org-edit-src-find-region-and-lang' was + ;; removed in 9c06f8cce (2014-11-11). (org-edit-src-find-region-and-lang) (let ((contents-lines (split-string (buffer-substring-no-properties beg end) @@ -150,8 +152,27 @@ parent." (org-element-contents object))) (org-element-extract-element object))) info nil) + (org-extra--merge-sections data backend info) data) +(defun org-extra--merge-sections (data _backend info) + (org-element-map data 'headline + (lambda (hl) + (let ((sections + (cl-loop + for el in (org-element-map (org-element-contents hl) + '(headline section) #'identity info) + until (eq (org-element-type el) 'headline) + collect el))) + (when (and sections + (> (length sections) 1)) + (apply #'org-element-adopt-elements + (car sections) + (cl-mapcan (lambda (s) (org-element-contents s)) + (cdr sections))) + (mapc #'org-element-extract-element (cdr sections))))) + info)) + (defconst ox-extras '((latex-header-blocks org-latex-header-blocks-filter org-export-before-parsing-hook) (ignore-headlines org-export-ignore-headlines org-export-filter-parse-tree-functions)) diff --git a/contrib/lisp/ox-freemind.el b/contrib/lisp/ox-freemind.el index 85323a2..a2bf129 100644 --- a/contrib/lisp/ox-freemind.el +++ b/contrib/lisp/ox-freemind.el @@ -1,6 +1,6 @@ ;;; ox-freemind.el --- Freemind Mindmap Back-End for Org Export Engine -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Jambunathan K <kjambunathan at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/contrib/lisp/ox-groff.el b/contrib/lisp/ox-groff.el index c83d44d..555a89d 100644 --- a/contrib/lisp/ox-groff.el +++ b/contrib/lisp/ox-groff.el @@ -1,6 +1,6 @@ ;;; ox-groff.el --- Groff Back-End for Org Export Engine -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> ;; Author: Luis R Anaya <papoanaya aroba hot mail punto com> @@ -823,9 +823,7 @@ information." (concat (format "\\fB%s\\fP " org-clock-string) (format org-groff-inactive-timestamp-format - (concat (org-translate-time - (org-element-property :raw-value - (org-element-property :value clock))) + (concat (org-timestamp-translate (org-element-property :value clock)) (let ((time (org-element-property :duration clock))) (and time (format " (%s)" time))))))) @@ -1409,22 +1407,19 @@ information." (concat (format "\\fR %s \\fP" org-closed-string) (format org-groff-inactive-timestamp-format - (org-translate-time - (org-element-property :raw-value closed)))))) + (org-timestamp-translate closed))))) (let ((deadline (org-element-property :deadline planning))) (when deadline (concat (format "\\fB %s \\fP" org-deadline-string) (format org-groff-active-timestamp-format - (org-translate-time - (org-element-property :raw-value deadline)))))) + (org-timestamp-translate deadline))))) (let ((scheduled (org-element-property :scheduled planning))) (when scheduled (concat (format "\\fR %s \\fP" org-scheduled-string) (format org-groff-active-timestamp-format - (org-translate-time - (org-element-property :raw-value scheduled)))))))) + (org-timestamp-translate scheduled))))))) "") "")) diff --git a/contrib/lisp/ox-koma-letter.el b/contrib/lisp/ox-koma-letter.el index 801ab7d..37da54c 100644 --- a/contrib/lisp/ox-koma-letter.el +++ b/contrib/lisp/ox-koma-letter.el @@ -1,6 +1,6 @@ ;;; ox-koma-letter.el --- KOMA Scrlttr2 Back-End for Org Export Engine -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou AT gmail DOT com> ;; Alan Schmitt <alan.schmitt AT polytechnique DOT org> @@ -631,7 +631,7 @@ holding export options." ;; LaTeX compiler (org-latex--insert-compiler info) ;; Document class and packages. - (org-latex--make-preamble info) + (org-latex-make-preamble info) ;; Settings. They can come from three locations, in increasing ;; order of precedence: global variables, LCO files and in-buffer ;; settings. Thus, we first insert settings coming from global diff --git a/contrib/lisp/ox-s5.el b/contrib/lisp/ox-s5.el index 503bfd0..8f95010 100644 --- a/contrib/lisp/ox-s5.el +++ b/contrib/lisp/ox-s5.el @@ -304,13 +304,15 @@ holding export options." "Return complete document string after HTML conversion. CONTENTS is the transcoded contents string. INFO is a plist holding export options." - (let ((org-html-divs - (if (equal (plist-get info :html-container) "li") - (append '((content "ol" "content")) org-s5--divs) - org-s5--divs)) - (info (plist-put + (let ((info (plist-put + (plist-put (plist-put info :html-preamble (plist-get info :s5-preamble)) - :html-postamble (plist-get info :s5-postamble)))) + :html-postamble + (plist-get info :s5-postamble)) + :html-divs + (if (equal "li" (plist-get info :html-container)) + (cons '(content "ol" "content") org-s5--divs) + org-s5--divs)))) (mapconcat 'identity (list diff --git a/contrib/lisp/ox-taskjuggler.el b/contrib/lisp/ox-taskjuggler.el index 133d8a3..d856878 100644 --- a/contrib/lisp/ox-taskjuggler.el +++ b/contrib/lisp/ox-taskjuggler.el @@ -1,6 +1,6 @@ ;;; ox-taskjuggler.el --- TaskJuggler Back-End for Org Export Engine ;; -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; ;; Emacs Lisp Archive Entry ;; Filename: ox-taskjuggler.el diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index dd332a4..8c21d07 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -3,7 +3,7 @@ ORG NEWS -- history of user-visible changes. -*- org -*- #+LINK: doc http://orgmode.org/worg/doc.html#%s #+LINK: git http://orgmode.org/cgit.cgi/org-mode.git/commit/?id=%s -Copyright (C) 2012-2016 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. See the end of the file for license conditions. Please send Org bug reports to mailto:emacs-orgmode@gnu.org. diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 0bd911e..2bdda68 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -1,6 +1,6 @@ ;;; ob-C.el --- Babel Functions for C and Similar Languages -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Thierry Banel @@ -125,7 +125,8 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (pcase org-babel-c-variant (`c ".c") (`cpp ".cpp") (`d ".d")))) (tmp-bin-file ;not used for D - (org-babel-temp-file "C-bin-" org-babel-exeext)) + (org-babel-process-file-name + (org-babel-temp-file "C-bin-" org-babel-exeext))) (cmdline (cdr (assq :cmdline params))) (cmdline (if cmdline (concat " " cmdline) "")) (flags (cdr (assq :flags params))) @@ -151,7 +152,7 @@ or `org-babel-execute:C++' or `org-babel-execute:D'." (pcase org-babel-c-variant (`c org-babel-C-compiler) (`cpp org-babel-C++-compiler)) - (org-babel-process-file-name tmp-bin-file) + tmp-bin-file flags (org-babel-process-file-name tmp-src-file) libs) @@ -278,12 +279,12 @@ its header arguments." (defun org-babel-prep-session:C (_session _params) "This function does nothing as C is a compiled language with no support for sessions" - (error "C is a compiled languages -- no support for sessions")) + (error "C is a compiled language -- no support for sessions")) (defun org-babel-load-session:C (_session _body _params) "This function does nothing as C is a compiled language with no support for sessions" - (error "C is a compiled languages -- no support for sessions")) + (error "C is a compiled language -- no support for sessions")) ;; helper functions diff --git a/lisp/ob-J.el b/lisp/ob-J.el index 572149b..eba4bc6 100644 --- a/lisp/ob-J.el +++ b/lisp/ob-J.el @@ -1,6 +1,6 @@ ;;; ob-J.el --- Babel Functions for J -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Oleh Krehel ;; Keywords: literate programming, reproducible research @@ -38,7 +38,7 @@ (defcustom org-babel-J-command "jconsole" "Command to call J." :group 'org-babel - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type 'string) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 2993b09..3accade 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -1,6 +1,6 @@ ;;; ob-R.el --- Babel Functions for R -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Dan Davison diff --git a/lisp/ob-abc.el b/lisp/ob-abc.el index 6872b1c..0ce503d 100644 --- a/lisp/ob-abc.el +++ b/lisp/ob-abc.el @@ -1,6 +1,6 @@ ;;; ob-abc.el --- Org Babel Functions for ABC -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: William Waites ;; Keywords: literate programming, music diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el index e69afc4..1dbf484 100644 --- a/lisp/ob-asymptote.el +++ b/lisp/ob-asymptote.el @@ -1,6 +1,6 @@ ;;; ob-asymptote.el --- Babel Functions for Asymptote -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el index 90cfe79..2db4eea 100644 --- a/lisp/ob-awk.el +++ b/lisp/ob-awk.el @@ -1,6 +1,6 @@ ;;; ob-awk.el --- Babel Functions for Awk -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el index 415cab1..d4b7260 100644 --- a/lisp/ob-calc.el +++ b/lisp/ob-calc.el @@ -1,6 +1,6 @@ ;;; ob-calc.el --- Babel Functions for Calc -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index 72ea77d..3956157 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -1,6 +1,6 @@ ;;; ob-clojure.el --- Babel Functions for Clojure -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Joel Boehland, Eric Schulte, Oleh Krehel ;; diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index dd696c2..cc60f4e 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -1,6 +1,6 @@ ;;; ob-comint.el --- Babel Functions for Interaction with Comint Buffers -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint diff --git a/lisp/ob-coq.el b/lisp/ob-coq.el index 7aea5a6..93d2b1f 100644 --- a/lisp/ob-coq.el +++ b/lisp/ob-coq.el @@ -1,6 +1,6 @@ ;;; ob-coq.el --- Babel Functions for Coq -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 7540ba2..c630b70 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1,6 +1,6 @@ ;;; ob-core.el --- Working with Code Blocks -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison @@ -175,7 +175,7 @@ This string must include a \"%s\" which will be replaced by the results." "Non-nil means show the time the code block was evaluated in the result hash." :group 'org-babel :type 'boolean - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :safe #'booleanp) @@ -1432,36 +1432,77 @@ specified in the properties of the current outline entry." (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. -ALTS is a cons of two character options where each option may be -either the numeric code of a single character or a list of -character alternatives. For example to split on balanced -instances of \"[ \t]:\" set ALTS to ((32 9) . 58)." - (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) - (matched (lambda (ch last) - (if (consp alts) - (and (funcall matches ch (cdr alts)) - (funcall matches last (car alts))) - (funcall matches ch alts)))) - (balance 0) (last 0) - quote partial lst) - (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: - (setq balance (+ balance - (cond ((or (equal 91 ch) (equal 40 ch)) 1) - ((or (equal 93 ch) (equal 41 ch)) -1) - (t 0)))) - (when (and (equal 34 ch) (not (equal 92 last))) - (setq quote (not quote))) - (setq partial (cons ch partial)) - (when (and (= balance 0) (not quote) (funcall matched ch last)) - (setq lst (cons (apply #'string (nreverse - (if (consp alts) - (cddr partial) - (cdr partial)))) - lst)) - (setq partial nil)) - (setq last ch)) - (string-to-list string)) - (nreverse (cons (apply #'string (nreverse partial)) lst)))) +ALTS is a character, or cons of two character options where each +option may be either the numeric code of a single character or +a list of character alternatives. For example, to split on +balanced instances of \"[ \t]:\", set ALTS to ((32 9) . 58)." + (with-temp-buffer + (insert string) + (goto-char (point-min)) + (let ((splitp (lambda (past next) + ;; Non-nil when there should be a split after NEXT + ;; character. PAST is the character before NEXT. + (pcase alts + (`(,(and first (pred consp)) . ,(and second (pred consp))) + (and (memq past first) (memq next second))) + (`(,first . ,(and second (pred consp))) + (and (eq past first) (memq next second))) + (`(,(and first (pred consp)) . ,second) + (and (memq past first) (eq next second))) + (`(,first . ,second) + (and (eq past first) (eq next second))) + ((pred (eq next)) t) + (_ nil)))) + (partial nil) + (result nil)) + (while (not (eobp)) + (cond + ((funcall splitp (char-before) (char-after)) + ;; There is a split after point. If ALTS is two-folds, + ;; remove last parsed character as it belongs to ALTS. + (when (consp alts) (pop partial)) + ;; Include elements parsed so far in RESULTS and flush + ;; partial parsing. + (when partial + (push (apply #'string (nreverse partial)) result) + (setq partial nil)) + (forward-char)) + ((memq (char-after) '(?\( ?\[)) + ;; Include everything between balanced brackets. + (let* ((origin (point)) + (after (char-after)) + (openings (list after))) + (forward-char) + (while (and openings (re-search-forward "[]()]" nil t)) + (pcase (char-before) + ((and match (or ?\[ ?\()) (push match openings)) + (?\] (when (eq ?\[ (car openings)) (pop openings))) + (_ (when (eq ?\( (car openings)) (pop openings))))) + (if (null openings) + (setq partial + (nconc (nreverse (string-to-list + (buffer-substring origin (point)))) + partial)) + ;; Un-balanced bracket. Backtrack. + (push after partial) + (goto-char (1+ origin))))) + ((and (eq ?\" (char-after)) (not (eq ?\\ (char-before)))) + ;; Include everything from current double quote to next + ;; non-escaped double quote. + (let ((origin (point))) + (if (re-search-forward "[^\\]\"" nil t) + (setq partial + (nconc (nreverse (string-to-list + (buffer-substring origin (point)))) + partial)) + ;; No closing double quote. Backtrack. + (push ?\" partial) + (forward-char)))) + (t (push (char-after) partial) + (forward-char)))) + ;; Add pending parsing and return result. + (when partial (push (apply #'string (nreverse partial)) result)) + (nreverse result)))) (defun org-babel-join-splits-near-ch (ch list) "Join splits where \"=\" is on either end of the split." @@ -2463,7 +2504,9 @@ file's directory then expand relative links." (funcall maybe-cap "#+begin_example") results-switches) (funcall maybe-cap "#+begin_example\n"))) - (if (markerp end) (goto-char end) (forward-char (- end beg))) + (let ((p (point))) + (if (markerp end) (goto-char end) (forward-char (- end beg))) + (org-escape-code-in-region p (point))) (insert (funcall maybe-cap "#+end_example\n"))))))))) (defun org-babel-update-block-body (new-body) @@ -2847,24 +2890,20 @@ Otherwise if CELL looks like lisp (meaning it starts with a lisp, otherwise return it unmodified as a string. Optional argument INHIBIT-LISP-EVAL inhibits lisp evaluation for situations in which is it not appropriate." - (if (and (stringp cell) (not (equal cell ""))) - (or (org-babel--string-to-number cell) - (if (and (not inhibit-lisp-eval) - (or (member (substring cell 0 1) '("(" "'" "`" "[")) - (string= cell "*this*"))) - (eval (read cell) t) - (if (string= (substring cell 0 1) "\"") - (read cell) - (progn (set-text-properties 0 (length cell) nil cell) cell)))) - cell)) + (cond ((not (org-string-nw-p cell)) cell) + ((org-babel--string-to-number cell)) + ((and (not inhibit-lisp-eval) + (or (memq (string-to-char cell) '(?\( ?' ?` ?\[)) + (string= cell "*this*"))) + (eval (read cell) t)) + ((eq (string-to-char cell) ?\") (read cell)) + (t (org-no-properties cell)))) (defun org-babel--string-to-number (string) "If STRING represents a number return its value. - Otherwise return nil." - (when (string-match "\\`-?[0-9]*\\.?[0-9]*\\'" string) - (string-to-number string))) -(define-obsolete-function-alias 'org-babel-number-p 'org-babel--string-to-number "Org 9.0") + (and (string-match-p "\\`-?[0-9]*\\.?[0-9]*\\'" string) + (string-to-number string))) (defun org-babel-import-elisp-from-file (file-name &optional separator) "Read the results located at FILE-NAME into an elisp table. @@ -2905,10 +2944,6 @@ can be specified as the REGEXP argument." (setq string (substring string 0 -1))) string)) -(defun org-babel-local-file-name (file) - "Return the local name component of FILE." - (or (file-remote-p file 'localname) file)) - (defun org-babel-process-file-name (name &optional no-quote-p) "Prepare NAME to be used in an external process. If NAME specifies a remote location, the remote portion of the diff --git a/lisp/ob-css.el b/lisp/ob-css.el index 5734373..4203b12 100644 --- a/lisp/ob-css.el +++ b/lisp/ob-css.el @@ -1,6 +1,6 @@ ;;; ob-css.el --- Babel Functions for CSS -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index 1fa96aa..89b5d24 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -1,6 +1,6 @@ ;;; ob-ditaa.el --- Babel Functions for ditaa -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el index 8cc1c74..81442bf 100644 --- a/lisp/ob-dot.el +++ b/lisp/ob-dot.el @@ -1,6 +1,6 @@ ;;; ob-dot.el --- Babel Functions for dot -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-ebnf.el b/lisp/ob-ebnf.el index 36f2c38..410570b 100644 --- a/lisp/ob-ebnf.el +++ b/lisp/ob-ebnf.el @@ -1,6 +1,6 @@ ;;; ob-ebnf.el --- Babel Functions for EBNF -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Michael Gauland ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index c42034d..c0bd12a 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -1,6 +1,6 @@ ;;; ob-emacs-lisp.el --- Babel Functions for Emacs-lisp Code -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-eval.el b/lisp/ob-eval.el index 4a368b7..324cf5f 100644 --- a/lisp/ob-eval.el +++ b/lisp/ob-eval.el @@ -1,6 +1,6 @@ ;;; ob-eval.el --- Babel Functions for External Code Evaluation -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, comint diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 6aebcd5..2556362 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -1,6 +1,6 @@ ;;; ob-exp.el --- Exportation of Babel Source Blocks -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison @@ -159,8 +159,24 @@ this template." (goto-char (point-min)) (while (re-search-forward regexp nil t) (unless (save-match-data (org-in-commented-heading-p)) - (let* ((element (save-match-data (org-element-context))) - (type (org-element-type element)) + (let* ((object? (match-end 1)) + (element (save-match-data + (if object? (org-element-context) + ;; No deep inspection if we're + ;; just looking for an element. + (org-element-at-point)))) + (type + (pcase (org-element-type element) + ;; Discard block elements if we're looking + ;; for inline objects. False results + ;; happen when, e.g., "call_" syntax is + ;; located within affiliated keywords: + ;; + ;; #+name: call_src + ;; #+begin_src ... + ((and (or `babel-call `src-block) (guard object?)) + nil) + (type type))) (begin (copy-marker (org-element-property :begin element))) (end @@ -323,7 +339,7 @@ defined for the code block may be used as a key and will be replaced with its value." :group 'org-babel :type 'string - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) (defun org-babel-exp-code (info type) diff --git a/lisp/ob-forth.el b/lisp/ob-forth.el index e487931..152cf72 100644 --- a/lisp/ob-forth.el +++ b/lisp/ob-forth.el @@ -1,6 +1,6 @@ ;;; ob-forth.el --- Babel Functions for Forth -*- lexical-binding: t; -*- -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, forth diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index 6241c65..d059245 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -1,6 +1,6 @@ ;;; ob-fortran.el --- Babel Functions for Fortran -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Authors: Sergey Litvinov ;; Eric Schulte diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index e91e05a..400823b 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -1,6 +1,6 @@ ;;; ob-gnuplot.el --- Babel Functions for Gnuplot -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research @@ -187,7 +187,7 @@ This function is called by `org-babel-execute-src-block'." script-file (if (member system-type '(cygwin windows-nt ms-dos)) t nil))))) - (message output)) + (message "%s" output)) (with-temp-buffer (insert (concat body "\n")) (gnuplot-mode) diff --git a/lisp/ob-groovy.el b/lisp/ob-groovy.el index 9578c70..69993c0 100644 --- a/lisp/ob-groovy.el +++ b/lisp/ob-groovy.el @@ -1,6 +1,6 @@ ;;; ob-groovy.el --- Babel Functions for Groovy -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Miro Bezjak ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index 5dcb516..ecce6dc 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -1,6 +1,6 @@ ;;; ob-haskell.el --- Babel Functions for Haskell -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-io.el b/lisp/ob-io.el index 186b1b2..5dd6110 100644 --- a/lisp/ob-io.el +++ b/lisp/ob-io.el @@ -1,6 +1,6 @@ ;;; ob-io.el --- Babel Functions for Io -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Andrzej Lichnerowicz ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-java.el b/lisp/ob-java.el index ccae020..7e72023 100644 --- a/lisp/ob-java.el +++ b/lisp/ob-java.el @@ -1,6 +1,6 @@ ;;; ob-java.el --- Babel Functions for Java -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-js.el b/lisp/ob-js.el index 0cd3b06..91be6b0 100644 --- a/lisp/ob-js.el +++ b/lisp/ob-js.el @@ -1,6 +1,6 @@ ;;; ob-js.el --- Babel Functions for Javascript -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, js diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index 318f549..f5fb910 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -1,6 +1,6 @@ ;;; ob-keys.el --- Key Bindings for Babel -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 8fc0493..763ffb1 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -1,6 +1,6 @@ ;;; ob-latex.el --- Babel Functions for LaTeX -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el index ee2ce0a..c02069e 100644 --- a/lisp/ob-ledger.el +++ b/lisp/ob-ledger.el @@ -1,6 +1,6 @@ ;;; ob-ledger.el --- Babel Functions for Ledger -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric S Fraga ;; Keywords: literate programming, reproducible research, accounting diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index 3d2e50f..37a7a6b 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -1,6 +1,6 @@ ;;; ob-lilypond.el --- Babel Functions for Lilypond -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Martyn Jago ;; Keywords: babel language, literate programming diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index da7e4f4..1e381d0 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -1,6 +1,6 @@ ;;; ob-lisp.el --- Babel Functions for Common Lisp -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Joel Boehland ;; Eric Schulte @@ -52,7 +52,7 @@ "The function to be called to evaluate code on the Lisp side. Valid values include `slime-eval' and `sly-eval'." :group 'org-babel - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type 'function) diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index 1c4123b..b6f50d3 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -1,6 +1,6 @@ ;;; ob-lob.el --- Functions Supporting the Library of Babel -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison diff --git a/lisp/ob-lua.el b/lisp/ob-lua.el index afb5c45..fa60b0e 100644 --- a/lisp/ob-lua.el +++ b/lisp/ob-lua.el @@ -1,6 +1,6 @@ ;;; ob-lua.el --- Org Babel functions for Lua evaluation -*- lexical-binding: t; -*- -;; Copyright (C) 2014, 2016 Free Software Foundation, Inc. +;; Copyright (C) 2014, 2016, 2017 Free Software Foundation, Inc. ;; Authors: Dieter Schoen ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-makefile.el b/lisp/ob-makefile.el index 69c6e51..2aa04fd 100644 --- a/lisp/ob-makefile.el +++ b/lisp/ob-makefile.el @@ -1,6 +1,6 @@ ;;; ob-makefile.el --- Babel Functions for Makefile -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Thomas S. Dye diff --git a/lisp/ob-matlab.el b/lisp/ob-matlab.el index 0d3909d..23cfa36 100644 --- a/lisp/ob-matlab.el +++ b/lisp/ob-matlab.el @@ -1,6 +1,6 @@ ;;; ob-matlab.el --- Babel support for Matlab -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el index 4d16156..0a4d835 100644 --- a/lisp/ob-maxima.el +++ b/lisp/ob-maxima.el @@ -1,6 +1,6 @@ ;;; ob-maxima.el --- Babel Functions for Maxima -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric S Fraga ;; Eric Schulte diff --git a/lisp/ob-mscgen.el b/lisp/ob-mscgen.el index f53b09f..5c9dccc 100644 --- a/lisp/ob-mscgen.el +++ b/lisp/ob-mscgen.el @@ -1,6 +1,6 @@ ;;; ob-msc.el --- Babel Functions for Mscgen -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Juan Pechiar ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-ocaml.el b/lisp/ob-ocaml.el index 4c9d295..7997ff0 100644 --- a/lisp/ob-ocaml.el +++ b/lisp/ob-ocaml.el @@ -1,6 +1,6 @@ ;;; ob-ocaml.el --- Babel Functions for Ocaml -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el index 09b4092..90735b1 100644 --- a/lisp/ob-octave.el +++ b/lisp/ob-octave.el @@ -1,6 +1,6 @@ ;;; ob-octave.el --- Babel Functions for Octave and Matlab -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Dan Davison ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-org.el b/lisp/ob-org.el index 580d2b0..5683b96 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -1,6 +1,6 @@ ;;; ob-org.el --- Babel Functions for Org Code Blocks -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index a1aadbb..62df8c5 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -1,6 +1,6 @@ ;;; ob-perl.el --- Babel Functions for Perl -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Dan Davison ;; Eric Schulte diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el index 348b1f6..f577381 100644 --- a/lisp/ob-picolisp.el +++ b/lisp/ob-picolisp.el @@ -1,6 +1,6 @@ ;;; ob-picolisp.el --- Babel Functions for Picolisp -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Authors: Thorsten Jolitz ;; Eric Schulte diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index 9ce65a9..e90021a 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -1,6 +1,6 @@ ;;; ob-plantuml.el --- Babel Functions for Plantuml -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Zhang Weize ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-processing.el b/lisp/ob-processing.el index e1801e2..a18a53c 100644 --- a/lisp/ob-processing.el +++ b/lisp/ob-processing.el @@ -1,6 +1,6 @@ ;;; ob-processing.el --- Babel functions for processing -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Jarmo Hurri (adapted from ob-asymptote.el written by Eric Schulte) ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 05f2dbb..302f8bd 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -1,6 +1,6 @@ ;;; ob-python.el --- Babel Functions for Python -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison @@ -73,15 +73,16 @@ This will typically be either `python' or `python-mode'." (defun org-babel-execute:python (body params) "Execute a block of Python code with Babel. This function is called by `org-babel-execute-src-block'." - (let* ((session (org-babel-python-initiate-session + (let* ((org-babel-python-command + (or (cdr (assq :python params)) + org-babel-python-command)) + (session (org-babel-python-initiate-session (cdr (assq :session params)))) (result-params (cdr (assq :result-params params))) (result-type (cdr (assq :result-type params))) (return-val (when (and (eq result-type 'value) (not session)) (cdr (assq :return params)))) (preamble (cdr (assq :preamble params))) - (org-babel-python-command - (or (cdr (assq :python params)) org-babel-python-command)) (full-body (org-babel-expand-body:generic (concat body (if return-val (format "\nreturn %s" return-val) "")) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index c109d89..f8b9ea4 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -1,6 +1,6 @@ ;;; ob-ref.el --- Babel Functions for Referencing External Data -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Dan Davison @@ -131,7 +131,7 @@ the variable." ;; if ref is indexed grab the indices -- beware nested indices (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) (let ((str (substring ref 0 (match-beginning 0)))) - (= (cl-count ?( str) (cl-count ?) str)))) + (= (cl-count ?\( str) (cl-count ?\) str)))) (setq index (match-string 1 ref)) (setq ref (substring ref 0 (match-beginning 0)))) ;; assign any arguments to pass to source block diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index 6415f35..d055783 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -1,6 +1,6 @@ ;;; ob-ruby.el --- Babel Functions for Ruby -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research @@ -42,6 +42,9 @@ (declare-function run-ruby "ext:inf-ruby" (&optional command name)) (declare-function xmp "ext:rcodetools" (&optional option)) +(defvar inf-ruby-default-implementation) +(defvar inf-ruby-implementations) + (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) @@ -150,12 +153,16 @@ If there is not a current inferior-process-buffer in SESSION then create one. Return the initialized session." (unless (string= session "none") (require 'inf-ruby) - (let ((session-buffer (save-window-excursion - (run-ruby nil session) (current-buffer)))) + (let* ((cmd (cdr (assoc inf-ruby-default-implementation + inf-ruby-implementations))) + (buffer (get-buffer (format "*%s*" session))) + (session-buffer (or buffer (save-window-excursion + (run-ruby cmd session) + (current-buffer))))) (if (org-babel-comint-buffer-livep session-buffer) (progn (sit-for .25) session-buffer) - (sit-for .5) - (org-babel-ruby-initiate-session session))))) + (sit-for .5) + (org-babel-ruby-initiate-session session))))) (defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" "String to indicate that evaluation has completed.") diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el index 53fb45e..a9a2a9f 100644 --- a/lisp/ob-sass.el +++ b/lisp/ob-sass.el @@ -1,6 +1,6 @@ ;;; ob-sass.el --- Babel Functions for the Sass CSS generation language -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el index 8cdf2c0..7d5f299 100644 --- a/lisp/ob-scala.el +++ b/lisp/ob-scala.el @@ -1,6 +1,6 @@ ;;; ob-scala.el --- Babel Functions for Scala -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Andrzej Lichnerowicz ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index c1d5462..cd8c386 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -1,6 +1,6 @@ ;;; ob-scheme.el --- Babel Functions for Scheme -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Michael Gauland diff --git a/lisp/ob-screen.el b/lisp/ob-screen.el index c4c9528..554f8c4 100644 --- a/lisp/ob-screen.el +++ b/lisp/ob-screen.el @@ -1,6 +1,6 @@ ;;; ob-screen.el --- Babel Support for Interactive Terminal -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Benjamin Andresen ;; Keywords: literate programming, interactive shell diff --git a/lisp/ob-sed.el b/lisp/ob-sed.el index dd8a17b..733c7e1 100644 --- a/lisp/ob-sed.el +++ b/lisp/ob-sed.el @@ -1,6 +1,6 @@ ;;; ob-sed.el --- Babel Functions for Sed Scripts -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Bjarte Johansen ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el index 74b6c7e..3787c26 100644 --- a/lisp/ob-shell.el +++ b/lisp/ob-shell.el @@ -1,6 +1,6 @@ ;;; ob-shell.el --- Babel Functions for Shell Evaluation -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research @@ -52,7 +52,12 @@ is modified outside the Customize interface." (body params) ,(format "Execute a block of %s commands with Babel." name) (let ((shell-file-name ,name)) - (org-babel-execute:shell body params)))))) + (org-babel-execute:shell body params)))) + (eval `(defalias ',(intern (concat "org-babel-variable-assignments:" name)) + 'org-babel-variable-assignments:shell + ,(format "Return list of %s statements assigning to the block's \ +variables." + name))))) (defcustom org-babel-shell-names '("sh" "bash" "csh" "ash" "dash" "ksh" "mksh" "posh") @@ -102,13 +107,14 @@ This function is called by `org-babel-execute-src-block'." (insert (org-babel-chomp body))) buffer))) -;; helper functions -(defun org-babel-variable-assignments:sh-generic + +;;; Helper functions +(defun org-babel--variable-assignments:sh-generic (varname values &optional sep hline) "Returns a list of statements declaring the values as a generic variable." (format "%s=%s" varname (org-babel-sh-var-to-sh values sep hline))) -(defun org-babel-variable-assignments:bash_array +(defun org-babel--variable-assignments:bash_array (varname values &optional sep hline) "Returns a list of statements declaring the values as a bash array." (format "unset %s\ndeclare -a %s=( %s )" @@ -118,7 +124,7 @@ This function is called by `org-babel-execute-src-block'." values " "))) -(defun org-babel-variable-assignments:bash_assoc +(defun org-babel--variable-assignments:bash_assoc (varname values &optional sep hline) "Returns a list of statements declaring the values as bash associative array." (format "unset %s\ndeclare -A %s\n%s" @@ -132,13 +138,15 @@ This function is called by `org-babel-execute-src-block'." values "\n"))) -(defun org-babel-variable-assignments:bash (varname values &optional sep hline) +(defun org-babel--variable-assignments:bash (varname values &optional sep hline) "Represents the parameters as useful Bash shell variables." - (if (listp values) - (if (and (listp (car values)) (= 1 (length (car values)))) - (org-babel-variable-assignments:bash_array varname values sep hline) - (org-babel-variable-assignments:bash_assoc varname values sep hline)) - (org-babel-variable-assignments:sh-generic varname values sep hline))) + (pcase values + (`((,_ ,_ . ,_) . ,_) ;two-dimensional array + (org-babel--variable-assignments:bash_assoc varname values sep hline)) + (`(,_ . ,_) ;simple list + (org-babel--variable-assignments:bash_array varname values sep hline)) + (_ ;scalar value + (org-babel--variable-assignments:sh-generic varname values sep hline)))) (defun org-babel-variable-assignments:shell (params) "Return list of shell statements assigning the block's variables." @@ -149,9 +157,9 @@ This function is called by `org-babel-execute-src-block'." (mapcar (lambda (pair) (if (string-suffix-p "bash" shell-file-name) - (org-babel-variable-assignments:bash + (org-babel--variable-assignments:bash (car pair) (cdr pair) sep hline) - (org-babel-variable-assignments:sh-generic + (org-babel--variable-assignments:sh-generic (car pair) (cdr pair) sep hline))) (org-babel--get-vars params)))) diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el index f502d43..6bf36c6 100644 --- a/lisp/ob-shen.el +++ b/lisp/ob-shen.el @@ -1,6 +1,6 @@ ;;; ob-shen.el --- Babel Functions for Shen -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research, shen diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index ec94c35..06477d3 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -1,6 +1,6 @@ ;;; ob-sql.el --- Babel Functions for SQL -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research @@ -117,14 +117,14 @@ SQL Server on Windows and Linux platform." " ")) (defun org-babel-sql-convert-standard-filename (file) - "Convert the file name to OS standard. + "Convert FILE to OS standard file name. If in Cygwin environment, uses Cygwin specific function to -convert the file name. Otherwise, uses Emacs' standard conversion -function." - (format "\"%s\"" - (if (fboundp 'cygwin-convert-file-name-to-windows) - (cygwin-convert-file-name-to-windows file) - (convert-standard-filename file)))) +convert the file name. In a Windows-NT environment, do nothing. +Otherwise, use Emacs' standard conversion function." + (cond ((fboundp 'cygwin-convert-file-name-to-windows) + (format "%S" (cygwin-convert-file-name-to-windows file))) + ((string= "windows-nt" system-type) file) + (t (format "%S" (convert-standard-filename file))))) (defun org-babel-execute:sql (body params) "Execute a block of Sql code with Babel. diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index 0d954a4..8094019 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -1,6 +1,6 @@ ;;; ob-sqlite.el --- Babel Functions for SQLite Databases -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-stan.el b/lisp/ob-stan.el index bf4e394..40dd0ef 100644 --- a/lisp/ob-stan.el +++ b/lisp/ob-stan.el @@ -1,6 +1,6 @@ ;;; ob-stan.el --- Babel Functions for Stan -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation, Inc. +;; Copyright (C) 2015-2017 Free Software Foundation, Inc. ;; Author: Kyle Meyer ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-table.el b/lisp/ob-table.el index efee5b7..4de8936 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -1,6 +1,6 @@ ;;; ob-table.el --- Support for Calling Babel Functions from Tables -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index a5e18a8..3b05332 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -1,6 +1,6 @@ ;;; ob-tangle.el --- Extract Source Code From Org Files -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Eric Schulte ;; Keywords: literate programming, reproducible research @@ -1,6 +1,6 @@ ;;; ob.el --- Working with Code Blocks in Org -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Authors: Eric Schulte ;; Keywords: literate programming, reproducible research diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index ce16473..f90dd53 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1,6 +1,6 @@ ;;; org-agenda.el --- Dynamic task and appointment lists for Org -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -469,8 +469,8 @@ match What to search for: settings A list of option settings, similar to that in a let form, so like this: ((opt1 val1) (opt2 val2) ...). The values will be evaluated at the moment of execution, so quote them when needed. -files A list of files file to write the produced agenda buffer to - with the command `org-store-agenda-views'. +files A list of files to write the produced agenda buffer to with + the command `org-store-agenda-views'. If a file name ends in \".html\", an HTML version of the buffer is written out. If it ends in \".ps\", a postscript version is produced. Otherwise, only the plain text is written to the file. @@ -1784,7 +1784,7 @@ When non-nil, this must be the number of minutes, e.g. 60 for one hour." (defcustom org-agenda-show-inherited-tags t "Non-nil means show inherited tags in each agenda line. -When this option is set to `always', it take precedences over +When this option is set to `always', it takes precedence over `org-agenda-use-tag-inheritance' and inherited tags are shown in every agenda. @@ -1945,7 +1945,7 @@ category, you can use: "When non-nil, switch to columns view right after creating the agenda." :group 'org-agenda-column-view :type 'boolean - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :safe #'booleanp) @@ -2131,13 +2131,12 @@ The following commands are available: ;; while letting `kill-all-local-variables' kill the rest (let ((save (buffer-local-variables))) (kill-all-local-variables) - (mapc 'make-local-variable org-agenda-local-vars) + (mapc #'make-local-variable org-agenda-local-vars) (dolist (elem save) - (let ((var (car elem)) - (val (cdr elem))) - (when (and val - (member var org-agenda-local-vars)) - (set var val))))) + (pcase elem + (`(,var . ,val) ;ignore unbound variables + (when (and val (memq var org-agenda-local-vars)) + (set var val)))))) (setq-local org-agenda-this-buffer-is-sticky t)) (org-agenda-sticky ;; Creating a sticky Agenda buffer for the first time @@ -2164,9 +2163,9 @@ The following commands are available: (add-hook 'pre-command-hook 'org-unhighlight nil 'local) ;; Make sure properties are removed when copying text (add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (substring-no-properties (funcall fun start end delete))) - nil t) + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete))) + 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)) @@ -2358,7 +2357,7 @@ The following commands are available: ["Fortnight View" org-agenda-fortnight-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (eq org-agenda-current-span 'fortnight) - :keys "v f"] + :keys "v t"] ["Month View" org-agenda-month-view :active (org-agenda-check-type nil 'agenda) :style radio :selected (eq org-agenda-current-span 'month) @@ -2941,7 +2940,7 @@ L Timeline for current buffer # List stuck projects (!=configure) type (nth 2 entry) match (nth 3 entry)) (if (> (length key) 1) - (add-to-list 'prefixes (string-to-char key)) + (cl-pushnew (string-to-char key) prefixes :test #'equal) (setq line (format "%-4s%-14s" @@ -3471,7 +3470,7 @@ removed from the entry content. Currently only `planning' is allowed here." (insert txt) (when org-agenda-add-entry-text-descriptive-links (goto-char (point-min)) - (while (org-activate-bracket-links (point-max)) + (while (org-activate-links (point-max)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-link)))) (goto-char (point-min)) @@ -3713,11 +3712,7 @@ FILTER-ALIST is an alist of filters we need to apply when (let ((inhibit-read-only t)) (goto-char (point-min)) (save-excursion - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (save-excursion - (while (org-activate-plain-links (point-max)) + (while (org-activate-links (point-max)) (add-text-properties (match-beginning 0) (match-end 0) '(face org-link)))) (unless (eq org-agenda-remove-tags t) @@ -4201,13 +4196,14 @@ items if they have an hour specification like [h]h:mm." (catch 'exit (setq org-agenda-buffer-name (or org-agenda-buffer-tmp-name + (and org-agenda-doing-sticky-redo org-agenda-buffer-name) (if org-agenda-sticky (cond ((and org-keys (stringp org-match)) (format "*Org Agenda(%s:%s)*" org-keys org-match)) (org-keys (format "*Org Agenda(%s)*" org-keys)) (t "*Org Agenda(a)*"))) - org-agenda-buffer-name)) + "*Org Agenda*")) (org-agenda-prepare "Day/Week") (setq start-day (or start-day org-agenda-start-day)) (if (stringp start-day) @@ -4822,6 +4818,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." (let* ((org-tags-match-list-sublevels org-tags-match-list-sublevels) (completion-ignore-case t) + (org--matcher-tags-todo-only todo-only) rtn rtnall files file pos matcher buffer) (when (and (stringp match) (not (string-match "\\S-" match))) @@ -4836,8 +4833,7 @@ The prefix arg TODO-ONLY limits the search to TODO entries." ;; Prepare agendas (and `org-tag-alist-for-agenda') before ;; expanding tags within `org-make-tags-matcher' (org-agenda-prepare (concat "TAGS " match)) - (setq org--matcher-tags-todo-only todo-only - matcher (org-make-tags-matcher match) + (setq matcher (org-make-tags-matcher match) match (car matcher) matcher (cdr matcher)) (org-compile-prefix-format 'tags) @@ -5089,50 +5085,53 @@ Stuck projects are project that have no next actions. For the definitions of what a project is and how to check if it stuck, customize the variable `org-stuck-projects'." (interactive) - (let* ((org-agenda-skip-function - 'org-agenda-skip-entry-when-regexp-matches-in-subtree) - ;; We could have used org-agenda-skip-if here. - (org-agenda-overriding-header + (let* ((org-agenda-overriding-header (or org-agenda-overriding-header "List of stuck projects: ")) (matcher (nth 0 org-stuck-projects)) (todo (nth 1 org-stuck-projects)) - (todo-wds (if (member "*" todo) - (progn - (org-agenda-prepare-buffers (org-agenda-files - nil 'ifmode)) - (org-delete-all - org-done-keywords-for-agenda - (copy-sequence org-todo-keywords-for-agenda))) - todo)) - (todo-re (concat "^\\*+[ \t]+\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) (tags (nth 2 org-stuck-projects)) - (tags-re (if (member "*" tags) - (concat org-outline-regexp-bol - ".*:[[:alnum:]_@#%]+:[ \t]*$") - (if tags - (concat org-outline-regexp-bol - ".*:\\(" - (mapconcat #'identity tags "\\|") - "\\):[[:alnum:]_@#%:]*[ \t]*$")))) - (gen-re (nth 3 org-stuck-projects)) - (re-list - (delq nil - (list - (if todo todo-re) - (if tags tags-re) - (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) - gen-re))))) - (setq org-agenda-skip-regexp - (if re-list - (mapconcat 'identity re-list "\\|") - (error "No information how to identify unstuck projects"))) + (gen-re (org-string-nw-p (nth 3 org-stuck-projects))) + (todo-wds + (if (not (member "*" todo)) todo + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) + (org-delete-all org-done-keywords-for-agenda + (copy-sequence org-todo-keywords-for-agenda)))) + (todo-re (and todo + (format "^\\*+[ \t]+\\(%s\\)\\>" + (mapconcat #'identity todo-wds "\\|")))) + (tags-re (cond ((null tags) nil) + ((member "*" tags) + (eval-when-compile + (concat org-outline-regexp-bol + ".*:[[:alnum:]_@#%]+:[ \t]*$"))) + (tags (concat org-outline-regexp-bol + ".*:\\(" + (mapconcat #'identity tags "\\|") + "\\):[[:alnum:]_@#%:]*[ \t]*$")) + (t nil))) + (re-list (delq nil (list todo-re tags-re gen-re))) + (skip-re + (if (null re-list) + (error "Missing information to identify unstuck projects") + (mapconcat #'identity re-list "\\|"))) + (org-agenda-skip-function + ;; Skip entry if `org-agenda-skip-regexp' matches anywhere + ;; in the subtree. + `(lambda () + (and (save-excursion + (let ((case-fold-search nil)) + (re-search-forward + ,skip-re (save-excursion (org-end-of-subtree t)) t))) + (progn (outline-next-heading) (point)))))) (org-tags-view nil matcher) (setq org-agenda-buffer-name (buffer-name)) (with-current-buffer org-agenda-buffer-name (setq org-agenda-redo-command - `(org-agenda-list-stuck-projects ,current-prefix-arg))))) + `(org-agenda-list-stuck-projects ,current-prefix-arg)) + (let ((inhibit-read-only t)) + (add-text-properties + (point-min) (point-max) + `(org-redo-cmd ,org-agenda-redo-command)))))) ;;; Diary integration @@ -6070,19 +6069,24 @@ specification like [h]h:mm." (show-all (or (eq org-agenda-repeating-timestamp-show-all t) (member todo-state org-agenda-repeating-timestamp-show-all))) + (sexp? (string-prefix-p "%%" s)) ;; DEADLINE is the bare deadline date, i.e., without ;; any repeater, or the last repeat if SHOW-ALL is ;; non-nil. REPEAT is closest repeat after CURRENT, if ;; all repeated time stamps are to be shown, or after ;; TODAY otherwise. REPEAT only applies to future ;; dates. - (deadline (if show-all (org-agenda--timestamp-to-absolute s) - (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos))) - (repeat - (if (< current today) deadline - (org-agenda--timestamp-to-absolute - s (if show-all current today) 'future (current-buffer) pos))) + (deadline (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + (show-all (org-agenda--timestamp-to-absolute s)) + (t (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)))) + (repeat (cond (sexp? deadline) + ((< current today) deadline) + (t + (org-agenda--timestamp-to-absolute + s (if show-all current today) 'future + (current-buffer) pos)))) (diff (- deadline current)) (suppress-prewarning (let ((scheduled @@ -6235,22 +6239,25 @@ scheduled items with an hour specification like [h]h:mm." (show-all (or (eq org-agenda-repeating-timestamp-show-all t) (member todo-state org-agenda-repeating-timestamp-show-all))) + (sexp? (string-prefix-p "%%" s)) ;; SCHEDULE is the bare scheduled date, i.e., without ;; any repeater if non-nil, or last repeat if SHOW-ALL ;; is nil. REPEAT is the closest repeat after CURRENT, ;; if all repeated time stamps are to be shown, or ;; after TODAY otherwise. REPEAT only applies to ;; future dates. - (schedule (if show-all (org-agenda--timestamp-to-absolute s) - (org-agenda--timestamp-to-absolute - s today 'past (current-buffer) pos))) - (repeat (cond ((< current today) schedule) - (show-all - (org-agenda--timestamp-to-absolute - s current 'future (current-buffer) pos)) - (t - (org-agenda--timestamp-to-absolute - s today 'future (current-buffer) pos)))) + (schedule (cond + (sexp? (org-agenda--timestamp-to-absolute s current)) + (show-all (org-agenda--timestamp-to-absolute s)) + (t (org-agenda--timestamp-to-absolute + s today 'past (current-buffer) pos)))) + (repeat (cond + (sexp? schedule) + ((< current today) schedule) + (t + (org-agenda--timestamp-to-absolute + s (if show-all current today) 'future + (current-buffer) pos)))) (diff (- current schedule)) (warntime (get-text-property (point) 'org-appt-warntime)) (pastschedp (< schedule today)) @@ -6365,7 +6372,7 @@ scheduled items with an hour specification like [h]h:mm." ((= schedule current) first) ;; Subsequent reminders. Count from base ;; schedule. - (t (format next (1+ diff))))) + (t (format next diff)))) head level category tags time nil habitp)) (face (cond ((and (not habitp) pastschedp) 'org-scheduled-previously) @@ -7438,14 +7445,15 @@ With a prefix argument, exclude the lines of that category. (t (error "No category at point")))))) (defun org-find-top-headline (&optional pos) - "Find the topmost parent headline and return it." + "Find the topmost parent headline and return it. +POS when non-nil is the marker or buffer position to start the +search from." (save-excursion - (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) - (if pos (goto-char pos)) - ;; Skip up to the topmost parent - (while (ignore-errors (outline-up-heading 1) t)) - (ignore-errors - (nth 4 (org-heading-components)))))) + (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) + (when pos (goto-char pos)) + ;; Skip up to the topmost parent. + (while (org-up-heading-safe)) + (ignore-errors (nth 4 (org-heading-components)))))) (defvar org-agenda-filtered-by-top-headline nil) (defun org-agenda-filter-by-top-headline (strip) @@ -7487,31 +7495,41 @@ With no prefix argument, keep entries matching the effort condition. With one prefix argument, filter out entries matching the condition. With two prefix arguments, remove the effort filters." (interactive "P") - (cond ((member strip '(nil 4)) - (let ((efforts (org-split-string - (or (cdr (assoc (concat org-effort-property "_ALL") - org-global-properties)) - "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" - ""))) - (eff -1) - effort-prompt op) - (while (not (member op '(?< ?> ?=))) - (setq op (read-char-exclusive "Effort operator? (> = or <)"))) - (cl-loop for i from 0 to 9 do - (setq effort-prompt - (concat - effort-prompt " [" - (if (= i 9) "0" (int-to-string (1+ i))) - "]" (nth i efforts)))) - (message "Effort %s%s" (char-to-string op) effort-prompt) - (while (or (< eff 0) (> eff 9)) - (setq eff (string-to-number (char-to-string (read-char-exclusive))))) - (setq org-agenda-effort-filter - (list (concat (if strip "-" "+") - (char-to-string op) (nth (1- eff) efforts)))) - (org-agenda-filter-apply org-agenda-effort-filter 'effort))) - (t (org-agenda-filter-show-all-effort) - (message "Effort filter removed")))) + (cond + ((member strip '(nil 4)) + (let* ((efforts (split-string + (or (cdr (assoc (concat org-effort-property "_ALL") + org-global-properties)) + "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00"))) + ;; XXX: the following handles only up to 10 different + ;; effort values. + (allowed-keys (if (null efforts) nil + (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0 + (number-sequence 1 (length efforts))))) + (op nil)) + (while (not (memq op '(?< ?> ?=))) + (setq op (read-char-exclusive "Effort operator? (> = or <)"))) + ;; Select appropriate duration. Ignore non-digit characters. + (let ((prompt + (apply #'format + (concat "Effort %c " + (mapconcat (lambda (s) (concat "[%d]" s)) + efforts + " ")) + op allowed-keys)) + (eff -1)) + (while (not (memq eff allowed-keys)) + (message prompt) + (setq eff (- (read-char-exclusive) 48))) + (setq org-agenda-effort-filter + (list (concat (if strip "-" "+") + (char-to-string op) + ;; Numbering is 1 2 3 ... 9 0, but we want + ;; 0 1 2 ... 8 9. + (nth (mod (1- eff) 10) efforts))))) + (org-agenda-filter-apply org-agenda-effort-filter 'effort))) + (t (org-agenda-filter-show-all-effort) + (message "Effort filter removed")))) (defun org-agenda-filter-remove-all () "Remove all filters from the current agenda buffer." @@ -7703,8 +7721,11 @@ E looks like \"+<2:25\"." (defun org-agenda-compare-effort (op value) "Compare the effort of the current line with VALUE, using OP. If the line does not have an effort defined, return nil." - (let ((eff (org-get-at-eol 'effort-minutes 1))) - (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 -1)) + ;; `effort-minutes' property cannot be extracted directly from + ;; current line but is stored as a property in `txt'. + (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt)))) + (funcall op + (or effort (if org-sort-agenda-noeffort-is-high 32767 -1)) value))) (defun org-agenda-filter-expand-tags (filter &optional no-operator) @@ -8321,7 +8342,7 @@ When called with a prefix argument, include all archive files as well." (t "")) (if (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) - '(:eval (propertize + '(:eval (propertize (concat " <" (mapconcat 'identity @@ -9843,7 +9864,6 @@ This will remove the markers and the overlays." (interactive) (if (null org-agenda-bulk-marked-entries) (message "No entry to unmark") - (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) (setq org-agenda-bulk-marked-entries nil) (org-agenda-bulk-remove-overlays (point-min) (point-max)))) @@ -9944,11 +9964,13 @@ The prefix arg is passed through to the command if possible." (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) ;; Make sure to not prompt for a note when bulk - ;; rescheduling as Org cannot cope with simultaneous Org. - ;; Besides, it could be annoying depending on the number - ;; of items re-scheduled. + ;; rescheduling as Org cannot cope with simultaneous + ;; notes. Besides, it could be annoying depending on the + ;; number of items re-scheduled. (setq cmd `(eval '(let ((org-log-reschedule - (and org-log-reschedule 'time))) + (and org-log-reschedule 'time)) + (org-log-redeadline + (and org-log-redeadline 'time))) (,c1 arg ,time)))))) ((equal action ?S) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 3ba8bf1..ce1f35d 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -1,6 +1,6 @@ ;;; org-archive.el --- Archiving for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -204,17 +204,19 @@ if LOCATION is not given, the value of `org-archive-location' is used." ;;;###autoload (defun org-archive-subtree (&optional find-done) "Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with a single prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -When called with a double prefix argument, find whole trees with timestamps before -today and archive them (after getting confirmation from the user). -If the cursor is not at a headline when these commands are called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading." +The archive can be a certain top-level heading in the current +file, or in a different file. The tree will be moved to that +location, the subtree heading be marked DONE, and the current +time will be added. + +When called with a single prefix argument FIND-DONE, find whole +trees without any open TODO items and archive them (after getting +confirmation from the user). When called with a double prefix +argument, find whole trees with timestamps before today and +archive them (after getting confirmation from the user). If the +cursor is not at a headline when these commands are called, try +all level 1 trees. If the cursor is on a headline, only try the +direct children of this heading." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) @@ -224,7 +226,7 @@ this heading." `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point))) (org-archive-subtree ,find-done)) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (cond ((equal find-done '(4)) (org-archive-all-done)) ((equal find-done '(16)) (org-archive-all-old)) @@ -416,7 +418,7 @@ Archiving time is retained in the ARCHIVE_TIME node property." (when (org-at-heading-p) (org-archive-to-archive-sibling))) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (save-restriction (widen) (let (b e pos leader level) @@ -564,7 +566,7 @@ the children that do not contain any open TODO items." (org-map-entries `(org-toggle-archive-tag ,find-done) org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (if find-done (org-archive-all-done 'tag) (let (set) @@ -585,7 +587,7 @@ the children that do not contain any open TODO items." (org-map-entries 'org-archive-set-tag org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (if (org-invisible-p) (org-end-of-subtree nil t)))) (org-toggle-tag org-archive-tag 'on))) ;;;###autoload diff --git a/lisp/org-attach.el b/lisp/org-attach.el index d6e587d..a026eee 100644 --- a/lisp/org-attach.el +++ b/lisp/org-attach.el @@ -1,6 +1,6 @@ ;;; org-attach.el --- Manage file attachments to Org tasks -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@newartisans.com> ;; Keywords: org data task @@ -59,7 +59,7 @@ where the Org file lives." This is only done if the Org file is in a git repository." :group 'org-attach :type 'boolean - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) (defcustom org-attach-git-annex-cutoff (* 32 1024) @@ -131,7 +131,7 @@ lns create a symbol link. Note that this is not supported "Non-nil means attachments are deleted upon archiving a subtree. When set to `query', ask the user instead." :group 'org-attach - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "Never delete attachments" nil) @@ -143,7 +143,7 @@ When set to `query', ask the user instead." If \\='ask, prompt using `y-or-n-p'. If t, always get. If nil, never get." :group 'org-attach :package-version '(Org . "9") - :version "25.2" + :version "26.1" :type '(choice (const :tag "confirm with `y-or-n-p'" ask) (const :tag "always get from annex if necessary" t) @@ -441,7 +441,8 @@ The attachment is created as an Emacs buffer." (unless (file-exists-p file) (error "No such attachment: %s" file)) (delete-file file) - (org-attach-commit))) + (when org-attach-commit + (org-attach-commit)))) (defun org-attach-delete-all (&optional force) "Delete all attachments from the current task. @@ -457,14 +458,16 @@ A safer way is to open the directory in dired and delete from there." (y-or-n-p "Are you sure you want to remove all attachments of this entry? "))) (shell-command (format "rm -fr %s" attach-dir)) (message "Attachment directory removed") - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (org-attach-untag)))) (defun org-attach-sync () "Synchronize the current tasks with its attachments. This can be used after files have been added externally." (interactive) - (org-attach-commit) + (when org-attach-commit + (org-attach-commit)) (when (and org-attach-file-list-property (not org-attach-inherited)) (org-entry-delete (point) org-attach-file-list-property)) (let ((attach-dir (org-attach-dir))) diff --git a/lisp/org-bbdb.el b/lisp/org-bbdb.el index dd9ef26..f851668 100644 --- a/lisp/org-bbdb.el +++ b/lisp/org-bbdb.el @@ -1,6 +1,6 @@ ;;; org-bbdb.el --- Support for links to BBDB entries -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Authors: Carsten Dominik <carsten at orgmode dot org> ;; Thomas Baumann <thomas dot baumann at ch dot tum dot de> diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index db5d97b..d81c9f1 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -1,6 +1,6 @@ ;;; org-bibtex.el --- Org links to BibTeX entries -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; ;; Authors: Bastien Guerry <bzg@gnu.org> ;; Carsten Dominik <carsten dot dominik at gmail dot com> @@ -293,7 +293,7 @@ It is relevant only if `org-bibtex-tags-are-keywords' is non-nil. Tag inheritence itself is controlled by `org-use-tag-inheritence' and `org-exclude-tags-from-inheritence'." :group 'org-bibtex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'boolean) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index f757927..63e23cc 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1,6 +1,6 @@ ;;; org-capture.el --- Fast note taking in Org -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -723,16 +723,6 @@ captured item after finalizing." (kill-region m1 m2)) (setq abort-note 'dirty))) - ;; Make sure that the empty lines after are correct - (when (and (> (point-max) end) ; indeed, the buffer was still narrowed - (member (org-capture-get :type 'local) - '(entry item checkitem plain))) - (save-excursion - (goto-char end) - (or (bolp) (newline)) - (org-capture-empty-lines-after - (or (org-capture-get :empty-lines-after 'local) - (org-capture-get :empty-lines 'local) 0)))) ;; Postprocessing: Update Statistics cookies, do the sorting (when (derived-mode-p 'org-mode) (save-excursion @@ -749,8 +739,7 @@ captured item after finalizing." ;; Store this place as the last one where we stored something ;; Do the marking in the base buffer, so that it makes sense after ;; the indirect buffer has been killed. - (when org-capture-bookmark - (org-capture-bookmark-last-stored-position)) + (org-capture-store-last-position) ;; Run the hook (run-hooks 'org-capture-before-finalize-hook)) @@ -821,20 +810,28 @@ Refiling is done from the base buffer, because the indirect buffer is then already gone. Any prefix argument will be passed to the refile command." (interactive) (unless (eq (org-capture-get :type 'local) 'entry) - (error - "Refiling from a capture buffer makes only sense for `entry'-type templates")) - (let ((pos (point)) - (base (buffer-base-buffer (current-buffer))) - (org-capture-is-refiling t) - (kill-buffer (org-capture-get :kill-buffer 'local))) + (user-error "Refiling from a capture buffer makes only sense \ +for `entry'-type templates")) + (let* ((base (or (buffer-base-buffer) (current-buffer))) + (pos (make-marker)) + (org-capture-is-refiling t) + (kill-buffer (org-capture-get :kill-buffer 'local))) + ;; Since `org-capture-finalize' may alter buffer contents (e.g., + ;; empty lines) around entry, use a marker to refer to the + ;; headline to be refiled. Place the marker in the base buffer, + ;; as the current indirect one is going to be killed. + (set-marker pos (save-excursion (org-back-to-heading t) (point)) base) (org-capture-put :kill-buffer nil) - (org-capture-finalize) - (save-window-excursion - (with-current-buffer (or base (current-buffer)) - (org-with-wide-buffer - (goto-char pos) - (call-interactively 'org-refile)))) - (when kill-buffer (kill-buffer base)))) + (unwind-protect + (progn + (org-capture-finalize) + (save-window-excursion + (with-current-buffer base + (org-with-wide-buffer + (goto-char pos) + (call-interactively 'org-refile)))) + (when kill-buffer (kill-buffer base))) + (set-marker pos nil)))) (defun org-capture-kill () "Abort the current capture process." @@ -890,14 +887,14 @@ Store them in the capture property list." ((eq (car target) 'file+headline) (set-buffer (org-capture-target-buffer (nth 1 target))) + (unless (derived-mode-p 'org-mode) + (error + "Target buffer \"%s\" for file+headline should be in Org mode" + (current-buffer))) (org-capture-put-target-region-and-position) (widen) (let ((hd (nth 2 target))) (goto-char (point-min)) - (unless (derived-mode-p 'org-mode) - (error - "Target buffer \"%s\" for file+headline should be in Org mode" - (current-buffer))) (if (re-search-forward (format org-complex-heading-regexp-format (regexp-quote hd)) nil t) @@ -932,6 +929,10 @@ Store them in the capture property list." ((memq (car target) '(file+datetree file+datetree+prompt file+weektree file+weektree+prompt)) (require 'org-datetree) (set-buffer (org-capture-target-buffer (nth 1 target))) + (unless (derived-mode-p 'org-mode) + (error "Target buffer \"%s\" for %s should be in Org mode" + (current-buffer) + (car target))) (org-capture-put-target-region-and-position) (widen) ;; Make a date/week tree entry, with the current date (or @@ -1057,48 +1058,38 @@ may have been stored before." (defun org-capture-place-entry () "Place the template as a new Org entry." - (let* ((txt (org-capture-get :template)) - (reversed (org-capture-get :prepend)) - (target-entry-p (org-capture-get :target-entry-p)) - level beg end) - - (and (org-capture-get :exact-position) - (goto-char (org-capture-get :exact-position))) + (let ((reversed? (org-capture-get :prepend)) + level) + (when (org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) (cond - ((not target-entry-p) - ;; Insert as top-level entry, either at beginning or at end of - ;; file. - (setq level 1) - (if reversed - (progn (goto-char (point-min)) - (or (org-at-heading-p) - (outline-next-heading))) - (goto-char (point-max)) - (or (bolp) (insert "\n")))) - (t - ;; Insert as a child of the current entry - (and (looking-at "\\*+") - (setq level (- (match-end 0) (match-beginning 0)))) - (setq level (org-get-valid-level (or level 1) 1)) - (if reversed - (progn - (outline-next-heading) - (or (bolp) (insert "\n"))) - (org-end-of-subtree t nil) - (or (bolp) (insert "\n"))))) + ;; Insert as a child of the current entry. + ((org-capture-get :target-entry-p) + (setq level (org-get-valid-level + (if (org-at-heading-p) (org-outline-level) 1) + 1)) + (if reversed? (outline-next-heading) (org-end-of-subtree t))) + ;; Insert as a top-level entry at the beginning of the file. + (reversed? + (goto-char (point-min)) + (unless (org-at-heading-p) (outline-next-heading))) + ;; Otherwise, insert as a top-level entry at the end of the file. + (t (goto-char (point-max)))) + (unless (bolp) (insert "\n")) (org-capture-empty-lines-before) - (setq beg (point)) - (org-capture-verify-tree txt) - (org-paste-subtree level txt 'for-yank) - (org-capture-empty-lines-after 1) - (org-capture-position-for-last-stored beg) - (outline-next-heading) - (setq end (point)) - (org-capture-mark-kill-region beg (1- end)) - (org-capture-narrow beg (1- end)) - (if (or (re-search-backward "%\\?" beg t) - (re-search-forward "%\\?" end t)) - (replace-match "")))) + (let ((beg (point)) + (template (org-capture-get :template))) + (org-capture-verify-tree template) + (org-paste-subtree level template 'for-yank) + (org-capture-empty-lines-after) + (org-capture-position-for-last-stored beg) + (unless (org-at-heading-p) (outline-next-heading)) + (let ((end (point))) + (org-capture-mark-kill-region beg end) + (org-capture-narrow beg end) + (when (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))))) (defun org-capture-place-item () "Place the template as a new plain list item." @@ -1150,7 +1141,7 @@ may have been stored before." "\n")) ;; Insert item. (insert txt) - (org-capture-empty-lines-after 1) + (org-capture-empty-lines-after) (org-capture-position-for-last-stored beg) (forward-char 1) (setq end (point)) @@ -1271,7 +1262,7 @@ Of course, if exact position has been required, just put it there." (org-capture-empty-lines-before) (setq beg (point)) (insert txt) - (org-capture-empty-lines-after 1) + (org-capture-empty-lines-after) (org-capture-position-for-last-stored beg) (setq end (point)) (org-capture-mark-kill-region beg (1- end)) @@ -1301,8 +1292,8 @@ Of course, if exact position has been required, just put it there." (org-table-current-dline)))) (t (error "This should not happen")))) -(defun org-capture-bookmark-last-stored-position () - "Bookmark the last-captured position." +(defun org-capture-store-last-position () + "Store the last-captured position." (let* ((where (org-capture-get :position-for-last-stored 'local)) (pos (cond ((markerp where) @@ -1315,14 +1306,11 @@ Of course, if exact position has been required, just put it there." (point-at-bol)) (point)))))) (with-current-buffer (buffer-base-buffer (current-buffer)) - (org-with-wide-buffer - (goto-char pos) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point)))))) + (org-with-point-at pos + (when org-capture-bookmark + (let ((bookmark (plist-get org-bookmark-names-plist :last-capture))) + (when bookmark (with-demoted-errors (bookmark-set bookmark))))) + (move-marker org-capture-last-stored-marker (point)))))) (defun org-capture-narrow (beg end) "Narrow, unless configuration says not to narrow." @@ -1358,7 +1346,7 @@ Point will remain at the first line after the inserted text." (let* ((template (org-capture-get :template)) (type (org-capture-get :type)) beg end pp) - (or (bolp) (newline)) + (unless (bolp) (insert "\n")) (setq beg (point)) (cond ((and (eq type 'entry) (derived-mode-p 'org-mode)) @@ -1380,13 +1368,16 @@ Point will remain at the first line after the inserted text." (org-capture-empty-lines-after) (goto-char beg) (org-list-repair) - (org-end-of-item) - (setq end (point))) - (t (insert template))) + (org-end-of-item)) + (t + (insert template) + (org-capture-empty-lines-after) + (skip-chars-forward " \t\n") + (unless (eobp) (beginning-of-line)))) (setq end (point)) (goto-char beg) - (if (re-search-forward "%\\?" end t) - (replace-match "")))) + (when (re-search-forward "%\\?" end t) + (replace-match "")))) (defun org-capture-set-plist (entry) "Initialize the property list from the template definition." @@ -1437,6 +1428,7 @@ Use PREFIX as a prefix for the name of the indirect buffer." (defun org-mks (table title &optional prompt specials) "Select a member of an alist with multiple keys. + TABLE is the alist which should contain entries where the car is a string. There should be two types of entries. @@ -1444,7 +1436,7 @@ There should be two types of entries. This indicates that `a' is a prefix key for multi-letter selection, and that there are entries following with keys like \"ab\", \"ax\"... -2. Selectable members must have more than two elements, with the first +2. Select-able members must have more than two elements, with the first being the string of keys that lead to selecting it, and the second a short description string of the item. @@ -1455,84 +1447,72 @@ When you press a prefix key, the commands (and maybe further prefixes) under this key will be shown and offered for selection. TITLE will be placed over the selection in the temporary buffer, -PROMPT will be used when prompting for a key. SPECIAL is an alist with -also (\"key\" \"description\") entries. When one of these is selection, -only the bare key is returned." - (setq prompt (or prompt "Select: ")) - (let (tbl orig-table dkey ddesc des-keys allowed-keys - current prefix rtn re pressed buffer (inhibit-quit t)) - (save-window-excursion - (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) - (setq orig-table table) - (catch 'exit - (while t - (erase-buffer) - (insert title "\n\n") - (setq tbl table - des-keys nil - allowed-keys nil - cursor-type nil) - (setq prefix (if current (concat current " ") "")) - (while tbl - (cond - ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) - ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cl-cadar tbl)) - (pop tbl) - (push dkey des-keys) - (push dkey allowed-keys) - (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") - ;; Skip keys which are below this prefix - (setq re (concat "\\`" (regexp-quote dkey))) - (let (case-fold-search) - (while (and tbl (string-match re (caar tbl))) (pop tbl)))) - ((= 2 (length (car tbl))) - ;; Not yet a usable description, skip it - ) - (t - ;; usable entry on this level - (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") - (push (caar tbl) allowed-keys) - (pop tbl)))) - (when specials - (insert "-------------------------------------------------------------------------------\n") - (let ((sp specials)) - (while sp - (insert (format "[%s] %s\n" - (caar sp) (nth 1 (car sp)))) - (push (caar sp) allowed-keys) - (pop sp)))) - (push "\C-g" allowed-keys) - (goto-char (point-min)) - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive))) - (while (not (member pressed allowed-keys)) - (message "Invalid key `%s'" pressed) (sit-for 1) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive)))) - (when (equal pressed "\C-g") - (kill-buffer buffer) - (user-error "Abort")) - (when (and (not (assoc pressed table)) - (not (member pressed des-keys)) - (assoc pressed specials)) - (throw 'exit (setq rtn pressed))) - (unless (member pressed des-keys) - (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) - orig-table)))) - (setq current (concat current pressed)) - (setq table (mapcar - (lambda (x) - (if (and (> (length (car x)) 1) - (equal (substring (car x) 0 1) pressed)) - (cons (substring (car x) 1) (cdr x)) - nil)) - table)) - (setq table (remove nil table))))) - (when buffer (kill-buffer buffer)) - rtn)) +PROMPT will be used when prompting for a key. SPECIAL is an +alist with (\"key\" \"description\") entries. When one of these +is selected, only the bare key is returned." + (save-window-excursion + (let ((inhibit-quit t) + (buffer (org-switch-to-buffer-other-window "*Org Select*")) + (prompt (or prompt "Select: ")) + current) + (unwind-protect + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (let ((des-keys nil) + (allowed-keys '("\C-g")) + (cursor-type nil)) + ;; Populate allowed keys and descriptions keys + ;; available with CURRENT selector. + (let ((re (format "\\`%s\\(.\\)\\'" + (if current (regexp-quote current) ""))) + (prefix (if current (concat current " ") ""))) + (dolist (entry table) + (pcase entry + ;; Description. + (`(,(and key (pred (string-match re))) ,desc) + (let ((k (match-string 1 key))) + (push k des-keys) + (push k allowed-keys) + (insert prefix "[" k "]" "..." " " desc "..." "\n"))) + ;; Usable entry. + (`(,(and key (pred (string-match re))) ,desc . ,_) + (let ((k (match-string 1 key))) + (insert prefix "[" k "]" " " desc "\n") + (push k allowed-keys))) + (_ nil)))) + ;; Insert special entries, if any. + (when specials + (insert "----------------------------------------------------\ +---------------------------\n") + (pcase-dolist (`(,key ,description) specials) + (insert (format "[%s] %s\n" key description)) + (push key allowed-keys))) + ;; Display UI and let user select an entry or + ;; a sub-level prefix. + (goto-char (point-min)) + (unless (pos-visible-in-window-p (point-max)) + (org-fit-window-to-buffer)) + (message prompt) + (let ((pressed (char-to-string (read-char-exclusive)))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (setq current (concat current pressed)) + (cond + ((equal pressed "\C-g") (user-error "Abort")) + ;; Selection is a prefix: open a new menu. + ((member pressed des-keys)) + ;; Selection matches an association: return it. + ((let ((entry (assoc current table))) + (and entry (throw 'exit entry)))) + ;; Selection matches a special entry: return the + ;; selection prefix. + ((assoc current specials) (throw 'exit current)) + (t (error "No entry available"))))))) + (when buffer (kill-buffer buffer)))))) ;;; The template code (defun org-capture-select-template (&optional keys) @@ -1552,6 +1532,9 @@ Lisp programs can force the template by setting KEYS to a string." '(("C" "Customize org-capture-templates") ("q" "Abort")))))) +(defvar org-capture--clipboards nil + "List various clipboards values.") + (defun org-capture-fill-template (&optional template initial annotation) "Fill a template and return the filled template as a string. The template may still contain \"%?\" for cursor positioning." @@ -1600,12 +1583,13 @@ The template may still contain \"%?\" for cursor positioning." org-clock-heading))) (v-f (or (org-capture-get :original-file-nondirectory) "")) (v-F (or (org-capture-get :original-file) "")) - (clipboards (delq nil - (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c)))) + (org-capture--clipboards + (delq nil + (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c)))) (setq org-store-link-plist (plist-put org-store-link-plist :annotation v-a)) (setq org-store-link-plist (plist-put org-store-link-plist :initial v-i)) @@ -1657,34 +1641,41 @@ The template may still contain \"%?\" for cursor positioning." (delete-region pos end) (set-marker pos nil) (set-marker end nil) - (let ((replacement - (pcase (string-to-char value) - (?< (format-time-string time-string)) - (?: - (or (plist-get org-store-link-plist (intern value)) - "")) - (?i (let ((lead (buffer-substring-no-properties + (let* ((inside-sexp? (org-capture-inside-embedded-elisp-p)) + (replacement + (pcase (string-to-char value) + (?< (format-time-string time-string)) + (?: + (or (plist-get org-store-link-plist (intern value)) + "")) + (?i + (if inside-sexp? v-i + ;; Outside embedded Lisp, repeat leading + ;; characters before initial place holder + ;; every line. + (let ((lead (buffer-substring-no-properties (line-beginning-position) (point)))) - (mapconcat #'identity - (split-string v-i "\n") - (concat "\n" lead)))) - (?a v-a) - (?A v-A) - (?c v-c) - (?f v-f) - (?F v-F) - (?k v-k) - (?K v-K) - (?l v-l) - (?n v-n) - (?t v-t) - (?T v-T) - (?u v-u) - (?U v-U) - (?x v-x)))) + (replace-regexp-in-string "\n\\(.\\)" + (concat lead "\\1") + v-i nil nil 1)))) + (?a v-a) + (?A v-A) + (?c v-c) + (?f v-f) + (?F v-F) + (?k v-k) + (?K v-K) + (?l v-l) + (?n v-n) + (?t v-t) + (?T v-T) + (?u v-u) + (?U v-U) + (?x v-x)))) (insert - (if (org-capture-inside-embedded-elisp-p) - (replace-regexp-in-string "\"" "\\\\\"" replacement) + (if inside-sexp? + ;; Escape sensitive characters. + (replace-regexp-in-string "[\\\"]" "\\\\\\&" replacement) replacement)))))))) ;; Expand %() embedded Elisp. Limit to Sexp originally marked. @@ -1738,24 +1729,20 @@ The template may still contain \"%?\" for cursor positioning." (and (org-at-heading-p) (let ((org-ignore-region t)) (org-set-tags nil 'align)))))) - ("C" - (cond - ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ("L" - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link - 0 - (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) + ((or "C" "L") + (let ((insert-fun (if (equal key "C") #'insert + (lambda (s) (org-insert-link 0 s))))) + (pcase org-capture--clipboards + (`nil nil) + (`(,value) (funcall insert-fun value)) + (`(,first-value . ,_) + (funcall insert-fun + (read-string "Clipboard/kill value: " + first-value + 'org-capture--clipboards + first-value))) + (_ (error "Invalid `org-capture--clipboards' value: %S" + org-capture--clipboards))))) ("p" (org-set-property prompt nil)) ((guard key) ;; These are the date/time related ones. diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 6e58ce9..cb6a6c9 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1,6 +1,6 @@ ;;; org-clock.el --- The time clocking code for Org mode -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -65,7 +65,7 @@ Do not check directly this variable in a Lisp program. Call function `org-clock-into-drawer' instead." :group 'org-todo :group 'org-clock - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "Always" t) @@ -321,7 +321,9 @@ For more information, see `org-clocktable-write-default'." '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at") ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") - ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")) + ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at") + ("de" "Datei" "E" "Zeitstempel" "Kopfzeile" "Dauer" "GESAMT" + "Gesamtdauer" "Dateizeit" "Erstellt am")) "Terms used in clocktable, translated to different languages." :group 'org-clocktable :version "24.1" @@ -1585,26 +1587,27 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (insert "--") (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) (setq s (- (float-time - (apply #'encode-time (org-parse-time-string te))) + (apply #'encode-time (org-parse-time-string te nil t))) (float-time - (apply #'encode-time (org-parse-time-string ts)))) + (apply #'encode-time (org-parse-time-string ts nil t)))) h (floor (/ s 3600)) s (- s (* 3600 h)) m (floor (/ s 60)) s (- s (* 60 s))) (insert " => " (format "%2d:%02d" h m)) - (when (setq remove (and org-clock-out-remove-zero-time-clocks - (= (+ h m) 0))) - (beginning-of-line 1) - (delete-region (point) (point-at-eol)) - (and (looking-at "\n") (> (point-max) (1+ (point))) - (delete-char 1))) (move-marker org-clock-marker nil) (move-marker org-clock-hd-marker nil) - (when org-log-note-clock-out - (org-add-log-setup - 'clock-out nil nil nil - (concat "# Task: " (org-get-heading t) "\n\n"))) + ;; Possibly remove zero time clocks. However, do not add + ;; a note associated to the CLOCK line in this case. + (cond ((and org-clock-out-remove-zero-time-clocks + (= (+ h m) 0)) + (setq remove t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (org-log-note-clock-out + (org-add-log-setup + 'clock-out nil nil nil + (concat "# Task: " (org-get-heading t) "\n\n")))) (when org-clock-mode-line-timer (cancel-timer org-clock-mode-line-timer) (setq org-clock-mode-line-timer nil)) @@ -1820,9 +1823,9 @@ PROPNAME lets you set a custom text property instead of :org-clock-minutes." (setq ts (match-string 2) te (match-string 3) ts (float-time - (apply #'encode-time (org-parse-time-string ts))) + (apply #'encode-time (org-parse-time-string ts nil t))) te (float-time - (apply #'encode-time (org-parse-time-string te))) + (apply #'encode-time (org-parse-time-string te nil t))) ts (if tstart (max ts tstart) ts) te (if tend (min te tend) te) dt (- te ts) @@ -1959,7 +1962,8 @@ will be easy to remove." (make-string (max 0 (- (- 60 (current-column)) (- (match-end 4) (match-beginning 4)) - (length (org-get-at-bol 'line-prefix)))) ?·) + (length (org-get-at-bol 'line-prefix)))) + ?\·) '(face shadow)) (org-add-props (format " %9s " (org-minutes-to-clocksum-string time)) @@ -2407,26 +2411,27 @@ the currently selected interval size." (org-clock-get-table-data file params))))) files) ;; Get the right restriction for the scope. - (cond - ((not scope)) ;use the restriction as it is now - ((eq scope 'file) (widen)) - ((eq scope 'subtree) (org-narrow-to-subtree)) - ((eq scope 'tree) - (while (org-up-heading-safe)) - (org-narrow-to-subtree)) - ((and (symbolp scope) - (string-match "\\`tree\\([0-9]+\\)\\'" - (symbol-name scope))) - (let ((level (string-to-number - (match-string 1 (symbol-name scope))))) - (catch 'exit - (while (org-up-heading-safe) - (looking-at org-outline-regexp) - (when (<= (org-reduced-level (funcall outline-level)) - level) - (throw 'exit nil)))) - (org-narrow-to-subtree)))) - (list (org-clock-get-table-data nil params)))) + (save-restriction + (cond + ((not scope)) ;use the restriction as it is now + ((eq scope 'file) (widen)) + ((eq scope 'subtree) (org-narrow-to-subtree)) + ((eq scope 'tree) + (while (org-up-heading-safe)) + (org-narrow-to-subtree)) + ((and (symbolp scope) + (string-match "\\`tree\\([0-9]+\\)\\'" + (symbol-name scope))) + (let ((level (string-to-number + (match-string 1 (symbol-name scope))))) + (catch 'exit + (while (org-up-heading-safe) + (looking-at org-outline-regexp) + (when (<= (org-reduced-level (funcall outline-level)) + level) + (throw 'exit nil)))) + (org-narrow-to-subtree)))) + (list (org-clock-get-table-data nil params))))) (multifile ;; Even though `file-with-archives' can consist of ;; multiple files, we consider this is one extended file @@ -2457,35 +2462,40 @@ from the dynamic block definition." (multifile (plist-get params :multifile)) (block (plist-get params :block)) (sort (plist-get params :sort)) - (header (plist-get params :header)) - (narrow (plist-get params :narrow)) + (header (plist-get params :header)) (ws (or (plist-get params :wstart) 1)) (ms (or (plist-get params :mstart) 1)) (link (plist-get params :link)) - (maxlevel (or (plist-get params :maxlevel) 3)) - (emph (plist-get params :emphasize)) - (level-p (plist-get params :level)) (org-time-clocksum-use-effort-durations (plist-get params :effort-durations)) + (maxlevel (or (plist-get params :maxlevel) 3)) + (emph (plist-get params :emphasize)) + (compact? (plist-get params :compact)) + (narrow (or (plist-get params :narrow) (and compact? '40!))) + (level? (and (not compact?) (plist-get params :level))) (timestamp (plist-get params :timestamp)) (properties (plist-get params :properties)) - (ntcol (max 1 (or (plist-get params :tcolumns) 100))) - (indent (plist-get params :indent)) + (time-columns + (if (or compact? (< maxlevel 2)) 1 + ;; Deepest headline level is a hard limit for the number + ;; of time columns. + (let ((levels + (cl-mapcan + (lambda (table) + (pcase table + (`(,_ ,(and (pred wholenump) (pred (/= 0))) ,entries) + (mapcar #'car entries)))) + tables))) + (min maxlevel + (or (plist-get params :tcolumns) 100) + (if (null levels) 1 (apply #'max levels)))))) + (indent (or compact? (plist-get params :indent))) + (formula (plist-get params :formula)) (case-fold-search t) - range-text total-time tbl level hlc formula pcol - file-time entries entry headline - recalc content narrow-cut-p tcol) - - ;; Implement abbreviations - (when (plist-get params :compact) - (setq level nil indent t narrow (or narrow '40!) ntcol 1)) - - ;; Some consistency test for parameters - (unless (integerp ntcol) - (setq params (plist-put params :tcolumns (setq ntcol 100)))) + range-text total-time recalc narrow-cut-p) (when (and narrow (integerp narrow) link) - ;; We cannot have both integer narrow and link + ;; We cannot have both integer narrow and link. (message "Using hard narrowing in clocktable to allow for links") (setq narrow (intern (format "%d!" narrow)))) @@ -2503,19 +2513,19 @@ from the dynamic block definition." narrow)))) (when block - ;; Get the range text for the header + ;; Get the range text for the header. (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) - ;; Compute the total time - (setq total-time (apply '+ (mapcar 'cadr tables))) + ;; Compute the total time. + (setq total-time (apply #'+ (mapcar #'cadr tables))) - ;; Now we need to output this tsuff + ;; Now we need to output this tsuff. (goto-char ipos) - ;; Insert the text *before* the actual table + ;; Insert the text *before* the actual table. (insert-before-markers (or header - ;; Format the standard header + ;; Format the standard header. (concat "#+CAPTION: " (nth 9 lwords) " [" @@ -2529,151 +2539,137 @@ from the dynamic block definition." ;; Insert the narrowing line (when (and narrow (integerp narrow) (not narrow-cut-p)) (insert-before-markers - "|" ; table line starter - (if multifile "|" "") ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (format "<%d>| |\n" narrow))) ; headline and time columns + "|" ;table line starter + (if multifile "|" "") ;file column, maybe + (if level? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (format "<%d>| |\n" narrow))) ; headline and time columns ;; Insert the table header line (insert-before-markers - "|" ; table line starter - (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe - (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe - (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe - (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe - (concat (nth 4 lwords) "|" - (nth 5 lwords) "|\n")) ; headline and time columns + "|" ;table line starter + (if multifile (concat (nth 1 lwords) "|") "") ;file column, maybe + (if level? (concat (nth 2 lwords) "|") "") ;level column, maybe + (if timestamp (concat (nth 3 lwords) "|") "") ;timestamp column, maybe + (if properties ;properties columns, maybe + (concat (mapconcat #'identity properties "|") "|") + "") + (concat (nth 4 lwords) "|") ;headline + (concat (nth 5 lwords) "|") ;time column + (make-string (max 0 (1- time-columns)) ?|) ;other time columns + (if (eq formula '%) "%|\n" "\n")) ;; Insert the total time in the table (insert-before-markers - "|-\n" ; a hline - "|" ; table line starter + "|-\n" ;a hline + "|" ;table line starter (if multifile (concat "| " (nth 6 lwords) " ") "") - ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ; properties columns, maybe - (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline + ;file column, maybe + (if level? "|" "") ;level column, maybe + (if timestamp "|" "") ;timestamp column, maybe + (make-string (length properties) ?|) ;properties columns, maybe + (concat (format org-clock-total-time-cell-format (nth 7 lwords)) + "| ") (format org-clock-total-time-cell-format - (org-minutes-to-clocksum-string (or total-time 0))) ; the time - "|\n") ; close line - - ;; Now iterate over the tables and insert the data - ;; but only if any time has been collected + (org-minutes-to-clocksum-string (or total-time 0))) ;time + "|" + (make-string (max 0 (1- time-columns)) ?|) + (cond ((not (eq formula '%)) "") + ((or (not total-time) (= total-time 0)) "0.0|") + (t "100.0|")) + "\n") + + ;; Now iterate over the tables and insert the data but only if any + ;; time has been collected. (when (and total-time (> total-time 0)) - - (while (setq tbl (pop tables)) - ;; now tbl is the table resulting from one file. - (setq file-time (nth 1 tbl)) + (pcase-dolist (`(,file-name ,file-time ,entries) tables) (when (or (and file-time (> file-time 0)) (not (plist-get params :fileskip0))) - (insert-before-markers "|-\n") ; a hline because a new file starts - ;; First the file time, if we have multiple files + (insert-before-markers "|-\n") ;hline at new file + ;; First the file time, if we have multiple files. (when multifile - ;; Summarize the time collected from this file + ;; Summarize the time collected from this file. (insert-before-markers (format (concat "| %s %s | %s%s" - (format org-clock-file-time-cell-format (nth 8 lwords)) + (format org-clock-file-time-cell-format + (nth 8 lwords)) " | *%s*|\n") - (file-name-nondirectory (car tbl)) - (if level-p "| " "") ; level column, maybe - (if timestamp "| " "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time + (file-name-nondirectory file-name) + (if level? "| " "") ;level column, maybe + (if timestamp "| " "") ;timestamp column, maybe + (if properties ;properties columns, maybe + (make-string (length properties) ?|) + "") + (org-minutes-to-clocksum-string file-time)))) ;time ;; Get the list of node entries and iterate over it - (setq entries (nth 2 tbl)) - (while (setq entry (pop entries)) - (setq level (car entry) - headline (nth 1 entry) - hlc (if emph (or (cdr (assoc level hlchars)) "") "")) - (when narrow-cut-p - (if (and (string-match (concat "\\`" org-bracket-link-regexp - "\\'") - headline) - (match-end 3)) - (setq headline - (format "[[%s][%s]]" - (match-string 1 headline) - (org-shorten-string (match-string 3 headline) - narrow))) - (setq headline (org-shorten-string headline narrow)))) - (insert-before-markers - "|" ; start the table line - (if multifile "|" "") ; free space for file name column? - (if level-p (format "%d|" (car entry)) "") ; level, maybe - (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe - (if properties - (concat - (mapconcat - (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) - properties "|") "|") "") ;properties columns, maybe - (if indent (org-clocktable-indent-string level) "") ; indentation - hlc headline hlc "|" ; headline - (make-string (min (1- ntcol) (or (- level 1))) ?|) - ; empty fields for higher levels - hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time - "|\n" ; close line - ))))) - ;; When exporting subtrees or regions the region might be - ;; activated, so let's disable ̀delete-active-region' - (let ((delete-active-region nil)) (backward-delete-char 1)) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - ;; compute the column where the % numbers need to go - (setq pcol (+ 2 - (length properties) - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0) - (min maxlevel (or ntcol 100)))) - ;; compute the column where the total time is - (setq tcol (+ 2 - (length properties) - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0))) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol ; the column where the % numbers should go - (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time - tcol ; column of the total time - tcol (1- pcol) ; range of columns where times can be found - )) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "Invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) + (when (> maxlevel 0) + (pcase-dolist (`(,level ,headline ,ts ,time ,props) entries) + (when narrow-cut-p + (setq headline + (if (and (string-match + (format "\\`%s\\'" org-bracket-link-regexp) + headline) + (match-end 3)) + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow)) + (org-shorten-string headline narrow)))) + (let ((hlc (if emph (or (cdr (assoc level hlchars)) "") ""))) + (insert-before-markers + "|" ;start the table line + (if multifile "|" "") ;free space for file name column? + (if level? (format "%d|" level) "") ;level, maybe + (if timestamp (concat ts "|") "") ;timestamp, maybe + (if properties ;properties columns, maybe + (concat (mapconcat (lambda (p) + (or (cdr (assoc p props)) "")) + properties + "|") + "|") + "") + (if indent ;indentation + (org-clocktable-indent-string level) + "") + hlc headline hlc "|" ;headline + ;; Empty fields for higher levels. + (make-string (max 0 (1- (min time-columns level))) ?|) + hlc (org-minutes-to-clocksum-string time) hlc "|" ; time + (make-string (max 0 (- time-columns level)) ?|) + (if (eq formula '%) + (format "%.1f |" (* 100 (/ time (float total-time)))) + "") + "\n"))))))) + (delete-char -1) + (cond + ;; Possibly rescue old formula? + ((or (not formula) (eq formula '%)) + (let ((contents (org-string-nw-p (plist-get params :content)))) + (when (and contents (string-match "^\\([ \t]*#\\+tblfm:.*\\)" contents)) (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) + (insert "\n" (match-string 1 contents)) (beginning-of-line 0)))) - ;; Back to beginning, align the table, recalculate if necessary + ;; Insert specified formula line. + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t + (user-error "Invalid :formula parameter in clocktable"))) + ;; Back to beginning, align the table, recalculate if necessary. (goto-char ipos) (skip-chars-forward "^|") (org-table-align) (when org-hide-emphasis-markers - ;; we need to align a second time + ;; We need to align a second time. (org-table-align)) (when sort (save-excursion (org-table-goto-line 3) (org-table-goto-column (car sort)) (org-table-sort-lines nil (cdr sort)))) - (when recalc - (if (eq formula '%) - (save-excursion - (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) - (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) + (when recalc (org-table-recalculate 'all)) total-time)) (defun org-clocktable-indent-string (level) @@ -2705,14 +2701,16 @@ LEVEL is an integer. Indent by two spaces per level above 1." (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute ts))) (setq ts (float-time (encode-time 0 0 0 day month year))))) (ts - (setq ts (float-time (apply #'encode-time (org-parse-time-string ts)))))) + (setq ts (float-time + (apply #'encode-time (org-parse-time-string ts nil t)))))) (cond ((numberp te) ;; Likewise for te. (pcase-let ((`(,month ,day ,year) (calendar-gregorian-from-absolute te))) (setq te (float-time (encode-time 0 0 0 day month year))))) (te - (setq te (float-time (apply #'encode-time (org-parse-time-string te)))))) + (setq te (float-time + (apply #'encode-time (org-parse-time-string te nil t)))))) (setq tsb (if (eq step0 'week) (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) @@ -2752,19 +2750,22 @@ file time (in minutes) as 1st and 2nd elements. The third element of this list will be a list of headline entries. Each entry has the following structure: - (LEVEL HEADLINE TIMESTAMP TIME) - -LEVEL: The level of the headline, as an integer. This will be - the reduced level, so 1,2,3,... even if only odd levels - are being used. -HEADLINE: The text of the headline. Depending on PARAMS, this may - already be formatted like a link. -TIMESTAMP: If PARAMS require it, this will be a time stamp found in the - entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, - in this sequence. -TIME: The sum of all time spend in this tree, in minutes. This time - will of cause be restricted to the time block and tags match - specified in PARAMS." + (LEVEL HEADLINE TIMESTAMP TIME PROPERTIES) + +LEVEL: The level of the headline, as an integer. This will be + the reduced level, so 1,2,3,... even if only odd levels + are being used. +HEADLINE: The text of the headline. Depending on PARAMS, this may + already be formatted like a link. +TIMESTAMP: If PARAMS require it, this will be a time stamp found in the + entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, + in this sequence. +TIME: The sum of all time spend in this tree, in minutes. This time + will of cause be restricted to the time block and tags match + specified in PARAMS. +PROPERTIES: The list properties specified in the `:properties' parameter + along with their value, as an alist following the pattern + (NAME . VALUE)." (let* ((maxlevel (or (plist-get params :maxlevel) 3)) (timestamp (plist-get params :timestamp)) (ts (plist-get params :tstart)) @@ -2777,7 +2778,7 @@ TIME: The sum of all time spend in this tree, in minutes. This time (properties (plist-get params :properties)) (inherit-property-p (plist-get params :inherit-props)) (matcher (and tags (cdr (org-make-tags-matcher tags)))) - cc st p time level hdl props tsp tbl) + cc st p tbl) (setq org-clock-file-total-minutes nil) (when block @@ -2809,66 +2810,46 @@ TIME: The sum of all time spend in this tree, in minutes. This time (setq p (next-single-property-change (point) :org-clock-minutes))) (goto-char p) - (when (setq time (get-text-property p :org-clock-minutes)) - (save-excursion - (beginning-of-line 1) - (when (and (looking-at "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$") - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1)))) - (<= level maxlevel)) - (setq hdl (if (not link) - (match-string 2) - (org-make-link-string - (format "file:%s::%s" - (buffer-file-name) - (save-match-data - (match-string 2))) - (org-make-org-heading-search-string - (replace-regexp-in-string - org-bracket-link-regexp - (lambda (m) (or (match-string 3 m) - (match-string 1 m))) - (match-string 2))))) - tsp (when timestamp - (setq props (org-entry-properties (point))) - (or (cdr (assoc "SCHEDULED" props)) - (cdr (assoc "DEADLINE" props)) - (cdr (assoc "TIMESTAMP" props)) - (cdr (assoc "TIMESTAMP_IA" props)))) - props (when properties - (remove nil - (mapcar - (lambda (p) - (when (org-entry-get (point) p inherit-property-p) - (cons p (org-entry-get (point) p inherit-property-p)))) - properties)))) - (when (> time 0) (push (list level hdl tsp time props) tbl)))))) - (setq tbl (nreverse tbl)) - (list file org-clock-file-total-minutes tbl)))) - -(defun org-clock-time% (total &rest strings) - "Compute a time fraction in percent. -TOTAL s a time string like 10:21 specifying the total times. -STRINGS is a list of strings that should be checked for a time. -The first string that does have a time will be used. -This function is made for clock tables." - (let ((re "\\([0-9]+\\):\\([0-9]+\\)") - tot s) - (save-match-data - (catch 'exit - (if (not (string-match re total)) - (throw 'exit 0.) - (setq tot (+ (string-to-number (match-string 2 total)) - (* 60 (string-to-number (match-string 1 total))))) - (if (= tot 0.) (throw 'exit 0.))) - (while (setq s (pop strings)) - (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (throw 'exit - (/ (* 100.0 (+ (string-to-number (match-string 2 s)) - (* 60 (string-to-number - (match-string 1 s))))) - tot)))) - 0)))) + (let ((time (get-text-property p :org-clock-minutes))) + (when (and time (> time 0) (org-at-heading-p)) + (let ((level (org-reduced-level (org-current-level)))) + (when (<= level maxlevel) + (let* ((headline (replace-regexp-in-string + (format "\\`%s[ \t]+" org-comment-string) "" + (nth 4 (org-heading-components)))) + (hdl + (if (not link) headline + (let ((search + (org-make-org-heading-search-string headline))) + (org-make-link-string + (if (not (buffer-file-name)) search + (format "file:%s::%s" (buffer-file-name) search)) + ;; Prune statistics cookies. Replace + ;; links with their description, or + ;; a plain link if there is none. + (org-trim + (org-link-display-format + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + headline))))))) + (tsp + (and timestamp + (let ((p (org-entry-properties (point) 'special))) + (or (cdr (assoc "SCHEDULED" p)) + (cdr (assoc "DEADLINE" p)) + (cdr (assoc "TIMESTAMP" p)) + (cdr (assoc "TIMESTAMP_IA" p)))))) + (props + (and properties + (delq nil + (mapcar + (lambda (p) + (let ((v (org-entry-get + (point) p inherit-property-p))) + (and v (cons p v)))) + properties))))) + (push (list level hdl tsp time props) tbl))))))) + (list file org-clock-file-total-minutes (nreverse tbl))))) ;; Saving and loading the clock @@ -2906,9 +2887,9 @@ Otherwise, return nil." (setq ts (match-string 1) te (match-string 3)) (setq s (- (float-time - (apply #'encode-time (org-parse-time-string te))) + (apply #'encode-time (org-parse-time-string te nil t))) (float-time - (apply #'encode-time (org-parse-time-string ts)))) + (apply #'encode-time (org-parse-time-string ts nil t)))) neg (< s 0) s (abs s) h (floor (/ s 3600)) @@ -2927,7 +2908,8 @@ The details of what will be saved are regulated by the variable org-clock-has-been-used (not (file-exists-p org-clock-persist-file)))) (with-temp-file org-clock-persist-file - (insert (format ";; org-persist.el - %s at %s\n" + (insert (format ";; %s - %s at %s\n" + (file-name-nondirectory org-clock-persist-file) (system-name) (format-time-string (org-time-stamp-format t)))) ;; Store clock to be resumed. @@ -2984,7 +2966,7 @@ The details of what will be saved are regulated by the variable (let ((org-clock-in-resume 'auto-restart) (org-clock-auto-clock-resolution nil)) (org-clock-in) - (when (outline-invisible-p) (org-show-context)))))) + (when (org-invisible-p) (org-show-context)))))) (_ nil))))) ;; Suggested bindings diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 3e53ccb..ac8f36a 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -1,6 +1,6 @@ ;;; org-colview.el --- Column View in Org -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -85,7 +85,7 @@ output. Types defined in this variable take precedence over those defined in `org-columns-summary-types-default', which see." :group 'org-properties - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type '(alist :key-type (string :tag " Label") :value-type (function :tag "Summarize"))) @@ -223,21 +223,24 @@ See `org-columns-summary-types' for details.") (defun org-columns--displayed-value (spec value) "Return displayed value for specification SPEC in current entry. - SPEC is a column format specification as stored in `org-columns-current-fmt-compiled'. VALUE is the real value to display, as a string." - (cond - ((and (functionp org-columns-modify-value-for-display-function) - (funcall org-columns-modify-value-for-display-function - (nth 1 spec) - value))) - ((equal (car spec) "ITEM") - (concat (make-string (1- (org-current-level)) - (if org-hide-leading-stars ?\s ?*)) - "* " - (org-columns-compact-links value))) - (value))) + (or (and (functionp org-columns-modify-value-for-display-function) + (funcall org-columns-modify-value-for-display-function + (nth 1 spec) ;column name + value)) + (pcase spec + (`("ITEM" . ,_) + (concat (make-string (1- (org-current-level)) + (if org-hide-leading-stars ?\s ?*)) + "* " + (org-columns-compact-links value))) + (`(,_ ,_ ,_ ,_ nil) value) + ;; If PRINTF is set, assume we are displaying a number and + ;; obey to the format string. + (`(,_ ,_ ,_ ,_ ,printf) (format printf (string-to-number value))) + (_ (error "Invalid column specification format: %S" spec))))) (defun org-columns--collect-values (&optional compiled-fmt) "Collect values for columns on the current line. @@ -778,6 +781,7 @@ view for the whole buffer unconditionally. When COLUMNS-FMT-STRING is non-nil, use it as the column format." (interactive "P") (org-columns-remove-overlays) + (when global (goto-char (point-min))) (move-marker org-columns-begin-marker (point)) (org-columns-goto-top-level) ;; Initialize `org-columns-current-fmt' and @@ -1081,7 +1085,7 @@ as days/hours/minutes/seconds." ((string-match-p org-ts-regexp s) (floor (- org-columns--time - (float-time (apply #'encode-time (org-parse-time-string s)))))) + (float-time (apply #'encode-time (org-parse-time-string s nil t)))))) ;; Match own output for computations in upper levels. ((string-match "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" s) (+ (* 86400 (string-to-number (match-string 1 s))) @@ -1165,8 +1169,13 @@ properties drawers." ;; When PROPERTY exists in current node, even if empty, ;; but its value doesn't match the one computed, use ;; the latter instead. - (when (and update value (not (equal value summary))) - (org-entry-put (point) property summary))) + ;; + ;; Ignore leading or trailing white spaces that might + ;; have been introduced in summary, since those are not + ;; significant in properties value. + (let ((new-value (org-trim summary))) + (when (and update value (not (equal value new-value))) + (org-entry-put (point) property new-value)))) ;; Add current to current level accumulator. (when (or summary value-set) (push (or summary value) (aref lvals level))) @@ -1223,14 +1232,17 @@ When PRINTF is non-nil, use it to format the result." (defun org-columns--summary-checkbox-count (check-boxes _) "Summarize CHECK-BOXES with a check-box cookie." (format "[%d/%d]" - (cl-count "[X]" check-boxes :test #'equal) + (cl-count-if (lambda (b) (or (equal b "[X]") + (string-match-p "\\[\\([1-9]\\)/\\1\\]" b))) + check-boxes) (length check-boxes))) (defun org-columns--summary-checkbox-percent (check-boxes _) "Summarize CHECK-BOXES with a check-box percent." (format "[%d%%]" - (round (* 100.0 (cl-count "[X]" check-boxes :test #'equal)) - (float (length check-boxes))))) + (round (* 100.0 (cl-count-if (lambda (b) (member b '("[X]" "[100%]"))) + check-boxes)) + (length check-boxes)))) (defun org-columns--summary-min (values printf) "Compute the minimum of VALUES. @@ -1288,7 +1300,7 @@ When PRINTF is non-nil, use it to format the result." (/ (apply #'+ (mapcar #'org-columns--age-to-seconds ages)) (float (length ages))))) -(defun org-columns--summary-estimate (estimates printf) +(defun org-columns--summary-estimate (estimates _) "Combine a list of estimates, using mean and variance. The mean and variance of the result will be the sum of the means and variances (respectively) of the individual estimates." @@ -1303,8 +1315,8 @@ and variances (respectively) of the individual estimates." (`(,value) (cl-incf mean value)))) (let ((sd (sqrt var))) (format "%s-%s" - (format (or printf "%.0f") (- mean sd)) - (format (or printf "%.0f") (+ mean sd)))))) + (format "%.0f" (- mean sd)) + (format "%.0f" (+ mean sd)))))) @@ -1531,8 +1543,7 @@ PARAMS is a property list of parameters: (goto-char (point-min)) (let (cache) (while (not (eobp)) - (let ((m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)))) + (let ((m (org-get-at-bol 'org-hd-marker))) (when m (push (cons (line-beginning-position) ;; `org-columns-current-fmt-compiled' is @@ -1566,56 +1577,60 @@ This will add overlays to the date lines, to show the summary for each day." (if (member property '("CLOCKSUM" "CLOCKSUM_T")) (list property title width ":" nil) spec)))) - org-columns-current-fmt-compiled)) - entries) + org-columns-current-fmt-compiled))) ;; Ensure there's at least one summation column. (when (cl-some (lambda (spec) (nth 3 spec)) fmt) (goto-char (point-max)) - (while (not (bobp)) - (when (or (get-text-property (point) 'org-date-line) - (eq (get-text-property (point) 'face) - 'org-agenda-structure)) - ;; OK, this is a date line that should be used. - (let (rest) - (dolist (c cache (setq cache rest)) - (if (> (car c) (point)) - (push c entries) - (push c rest)))) - ;; Now ENTRIES contains entries below the current one. - ;; CACHE is the rest. Compute the summaries for the - ;; properties we want, set nil properties for the rest. - (when (setq entries (mapcar 'cdr entries)) - (org-columns--display-here - (mapcar - (lambda (spec) - (pcase spec - (`("ITEM" . ,_) - ;; Replace ITEM with current date. Preserve - ;; properties for fontification. - (let ((date (buffer-substring - (line-beginning-position) - (line-end-position)))) - (list spec date date))) - (`(,_ ,_ ,_ nil ,_) (list spec "" "")) - (`(,_ ,_ ,_ ,operator ,printf) - (let* ((summarize (org-columns--summarize operator)) - (values - ;; Use real values for summary, not those - ;; prepared for display. - (delq nil - (mapcar - (lambda (e) - (org-string-nw-p (nth 1 (assoc spec e)))) - entries))) - (final (if values (funcall summarize values printf) - ""))) - (unless (equal final "") - (put-text-property 0 (length final) 'face 'bold final)) - (list spec final final))))) - fmt) - 'dateline) - (setq-local org-agenda-columns-active t))) - (forward-line -1))))) + (catch :complete + (while t + (when (or (get-text-property (point) 'org-date-line) + (eq (get-text-property (point) 'face) + 'org-agenda-structure)) + ;; OK, this is a date line that should be used. + (let (entries) + (let (rest) + (dolist (c cache) + (if (> (car c) (point)) + (push c entries) + (push c rest))) + (setq cache rest)) + ;; ENTRIES contains entries below the current one. + ;; CACHE is the rest. Compute the summaries for the + ;; properties we want, set nil properties for the rest. + (when (setq entries (mapcar #'cdr entries)) + (org-columns--display-here + (mapcar + (lambda (spec) + (pcase spec + (`("ITEM" . ,_) + ;; Replace ITEM with current date. Preserve + ;; properties for fontification. + (let ((date (buffer-substring + (line-beginning-position) + (line-end-position)))) + (list spec date date))) + (`(,_ ,_ ,_ nil ,_) (list spec "" "")) + (`(,_ ,_ ,_ ,operator ,printf) + (let* ((summarize (org-columns--summarize operator)) + (values + ;; Use real values for summary, not + ;; those prepared for display. + (delq nil + (mapcar + (lambda (e) (org-string-nw-p + (nth 1 (assoc spec e)))) + entries))) + (final (if values + (funcall summarize values printf) + ""))) + (unless (equal final "") + (put-text-property 0 (length final) + 'face 'bold final)) + (list spec final final))))) + fmt) + 'dateline) + (setq-local org-agenda-columns-active t)))) + (if (bobp) (throw :complete t) (forward-line -1))))))) (defun org-agenda-colview-compute (fmt) "Compute the relevant columns in the contributing source buffers." diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 202b728..e1d4036 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -1,6 +1,6 @@ ;;; org-compat.el --- Compatibility Code for Older Emacsen -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -61,7 +61,7 @@ (defalias 'gui-get-selection 'x-get-selection)) -;;; Obsolete aliases (remove them once the next major release is released). +;;; Obsolete aliases (remove them after the next major release). ;;;; XEmacs compatibility, now removed. (define-obsolete-function-alias 'org-activate-mark 'activate-mark) @@ -191,6 +191,10 @@ Counting starts at 1." (define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") (define-obsolete-function-alias 'org-insert-columns-dblock 'org-columns-insert-dblock "Org 9.0") +(define-obsolete-function-alias 'org-activate-bracket-links + 'org-activate-links "Org 9.0") +(define-obsolete-function-alias 'org-activate-plain-links 'ignore "Org 9.0") +(define-obsolete-function-alias 'org-activate-angle-links 'ignore "Org 9.0") (defun org-in-fixed-width-region-p () "Non-nil if point in a fixed-width region." @@ -286,6 +290,11 @@ See `org-link-parameters' for documentation on the other parameters." (org-unbracket-string "\"" "\"" s)) (make-obsolete 'org-remove-double-quotes 'org-unbracket-string "Org 9.0") +(define-obsolete-function-alias 'org-babel-number-p + 'org-babel--string-to-number "Org 9.0") + + + ;;;; Obsolete link types (eval-after-load 'org @@ -430,6 +439,14 @@ Pass COLUMN and FORCE to `move-to-column'." (lambda (&optional _beg _end) (with-no-warnings (font-lock-fontify-buffer))))) +;; `file-local-name' was added in Emacs 26.1. +(defalias 'org-babel-local-file-name + (if (fboundp 'file-local-name) + 'file-local-name + (lambda (file) + "Return the local name component of FILE." + (or (file-remote-p file 'localname) file)))) + (defmacro org-no-popups (&rest body) "Suppress popup windows. Let-bind some variables to nil around BODY to achieve the desired diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 1039996..3c431e4 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -1,5 +1,5 @@ ;;; org-crypt.el --- Public Key Encryption for Org Entries -*- lexical-binding: t; -*- -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; Emacs Lisp Archive Entry ;; Filename: org-crypt.el @@ -176,14 +176,18 @@ See `org-crypt-disable-auto-save'." (let ((start-heading (point))) (org-end-of-meta-data) (unless (looking-at-p "-----BEGIN PGP MESSAGE-----") - (let ((folded (outline-invisible-p)) + (let ((folded (org-invisible-p)) (crypt-key (org-crypt-key-for-heading)) (beg (point))) (goto-char start-heading) (org-end-of-subtree t t) (org-back-over-empty-lines) (let ((contents (delete-and-extract-region beg (point)))) - (insert (org-encrypt-string contents crypt-key))) + (condition-case err + (insert (org-encrypt-string contents crypt-key)) + ;; If encryption failed, make sure to insert back entry + ;; contents in the buffer. + (error (insert contents) (error (nth 1 err))))) (when folded (goto-char start-heading) (outline-hide-subtree)) @@ -200,7 +204,7 @@ See `org-crypt-disable-auto-save'." (heading-was-invisible-p (save-excursion (outline-end-of-heading) - (outline-invisible-p)))) + (org-invisible-p)))) (org-end-of-meta-data) (when (looking-at "-----BEGIN PGP MESSAGE-----") (org-crypt-check-auto-save) diff --git a/lisp/org-ctags.el b/lisp/org-ctags.el index 3c63af0..98eb806 100644 --- a/lisp/org-ctags.el +++ b/lisp/org-ctags.el @@ -1,6 +1,6 @@ ;;; org-ctags.el - Integrate Emacs "tags" Facility with Org -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; Author: Paul Sexton <eeeickythump@gmail.com> diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el index 2a921bf..540753d 100644 --- a/lisp/org-datetree.el +++ b/lisp/org-datetree.el @@ -1,6 +1,6 @@ ;;; org-datetree.el --- Create date entries in a tree -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-docview.el b/lisp/org-docview.el index 0f0bdaf..dfad893 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -1,6 +1,6 @@ ;;; org-docview.el --- Support for links to doc-view-mode buffers -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: Jan Böcker <jan.boecker at jboecker dot de> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-element.el b/lisp/org-element.el index b86244e..41b4a3a 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1,6 +1,6 @@ ;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -22,79 +22,21 @@ ;;; Commentary: ;; -;; Org syntax can be divided into three categories: "Greater -;; elements", "Elements" and "Objects". +;; See <http://orgmode.org/worg/dev/org-syntax.html> for details about +;; Org syntax. ;; -;; Elements are related to the structure of the document. Indeed, all -;; elements are a cover for the document: each position within belongs -;; to at least one element. -;; -;; An element always starts and ends at the beginning of a line. With -;; a few exceptions (`clock', `headline', `inlinetask', `item', -;; `planning', `property-drawer', `node-property', `section' and -;; `table-row' types), it can also accept a fixed set of keywords as -;; attributes. Those are called "affiliated keywords" to distinguish -;; them from other keywords, which are full-fledged elements. Almost -;; all affiliated keywords are referenced in -;; `org-element-affiliated-keywords'; the others are export attributes -;; and start with "ATTR_" prefix. -;; -;; Element containing other elements (and only elements) are called -;; greater elements. Concerned types are: `center-block', `drawer', -;; `dynamic-block', `footnote-definition', `headline', `inlinetask', -;; `item', `plain-list', `property-drawer', `quote-block', `section' -;; and `special-block'. -;; -;; Other element types are: `babel-call', `clock', `comment', -;; `comment-block', `diary-sexp', `example-block', `export-block', -;; `fixed-width', `horizontal-rule', `keyword', `latex-environment', -;; `node-property', `paragraph', `planning', `src-block', `table', -;; `table-row' and `verse-block'. Among them, `paragraph' and -;; `verse-block' types can contain Org objects and plain text. -;; -;; Objects are related to document's contents. Some of them are -;; recursive. Associated types are of the following: `bold', `code', -;; `entity', `export-snippet', `footnote-reference', -;; `inline-babel-call', `inline-src-block', `italic', -;; `latex-fragment', `line-break', `link', `macro', `radio-target', -;; `statistics-cookie', `strike-through', `subscript', `superscript', -;; `table-cell', `target', `timestamp', `underline' and `verbatim'. -;; -;; Some elements also have special properties whose value can hold -;; objects themselves (e.g. an item tag or a headline name). Such -;; values are called "secondary strings". Any object belongs to -;; either an element or a secondary string. -;; -;; Notwithstanding affiliated keywords, each greater element, element -;; and object has a fixed set of properties attached to it. Among -;; them, four are shared by all types: `:begin' and `:end', which -;; refer to the beginning and ending buffer positions of the -;; considered element or object, `:post-blank', which holds the number -;; of blank lines, or white spaces, at its end and `:parent' which -;; refers to the element or object containing it. Greater elements, -;; elements and objects containing objects will also have -;; `:contents-begin' and `:contents-end' properties to delimit -;; contents. Eventually, All elements have a `:post-affiliated' -;; property referring to the buffer position after all affiliated -;; keywords, if any, or to their beginning position otherwise. -;; -;; At the lowest level, a `:parent' property is also attached to any -;; string, as a text property. -;; -;; Lisp-wise, an element or an object can be represented as a list. +;; Lisp-wise, a syntax object can be represented as a list. ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: -;; TYPE is a symbol describing the Org element or object. +;; TYPE is a symbol describing the object. ;; PROPERTIES is the property list attached to it. See docstring of -;; appropriate parsing function to get an exhaustive -;; list. -;; CONTENTS is a list of elements, objects or raw strings contained -;; in the current element or object, when applicable. +;; appropriate parsing function to get an exhaustive list. +;; CONTENTS is a list of syntax objects or raw strings contained +;; in the current object, when applicable. ;; -;; An Org buffer is a nested list of such elements and objects, whose -;; type is `org-data' and properties is nil. +;; For the whole document, TYPE is `org-data' and PROPERTIES is nil. ;; -;; The first part of this file defines Org syntax, while the second -;; one provide accessors and setters functions. +;; The first part of this file defines constants for the Org syntax, +;; while the second one provide accessors and setters functions. ;; ;; The next part implements a parser and an interpreter for each ;; element and object type in Org syntax. @@ -450,7 +392,7 @@ past the brackets." ;; There is `org-element-put-property', `org-element-set-contents'. ;; These low-level functions are useful to build a parse tree. ;; -;; `org-element-adopt-element', `org-element-set-element', +;; `org-element-adopt-elements', `org-element-set-element', ;; `org-element-extract-element' and `org-element-insert-before' are ;; high-level functions useful to modify a parse tree. ;; @@ -593,16 +535,15 @@ Parse tree is modified by side effect." (specialp (and (not property) (eq siblings parent) (eq (car parent) location)))) - ;; Install ELEMENT at the appropriate POSITION within SIBLINGS. + ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS. (cond (specialp) ((or (null siblings) (eq (car siblings) location)) (push element siblings)) ((null location) (nconc siblings (list element))) - (t (let ((previous (cadr (memq location (reverse siblings))))) - (if (not previous) - (error "No location found to insert element") - (let ((next (memq previous siblings))) - (setcdr next (cons element (cdr next)))))))) + (t + (let ((index (cl-position location siblings))) + (unless index (error "No location found to insert element")) + (push element (cdr (nthcdr (1- index) siblings)))))) ;; Store SIBLINGS at appropriate place in parse tree. (cond (specialp (setcdr parent (copy-sequence parent)) (setcar parent element)) @@ -850,7 +791,7 @@ CONTENTS is the contents of the element." (format "#+BEGIN: %s%s\n%s#+END:" (org-element-property :block-name dynamic-block) (let ((args (org-element-property :arguments dynamic-block))) - (and args (concat " " args))) + (if args (concat " " args) "")) contents)) @@ -880,14 +821,14 @@ Assume point is at the beginning of the footnote definition." (match-string-no-properties 1))) (begin (car affiliated)) (post-affiliated (point)) - (ending + (end (save-excursion (end-of-line) (cond ((not (re-search-forward org-element--footnote-separator limit t)) limit) - ((eq (char-after (match-beginning 0)) ?\[) + ((eq ?\[ (char-after (match-beginning 0))) ;; At a new footnote definition, make sure we end ;; before any affiliated keyword above. (forward-line -1) @@ -895,26 +836,27 @@ Assume point is at the beginning of the footnote definition." (looking-at-p org-element--affiliated-re)) (forward-line -1)) (line-beginning-position 2)) - (t (match-beginning 0))))) + ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) + (t (skip-chars-forward " \r\t\n" limit) + (if (= limit (point)) limit (line-beginning-position)))))) (contents-begin - (progn - (search-forward "]") - (skip-chars-forward " \r\t\n" ending) - (cond ((= (point) ending) nil) - ((= (line-beginning-position) post-affiliated) (point)) - (t (line-beginning-position))))) - (contents-end (and contents-begin ending)) - (end (progn (goto-char ending) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) + (progn (search-forward "]") + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ((= (line-beginning-position) post-affiliated) (point)) + (t (line-beginning-position))))) + (contents-end + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) (list 'footnote-definition (nconc (list :label label :begin begin :end end :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines ending end) + :contents-end (and contents-begin contents-end) + :post-blank (count-lines contents-end end) :post-affiliated post-affiliated) (cdr affiliated)))))) @@ -1696,30 +1638,37 @@ containing `:call', `:inside-header', `:arguments', (save-excursion (let* ((begin (car affiliated)) (post-affiliated (point)) - (value (progn (search-forward ":" nil t) + (before-blank (line-beginning-position 2)) + (value (progn (search-forward ":" before-blank t) + (skip-chars-forward " \t") (org-trim (buffer-substring-no-properties (point) (line-end-position))))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (valid-value - (string-match - "\\([^()\n]+?\\)\\(?:\\[\\(.*?\\)\\]\\)?(\\(.*\\))[ \t]*\\(.*\\)" - value))) + (call + (or (org-string-nw-p + (buffer-substring-no-properties + (point) (progn (skip-chars-forward "^[]()" before-blank) + (point)))))) + (inside-header (org-element--parse-paired-brackets ?\[)) + (arguments (org-string-nw-p + (org-element--parse-paired-brackets ?\())) + (end-header + (org-string-nw-p + (org-trim + (buffer-substring-no-properties (point) (line-end-position))))) + (end (progn (forward-line) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) (list 'babel-call (nconc - (list :call (and valid-value (match-string 1 value)) - :inside-header (and valid-value - (org-string-nw-p (match-string 2 value))) - :arguments (and valid-value - (org-string-nw-p (match-string 3 value))) - :end-header (and valid-value - (org-string-nw-p (match-string 4 value))) + (list :call call + :inside-header inside-header + :arguments arguments + :end-header end-header :begin begin :end end :value value - :post-blank (count-lines pos-before-blank end) + :post-blank (count-lines before-blank end) :post-affiliated post-affiliated) (cdr affiliated)))))) @@ -3041,7 +2990,8 @@ Assume point is at the beginning of the LaTeX fragment." (search-forward "$" nil t 2) (not (memq (char-before (match-beginning 0)) '(?\s ?\t ?\n ?, ?.))) - (looking-at "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|$\\)") + (looking-at-p + "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)") (point))) (pcase (char-after (1+ (point))) (?\( (search-forward "\\)" nil t)) @@ -3196,7 +3146,7 @@ Assume point is at the beginning of the link." (when (string-match "::\\(.*\\)\\'" path) (setq search-option (match-string 1 path)) (setq path (replace-match "" nil nil path))) - (setq path (replace-regexp-in-string "\\`///+" "/" path))) + (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) ;; Translate link, if `org-link-translation-function' is set. (let ((trans (and (functionp org-link-translation-function) (funcall org-link-translation-function type path)))) @@ -4031,7 +3981,7 @@ Optional argument GRANULARITY determines the depth of the recursion. It can be set to the following symbols: `headline' Only parse headlines. -`greater-element' Don't recurse into greater elements excepted +`greater-element' Don't recurse into greater elements except headlines and sections. Thus, elements parsed are the top-level ones. `element' Parse everything but objects and plain text. @@ -4040,7 +3990,7 @@ recursion. It can be set to the following symbols: When VISIBLE-ONLY is non-nil, don't parse contents of hidden elements. -An element or an objects is represented as a list with the +An element or object is represented as a list with the pattern (TYPE PROPERTIES CONTENTS), where : TYPE is a symbol describing the element or object. See @@ -4367,6 +4317,10 @@ to an appropriate container (e.g., a paragraph)." (if (memq 'table-cell restriction) (org-element-table-cell-parser) (let* ((start (point)) (limit + ;; Object regexp sometimes needs to have a peek at + ;; a character ahead. Therefore, when there is a hard + ;; limit, make it one more than the true beginning of the + ;; radio target. (save-excursion (cond ((not org-target-link-regexp) nil) ((not (memq 'link restriction)) nil) @@ -4382,8 +4336,8 @@ to an appropriate container (e.g., a paragraph)." ((and (= start (1+ (line-beginning-position))) (= start (match-end 1))) (and (re-search-forward org-target-link-regexp nil t) - (match-beginning 1))) - (t (match-beginning 1))))) + (1+ (match-beginning 1)))) + (t (1+ (match-beginning 1)))))) found) (save-excursion (while (and (not found) @@ -4457,7 +4411,8 @@ to an appropriate container (e.g., a paragraph)." (org-element-link-parser))))))) (or (eobp) (forward-char)))) (cond (found) - (limit (org-element-link-parser)) ;radio link + (limit (forward-char -1) + (org-element-link-parser)) ;radio link (t nil)))))) (defun org-element--parse-objects (beg end acc restriction &optional parent) @@ -4677,47 +4632,51 @@ indentation removed from its contents." ;; the beginnings of the contents or right after a line ;; break. (lambda (blob first-flag min-ind) - (catch 'zero - (dolist (datum (org-element-contents blob) min-ind) - (when first-flag - (setq first-flag nil) - (cond - ;; Objects cannot start with spaces: in this - ;; case, indentation is 0. - ((not (stringp datum)) (throw 'zero 0)) - ((not (string-match - "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) - (throw 'zero 0)) - ((equal (match-string 2 datum) "\n") - (put-text-property - (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) - (t - (let ((i (string-width (match-string 1 datum)))) - (put-text-property - (match-beginning 1) (match-end 1) 'org-ind i datum) - (setq min-ind (min i min-ind)))))) + (dolist (datum (org-element-contents blob) min-ind) + (when first-flag + (setq first-flag nil) (cond - ((stringp datum) - (let ((s 0)) - (while (string-match - "\n\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) - (setq s (match-end 1)) - (if (equal (match-string 2 datum) "\n") - (put-text-property - (match-beginning 1) (match-end 1) - 'org-ind 'empty - datum) - (let ((i (string-width (match-string 1 datum)))) - (put-text-property - (match-beginning 1) (match-end 1) 'org-ind i datum) - (setq min-ind (min i min-ind))))))) - ((eq (org-element-type datum) 'line-break) - (setq first-flag t)) - ((memq (org-element-type datum) org-element-recursive-objects) - (setq min-ind - (funcall find-min-ind datum first-flag min-ind)))))))) - (min-ind (funcall find-min-ind - element (not ignore-first) most-positive-fixnum))) + ;; Objects cannot start with spaces: in this + ;; case, indentation is 0. + ((not (stringp datum)) (throw :zero 0)) + ((not (string-match + "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) + (throw :zero 0)) + ((equal (match-string 2 datum) "\n") + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind i datum) + (setq min-ind (min i min-ind)))))) + (cond + ((stringp datum) + (let ((s 0)) + (while (string-match + "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) + (setq s (match-end 1)) + (cond + ((equal (match-string 1 datum) "") + (unless (member (match-string 2 datum) '("" "\n")) + (throw :zero 0))) + ((equal (match-string 2 datum) "\n") + (put-text-property (match-beginning 1) (match-end 1) + 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property (match-beginning 1) (match-end 1) + 'org-ind i datum) + (setq min-ind (min i min-ind)))))))) + ((eq (org-element-type datum) 'line-break) + (setq first-flag t)) + ((memq (org-element-type datum) org-element-recursive-objects) + (setq min-ind + (funcall find-min-ind datum first-flag min-ind))))))) + (min-ind + (catch :zero + (funcall find-min-ind + element (not ignore-first) most-positive-fixnum)))) (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element ;; Build ELEMENT back, replacing each string with the same ;; string minus common indentation. @@ -4800,9 +4759,12 @@ indentation removed from its contents." ;; `org-element--cache-objects'. -(defvar org-element-use-cache t - "Non nil when Org parser should cache its results. -This is mostly for debugging purpose.") +(defvar org-element-use-cache nil + "Non-nil when Org parser should cache its results. + +WARNING: for the time being, using cache sometimes triggers +freezes. Therefore, it is disabled by default. Activate it if +you want to help debugging the issue.") (defvar org-element-cache-sync-idle-time 0.6 "Length, in seconds, of idle time before syncing cache.") diff --git a/lisp/org-entities.el b/lisp/org-entities.el index 79b28e2..05ccf0c 100644 --- a/lisp/org-entities.el +++ b/lisp/org-entities.el @@ -1,6 +1,6 @@ ;;; org-entities.el --- Support for Special Entities -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org>, ;; Ulf Stegemann <ulf at zeitform dot de> diff --git a/lisp/org-eshell.el b/lisp/org-eshell.el index 6f9a18a..34cc4ff 100644 --- a/lisp/org-eshell.el +++ b/lisp/org-eshell.el @@ -1,6 +1,6 @@ ;;; org-eshell.el - Support for Links to Working Directories in Eshell -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Konrad Hinsen <konrad.hinsen AT fastmail.net> diff --git a/lisp/org-eww.el b/lisp/org-eww.el index 01ec905..7bc248d 100644 --- a/lisp/org-eww.el +++ b/lisp/org-eww.el @@ -1,6 +1,6 @@ ;;; org-eww.el --- Store url and kill from Eww mode for Org -*- lexical-binding: t -*- -;; Copyright (C) 2014-2016 Free Software Foundation, Inc. +;; Copyright (C) 2014-2017 Free Software Foundation, Inc. ;; Author: Marco Wahl <marcowahlsoft>a<gmailcom> ;; Keywords: link, eww @@ -138,9 +138,12 @@ the structure of the Org file." (point) (org-eww-goto-next-url-property-change))) ;; concat `org-mode' style url to `return-content'. - (setq return-content (concat return-content - (org-make-link-string - link-location link-title)))) + (setq return-content + (concat return-content + (if (stringp link-location) + ;; hint: link-location is different for form-elements. + (org-make-link-string link-location link-title) + link-title)))) (goto-char temp-position) ; reset point before jump next anchor (setq out-bound t) ; for break out `while' loop )) diff --git a/lisp/org-faces.el b/lisp/org-faces.el index 96f7b8e..cd43d37 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -1,6 +1,6 @@ ;;; org-faces.el --- Face definitions -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -398,7 +398,7 @@ follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." For source-blocks `org-src-block-faces' takes precedence. See also `org-fontify-quote-and-verse-blocks'." :group 'org-faces - :version "25.2") + :version "26.1") (defface org-block-begin-line '((t (:inherit org-meta-line))) "Face used for the line delimiting the begin of source blocks." @@ -558,7 +558,11 @@ month and 365.24 days for a year)." :group 'org-faces) (defface org-agenda-filter-category '((t :inherit mode-line)) - "Face for categories(s) in the mode-line when filtering the agenda." + "Face for categories in the mode-line when filtering the agenda." + :group 'org-faces) + +(defface org-agenda-filter-effort '((t :inherit mode-line)) + "Face for effort in the mode-line when filtering the agenda." :group 'org-faces) (defface org-time-grid ;Copied from `font-lock-variable-name-face' diff --git a/lisp/org-feed.el b/lisp/org-feed.el index 0c3cd05..6ebe5ec 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -1,6 +1,6 @@ ;;; org-feed.el --- Add RSS feed items to Org files -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 5b60a19..af03fbf 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -1,6 +1,6 @@ ;;; org-footnote.el --- Footnote support in Org -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -712,14 +712,18 @@ Return the number of footnotes removed." (let ((def-re (format "^\\[fn:%s\\]" (regexp-quote label))) (ndef 0)) (while (re-search-forward def-re nil t) - (let ((full-def (org-footnote-at-definition-p))) - (when full-def - ;; Remove the footnote, and all blank lines before it. - (goto-char (nth 1 full-def)) - (skip-chars-backward " \r\t\n") - (unless (bolp) (forward-line)) - (delete-region (point) (nth 2 full-def)) - (cl-incf ndef)))) + (pcase (org-footnote-at-definition-p) + (`(,_ ,start ,end ,_) + ;; Remove the footnote, and all blank lines before it. + (delete-region (progn + (goto-char start) + (skip-chars-backward " \r\t\n") + (if (bobp) (point) (line-beginning-position 2))) + (progn + (goto-char end) + (skip-chars-backward " \r\t\n") + (if (bobp) (point) (line-beginning-position 2)))) + (cl-incf ndef)))) ndef))) (defun org-footnote-delete (&optional label) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index a0de1c1..b9d0989 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -1,6 +1,6 @@ ;;; org-gnus.el --- Support for Links to Gnus Groups and Messages -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Tassilo Horn <tassilo at member dot fsf dot org> diff --git a/lisp/org-habit.el b/lisp/org-habit.el index 081627e..1f61565 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -1,6 +1,6 @@ ;;; org-habit.el --- The habit tracking code for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw at gnu dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-id.el b/lisp/org-id.el index cf26851..f07d243 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -1,6 +1,6 @@ ;;; org-id.el --- Global identifiers for Org entries -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-indent.el b/lisp/org-indent.el index fd58c69..10c9617 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -1,6 +1,6 @@ ;;; org-indent.el --- Dynamic indentation for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -110,6 +110,51 @@ The default is to make it look like whitespace. But you may find it useful to make it ever so slightly different." :group 'org-faces) +(defvar org-indent--text-line-prefixes nil + "Vector containing line prefixes strings for regular text.") + +(defvar org-indent--heading-line-prefixes nil + "Vector containing line prefix strings for headlines.") + +(defvar org-indent--inlinetask-line-prefixes nil + "Vector containing line prefix strings for inline tasks.") + +(defconst org-indent--deepest-level 50 + "Maximum theoretical headline depth.") + +(defun org-indent--compute-prefixes () + "Compute prefix strings for regular text and headlines." + (setq org-indent--heading-line-prefixes + (make-vector org-indent--deepest-level nil)) + (setq org-indent--inlinetask-line-prefixes + (make-vector org-indent--deepest-level nil)) + (setq org-indent--text-line-prefixes + (make-vector org-indent--deepest-level nil)) + (dotimes (n org-indent--deepest-level) + (let ((indentation (if (<= n 1) 0 + (* (1- org-indent-indentation-per-level) + (1- n))))) + ;; Headlines line prefixes. + (let ((heading-prefix (make-string indentation ?*))) + (aset org-indent--heading-line-prefixes + n + (org-add-props heading-prefix nil 'face 'org-indent)) + ;; Inline tasks line prefixes + (aset org-indent--inlinetask-line-prefixes + n + (org-add-props (if (bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring heading-prefix 1)) + heading-prefix) + nil 'face 'org-indent))) + ;; Text line prefixes. + (aset org-indent--text-line-prefixes + n + (concat (org-add-props (make-string (+ n indentation) ?\s) + nil 'face 'org-indent) + (and (> n 0) + (char-to-string org-indent-boundary-char))))))) + (defsubst org-indent-remove-properties (beg end) "Remove indentations between BEG and END." (org-with-silent-modifications @@ -137,14 +182,15 @@ during idle time." (setq-local org-hide-leading-stars-before-indent-mode org-hide-leading-stars) (setq-local org-hide-leading-stars t)) + (org-indent--compute-prefixes) (add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (org-indent-remove-properties-from-string - (funcall fun start end delete))) - nil t) + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete))) + nil t) (add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) (add-hook 'before-change-functions - 'org-indent-notify-modified-headline nil 'local) + 'org-indent-notify-modified-headline nil 'local) (and font-lock-mode (org-restart-font-lock)) (org-indent-remove-properties (point-min) (point-max)) ;; Submit current buffer to initialize agent. If it's the first @@ -247,27 +293,16 @@ expected indentation when wrapping line. When optional argument HEADING is non-nil, assume line is at a heading. Moreover, if is is `inlinetask', the first star will have `org-warning' face." - (let* ((stars (if (<= level 1) "" - (make-string (* (1- org-indent-indentation-per-level) - (1- level)) - ?*))) - (line - (cond - ((and (bound-and-true-p org-inlinetask-show-first-star) - (eq heading 'inlinetask)) - (concat org-indent-inlinetask-first-star - (org-add-props (substring stars 1) nil 'face 'org-hide))) - (heading (org-add-props stars nil 'face 'org-hide)) - (t (concat (org-add-props (concat stars (make-string level ?*)) - nil 'face 'org-indent) - (and (> level 0) - (char-to-string org-indent-boundary-char)))))) + (let* ((line (aref (pcase heading + (`nil org-indent--text-line-prefixes) + (`inlinetask org-indent--inlinetask-line-prefixes) + (_ org-indent--heading-line-prefixes)) + level)) (wrap (org-add-props - (concat stars - (make-string level ?*) - (if heading " " - (make-string (+ indentation (min level 1)) ?\s))) + (concat line + (if heading (concat (make-string level ?*) " ") + (make-string indentation ?\s))) nil 'face 'org-indent))) ;; Add properties down to the next line to indent empty lines. (add-text-properties (line-beginning-position) (line-beginning-position 2) diff --git a/lisp/org-info.el b/lisp/org-info.el index b6e8e09..79b9bcc 100644 --- a/lisp/org-info.el +++ b/lisp/org-info.el @@ -1,6 +1,6 @@ ;;; org-info.el --- Support for Links to Info Nodes -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -113,6 +113,19 @@ See `org-info-emacs-documents' and `org-info-other-documents' for details." ((cdr (assoc filename org-info-other-documents))) (t (concat filename ".html")))) +(defun org-info--expand-node-name (node) + "Expand Info NODE to HTML cross reference." + ;; See (info "(texinfo) HTML Xref Node Name Expansion") for the + ;; expansion rule. + (let ((node (replace-regexp-in-string + "\\([ \t\n\r]+\\)\\|\\([^a-zA-Z0-9]\\)" + (lambda (m) + (if (match-end 1) "-" (format "_%04x" (string-to-char m)))) + (org-trim node)))) + (cond ((string= node "") "") + ((string-match-p "\\`[0-9]" node) (concat "g_t" node)) + (t node)))) + (defun org-info-export (path desc format) "Export an info link. See `org-link-parameters' for details about PATH, DESC and FORMAT." @@ -123,7 +136,7 @@ See `org-link-parameters' for details about PATH, DESC and FORMAT." (node (or (match-string 2 path) "Top"))) (format "<a href=\"%s#%s\">%s</a>" (org-info-map-html-url filename) - (replace-regexp-in-string " " "-" node) + (org-info--expand-node-name node) (or desc path))))) (provide 'org-info) diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 910b1a0..2918d40 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -1,6 +1,6 @@ ;;; org-inlinetask.el --- Tasks Independent of Outline Hierarchy -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-irc.el b/lisp/org-irc.el index 2447793..3a6a7f4 100644 --- a/lisp/org-irc.el +++ b/lisp/org-irc.el @@ -1,6 +1,6 @@ ;;; org-irc.el --- Store Links to IRC Sessions -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Author: Philip Jackson <emacs@shellarchive.co.uk> ;; Keywords: erc, irc, link, org diff --git a/lisp/org-lint.el b/lisp/org-lint.el index 2f92bb4..89aed4b 100644 --- a/lisp/org-lint.el +++ b/lisp/org-lint.el @@ -1,6 +1,6 @@ ;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*- -;; Copyright (C) 2015-2016 Free Software Foundation +;; Copyright (C) 2015-2017 Free Software Foundation ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr> ;; Keywords: outlines, hypermedia, calendar, wp @@ -97,6 +97,7 @@ ;; - indented diary-sexps ;; - obsolete QUOTE section ;; - obsolete "file+application" link +;; - blank headlines with tags ;;; Code: @@ -278,7 +279,12 @@ (make-org-lint-checker :name 'file-application :description "Report obsolete \"file+application\" link" - :categories '(link obsolete))) + :categories '(link obsolete)) + (make-org-lint-checker + :name 'empty-headline-with-tags + :description "Report ambiguous empty headlines with tags" + :categories '(headline) + :trust 'low)) "List of all available checkers.") (defun org-lint--collect-duplicates @@ -1014,6 +1020,15 @@ Use \"export %s\" instead" reports)))))))))))) reports)) +(defun org-lint-empty-headline-with-tags (ast) + (org-element-map ast '(headline inlinetask) + (lambda (h) + (let ((title (org-element-property :raw-value h))) + (and (string-match-p "\\`:[[:alnum:]_@#%:]+:\\'" title) + (list (org-element-property :begin h) + (format "Headline containing only tags is ambiguous: %S" + title))))))) + ;;; Reports UI diff --git a/lisp/org-list.el b/lisp/org-list.el index 1eb1b50..a3e2625 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1,6 +1,6 @@ ;;; org-list.el --- Plain lists for Org -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Bastien Guerry <bzg@gnu.org> @@ -154,8 +154,8 @@ (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-trim "org" (s &optional keep-lead)) (declare-function org-uniquify "org" (list)) +(declare-function org-invisible-p "org" (&optional pos)) (declare-function outline-flag-region "outline" (from to flag)) -(declare-function outline-invisible-p "outline" (&optional pos)) (declare-function outline-next-heading "outline" ()) (declare-function outline-previous-heading "outline" ()) @@ -2256,7 +2256,7 @@ item is invisible." (unless (or (not itemp) (save-excursion (goto-char itemp) - (outline-invisible-p))) + (org-invisible-p))) (if (save-excursion (goto-char itemp) (org-at-item-timer-p)) @@ -2837,7 +2837,8 @@ Return t at each successful move." (t (user-error "Cannot move item")))) t)))) -(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) +(defun org-sort-list + (&optional with-case sorting-type getkey-func compare-func interactive?) "Sort list items. The cursor may be at any item of the list that should be sorted. Sublists are not sorted. Checkboxes, if any, are ignored. @@ -2863,13 +2864,15 @@ Capital letters will reverse the sort order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be called with point at the beginning of the -record. It must return either a string or a number that should -serve as the sorting key for that record. It will then use -COMPARE-FUNC to compare entries. +record. It must return a value that is compatible with COMPARE-FUNC, +the function used to compare entries. Sorting is done against the visible part of the headlines, it -ignores hidden links." - (interactive "P") +ignores hidden links. + +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively." + (interactive (list current-prefix-arg nil nil nil t)) (let* ((case-func (if with-case 'identity 'downcase)) (struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) @@ -2881,23 +2884,31 @@ ignores hidden links." (message "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") (read-char-exclusive)))) + (dcst (downcase sorting-type)) (getkey-func - (or getkey-func - (and (= (downcase sorting-type) ?f) - (intern (completing-read "Sort using function: " - obarray 'fboundp t nil nil)))))) + (and (= dcst ?f) + (or getkey-func + (and interactive? + (org-read-function "Function for extracting keys: ")) + (error "Missing key extractor")))) + (sort-func + (cond + ((= dcst ?a) #'string<) + ((= dcst ?f) + (or compare-func + (and interactive? + (org-read-function + (concat "Function for comparing keys " + "(empty for default `sort-subr' predicate): ") + 'allow-empty)))) + ((= dcst ?t) #'<) + ((= dcst ?x) #'string<)))) (message "Sorting items...") (save-restriction (narrow-to-region start end) (goto-char (point-min)) - (let* ((dcst (downcase sorting-type)) - (case-fold-search nil) + (let* ((case-fold-search nil) (now (current-time)) - (sort-func (cond - ((= dcst ?a) 'string<) - ((= dcst ?f) compare-func) - ((= dcst ?t) '<) - ((= dcst ?x) 'string<))) (next-record (lambda () (skip-chars-forward " \r\t\n") (or (eobp) (beginning-of-line)))) @@ -3199,7 +3210,7 @@ Point is left at list's end." (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." (interactive) - (let* ((e (assq major-mode org-list-radio-list-templates)) + (let* ((e (cl-assoc-if #'derived-mode-p org-list-radio-list-templates)) (txt (nth 1 e)) name pos) (unless e (error "No radio list setup defined for %s" major-mode)) diff --git a/lisp/org-loaddefs.el b/lisp/org-loaddefs.el index 1312741..6b8d11b 100644 --- a/lisp/org-loaddefs.el +++ b/lisp/org-loaddefs.el @@ -963,17 +963,19 @@ archive file is. (autoload 'org-archive-subtree "org-archive" "\ Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with a single prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -When called with a double prefix argument, find whole trees with timestamps before -today and archive them (after getting confirmation from the user). -If the cursor is not at a headline when these commands are called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading. +The archive can be a certain top-level heading in the current +file, or in a different file. The tree will be moved to that +location, the subtree heading be marked DONE, and the current +time will be added. + +When called with a single prefix argument FIND-DONE, find whole +trees without any open TODO items and archive them (after getting +confirmation from the user). When called with a double prefix +argument, find whole trees with timestamps before today and +archive them (after getting confirmation from the user). If the +cursor is not at a headline when these commands are called, try +all level 1 trees. If the cursor is on a headline, only try the +direct children of this heading. \(fn &optional FIND-DONE)" t nil) @@ -2039,13 +2041,14 @@ any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that sorting should be done in reverse order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies -a function to be called to extract the key. It must return either -a string or a number that should serve as the sorting key for that -row. It will then use COMPARE-FUNC to compare entries. If GETKEY-FUNC -is specified interactively, the comparison will be either a string or -numeric compare based on the type of the first key in the table. +a function to be called to extract the key. It must return a value +that is compatible with COMPARE-FUNC, the function used to compare +entries. -\(fn WITH-CASE &optional SORTING-TYPE GETKEY-FUNC COMPARE-FUNC)" t nil) +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively. + +\(fn &optional WITH-CASE SORTING-TYPE GETKEY-FUNC COMPARE-FUNC INTERACTIVE\\=\\?)" t nil) (autoload 'org-table-cut-region "org-table" "\ Copy region in table to the clipboard and blank all relevant fields. @@ -2717,9 +2720,9 @@ Store an org-link to the current location. This link is added to `org-stored-links' and can later be inserted into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). -For some link types, a `\\[universal-argument]' prefix ARG is interpreted. -For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'. -For file links, ARG negates `org-context-in-file-links'. +For some link types, a `\\[universal-argument]' prefix ARG is interpreted. A single +`\\[universal-argument]' negates `org-context-in-file-links' for file links or +`org-gnus-prefer-web-links' for links to Usenet articles. A `\\[universal-argument] \\[universal-argument]' prefix ARG forces skipping storing functions that are not part of Org core. @@ -3193,6 +3196,17 @@ The file is stored under the name chosen in ;;;### (autoloads nil "ox-latex" "ox-latex.el" (0 0 0 0)) ;;; Generated autoloads from ox-latex.el +(autoload 'org-latex-make-preamble "ox-latex" "\ +Return a formatted LaTeX preamble. +INFO is a plist used as a communication channel. Optional +argument TEMPLATE, when non-nil, is the header template string, +as expected by `org-splice-latex-header'. When SNIPPET? is +non-nil, only includes packages relevant to image generation, as +specified in `org-latex-default-packages-alist' or +`org-latex-packages-alist'. + +\(fn INFO &optional TEMPLATE SNIPPET\\=\\?)" nil nil) + (autoload 'org-latex-export-as-latex "ox-latex" "\ Export current buffer as a LaTeX buffer. @@ -3616,6 +3630,27 @@ command to convert it. ;;;### (autoloads nil "ox" "ox.el" (0 0 0 0)) ;;; Generated autoloads from ox.el +(autoload 'org-export-get-backend "ox" "\ +Return export back-end named after NAME. +NAME is a symbol. Return nil if no such back-end is found. + +\(fn NAME)" nil nil) + +(autoload 'org-export-get-environment "ox" "\ +Collect export options from the current buffer. + +Optional argument BACKEND is an export back-end, as returned by +`org-export-create-backend'. + +When optional argument SUBTREEP is non-nil, assume the export is +done against the current sub-tree. + +Third optional argument EXT-PLIST is a property list with +external parameters overriding Org default settings, but still +inferior to file-local settings. + +\(fn &optional BACKEND SUBTREEP EXT-PLIST)" nil nil) + (autoload 'org-export-as "ox" "\ Transcode current Org buffer into BACKEND code. diff --git a/lisp/org-macro.el b/lisp/org-macro.el index 8560891..3dc9c54 100644 --- a/lisp/org-macro.el +++ b/lisp/org-macro.el @@ -1,6 +1,6 @@ ;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou@gmail.com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -49,14 +49,11 @@ (declare-function org-element-at-point "org-element" ()) (declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-map "org-element" - (data types fun &optional info first-match no-recursion - with-affiliated)) -(declare-function org-element-parse-buffer "org-element" - (&optional granularity visible-only)) +(declare-function org-element-macro-parser "org-element" ()) (declare-function org-element-property "org-element" (property element)) (declare-function org-element-type "org-element" (element)) (declare-function org-file-contents "org" (file &optional noerror)) +(declare-function org-in-commented-heading-p "org" (&optional no-inheritance)) (declare-function org-mode "org" ()) (declare-function vc-backend "vc-hooks" (f)) (declare-function vc-call "vc-hooks" (fun file &rest args) t) @@ -189,55 +186,56 @@ found in the buffer with no definition in TEMPLATES. Optional argument KEYWORDS, when non-nil is a list of keywords, as strings, where macro expansion is allowed." - (org-with-wide-buffer - (goto-char (point-min)) - (let ((properties-regexp - (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords))) - record) - (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) - (let* ((datum (save-match-data (org-element-context))) - (type (org-element-type datum)) - (macro - (cond - ((eq type 'macro) datum) - ;; In parsed keywords and associated node properties, - ;; force macro recognition. - ((or (and (eq type 'keyword) - (member (org-element-property :key datum) keywords)) - (and (eq type 'node-property) - (string-match-p - properties-regexp - (org-element-property :key datum)))) - (save-restriction - (narrow-to-region (match-beginning 0) (line-end-position)) - (org-element-map (org-element-parse-buffer) 'macro - #'identity nil t)))))) - (when macro - (let* ((value (org-macro-expand macro templates)) - (begin (org-element-property :begin macro)) - (signature (list begin - macro - (org-element-property :args macro)))) - ;; Avoid circular dependencies by checking if the same - ;; macro with the same arguments is expanded at the same - ;; position twice. - (cond ((member signature record) - (error "Circular macro expansion: %s" - (org-element-property :key macro))) - (value - (push signature record) - (delete-region - begin - ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end macro)) - (skip-chars-backward " \t") - (point))) - ;; Leave point before replacement in case of - ;; recursive expansions. - (save-excursion (insert value))) - (finalize - (error "Undefined Org macro: %s; aborting" - (org-element-property :key macro))))))))))) + (save-excursion + (goto-char (point-min)) + (let ((properties-regexp + (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords))) + record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (unless (save-match-data (org-in-commented-heading-p)) + (let* ((datum (save-match-data (org-element-context))) + (type (org-element-type datum)) + (macro + (cond + ((eq type 'macro) datum) + ;; In parsed keywords and associated node + ;; properties, force macro recognition. + ((or (and (eq type 'keyword) + (member (org-element-property :key datum) + keywords)) + (and (eq type 'node-property) + (string-match-p properties-regexp + (org-element-property :key + datum)))) + (save-excursion + (goto-char (match-beginning 0)) + (org-element-macro-parser)))))) + (when macro + (let* ((value (org-macro-expand macro templates)) + (begin (org-element-property :begin macro)) + (signature (list begin + macro + (org-element-property :args macro)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the + ;; same position twice. + (cond ((member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key macro))) + (value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end macro)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of + ;; recursive expansions. + (save-excursion (insert value))) + (finalize + (error "Undefined Org macro: %s; aborting" + (org-element-property :key macro)))))))))))) (defun org-macro-escape-arguments (&rest args) "Build macro's arguments string from ARGS. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index b7da6c6..ca47e5a 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -1,6 +1,6 @@ ;;; org-macs.el --- Top-level Definitions for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -294,6 +294,16 @@ removed." (substring string (length pre) (- (length post))) string)) +(defun org-read-function (prompt &optional allow-empty?) + "Prompt for a function. +If ALLOW-EMPTY? is non-nil, return nil rather than raising an +error when the user input is empty." + (let ((func (completing-read prompt obarray #'fboundp t))) + (cond ((not (string= func "")) + (intern func)) + (allow-empty? nil) + (t (user-error "Empty input is not valid"))))) + (provide 'org-macs) ;;; org-macs.el ends here diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el index 5d9ae58..4142ae4 100644 --- a/lisp/org-mhe.el +++ b/lisp/org-mhe.el @@ -1,6 +1,6 @@ ;;; org-mhe.el --- Support for Links to MH-E Messages -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> ;; Keywords: outlines, hypermedia, calendar, wp @@ -203,7 +203,7 @@ folders." (mh-search folder (list "--message-id" article)) (when (and org-mhe-search-all-folders (not (org-mhe-get-message-real-folder))) - (kill-this-buffer) + (kill-buffer) (mh-search "+" (list "--message-id" article)))) (if mh-search-regexp-builder (mh-search "+" (funcall mh-search-regexp-builder @@ -211,7 +211,7 @@ folders." (mh-search "+" article))) (if (org-mhe-get-message-real-folder) (mh-show-msg 1) - (kill-this-buffer) + (kill-buffer) (error "Message not found")))) (provide 'org-mhe) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 3ef3f4e..12e6c84 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -1,5 +1,5 @@ ;;; org-mobile.el --- Code for Asymmetric Sync With a Mobile Device -*- lexical-binding: t; -*- -;; Copyright (C) 2009-2016 Free Software Foundation, Inc. +;; Copyright (C) 2009-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -308,40 +308,29 @@ Also exclude files matching `org-mobile-files-exclude-regexp'." This will create the index file, copy all agenda files there, and also create all custom agenda views, for upload to the mobile phone." (interactive) - (let ((a-buffer (get-buffer org-agenda-buffer-name))) - (let ((org-agenda-curbuf-name org-agenda-buffer-name) - (org-agenda-buffer-name "*SUMO*") - (org-agenda-tag-filter org-agenda-tag-filter) - (org-agenda-redo-command org-agenda-redo-command)) - (save-excursion - (save-restriction - (save-window-excursion - (run-hooks 'org-mobile-pre-push-hook) - (org-mobile-check-setup) - (org-mobile-prepare-file-lists) - (message "Creating agendas...") - (let ((inhibit-redisplay t) - (org-agenda-files (mapcar 'car org-mobile-files-alist))) - (org-mobile-create-sumo-agenda)) - (message "Creating agendas...done") - (org-save-all-org-buffers) ; to save any IDs created by this process - (message "Copying files...") - (org-mobile-copy-agenda-files) - (message "Writing index file...") - (org-mobile-create-index-file) - (message "Writing checksums...") - (org-mobile-write-checksums) - (run-hooks 'org-mobile-post-push-hook)))) - (setq org-agenda-buffer-name org-agenda-curbuf-name - org-agenda-this-buffer-name org-agenda-curbuf-name)) - (redraw-display) - (when (buffer-live-p a-buffer) - (if (not (get-buffer-window a-buffer)) - (kill-buffer a-buffer) - (let ((cw (selected-window))) - (select-window (get-buffer-window a-buffer)) - (org-agenda-redo) - (select-window cw))))) + (let ((org-agenda-buffer-name "*SUMO*") + (org-agenda-tag-filter org-agenda-tag-filter) + (org-agenda-redo-command org-agenda-redo-command)) + (save-excursion + (save-restriction + (save-window-excursion + (run-hooks 'org-mobile-pre-push-hook) + (org-mobile-check-setup) + (org-mobile-prepare-file-lists) + (message "Creating agendas...") + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) + (message "Creating agendas...done") + (org-save-all-org-buffers) ; to save any IDs created by this process + (message "Copying files...") + (org-mobile-copy-agenda-files) + (message "Writing index file...") + (org-mobile-create-index-file) + (message "Writing checksums...") + (org-mobile-write-checksums) + (run-hooks 'org-mobile-post-push-hook))))) + (org-agenda-maybe-redo) (message "Files for mobile viewer staged")) (defvar org-mobile-before-process-capture-hook nil @@ -659,7 +648,7 @@ The table of checksums is written to the file mobile-checksums." (org-with-point-at pom (concat "olp:" (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) - "/" + ":" (mapconcat 'org-mobile-escape-olp (org-get-outline-path) "/") diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index 797a21f..d6a4727 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -1,6 +1,6 @@ ;;; org-mouse.el --- Better mouse support for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2006-2016 Free Software Foundation, Inc. +;; Copyright (C) 2006-2017 Free Software Foundation, Inc. ;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 5a52491..61ec5fa 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -1,6 +1,6 @@ ;;; org-pcomplete.el --- In-buffer Completion Code -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; John Wiegley <johnw at gnu dot org> diff --git a/lisp/org-plot.el b/lisp/org-plot.el index 6b51368..449143a 100644 --- a/lisp/org-plot.el +++ b/lisp/org-plot.el @@ -1,6 +1,6 @@ ;;; org-plot.el --- Support for Plotting from Org -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Author: Eric Schulte <schulte dot eric at gmail dot com> ;; Keywords: tables, plotting diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 4ffa030..8254356 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -1,6 +1,6 @@ ;;; org-protocol.el --- Intercept Calls from Emacsclient to Trigger Custom Actions -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; ;; Authors: Bastien Guerry <bzg@gnu.org> ;; Daniel M German <dmg AT uvic DOT org> @@ -498,7 +498,6 @@ Now template ?b will be used." (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link (setq org-stored-links (cons (list url title) org-stored-links)) - (kill-new orglink) (org-store-link-props :type type :link url :description title @@ -596,11 +595,14 @@ CLIENT is ignored." (let ((sub-protocols (append org-protocol-protocol-alist org-protocol-protocol-alist-default))) (catch 'fname - (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) + (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) + ":/+"))) (when (string-match the-protocol fname) (dolist (prolist sub-protocols) - (let ((proto (concat the-protocol - (regexp-quote (plist-get (cdr prolist) :protocol)) "\\(:/+\\|\\?\\)"))) + (let ((proto + (concat the-protocol + (regexp-quote (plist-get (cdr prolist) :protocol)) + "\\(:/+\\|\\?\\)"))) (when (string-match proto fname) (let* ((func (plist-get (cdr prolist) :function)) (greedy (plist-get (cdr prolist) :greedy)) @@ -613,12 +615,14 @@ CLIENT is ignored." (when (fboundp func) (unless greedy (throw 'fname - (condition-case nil - (funcall func (org-protocol-parse-parameters result new-style)) - (error - (warn "Please update your org protocol handler to deal with new-style links.") - (funcall func result))))) - ;; Greedy protocol handlers are responsible for parsing their own filenames + (if new-style + (funcall func (org-protocol-parse-parameters + result new-style)) + (warn "Please update your Org Protocol handler \ +to deal with new-style links.") + (funcall func result)))) + ;; Greedy protocol handlers are responsible for + ;; parsing their own filenames. (funcall func result) (throw 'fname t)))))))) fname))) @@ -651,11 +655,13 @@ The visited file needs to be part of a publishing project in `org-publish-project-alist' for this to work. The function delegates most of the work to `org-protocol-create'." (interactive) - (require 'org-publish) + (require 'ox-publish) (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) (if all (org-protocol-create (cdr all)) - (message "Not in an org-project. Did you mean `%s'?" - (substitute-command-keys "`\\[org-protocol-create]'"))))) + (message "%s" + (substitute-command-keys + "Not in an Org project. \ +Did you mean `\\[org-protocol-create]'?"))))) (defun org-protocol-create (&optional project-plist) "Create a new org-protocol project interactively. diff --git a/lisp/org-rmail.el b/lisp/org-rmail.el index f24e25b..31c59a1 100644 --- a/lisp/org-rmail.el +++ b/lisp/org-rmail.el @@ -1,6 +1,6 @@ ;;; org-rmail.el --- Support for Links to Rmail Messages -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org-src.el b/lisp/org-src.el index 89f3238..0e04d4b 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -1,6 +1,6 @@ ;;; org-src.el --- Source code examples in Org -*- lexical-binding: t; -*- ;; -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Bastien Guerry <bzg@gnu.org> @@ -215,7 +215,7 @@ green, respectability. (choice (face :tag "Face") (sexp :tag "Anonymous face")))) - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) (defcustom org-src-tab-acts-natively nil @@ -240,6 +240,12 @@ issued in the language major mode buffer." (defvar org-src--preserve-indentation nil) (defvar org-src--remote nil) (defvar org-src--saved-temp-window-config nil) +(defvar org-src--source-type nil + "Type of element being edited, as a symbol.") +(defvar org-src--tab-width nil + "Contains `tab-width' value from Org source buffer. +However, if `indent-tabs-mode' is nil in that buffer, its value +is 0.") (defun org-src--construct-edit-buffer-name (org-buffer-name lang) "Construct the buffer name for a source editing buffer." @@ -387,20 +393,34 @@ spaces after it as being outside." (defun org-src--contents-for-write-back () "Return buffer contents in a format appropriate for write back. Assume point is in the corresponding edit buffer." - (let ((indentation (or org-src--block-indentation 0)) - (preserve-indentation org-src--preserve-indentation) + (let ((indentation-offset + (if org-src--preserve-indentation 0 + (+ (or org-src--block-indentation 0) + (if (memq org-src--source-type '(example-block src-block)) + org-edit-src-content-indentation + 0)))) + (use-tabs? (and (> org-src--tab-width 0) t)) + (source-tab-width org-src--tab-width) (contents (org-with-wide-buffer (buffer-string))) (write-back org-src--allow-write-back)) (with-temp-buffer + ;; Reproduce indentation parameters from source buffer. + (setq-local indent-tabs-mode use-tabs?) + (when (> source-tab-width 0) (setq-local tab-width source-tab-width)) + ;; Apply WRITE-BACK function on edit buffer contents. (insert (org-no-properties contents)) (goto-char (point-min)) - (when (functionp write-back) (funcall write-back)) - (unless (or preserve-indentation (= indentation 0)) - (let ((ind (make-string indentation ?\s))) - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at-p "[ \t]*\\S-") (insert ind)) - (forward-line)))) + (when (functionp write-back) (save-excursion (funcall write-back))) + ;; Add INDENTATION-OFFSET to every non-empty line in buffer, + ;; unless indentation is meant to be preserved. + (when (> indentation-offset 0) + (while (not (eobp)) + (skip-chars-forward " \t") + (unless (eolp) ;ignore blank lines + (let ((i (current-column))) + (delete-region (line-beginning-position) (point)) + (indent-to (+ i indentation-offset)))) + (forward-line))) (buffer-string)))) (defun org-src--edit-element @@ -438,6 +458,7 @@ Leave point in edit buffer." (with-current-buffer old-edit-buffer (org-src--remove-overlay)) (kill-buffer old-edit-buffer)) (let* ((org-mode-p (derived-mode-p 'org-mode)) + (source-tab-width (if indent-tabs-mode tab-width 0)) (type (org-element-type datum)) (ind (org-with-wide-buffer (goto-char (org-element-property :begin datum)) @@ -477,10 +498,12 @@ Leave point in edit buffer." ;; Transmit buffer-local variables for exit function. It must ;; be done after initializing major mode, as this operation ;; may reset them otherwise. + (setq-local org-src--tab-width source-tab-width) (setq-local org-src--from-org-mode org-mode-p) (setq-local org-src--beg-marker beg) (setq-local org-src--end-marker end) (setq-local org-src--remote remote) + (setq-local org-src--source-type type) (setq-local org-src--block-indentation ind) (setq-local org-src--preserve-indentation preserve-ind) (setq-local org-src--overlay overlay) @@ -522,9 +545,10 @@ as `org-src-fontify-natively' is non-nil." (with-current-buffer (get-buffer-create (format " *org-src-fontification:%s*" lang-mode)) - (erase-buffer) - ;; Add string and a final space to ensure property change. - (insert string " ") + (let ((inhibit-modification-hooks nil)) + (erase-buffer) + ;; Add string and a final space to ensure property change. + (insert string " ")) (unless (eq major-mode lang-mode) (funcall lang-mode)) (org-font-lock-ensure) (let ((pos (point-min)) next) @@ -645,7 +669,8 @@ See also `org-src-mode-hook'." (setq buffer-offer-save t) (setq buffer-file-name (concat (buffer-file-name (marker-buffer org-src--beg-marker)) - "[" (buffer-name) "]"))) + "[" (buffer-name) "]")) + (setq-local write-contents-functions '(org-edit-src-save))) (setq buffer-read-only t)))) (add-hook 'org-src-mode-hook #'org-src-mode-configure-edit-buffer) @@ -785,45 +810,46 @@ A coderef format regexp can only match at the end of a line." (org-footnote-goto-definition label) (backward-char) (org-element-context))) - (inline (eq (org-element-type definition) 'footnote-reference)) + (inline? (eq 'footnote-reference (org-element-type definition))) (contents - (let ((c (org-with-wide-buffer - (org-trim (buffer-substring-no-properties - (org-element-property :begin definition) - (org-element-property :end definition)))))) - (add-text-properties - 0 - (progn (string-match (if inline "\\`\\[fn:.*?:" "\\`.*?\\]") c) - (match-end 0)) - '(read-only "Cannot edit footnote label" front-sticky t - rear-nonsticky t) - c) - (when inline - (let ((l (length c))) - (add-text-properties - (1- l) l - '(read-only "Cannot edit past footnote reference" - front-sticky nil rear-nonsticky nil) - c))) - c))) + (org-with-wide-buffer + (buffer-substring-no-properties + (or (org-element-property :post-affiliated definition) + (org-element-property :begin definition)) + (cond + (inline? (1+ (org-element-property :contents-end definition))) + ((org-element-property :contents-end definition)) + (t (goto-char (org-element-property :post-affiliated definition)) + (line-end-position))))))) + (add-text-properties + 0 + (progn (string-match (if inline? "\\`\\[fn:.*?:" "\\`.*?\\]") contents) + (match-end 0)) + '(read-only "Cannot edit footnote label" front-sticky t rear-nonsticky t) + contents) + (when inline? + (let ((l (length contents))) + (add-text-properties + (1- l) l + '(read-only "Cannot edit past footnote reference" + front-sticky nil rear-nonsticky nil) + contents))) (org-src--edit-element definition (format "*Edit footnote [%s]*" label) #'org-mode - `(lambda () - (if ,(not inline) (delete-region (point) (search-forward "]")) - (delete-region (point) (search-forward ":" nil t 2)) - (delete-region (1- (point-max)) (point-max)) - (when (re-search-forward "\n[ \t]*\n" nil t) - (user-error "Inline definitions cannot contain blank lines")) - ;; If footnote reference belongs to a table, make sure to - ;; remove any newline characters in order to preserve - ;; table's structure. - (when ,(org-element-lineage definition '(table-cell)) - (while (search-forward "\n" nil t) (delete-char -1))))) - (concat contents - (and (not (org-element-property :contents-begin definition)) - " ")) + (lambda () + (if (not inline?) (delete-region (point) (search-forward "]")) + (delete-region (point) (search-forward ":" nil t 2)) + (delete-region (1- (point-max)) (point-max)) + (when (re-search-forward "\n[ \t]*\n" nil t) + (user-error "Inline definitions cannot contain blank lines")) + ;; If footnote reference belongs to a table, make sure to + ;; remove any newline characters in order to preserve + ;; table's structure. + (when (org-element-lineage definition '(table-cell)) + (while (search-forward "\n" nil t) (replace-match ""))))) + contents 'remote)) ;; Report success. t)) @@ -915,16 +941,7 @@ name of the sub-editing buffer." (org-src--construct-edit-buffer-name (buffer-name) lang)) lang-f (and (null code) - `(lambda () - (unless ,(or org-src-preserve-indentation - (org-element-property :preserve-indent element)) - (when (> org-edit-src-content-indentation 0) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (indent-line-to (+ (org-get-indentation) - org-edit-src-content-indentation))) - (forward-line)))) - (org-escape-code-in-region (point-min) (point-max)))) + (lambda () (org-escape-code-in-region (point-min) (point-max)))) (and code (org-unescape-code-in-string code))) ;; Finalize buffer. (setq-local org-coderef-label-format @@ -1031,7 +1048,10 @@ Throw an error if there is no such buffer." (insert edited-code) (when (and expecting-bol (not (bolp))) (insert "\n"))) (save-buffer) - (move-overlay overlay beg (point))))) + (move-overlay overlay beg (point)))) + ;; `write-contents-functions' requires the function to return + ;; a non-nil value so that other functions are not called. + t) (defun org-edit-src-exit () "Kill current sub-editing buffer and return to source buffer." @@ -1046,8 +1066,10 @@ Throw an error if there is no such buffer." (code (and write-back (org-src--contents-for-write-back)))) (set-buffer-modified-p nil) ;; Switch to source buffer. Kill sub-editing buffer. - (let ((edit-buffer (current-buffer))) - (org-src-switch-to-buffer (marker-buffer beg) 'exit) + (let ((edit-buffer (current-buffer)) + (source-buffer (marker-buffer beg))) + (unless source-buffer (error "Source buffer disappeared. Aborting")) + (org-src-switch-to-buffer source-buffer 'exit) (kill-buffer edit-buffer)) ;; Insert modified code. Ensure it ends with a newline character. (org-with-wide-buffer @@ -1066,7 +1088,7 @@ Throw an error if there is no such buffer." (cond ;; Block is hidden; move at start of block. ((cl-some (lambda (o) (eq (overlay-get o 'invisible) 'org-hide-block)) - (overlays-at (point))) + (overlays-at (point))) (beginning-of-line 0)) (write-back (org-src--goto-coordinates coordinates beg end)))) ;; Clean up left-over markers and restore window configuration. diff --git a/lisp/org-table.el b/lisp/org-table.el index 4bd1c89..40a715a 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -1,6 +1,6 @@ ;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -265,7 +265,7 @@ t accept as input and present for editing" "Non-nil means increment when copying current field with \ `\\[org-table-copy-down]'." :group 'org-table-calculation - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "Use the difference between the current and the above fields" t) @@ -378,7 +378,7 @@ portability of tables." "Non-nil means that evaluation of a field formula can add new columns if an out-of-bounds field is being set." :group 'org-table-calculation - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "Setting an out-of-bounds field generates an error (default)" nil) @@ -407,7 +407,7 @@ The function can be slow on larger regions; this safety feature prevents it from hanging emacs." :group 'org-table-import-export :type 'integer - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" @@ -1155,7 +1155,7 @@ to a number. In the case of a timestamp, increment by days." (- (org-time-string-to-absolute txt) (org-time-string-to-absolute txt-up))) ((string-match org-ts-regexp3 txt) 1) - ((string-match "^[0-9]+\\(\.[0-9]+\\)?" txt-up) + ((string-match "\\([-+]\\)?[0-9]+\\(?:\.[0-9]+\\)?" txt-up) (- (string-to-number txt) (string-to-number (match-string 0 txt-up)))) (t 1))) @@ -1250,21 +1250,21 @@ Return t when the line exists, nil if it does not exist." (defun org-table-get-field (&optional n replace) "Return the value of the field in column N of current row. -N defaults to current field. -If REPLACE is a string, replace field with this value. The return value -is always the old value." - (and n (org-table-goto-column n)) +N defaults to current column. If REPLACE is a string, replace +field with this value. The return value is always the old +value." + (when n (org-table-goto-column n)) (skip-chars-backward "^|\n") - (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (if replace - (replace-match (concat "|" (if (equal replace "") " " replace)) - t t)) - (goto-char (min (point-at-eol) (+ 2 pos))) - val) - (forward-char 1) "")) + (if (or (bolp) (looking-at-p "[ \t]*$")) + ;; Before first column or after last one. + "" + (looking-at "[^|\r\n]*") + (let* ((pos (match-beginning 0)) + (val (buffer-substring pos (match-end 0)))) + (when replace + (replace-match (if (equal replace "") " " replace) t t)) + (goto-char (min (line-end-position) (1+ pos))) + val))) ;;;###autoload (defun org-table-field-info (_arg) @@ -1494,7 +1494,9 @@ non-nil, the one above is used." (unless (org-at-table-hline-p) (org-table-goto-column col1 t) (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|"))) + (transpose-regions + (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2)))) (forward-line))) (set-marker end nil) (org-table-goto-column colpos) @@ -1645,7 +1647,8 @@ In particular, this does handle wide and invisible characters." dline -1 dline)))) ;;;###autoload -(defun org-table-sort-lines (with-case &optional sorting-type getkey-func compare-func) +(defun org-table-sort-lines + (&optional with-case sorting-type getkey-func compare-func interactive?) "Sort table lines according to the column at point. The position of point indicates the column to be used for @@ -1669,12 +1672,13 @@ any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that sorting should be done in reverse order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies -a function to be called to extract the key. It must return either -a string or a number that should serve as the sorting key for that -row. It will then use COMPARE-FUNC to compare entries. If GETKEY-FUNC -is specified interactively, the comparison will be either a string or -numeric compare based on the type of the first key in the table." - (interactive "P") +a function to be called to extract the key. It must return a value +that is compatible with COMPARE-FUNC, the function used to compare +entries. + +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively." + (interactive (list current-prefix-arg nil nil nil t)) (when (org-region-active-p) (goto-char (region-beginning))) ;; Point must be either within a field or before a data line. (save-excursion @@ -1684,7 +1688,7 @@ numeric compare based on the type of the first key in the table." ;; Set appropriate case sensitivity and column used for sorting. (let ((column (let ((c (org-table-current-column))) (cond ((> c 0) c) - ((called-interactively-p 'any) + (interactive? (read-number "Use column N for sorting: ")) (t 1)))) (sorting-type @@ -1732,17 +1736,21 @@ numeric compare based on the type of the first key in the table." (t 0)))) ((?f ?F) (or getkey-func - (and (called-interactively-p 'any) - (intern - (completing-read "Sort using function: " - obarray #'fboundp t))) + (and interactive? + (org-read-function "Function for extracting keys: ")) (error "Missing key extractor to sort rows"))) (t (user-error "Invalid sorting type `%c'" sorting-type)))) (predicate (cl-case sorting-type ((?n ?N ?t ?T) #'<) ((?a ?A) #'string<) - ((?f ?F) compare-func)))) + ((?f ?F) + (or compare-func + (and interactive? + (org-read-function + (concat "Fuction for comparing keys " + "(empty for default `sort-subr' predicate): ") + 'allow-empty))))))) (goto-char (point-min)) (sort-subr (memq sorting-type '(?A ?N ?T ?F)) (lambda () @@ -4472,7 +4480,7 @@ to execute outside of tables." "--" ("Radio tables" ["Insert table template" orgtbl-insert-radio-table - (assq major-mode orgtbl-radio-table-templates)] + (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)] ["Comment/uncomment table" orgtbl-toggle-comment t]) "--" ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] @@ -4721,7 +4729,7 @@ First element has index 0, or I0 if given." (defun orgtbl-insert-radio-table () "Insert a radio table template appropriate for this major mode." (interactive) - (let* ((e (assq major-mode orgtbl-radio-table-templates)) + (let* ((e (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)) (txt (nth 1 e)) name pos) (unless e (user-error "No radio table setup defined for %s" major-mode)) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 2d2ee21..146775b 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -1,6 +1,6 @@ ;;; org-timer.el --- Timer code for Org mode -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Keywords: outlines, hypermedia, calendar, wp @@ -69,7 +69,7 @@ the value of the timer." "The default timer when a timer is set, in minutes or hh:mm:ss format. When 0, the user is prompted for a value." :group 'org-time - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'string) diff --git a/lisp/org-version.el b/lisp/org-version.el index bae032b..c083a83 100644 --- a/lisp/org-version.el +++ b/lisp/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.0.3")) + (let ((org-release "9.0.9")) org-release)) ;;;###autoload (defun org-git-version () "The Git version of org-mode. Inserted by installing Org or when a release is made." - (let ((org-git-version "9.0.3-dist")) + (let ((org-git-version "9.0.9-dist")) org-git-version)) ;;;###autoload (defvar org-odt-data-dir "/usr/share/emacs/etc/org" diff --git a/lisp/org-w3m.el b/lisp/org-w3m.el index 2f40169..e9bbeff 100644 --- a/lisp/org-w3m.el +++ b/lisp/org-w3m.el @@ -1,6 +1,6 @@ ;;; org-w3m.el --- Support from Copy and Paste From w3m -*- lexical-binding: t; -*- -;; Copyright (C) 2008-2016 Free Software Foundation, Inc. +;; Copyright (C) 2008-2017 Free Software Foundation, Inc. ;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/org.el b/lisp/org.el index 68befe3..22b7dbf 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1,7 +1,7 @@ ;;; org.el --- Outline-based notes management and organizer -*- lexical-binding: t; -*- ;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Maintainer: Carsten Dominik <carsten at orgmode dot org> @@ -115,8 +115,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function isearch-no-upper-case-p "isearch" (string regexp-flag)) (declare-function org-add-archive-files "org-archive" (files)) (declare-function org-agenda-entry-get-agenda-timestamp "org-agenda" (pom)) -(declare-function org-agenda-list "org-agenda" - (&optional arg start-day span with-hour)) +(declare-function org-agenda-list "org-agenda" (&optional arg start-day span with-hour)) (declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-babel-do-in-edit-buffer "ob-core" (&rest body) t) (declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) @@ -138,6 +137,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-element-copy "org-element" (datum)) (declare-function org-element-interpret-data "org-element" (data)) (declare-function org-element-lineage "org-element" (blob &optional types with-self)) +(declare-function org-element-link-parser "org-element" ()) (declare-function org-element-nested-p "org-element" (elem-a elem-b)) (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only)) (declare-function org-element-property "org-element" (property element)) @@ -172,6 +172,9 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function orgtbl-ascii-plot "org-table" (&optional ask)) (declare-function orgtbl-mode "org-table" (&optional arg)) +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist)) +(declare-function org-latex-make-preamble "ox-latex" (info &optional template snippet?)) (defsubst org-uniquify (list) "Non-destructively remove duplicate elements from LIST." @@ -533,10 +536,10 @@ An entry can be toggled between COMMENT and normal with (defconst org-latex-regexps '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) - ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) + ;; ("$" "\\([ \t(]\\|^\\)\\(\\(\\([$]\\)\\([^ \t\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \t\n,.$]\\)\\4\\)\\)\\([ \t.,?;:'\")]\\|$\\)" 2 nil) ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|$\\)" 2 nil) + ("$1" "\\([^$]\\|^\\)\\(\\$[^ \t\r\n,;.$]\\$\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) + ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \t\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \t\n,.$]\\)\\$\\)\\)\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|\000\\|'\\|$\\)" 2 nil) ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) @@ -789,7 +792,7 @@ Adding a back-end to this list will also pull the back-end it depends on, if any." :group 'org :group 'org-export - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :initialize 'custom-initialize-set :set (lambda (var val) @@ -1204,7 +1207,7 @@ make it harder to edit the location of the match. In such a case, use the command `org-reveal' (`\\[org-reveal]') to show more context." :group 'org-reveal-location - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type '(choice (const :tag "Canonical" t) @@ -1425,7 +1428,7 @@ argument is a symbol. After a global state change, it can have the values the values `folded', `children', or `subtree'." :group 'org-cycle :type 'hook - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) (defgroup org-edit-structure nil @@ -1692,7 +1695,7 @@ The highlights created by `org-toggle-latex-fragment' always need If set to `smart' the search will be case-insensitive only if it doesn't specify any upper case character." :group 'org-sparse-trees - :version "25.2" + :version "26.1" :type '(choice (const :tag "Case-sensitive" nil) (const :tag "Case-insensitive" t) @@ -3826,14 +3829,14 @@ in this variable)." (regexp :tag "Properties matched by regexp"))) (defun org-property-inherit-p (property) - "Check if PROPERTY is one that should be inherited." + "Return a non-nil value if PROPERTY should be inherited." (cond ((eq org-use-property-inheritance t) t) ((not org-use-property-inheritance) nil) ((stringp org-use-property-inheritance) (string-match org-use-property-inheritance property)) ((listp org-use-property-inheritance) - (member property org-use-property-inheritance)) + (member-ignore-case property org-use-property-inheritance)) (t (error "Invalid setting of `org-use-property-inheritance'")))) (defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" @@ -4079,7 +4082,7 @@ When using LaTeXML set this option to All available processes and theirs documents can be found in `org-preview-latex-process-alist', which see." :group 'org-latex - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type 'symbol) @@ -4169,7 +4172,7 @@ Place-holders only used by `:image-converter': %S the image size scale ratio, which is used to adjust image size by some processing commands." :group 'org-latex - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type '(alist :tag "LaTeX to image backends" :value-type (plist))) @@ -4180,7 +4183,7 @@ A relative path here creates many directories relative to the processed org files paths. An absolute path puts all preview images at the same place." :group 'org-latex - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type 'string) @@ -4298,7 +4301,7 @@ A string will be inserted as-is in the header of the document." :group 'org-export-latex :set 'org-set-packages-alist :get 'org-get-packages-alist - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(repeat (choice @@ -4844,7 +4847,7 @@ Otherwise, these types are allowed: (const :tag "Only scheduled timestamps" scheduled) (const :tag "Only deadline timestamps" deadline) (const :tag "Only closed timestamps" closed)) - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :group 'org-sparse-trees) @@ -5677,7 +5680,7 @@ The following commands are available: (when org-startup-align-all-tables (org-table-map-tables #'org-table-align t)) (when org-startup-with-inline-images (org-display-inline-images)) - (when org-startup-with-latex-preview (org-toggle-latex-fragment)) + (when org-startup-with-latex-preview (org-toggle-latex-fragment '(16))) (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)) (when org-startup-truncated (setq truncate-lines t)) (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) @@ -5692,7 +5695,7 @@ The following commands are available: '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") ("7.8.11" . "24.1") ("7.9.4" . "24.3") ("8.2.6" . "24.4") ("8.2.10" . "24.5") - ("9.0" . "25.2"))) + ("9.0" . "26.1"))) (defvar org-mode-transpose-word-syntax-table (let ((st (make-syntax-table text-mode-syntax-table))) @@ -5845,7 +5848,7 @@ This should be called after the variable `org-link-parameters' has changed." org-plain-link-re (concat "\\<" types-re ":" - "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") + "\\([^][ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)") ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" @@ -5954,62 +5957,72 @@ prompted for." (defsubst org-rear-nonsticky-at (pos) (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) -(defun org-activate-plain-links (limit) - "Add link properties for plain links." - (when (and (re-search-forward org-plain-link-re limit t) - (not (org-in-src-block-p))) - - (let* ((face (get-text-property (max (1- (match-beginning 0)) (point-min)) - 'face)) - (link (match-string-no-properties 0)) - (type (match-string-no-properties 1)) - (path (match-string-no-properties 2)) - (link-start (match-beginning 0)) - (link-end (match-end 0)) - (link-face (org-link-get-parameter type :face)) - (help-echo (org-link-get-parameter type :help-echo)) - (htmlize-link (org-link-get-parameter type :htmlize-link)) - (activate-func (org-link-get-parameter type :activate-func))) - (unless (if (consp face) (memq 'org-tag face) (eq 'org-tag face)) - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list - 'mouse-face (or (org-link-get-parameter type :mouse-face) - 'highlight) - 'face (cond - ;; A function that returns a face - ((functionp link-face) - (funcall link-face path)) - ;; a face - ((facep link-face) - link-face) - ;; An anonymous face - ((consp link-face) - link-face) - ;; default - (t - 'org-link)) - 'help-echo (cond - ((stringp help-echo) - help-echo) - ((functionp help-echo) - help-echo) - (t - (concat "LINK: " - (save-match-data - (org-link-unescape link))))) - 'htmlize-link (cond - ((functionp htmlize-link) - (funcall htmlize-link path)) - (t - `(:uri ,link))) - 'keymap (or (org-link-get-parameter type :keymap) - org-mouse-map) - 'org-link-start (match-beginning 0))) - (org-rear-nonsticky-at (match-end 0)) - (when activate-func - (funcall activate-func link-start link-end path nil)) - t)))) +(defun org-activate-links (limit) + "Add link properties to links. +This includes angle, plain, and bracket links." + (catch :exit + (while (re-search-forward org-any-link-re limit t) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (style (cond ((eq ?< (char-after start)) 'angle) + ((eq ?\[ (char-after (1+ start))) 'bracket) + (t 'plain)))) + (when (and (memq style org-highlight-links) + ;; Do not confuse plain links with tags. + (not (and (eq style 'plain) + (let ((face (get-text-property + (max (1- start) (point-min)) 'face))) + (if (consp face) (memq 'org-tag face) + (eq 'org-tag face)))))) + (let* ((link-object (save-excursion + (goto-char start) + (save-match-data (org-element-link-parser)))) + (link (org-element-property :raw-link link-object)) + (type (org-element-property :type link-object)) + (path (org-element-property :path link-object)) + (properties ;for link's visible part + (list + 'face (pcase (org-link-get-parameter type :face) + ((and (pred functionp) face) (funcall face path)) + ((and (pred facep) face) face) + ((and (pred consp) face) face) ;anonymous + (_ 'org-link)) + 'mouse-face (or (org-link-get-parameter type :mouse-face) + 'highlight) + 'keymap (or (org-link-get-parameter type :keymap) + org-mouse-map) + 'help-echo (pcase (org-link-get-parameter type :help-echo) + ((and (pred stringp) echo) echo) + ((and (pred functionp) echo) echo) + (_ (concat "LINK: " link))) + 'htmlize-link (pcase (org-link-get-parameter type + :htmlize-link) + ((and (pred functionp) f) (funcall f)) + (_ `(:uri ,link))) + 'font-lock-multiline t))) + (org-remove-flyspell-overlays-in start end) + (org-rear-nonsticky-at end) + (if (not (eq 'bracket style)) + (add-text-properties start end properties) + ;; Handle invisible parts in bracket links. + (remove-text-properties start end '(invisible nil)) + (let ((hidden + (append `(invisible + ,(or (org-link-get-parameter type :display) + 'org-link)) + properties)) + (visible-start (or (match-beginning 4) (match-beginning 2))) + (visible-end (or (match-end 4) (match-end 2)))) + (add-text-properties start visible-start hidden) + (add-text-properties visible-start visible-end properties) + (add-text-properties visible-end end hidden) + (org-rear-nonsticky-at visible-start) + (org-rear-nonsticky-at visible-end))) + (let ((f (org-link-get-parameter type :activate-func))) + (when (functionp f) + (funcall f start end path (eq style 'bracket)))) + (throw :exit t))))) ;signal success + nil)) (defun org-activate-code (limit) (when (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) @@ -6092,9 +6105,11 @@ by a #." '(org-block))))))) ; end of source block ((not org-fontify-quote-and-verse-blocks)) ((string= block-type "quote") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) + (add-face-text-property + beg1 (min (point-max) (1+ end1)) 'org-quote t)) ((string= block-type "verse") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) + (add-face-text-property + beg1 (min (point-max) (1+ end1)) 'org-verse t))) (add-text-properties beg beg1 '(face org-block-begin-line)) (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) '(face org-block-end-line)) @@ -6162,18 +6177,6 @@ by a #." (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) t)) -(defun org-activate-angle-links (limit) - "Add text properties for angle links." - (when (and (re-search-forward org-angle-link-re limit t) - (not (org-in-src-block-p))) - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map - 'font-lock-multiline t)) - (org-rear-nonsticky-at (match-end 0)) - t)) - (defun org-activate-footnote-links (limit) "Add text properties for footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) @@ -6197,96 +6200,6 @@ by a #." 'font-lock-multiline t 'face 'org-footnote)))))) -(defun org-activate-bracket-links (limit) - "Add text properties for bracketed links." - (when (and (re-search-forward org-bracket-link-regexp limit t) - (not (org-in-src-block-p))) - (let* ((hl (save-match-data - (org-link-expand-abbrev (match-string-no-properties 1)))) - (type (save-match-data - (and (string-match org-plain-link-re hl) - (match-string-no-properties 1 hl)))) - (path (save-match-data - (and (string-match org-plain-link-re hl) - (match-string-no-properties 2 hl)))) - (link-start (match-beginning 0)) - (link-end (match-end 0)) - (bracketp t) - (help-echo (org-link-get-parameter type :help-echo)) - (help (cond - ((stringp help-echo) - help-echo) - ((functionp help-echo) - help-echo) - (t - (concat "LINK: " - (save-match-data - (org-link-unescape hl)))))) - (link-face (org-link-get-parameter type :face)) - (face (cond - ;; A function that returns a face - ((functionp link-face) - (funcall link-face path)) - ;; a face - ((facep link-face) - link-face) - ;; An anonymous face - ((consp link-face) - link-face) - ;; default - (t - 'org-link))) - (keymap (or (org-link-get-parameter type :keymap) - org-mouse-map)) - (mouse-face (or (org-link-get-parameter type :mouse-face) - 'highlight)) - (htmlize (org-link-get-parameter type :htmlize-link)) - (htmlize-link (cond - ((functionp htmlize) - (funcall htmlize)) - (t - `(:uri ,(format "%s:%s" type path))))) - (activate-func (org-link-get-parameter type :activate-func)) - ;; invisible part - (ip (list 'invisible (or - (org-link-get-parameter type :display) - 'org-link) - 'face face - 'keymap keymap - 'mouse-face mouse-face - 'font-lock-multiline t - 'help-echo help - 'htmlize-link htmlize-link)) - ;; visible part - (vp (list 'keymap keymap - 'face face - 'mouse-face mouse-face - 'font-lock-multiline t - 'help-echo help - 'htmlize-link htmlize-link))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (org-rear-nonsticky-at (match-beginning 3)) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (org-rear-nonsticky-at (match-end 3)) - (add-text-properties (match-end 3) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (org-rear-nonsticky-at (match-beginning 1)) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (org-rear-nonsticky-at (match-end 1)) - (add-text-properties (match-end 1) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - (when activate-func - (funcall activate-func link-start link-end path bracketp)) - t))) - (defun org-activate-dates (limit) "Add text properties for dates." (when (and (re-search-forward org-tsr-regexp-both limit t) @@ -6553,11 +6466,9 @@ needs to be inserted at a specific position in the font-lock sequence.") (list org-property-re '(1 'org-special-keyword t) '(3 'org-property-value t)) - ;; Links + ;; Link related fontification. + '(org-activate-links) (when (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (when (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (when (memq 'plain lk) '(org-activate-plain-links (0 'org-link))) - (when (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link))) (when (memq 'radio lk) '(org-activate-target-links (1 'org-link t))) (when (memq 'date lk) '(org-activate-dates (0 'org-date t))) (when (memq 'footnote lk) '(org-activate-footnote-links)) @@ -7073,6 +6984,11 @@ Use `\\[org-edit-special]' to edit table.el tables")) (defvar org-called-with-limited-levels nil "Non-nil when `org-with-limited-levels' is currently active.") +(defun org-invisible-p (&optional pos) + "Non-nil if the character after POS is invisible. +If POS is nil, use `point' instead." + (get-char-property (or pos (point)) 'invisible)) + (defun org-cycle-internal-local () "Do the local cycling action." (let ((goal-column 0) eoh eol eos has-children children-skipped struct) @@ -7116,7 +7032,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (save-excursion (goto-char eos) (outline-next-heading) - (when (outline-invisible-p) (org-flag-heading nil)))) + (when (org-invisible-p) (org-flag-heading nil)))) ((and (or (>= eol eos) (not (string-match "\\S-" (buffer-substring eol eos)))) (or has-children @@ -7150,7 +7066,7 @@ Use `\\[org-edit-special]' to edit table.el tables")) (save-excursion (goto-char eos) (outline-next-heading) - (when (outline-invisible-p) (org-flag-heading nil))) + (when (org-invisible-p) (org-flag-heading nil))) (setq org-cycle-subtree-status 'children) (unless (org-before-first-heading-p) (run-hook-with-args 'org-cycle-hook 'children))) @@ -7324,9 +7240,9 @@ This function is the default value of the hook `org-cycle-hook'." ;; Properly fold already folded siblings (goto-char (point-min)) (while (re-search-forward re nil t) - (when (and (not (outline-invisible-p)) + (when (and (not (org-invisible-p)) (save-excursion - (goto-char (point-at-eol)) (outline-invisible-p))) + (goto-char (point-at-eol)) (org-invisible-p))) (outline-hide-entry)))) (org-cycle-show-empty-lines 'overview) (org-cycle-hide-drawers 'overview))))) @@ -7679,7 +7595,7 @@ With a prefix argument, use the alternative interface: e.g., if (progn (org-mark-ring-push org-goto-start-pos) (goto-char selected-point) - (when (or (outline-invisible-p) (org-invisible-p2)) + (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'org-goto))) (message "Quit")))) @@ -7720,7 +7636,7 @@ or nil." (if (and (boundp 'org-goto-start-pos) (integer-or-marker-p org-goto-start-pos)) (progn (goto-char org-goto-start-pos) - (when (outline-invisible-p) + (when (org-invisible-p) (org-show-set-visibility 'lineage))) (goto-char (point-min))) (let (org-special-ctrl-a/e) (org-beginning-of-line)) @@ -8632,7 +8548,7 @@ case." (setq beg (point))) (save-match-data (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) + (setq folded (org-invisible-p))) (progn (org-end-of-subtree nil t) (unless (eobp) (backward-char)))) (outline-next-heading) @@ -8728,7 +8644,7 @@ useful if the caller implements cut-and-paste as copy-then-paste-then-cut." (if nosubtrees (outline-next-heading) (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) + (setq folded (org-invisible-p))) (ignore-errors (org-forward-heading-same-level (1- n) t)) (org-end-of-subtree t t))) ;; Include the end of an inlinetask @@ -8781,7 +8697,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (substitute-command-keys "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) (org-with-limited-levels - (let* ((visp (not (outline-invisible-p))) + (let* ((visp (not (org-invisible-p))) (txt tree) (^re_ "\\(\\*+\\)[ \t]*") (old-level (if (string-match org-outline-regexp-bol txt) @@ -8838,7 +8754,7 @@ When REMOVE is non-nil, remove the subtree from the clipboard." (goto-char beg) (skip-chars-forward " \t\n\r") (setq beg (point)) - (when (and (outline-invisible-p) visp) + (when (and (org-invisible-p) visp) (save-excursion (outline-show-heading))) ;; Shift if necessary (unless (= shift 0) @@ -8976,77 +8892,79 @@ subtree has a repeater. Setting N to 0, then, can be used to remove the repeater from a subtree and create a shifted clone with the original repeater." (interactive "nNumber of clones to produce: ") - (let ((shift - (or shift - (if (and (not (equal current-prefix-arg '(4))) - (save-excursion - (re-search-forward org-ts-regexp-both - (save-excursion - (org-end-of-subtree t) - (point)) t))) - (read-from-minibuffer - "Date shift per clone (e.g. +1w, empty to copy unchanged): ") - ""))) ;; No time shift - (n-no-remove -1) - (drawer-re org-drawer-regexp) - (org-clock-re (format "^[ \t]*%s.*$" org-clock-string)) - beg end template task idprop - shift-n shift-what doshift nmin nmax) - (unless (wholenump n) - (user-error "Invalid number of replications %s" n)) - (when (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) - (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" - shift))) - (user-error "Invalid shift specification %s" shift)) - (when doshift - (setq shift-n (string-to-number (match-string 1 shift)) - shift-what (cdr (assoc (match-string 2 shift) - '(("d" . day) ("w" . week) - ("m" . month) ("y" . year)))))) - (when (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) - (setq nmin 1 nmax n) - (org-back-to-heading t) - (setq beg (point)) - (setq idprop (org-entry-get nil "ID")) - (org-end-of-subtree t t) - (or (bolp) (insert "\n")) - (setq end (point)) - (setq template (buffer-substring beg end)) - (when (and doshift - (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) - (delete-region beg end) - (setq end beg) - (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) - (goto-char end) - (cl-loop for n from nmin to nmax do - ;; prepare clone - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) - (org-show-subtree) - (and idprop (if org-clone-delete-id - (org-entry-delete nil "ID") - (org-id-get-create t))) - (unless (= n 0) - (while (re-search-forward org-clock-re nil t) - (kill-whole-line)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (org-remove-empty-drawer-at (point)))) - (goto-char (point-min)) - (when doshift - (while (re-search-forward org-ts-regexp-both nil t) - (org-timestamp-change (* n shift-n) shift-what)) - (unless (= n n-no-remove) - (goto-char (point-min)) - (while (re-search-forward org-ts-regexp nil t) - (save-excursion - (goto-char (match-beginning 0)) - (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") - (delete-region (match-beginning 1) (match-end 1))))))) - (setq task (buffer-string))) - (insert task)) + (unless (wholenump n) (user-error "Invalid number of replications %s" n)) + (when (org-before-first-heading-p) (user-error "No subtree to clone")) + (let* ((beg (save-excursion (org-back-to-heading t) (point))) + (end-of-tree (save-excursion (org-end-of-subtree t t) (point))) + (shift + (or shift + (if (and (not (equal current-prefix-arg '(4))) + (save-excursion + (goto-char beg) + (re-search-forward org-ts-regexp-both end-of-tree t))) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ") + ""))) ;No time shift + (doshift + (and (org-string-nw-p shift) + (or (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([dwmy]\\)[ \t]*\\'" + shift) + (user-error "Invalid shift specification %s" shift))))) + (goto-char end-of-tree) + (unless (bolp) (insert "\n")) + (let* ((end (point)) + (template (buffer-substring beg end)) + (shift-n (and doshift (string-to-number (match-string 1 shift)))) + (shift-what (pcase (and doshift (match-string 2 shift)) + (`nil nil) + ("d" 'day) + ("w" (setq shift-n (* 7 shift-n)) 'day) + ("m" 'month) + ("y" 'year) + (_ (error "Unsupported time unit")))) + (nmin 1) + (nmax n) + (n-no-remove -1) + (idprop (org-entry-get nil "ID"))) + (when (and doshift + (string-match-p "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" + template)) + (delete-region beg end) + (setq end beg) + (setq nmin 0) + (setq nmax (1+ nmax)) + (setq n-no-remove nmax)) + (goto-char end) + (cl-loop for n from nmin to nmax do + (insert + ;; Prepare clone. + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (org-show-subtree) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (unless (= n 0) + (while (re-search-forward org-clock-line-re nil t) + (delete-region (line-beginning-position) + (line-beginning-position 2))) + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (org-remove-empty-drawer-at (point)))) + (goto-char (point-min)) + (when doshift + (while (re-search-forward org-ts-regexp-both nil t) + (org-timestamp-change (* n shift-n) shift-what)) + (unless (= n n-no-remove) + (goto-char (point-min)) + (while (re-search-forward org-ts-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (when (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") + (delete-region (match-beginning 1) (match-end 1))))))) + (buffer-string))))) (goto-char beg))) ;;; Outline Sorting @@ -9084,7 +9002,8 @@ hook gets called. When a region or a plain list is sorted, the cursor will be in the first entry of the sorted region/list.") (defun org-sort-entries - (&optional with-case sorting-type getkey-func compare-func property) + (&optional with-case sorting-type getkey-func compare-func property + interactive?) "Sort entries on a certain level of an outline tree. If there is an active region, the entries in the region are sorted. Else, if the cursor is before the first entry, sort the top-level items. @@ -9114,8 +9033,9 @@ t By date/time, either the first active time stamp in the entry, or, if Capital letters will reverse the sort order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be -called with point at the beginning of the record. It must return either -a string or a number that should serve as the sorting key for that record. +called with point at the beginning of the record. It must return a +value that is compatible with COMPARE-FUNC, the function used to +compare entries. Comparing entries ignores case by default. However, with an optional argument WITH-CASE, the sorting considers case as well. @@ -9123,8 +9043,11 @@ WITH-CASE, the sorting considers case as well. Sorting is done against the visible part of the headlines, it ignores hidden links. -When sorting is done, call `org-after-sorting-entries-or-items-hook'." - (interactive "P") +When sorting is done, call `org-after-sorting-entries-or-items-hook'. + +A non-nil value for INTERACTIVE? is used to signal that this +function is being called interactively." + (interactive (list current-prefix-arg nil nil nil nil t)) (let ((case-func (if with-case 'identity 'downcase)) (cmstr ;; The clock marker is lost when using `sort-subr', let's @@ -9193,21 +9116,22 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." [t]ime [s]cheduled [d]eadline [c]reated cloc[k]ing A/N/P/R/O/F/T/S/D/C/K means reversed:" what) - (setq sorting-type (read-char-exclusive)) - - (unless getkey-func - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (completing-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func)))) - - (and (= (downcase sorting-type) ?r) - (not property) - (setq property - (completing-read "Property: " - (mapcar #'list (org-buffer-property-keys t)) - nil t)))) + (setq sorting-type (read-char-exclusive))) + + (unless getkey-func + (and (= (downcase sorting-type) ?f) + (setq getkey-func + (or (and interactive? + (org-read-function + "Function for extracting keys: ")) + (error "Missing key extractor"))))) + + (and (= (downcase sorting-type) ?r) + (not property) + (setq property + (completing-read "Property: " + (mapcar #'list (org-buffer-property-keys t)) + nil t))) (when (member sorting-type '(?k ?K)) (org-clock-sum)) (message "Sorting entries...") @@ -9291,7 +9215,13 @@ When sorting is done, call `org-after-sorting-entries-or-items-hook'." nil (cond ((= dcst ?a) 'string<) - ((= dcst ?f) compare-func) + ((= dcst ?f) + (or compare-func + (and interactive? + (org-read-function + (concat "Function for comparing keys " + "(empty for default `sort-subr' predicate): ") + 'allow-empty)))) ((member dcst '(?p ?t ?s ?d ?c ?k)) '<))))) (run-hooks 'org-after-sorting-entries-or-items-hook) ;; Reset the clock marker if needed @@ -9690,11 +9620,11 @@ auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" "Clone local variables from FROM-BUFFER. Optional argument REGEXP selects variables to clone." (dolist (pair (buffer-local-variables from-buffer)) - (let ((name (car pair))) - (when (and (symbolp name) - (not (memq name org-unique-local-variables)) - (or (null regexp) (string-match regexp (symbol-name name)))) - (set (make-local-variable name) (cdr pair)))))) + (pcase pair + (`(,name . ,value) ;ignore unbound variables + (when (and (not (memq name org-unique-local-variables)) + (or (null regexp) (string-match-p regexp (symbol-name name)))) + (set (make-local-variable name) value)))))) ;;;###autoload (defun org-run-like-in-org-mode (cmd) @@ -9731,31 +9661,39 @@ DPROP is the drawer property and TPROP is either the corresponding text property to set, or an alist with each element being a text property (as a symbol) and a function to apply to the value of the drawer property." - (let ((case-fold-search t) - (inhibit-read-only t)) + (let* ((case-fold-search t) + (inhibit-read-only t) + (inherit? (org-property-inherit-p dprop)) + (property-re (org-re-property (concat (regexp-quote dprop) "\\+?") t)) + (global (and inherit? (org--property-global-value dprop nil)))) (org-with-silent-modifications - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) - (org-refresh-property tprop (match-string-no-properties 1))))))) - -(defun org-refresh-property (tprop p) + (org-with-point-at 1 + ;; Set global values (e.g., values defined through + ;; "#+PROPERTY:" keywords) to the whole buffer. + (when global (put-text-property (point-min) (point-max) tprop global)) + ;; Set local values. + (while (re-search-forward property-re nil t) + (when (org-at-property-p) + (org-refresh-property tprop (org-entry-get (point) dprop) inherit?)) + (outline-next-heading)))))) + +(defun org-refresh-property (tprop p &optional inherit) "Refresh the buffer text property TPROP from the drawer property P. -The refresh happens only for the current tree (not subtree)." +The refresh happens only for the current headline, or the whole +sub-tree if optional argument INHERIT is non-nil." (unless (org-before-first-heading-p) (save-excursion (org-back-to-heading t) - (if (symbolp tprop) - ;; TPROP is a text property symbol - (put-text-property - (point) (or (outline-next-heading) (point-max)) tprop p) - ;; TPROP is an alist with (properties . function) elements - (dolist (al tprop) - (save-excursion - (put-text-property - (line-beginning-position) (or (outline-next-heading) (point-max)) - (car al) - (funcall (cdr al) p)))))))) + (let ((start (point)) + (end (save-excursion + (if inherit (org-end-of-subtree t t) + (or (outline-next-heading) (point-max)))))) + (if (symbolp tprop) + ;; TPROP is a text property symbol. + (put-text-property start end tprop p) + ;; TPROP is an alist with (property . function) elements. + (pcase-dolist (`(,prop . ,f) tprop) + (put-text-property start end prop (funcall f p)))))))) (defun org-refresh-category-properties () "Refresh category text properties in the buffer." @@ -9799,22 +9737,19 @@ The refresh happens only for the current tree (not subtree)." (defun org-refresh-stats-properties () "Refresh stats text properties in the buffer." - (let (stats) - (org-with-silent-modifications - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - (concat org-outline-regexp-bol ".*" - "\\(?:\\[\\([0-9]+\\)%\\|\\([0-9]+\\)/\\([0-9]+\\)\\]\\)") - nil t) - (setq stats (cond ((equal (match-string 3) "0") 0) - ((match-string 2) - (/ (* (string-to-number (match-string 2)) 100) - (string-to-number (match-string 3)))) - (t (string-to-number (match-string 1))))) - (org-back-to-heading t) - (put-text-property (point) (progn (org-end-of-subtree t t) (point)) - 'org-stats stats)))))) + (org-with-silent-modifications + (org-with-point-at 1 + (let ((regexp (concat org-outline-regexp-bol + ".*\\[\\([0-9]*\\)\\(?:%\\|/\\([0-9]*\\)\\)\\]"))) + (while (re-search-forward regexp nil t) + (let* ((numerator (string-to-number (match-string 1))) + (denominator (and (match-end 2) + (string-to-number (match-string 2)))) + (stats (cond ((not denominator) numerator) ;percent + ((= denominator 0) 0) + (t (/ (* numerator 100) denominator))))) + (put-text-property (point) (progn (org-end-of-subtree t t) (point)) + 'org-stats stats))))))) (defun org-refresh-effort-properties () "Refresh effort properties" @@ -9898,9 +9833,10 @@ and then used in capture templates." This link is added to `org-stored-links' and can later be inserted into an Org buffer with `org-insert-link' (`\\[org-insert-link]'). -For some link types, a `\\[universal-argument]' prefix ARG is interpreted. -For links to Usenet articles, ARG negates `org-gnus-prefer-web-links'. -For file links, ARG negates `org-context-in-file-links'. +For some link types, a `\\[universal-argument]' prefix ARG is interpreted. \ +A single +`\\[universal-argument]' negates `org-context-in-file-links' for file links or +`org-gnus-prefer-web-links' for links to Usenet articles. A `\\[universal-argument] \\[universal-argument]' prefix ARG forces \ skipping storing functions that are not @@ -10062,7 +9998,8 @@ active region." (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) ;; Add a context search string - (when (org-xor org-context-in-file-links arg) + (when (org-xor org-context-in-file-links + (equal arg '(4))) (let* ((element (org-element-at-point)) (name (org-element-property :name element))) (setq txt (cond @@ -10089,7 +10026,8 @@ active region." (abbreviate-file-name (buffer-file-name (buffer-base-buffer))))) ;; Add a context string. - (when (org-xor org-context-in-file-links arg) + (when (org-xor org-context-in-file-links + (equal arg '(4))) (setq txt (if (org-region-active-p) (buffer-substring (region-beginning) (region-end)) (buffer-substring (point-at-bol) (point-at-eol)))) @@ -10535,43 +10473,43 @@ Use TAB to complete link prefixes, then RET for type-specific completion support ;; option If yes, simplify the link by using only the search ;; option. (when (and buffer-file-name - (string-match "^file:\\(.+?\\)::\\(.+\\)" link)) - (let* ((path (match-string 1 link)) - (case-fold-search nil) - (search (match-string 2 link))) + (let ((case-fold-search nil)) + (string-match "\\`file:\\(.+?\\)::" link))) + (let ((path (match-string-no-properties 1 link)) + (search (substring-no-properties link (match-end 0)))) (save-match-data (when (equal (file-truename buffer-file-name) (file-truename path)) ;; We are linking to this same file, with a search option (setq link search))))) ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) - (let* ((type (match-string 1 link)) - (path (match-string 2 link)) - (origpath path) - (case-fold-search nil)) - (cond - ((or (eq org-link-file-path-type 'absolute) - (equal complete-file '(16))) - (setq path (abbreviate-file-name (expand-file-name path)))) - ((eq org-link-file-path-type 'noabbrev) - (setq path (expand-file-name path))) - ((eq org-link-file-path-type 'relative) - (setq path (file-relative-name path))) - (t - (save-match-data - (if (string-match (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory - default-directory)))) - (expand-file-name path)) - ;; We are linking a file with relative path name. - (setq path (substring (expand-file-name path) - (match-end 0))) - (setq path (abbreviate-file-name (expand-file-name path))))))) - (setq link (concat type path)) - (when (equal desc origpath) - (setq desc path)))) + (let ((case-fold-search nil)) + (when (string-match "\\`\\(file\\|docview\\):" link) + (let* ((type (match-string-no-properties 0 link)) + (path (substring-no-properties link (match-end 0))) + (origpath path)) + (cond + ((or (eq org-link-file-path-type 'absolute) + (equal complete-file '(16))) + (setq path (abbreviate-file-name (expand-file-name path)))) + ((eq org-link-file-path-type 'noabbrev) + (setq path (expand-file-name path))) + ((eq org-link-file-path-type 'relative) + (setq path (file-relative-name path))) + (t + (save-match-data + (if (string-match (concat "^" (regexp-quote + (expand-file-name + (file-name-as-directory + default-directory)))) + (expand-file-name path)) + ;; We are linking a file with relative path name. + (setq path (substring (expand-file-name path) + (match-end 0))) + (setq path (abbreviate-file-name (expand-file-name path))))))) + (setq link (concat type path)) + (when (equal desc origpath) + (setq desc path))))) (if org-make-link-description-function (setq desc @@ -10668,7 +10606,7 @@ If the link is in hidden text, expose it." (if (funcall srch-fun org-any-link-re nil t) (progn (goto-char (match-beginning 0)) - (when (outline-invisible-p) (org-show-context))) + (when (org-invisible-p) (org-show-context))) (goto-char pos) (setq org-link-search-failed t) (message "No further link found")))) @@ -11158,7 +11096,7 @@ of matched result, which is either `dedicated' or `fuzzy'." (normalized (replace-regexp-in-string "\n[ \t]*" " " s)) (starred (eq (string-to-char normalized) ?*)) (words (split-string (if starred (substring s 1) s))) - (s-multi-re (mapconcat #'regexp-quote words "[ \t]+\\(?:\n[ \t]*\\)?")) + (s-multi-re (mapconcat #'regexp-quote words "\\(?:[ \t\n]+\\)")) (s-single-re (mapconcat #'regexp-quote words "[ \t]+")) type) (cond @@ -11234,13 +11172,10 @@ of matched result, which is either `dedicated' or `fuzzy'." ;; statistics cookies and tags. ((and (derived-mode-p 'org-mode) (let ((title-re - (format "%s[ \t]*\\(?:%s[ \t]+\\)?.*%s" + (format "%s.*\\(?:%s[ \t]\\)?.*%s" org-outline-regexp-bol org-comment-string - (mapconcat - (lambda (w) (format "\\<%s\\>" (regexp-quote w))) - words - ".+"))) + (mapconcat #'regexp-quote words ".+"))) (cookie-re "\\[[0-9]*\\(?:%\\|/[0-9]*\\)\\]") (comment-re (format "\\`%s[ \t]+" org-comment-string))) (goto-char (point-min)) @@ -11378,7 +11313,7 @@ or to another Org file, automatically push the old position onto the ring." (setq m (car p)) (pop-to-buffer-same-window (marker-buffer m)) (goto-char m) - (when (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + (when (or (org-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) (defun org-add-angle-brackets (s) (unless (equal (substring s 0 1) "<") (setq s (concat "<" s))) @@ -11802,7 +11737,7 @@ order.") (org-refile-cache-put tgs (buffer-file-name) descre)) (setq targets (append tgs targets)))))) (message "Getting targets...done") - (nreverse targets))) + (delete-dups (nreverse targets)))) (defun org-protect-slash (s) (replace-regexp-in-string "/" "\\/" s nil t)) @@ -12452,7 +12387,7 @@ variable `org-mtags-prefer-muse-templates'." (list (string :tag "Key") (string :tag "Template"))) - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) (defun org-try-structure-completion () @@ -12574,7 +12509,8 @@ nil or a string to be used for the todo mark." ) bound1 t)) (replace-match "0" t nil nil 1))))) -(defvar org-state) ;; dynamically scoped into this function +(defvar org-state) +(defvar org-blocked-by-checkboxes) (defun org-todo (&optional arg) "Change the TODO state of an item. @@ -12616,7 +12552,7 @@ When called through ELisp, arg is also interpreted in the following way: (org-map-entries `(org-todo ,arg) org-loop-over-headlines-in-active-region - cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) + cl (when (org-invisible-p) (org-end-of-subtree nil t)))) (when (equal arg '(16)) (setq arg 'nextset)) (when (equal arg -1) (org-cancel-repeater) (setq arg nil)) (let ((org-blocker-hook org-blocker-hook) @@ -12664,12 +12600,12 @@ When called through ELisp, arg is also interpreted in the following way: (and (not arg) org-use-fast-todo-selection (not (eq org-use-fast-todo-selection 'prefix))))) - ;; Use fast selection + ;; Use fast selection. (org-fast-todo-selection)) ((and (equal arg '(4)) (or (not org-use-fast-todo-selection) (not org-todo-key-trigger))) - ;; Read a state with completion + ;; Read a state with completion. (completing-read "State: " (mapcar #'list org-todo-keywords-1) nil t)) @@ -12685,9 +12621,9 @@ When called through ELisp, arg is also interpreted in the following way: org-todo-keywords-1) (org-last org-todo-keywords-1)))) ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) - (setq arg nil))) ; hack to fall back to cycling + (setq arg nil))) ;hack to fall back to cycling (arg - ;; user or caller requests a specific state + ;; User or caller requests a specific state. (cond ((equal arg "") nil) ((eq arg 'none) nil) @@ -12705,8 +12641,8 @@ When called through ELisp, arg is also interpreted in the following way: ((nth (1- (prefix-numeric-value arg)) org-todo-keywords-1)))) ((null member) (or head (car org-todo-keywords-1))) - ((equal this final-done-word) nil) ;; -> make empty - ((null tail) nil) ;; -> first entry + ((equal this final-done-word) nil) ;-> make empty + ((null tail) nil) ;-> first entry ((memq interpret '(type priority)) (if (eq this-command last-command) (car tail) @@ -12724,20 +12660,24 @@ When called through ELisp, arg is also interpreted in the following way: :position startpos)) dolog now-done-p) (when org-blocker-hook - (setq org-last-todo-state-is-todo - (not (member this org-done-keywords))) - (unless (save-excursion - (save-match-data - (org-with-wide-buffer - (run-hook-with-args-until-failure - 'org-blocker-hook change-plist)))) - (if (called-interactively-p 'interactive) - (user-error "TODO state change from %s to %s blocked (by \"%s\")" - this org-state org-block-entry-blocking) - ;; fail silently - (message "TODO state change from %s to %s blocked (by \"%s\")" - this org-state org-block-entry-blocking) - (throw 'exit nil)))) + (let (org-blocked-by-checkboxes block-reason) + (setq org-last-todo-state-is-todo + (not (member this org-done-keywords))) + (unless (save-excursion + (save-match-data + (org-with-wide-buffer + (run-hook-with-args-until-failure + 'org-blocker-hook change-plist)))) + (setq block-reason (if org-blocked-by-checkboxes + "contained checkboxes" + (format "\"%s\"" org-block-entry-blocking))) + (if (called-interactively-p 'interactive) + (user-error "TODO state change from %s to %s blocked (by %s)" + this org-state block-reason) + ;; Fail silently. + (message "TODO state change from %s to %s blocked (by %s)" + this org-state block-reason) + (throw 'exit nil))))) (store-match-data match-data) (replace-match next t t) (cond ((equal this org-state) @@ -12764,7 +12704,7 @@ When called through ELisp, arg is also interpreted in the following way: (when (and (or org-todo-log-states org-log-done) (not (eq org-inhibit-logging t)) (not (memq arg '(nextset previousset)))) - ;; we need to look at recording a time and note + ;; We need to look at recording a time and note. (setq dolog (or (nth 1 (assoc org-state org-todo-log-states)) (nth 2 (assoc this org-todo-log-states)))) (when (and (eq dolog 'note) (eq org-inhibit-logging 'note)) @@ -12777,14 +12717,14 @@ When called through ELisp, arg is also interpreted in the following way: ;; If there was a CLOSED time stamp, get rid of it. (org-add-planning-info nil nil 'closed)) (when (and now-done-p org-log-done) - ;; It is now done, and it was not done before + ;; It is now done, and it was not done before. (org-add-planning-info 'closed (org-current-effective-time)) (when (and (not dolog) (eq 'note org-log-done)) (org-add-log-setup 'done org-state this 'note))) (when (and org-state dolog) - ;; This is a non-nil state, and we need to log it + ;; This is a non-nil state, and we need to log it. (org-add-log-setup 'state org-state this dolog))) - ;; Fixup tag positioning + ;; Fixup tag positioning. (org-todo-trigger-tag-changes org-state) (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) (when org-provide-todo-statistics @@ -12801,7 +12741,7 @@ When called through ELisp, arg is also interpreted in the following way: (setq org-agenda-headline-snapshot-before-repeat (org-get-heading)))) (org-auto-repeat-maybe org-state)) - ;; Fixup cursor location if close to the keyword + ;; Fixup cursor location if close to the keyword. (when (and (outline-on-heading-p) (not (bolp)) (save-excursion (beginning-of-line 1) @@ -12920,7 +12860,6 @@ See variable `org-track-ordered-property-with-tag'." (and tag (org-toggle-tag tag 'on)) (message "Subtasks must be completed in sequence"))))) -(defvar org-blocked-by-checkboxes) ; dynamically scoped (defun org-block-todo-from-checkboxes (change-plist) "Block turning an entry into a TODO, using checkboxes. This checks whether the current task should be blocked from state @@ -13069,7 +13008,7 @@ statistics everywhere." (and (member kwd org-done-keywords) (member kwd (cadr org-provide-todo-statistics)))))) (setq cnt-all (1+ cnt-all)) - (and (eq org-provide-todo-statistics t) + (and (eq org-provide-todo-statistics t) kwd (setq cnt-all (1+ cnt-all)))) (when (or (and (member org-provide-todo-statistics '(t all-headlines)) @@ -13308,9 +13247,11 @@ This function is run automatically after each state change to a DONE state." (when (eq org-log-repeat t) (setq org-log-repeat 'state)) (let ((to-state (or (org-entry-get nil "REPEAT_TO_STATE" 'selective) org-todo-repeat-to-state))) - (unless (and to-state (member to-state org-todo-keywords-1)) - (setq to-state (if (eq interpret 'type) org-last-state head))) - (org-todo to-state)) + (org-todo (cond ((and to-state (member to-state org-todo-keywords-1)) + to-state) + ((eq interpret 'type) org-last-state) + (head) + (t 'none)))) (when (or org-log-repeat (org-entry-get nil "CLOCK")) (org-entry-put nil "LAST_REPEAT" (format-time-string (org-time-stamp-format t t)))) @@ -13431,6 +13372,83 @@ of `org-todo-keywords-1'." (message "%d TODO entries found" (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) +(defun org--deadline-or-schedule (arg type time) + "Insert DEADLINE or SCHEDULE information in current entry. +TYPE is either `deadline' or `scheduled'. See `org-deadline' or +`org-schedule' for information about ARG and TIME arguments." + (let* ((deadline? (eq type 'deadline)) + (keyword (if deadline? org-deadline-string org-scheduled-string)) + (log (if deadline? org-log-redeadline org-log-reschedule)) + (old-date (org-entry-get nil (if deadline? "DEADLINE" "SCHEDULED"))) + (old-date-time (and old-date (org-time-string-to-time old-date))) + ;; Save repeater cookie from either TIME or current scheduled + ;; time stamp. We are going to insert it back at the end of + ;; the process. + (repeater (or (and (org-string-nw-p time) + ;; We use `org-repeat-re' because we need + ;; to tell the difference between a real + ;; repeater and a time delta, e.g. "+2d". + (string-match org-repeat-re time) + (match-string 1 time)) + (and (org-string-nw-p old-date) + (string-match "\\([.+-]+[0-9]+[hdwmy]\ +\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\)" + old-date) + (match-string 1 old-date))))) + (pcase arg + (`(4) + (when (and old-date log) + (org-add-log-setup (if deadline? 'deldeadline 'delschedule) + nil old-date log)) + (org-remove-timestamp-with-keyword keyword) + (message (if deadline? "Item no longer has a deadline." + "Item is no longer scheduled."))) + (`(16) + (save-excursion + (org-back-to-heading t) + (let ((regexp (if deadline? org-deadline-time-regexp + org-scheduled-time-regexp))) + (if (not (re-search-forward regexp (line-end-position 2) t)) + (user-error (if deadline? "No deadline information to update" + "No scheduled information to update")) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0)) + (msg (if deadline? "Warn starting from" "Delay until"))) + (replace-match + (concat keyword + " <" rpl + (format " -%dd" + (abs (- (time-to-days + (save-match-data + (org-read-date + nil t nil msg old-date-time))) + (time-to-days old-date-time)))) + ">") t t)))))) + (_ + (org-add-planning-info type time 'closed) + (when (and old-date + log + (not (equal old-date org-last-inserted-timestamp))) + (org-add-log-setup (if deadline? 'redeadline 'reschedule) + org-last-inserted-timestamp + old-date + log)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward + (concat keyword " " org-last-inserted-timestamp) + (line-end-position 2) + t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message (if deadline? "Deadline on %s" "Scheduled to %s") + org-last-inserted-timestamp))))) + (defun org-deadline (arg &optional time) "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. With one universal prefix argument, remove any deadline from the item. @@ -13439,66 +13457,14 @@ With argument TIME, set the deadline at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-deadline ',arg ,time) - org-loop-over-headlines-in-active-region - cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "DEADLINE")) - (old-date-time (when old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date org-log-redeadline)) - (org-remove-timestamp-with-keyword org-deadline-string) - (message "Item no longer has a deadline.")) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-deadline-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-deadline-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Warn starting from" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No deadline information to update")))) - (t - (org-add-planning-info 'deadline time 'closed) - (when (and old-date - org-log-redeadline - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup - 'redeadline org-last-inserted-timestamp old-date org-log-redeadline)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-deadline-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Deadline on %s" org-last-inserted-timestamp)))))) + (org-map-entries + (lambda () (org--deadline-or-schedule arg 'deadline time)) + nil + (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level + 'region) + (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) + (org--deadline-or-schedule arg 'deadline time))) (defun org-schedule (arg &optional time) "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. @@ -13508,67 +13474,14 @@ With argument TIME, scheduled at the corresponding date. TIME can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (interactive "P") (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-schedule ',arg ,time) - org-loop-over-headlines-in-active-region - cl (when (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "SCHEDULED")) - (old-date-time (when old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (progn - (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date org-log-reschedule)) - (org-remove-timestamp-with-keyword org-scheduled-string) - (message "Item is no longer scheduled."))) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-scheduled-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-scheduled-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Delay until" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No scheduled information to update")))) - (t - (org-add-planning-info 'scheduled time 'closed) - (when (and old-date - org-log-reschedule - (not (equal old-date org-last-inserted-timestamp))) - (org-add-log-setup - 'reschedule org-last-inserted-timestamp old-date org-log-reschedule)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-scheduled-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Scheduled to %s" org-last-inserted-timestamp)))))) + (org-map-entries + (lambda () (org--deadline-or-schedule arg 'scheduled time)) + nil + (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level + 'region) + (lambda () (when (org-invisible-p) (org-end-of-subtree nil t)))) + (org--deadline-or-schedule arg 'scheduled time))) (defun org-get-scheduled-time (pom &optional inherit) "Get the scheduled time as a time tuple, of a format suitable @@ -13911,7 +13824,10 @@ EXTRA is additional text that will be inserted into the notes buffer." ;; Find location for the new note. (goto-char org-log-note-marker) (set-marker org-log-note-marker nil) - (goto-char (org-log-beginning t)) + ;; Note associated to a clock is to be located right after + ;; the clock. Do not move point. + (unless (eq org-log-note-purpose 'clock-out) + (goto-char (org-log-beginning t))) ;; Make sure point is at the beginning of an empty line. (cond ((not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) ((looking-at "[ \t]*\\S-") (save-excursion (insert "\n")))) @@ -15111,7 +15027,7 @@ When JUST-ALIGN is non-nil, only align tags." #'org-set-tags org-loop-over-headlines-in-active-region cl - '(when (outline-invisible-p) (org-end-of-subtree nil t)))) + '(when (org-invisible-p) (org-end-of-subtree nil t)))) (let ((org-setting-tags t)) (if arg (save-excursion @@ -15176,6 +15092,9 @@ When JUST-ALIGN is non-nil, only align tags." org-tags-sort-function) ":"))) + (if (or (string= ":" tags) + (string= "::" tags)) + (setq tags "")) (if (not (org-string-nw-p tags)) (setq tags "") (unless (string-suffix-p ":" tags) (setq tags (concat tags ":"))) (unless (string-prefix-p ":" tags) (setq tags (concat ":" tags)))) @@ -15192,7 +15111,10 @@ When JUST-ALIGN is non-nil, only align tags." ;; white spaces. (end-of-line) (if (not (equal tags "")) - (insert " " tags) + ;; When text is being inserted on an invisible + ;; region boundary, it can be inadvertently sucked + ;; into invisibility. + (outline-flag-region (point) (progn (insert " " tags) (point)) nil) (skip-chars-backward " \t") (delete-region (point) (line-end-position))))) ;; Align tags, if any. Fix tags column if `org-indent-mode' @@ -15971,12 +15893,11 @@ strings." ;; First look for timestamps within headline. (let ((ts (funcall find-ts (line-end-position) nil))) (if (= (length ts) 2) (setq props (nconc ts props)) - (forward-line) ;; Then find timestamps in the section, skipping ;; planning line. - (when (looking-at-p org-planning-line-re) - (forward-line)) (let ((end (save-excursion (outline-next-heading)))) + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) (setq props (nconc (funcall find-ts end ts) props)))))))) ;; Get the standard properties, like :PROP:. (when (memq which '(nil all standard)) @@ -16016,7 +15937,7 @@ strings." ;; Return value. props))))) -(defun org-property--local-values (property literal-nil) +(defun org--property-local-values (property literal-nil) "Return value for PROPERTY in current entry. Value is a list whose car is the base value for PROPERTY and cdr a list of accumulated values. Return nil if neither is found in @@ -16041,6 +15962,17 @@ unless LITERAL-NIL is non-nil." ;; Return final values. (and (not (equal value '(nil))) (nreverse value)))))) +(defun org--property-global-value (property literal-nil) + "Return value for PROPERTY in current buffer. +Return value is a string. Return nil if property is not set +globally. Also return nil when PROPERTY is set to \"nil\", +unless LITERAL-NIL is non-nil." + (let ((global + (cdr (or (assoc-string property org-file-properties t) + (assoc-string property org-global-properties t) + (assoc-string property org-global-properties-fixed t))))) + (if literal-nil global (org-not-nil global)))) + (defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry or content at point-or-marker POM. @@ -16068,7 +16000,7 @@ value higher up the hierarchy." (or (not (eq inherit 'selective)) (org-property-inherit-p property))) (org-entry-get-with-inheritance property literal-nil)) (t - (let* ((local (org-property--local-values property literal-nil)) + (let* ((local (org--property-local-values property literal-nil)) (value (and local (mapconcat #'identity (delq nil local) " ")))) (if literal-nil value (org-not-nil value))))))) @@ -16084,24 +16016,22 @@ If yes, return this value. If not, return the current value of the variable." "Delete PROPERTY from entry at point-or-marker POM. Accumulated properties, i.e. PROPERTY+, are also removed. Return non-nil when a property was removed." - (unless (member property org-special-properties) - (org-with-point-at pom - (let ((range (org-get-property-block))) - (when range - (let* ((begin (car range)) - (origin (cdr range)) - (end (copy-marker origin)) - (re (org-re-property - (concat (regexp-quote property) "\\+?") t t))) - (goto-char begin) - (while (re-search-forward re end t) - (delete-region (match-beginning 0) (line-beginning-position 2))) - ;; If drawer is empty, remove it altogether. - (when (= begin end) - (delete-region (line-beginning-position 0) - (line-beginning-position 2))) - ;; Return non-nil if some property was removed. - (prog1 (/= end origin) (set-marker end nil)))))))) + (org-with-point-at pom + (pcase (org-get-property-block) + (`(,begin . ,origin) + (let* ((end (copy-marker origin)) + (re (org-re-property + (concat (regexp-quote property) "\\+?") t t))) + (goto-char begin) + (while (re-search-forward re end t) + (delete-region (match-beginning 0) (line-beginning-position 2))) + ;; If drawer is empty, remove it altogether. + (when (= begin end) + (delete-region (line-beginning-position 0) + (line-beginning-position 2))) + ;; Return non-nil if some property was removed. + (prog1 (/= end origin) (set-marker end nil)))) + (_ nil)))) ;; Multi-values properties are properties that contain multiple values ;; These values are assumed to be single words, separated by whitespace. @@ -16182,7 +16112,7 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead." (let (value) (catch 'exit (while t - (let ((v (org-property--local-values property literal-nil))) + (let ((v (org--property-local-values property literal-nil))) (when v (setq value (concat (mapconcat #'identity (delq nil v) " ") @@ -16195,10 +16125,7 @@ However, if LITERAL-NIL is set, return the string value \"nil\" instead." (throw 'exit nil)) ((org-up-heading-safe)) (t - (let ((global - (cdr (or (assoc-string property org-file-properties t) - (assoc-string property org-global-properties t) - (assoc-string property org-global-properties-fixed t))))) + (let ((global (org--property-global-value property literal-nil))) (cond ((not global)) (value (setq value (concat global " " value))) (t (setq value global)))) @@ -18016,11 +17943,17 @@ day number." (list (nth 4 d) (nth 3 d) (nth 5 d)))) ((listp d) (list (nth 4 d) (nth 3 d) (nth 5 d))))) -(defun org-parse-time-string (s &optional nodefault) +(defun org-parse-time-string (s &optional nodefault zone) "Parse the standard Org time string. + This should be a lot faster than the normal `parse-time-string'. -If time is not given, defaults to 0:00. However, with optional NODEFAULT, -hour and minute fields will be nil if not given." + +If time is not given, defaults to 0:00. However, with optional +NODEFAULT, hour and minute fields will be nil if not given. + +The optional ZONE is omitted or nil for Emacs local time, t for +Universal Time, ‘wall’ for system wall clock time, or a string as +in the TZ environment variable." (cond ((string-match org-ts-regexp0 s) (list 0 (when (or (match-beginning 8) (not nodefault)) @@ -18030,8 +17963,12 @@ hour and minute fields will be nil if not given." (string-to-number (match-string 4 s)) (string-to-number (match-string 3 s)) (string-to-number (match-string 2 s)) - nil nil nil)) + nil nil zone)) ((string-match "^<[^>]+>$" s) + ;; FIXME: `decode-time' needs to be called with ZONE as its + ;; second argument. However, this requires at least Emacs + ;; 25.1. We can do it when we switch to this version as our + ;; minimal requirement. (decode-time (seconds-to-time (org-matcher-time s)))) (t (error "Not a standard Org time string: %s" s)))) @@ -18371,7 +18308,7 @@ minutes. For example, if the value of this variable is ((\"hours\" . 60)), then an effort string \"2hours\" is equivalent to 120 minutes." :group 'org-agenda - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) @@ -18533,7 +18470,7 @@ The value is a list, with zero or more of the symbols `effort', `appt', (const appt) (const stats) (const category)) - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :group 'org-agenda) @@ -19436,26 +19373,6 @@ inspection." ;; Failed conversion. Return the LaTeX fragment verbatim latex-frag))) -(declare-function org-export-get-backend "ox" (name)) -(declare-function org-export--get-global-options "ox" (&optional backend)) -(declare-function org-export--get-inbuffer-options "ox" (&optional backend)) -(declare-function org-latex-guess-inputenc "ox-latex" (header)) -(declare-function org-latex-guess-babel-language "ox-latex" (header info)) -(defun org-create-formula--latex-header () - "Return LaTeX header appropriate for previewing a LaTeX snippet." - (let ((info (org-combine-plists (org-export--get-global-options - (org-export-get-backend 'latex)) - (org-export--get-inbuffer-options - (org-export-get-backend 'latex))))) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-splice-latex-header - org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist t - (plist-get info :latex-header))) - info))) - (defun org--get-display-dpi () "Get the DPI of the display. The function assumes that the display has the same pixel width in @@ -19494,8 +19411,12 @@ a HTML file." (post-clean (or (plist-get processing-info :post-clean) '(".dvi" ".xdv" ".pdf" ".tex" ".aux" ".log" ".svg" ".png" ".jpg" ".jpeg" ".out"))) - (latex-header (or (plist-get processing-info :latex-header) - (org-create-formula--latex-header))) + (latex-header + (or (plist-get processing-info :latex-header) + (org-latex-make-preamble + (org-export-get-environment (org-export-get-backend 'latex)) + org-format-latex-header + 'snippet))) (latex-compiler (plist-get processing-info :latex-compiler)) (image-converter (plist-get processing-info :image-converter)) (tmpdir temporary-file-directory) @@ -21145,11 +21066,6 @@ This command does many different things, depending on context: (funcall org-finish-function)) ((org-babel-hash-at-point)) ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) - ((save-excursion (beginning-of-line) (looking-at-p "[ \t]*$")) - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error - (substitute-command-keys - "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) (t (let* ((context (org-element-lineage @@ -21173,7 +21089,21 @@ This command does many different things, depending on context: (setq context parent) (setq type 'item)))) ;; Act according to type of element or object at point. + ;; + ;; Do nothing on a blank line, except if it is contained in + ;; a src block. Hence, we first check if point is in such + ;; a block and then if it is at a blank line. (pcase type + ((or `inline-src-block `src-block) + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-eval-wipe-error-buffer) + (org-babel-execute-src-block + current-prefix-arg (org-babel-get-src-block-info nil context)))) + ((guard (org-match-line "[ \t]*$")) + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error + (substitute-command-keys + "`\\[org-ctrl-c-ctrl-c]' can do nothing useful here")))) ((or `babel-call `inline-babel-call) (let ((info (org-babel-lob-get-info context))) (when info (org-babel-execute-src-block nil info)))) @@ -21189,11 +21119,6 @@ This command does many different things, depending on context: ((or `headline `inlinetask) (save-excursion (goto-char (org-element-property :begin context)) (call-interactively #'org-set-tags))) - ((or `inline-src-block `src-block) - (unless org-babel-no-eval-on-ctrl-c-ctrl-c - (org-babel-eval-wipe-error-buffer) - (org-babel-execute-src-block - current-prefix-arg (org-babel-get-src-block-info nil context)))) (`item ;; At an item: `C-u C-u' sets checkbox to "[-]" ;; unconditionally, whereas `C-u' will toggle its presence. @@ -22799,6 +22724,7 @@ it for output." ;;; Indentation +(defvar org-element-greater-elements) (defun org--get-expected-indentation (element contentsp) "Expected indentation column for current line, according to ELEMENT. ELEMENT is an element containing point. CONTENTSP is non-nil @@ -22821,7 +22747,7 @@ ELEMENT." (goto-char start) (org-get-indentation)))) ((memq type '(headline inlinetask nil)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) + (if (org-match-line "[ \t]*$") (org--get-expected-indentation element t) 0)) ((memq type '(diary-sexp footnote-definition)) 0) @@ -22885,16 +22811,16 @@ ELEMENT." (org--get-expected-indentation element t)) ;; POS is after contents in a greater element. Indent like ;; the beginning of the element. - ;; - ;; As a special case, if point is at the end of a footnote - ;; definition or an item, indent like the very last element - ;; within. If that last element is an item, indent like its - ;; contents. - ((and (not (eq type 'paragraph)) + ((and (memq type org-element-greater-elements) (let ((cend (org-element-property :contents-end element))) (and cend (<= cend pos)))) + ;; As a special case, if point is at the end of a footnote + ;; definition or an item, indent like the very last element + ;; within. If that last element is an item, indent like + ;; its contents. (if (memq type '(footnote-definition item plain-list)) (let ((last (org-element-at-point))) + (goto-char pos) (org--get-expected-indentation last (eq (org-element-type last) 'item))) (goto-char start) @@ -22973,6 +22899,13 @@ Also align node properties according to `org-property-format'." (= (line-beginning-position) (org-element-property :post-affiliated element))) 'noindent) + ((and (eq type 'latex-environment) + (>= (point) (org-element-property :post-affiliated element)) + (< (point) (org-with-wide-buffer + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + 'noindent) ((and (eq type 'src-block) org-src-tab-acts-natively (> (line-beginning-position) @@ -23024,22 +22957,38 @@ assumed to be significant there." (element-end (copy-marker (org-element-property :end element))) (ind (org--get-expected-indentation element nil))) (cond + ;; Element indented as a single block. Example blocks + ;; preserving indentation are a special case since the + ;; "contents" must not be indented whereas the block + ;; boundaries can. + ((or (memq type '(export-block latex-environment)) + (and (eq type 'example-block) + (not + (or org-src-preserve-indentation + (org-element-property :preserve-indent element))))) + (let ((offset (- ind (org-get-indentation)))) + (unless (zerop offset) + (indent-rigidly (org-element-property :begin element) + (org-element-property :end element) + offset))) + (goto-char element-end)) + ;; Elements indented line wise. Be sure to exclude + ;; example blocks (preserving indentation) and source + ;; blocks from this category as they are treated + ;; specially later. ((or (memq type '(paragraph table table-row)) (not (or (org-element-property :contents-begin element) - (memq type - '(example-block export-block src-block))))) - ;; Elements here are indented as a single block. Also - ;; align node properties. + (memq type '(example-block src-block))))) (when (eq type 'node-property) (org--align-node-property) (beginning-of-line)) (funcall indent-to ind (min element-end end))) + ;; Elements consisting of three parts: before the + ;; contents, the contents, and after the contents. The + ;; contents are treated specially, according to the + ;; element type, or not indented at all. Other parts are + ;; indented as a single block. (t - ;; Elements in this category consist of three parts: - ;; before the contents, the contents, and after the - ;; contents. The contents are treated specially, - ;; according to the element type, or not indented at - ;; all. Other parts are indented as a single block. (let* ((post (copy-marker (org-element-property :post-affiliated element))) (cbeg @@ -23049,8 +22998,7 @@ assumed to be significant there." ;; Fake contents for source blocks. (org-with-wide-buffer (goto-char post) - (forward-line) - (point))) + (line-beginning-position 2))) ((memq type '(footnote-definition item plain-list)) ;; Contents in these elements could start on ;; the same line as the beginning of the @@ -23084,7 +23032,7 @@ assumed to be significant there." (t (funcall indent-to ind (min cbeg end)))) (when (< (point) end) (cl-case type - ((example-block export-block verse-block)) + ((example-block verse-block)) (src-block ;; In a source block, indent source code ;; according to language major mode, but only if @@ -24094,16 +24042,18 @@ interactive command with similar behavior." "Check if point is at a character currently not visible. This version does not only check the character property, but also `visible-mode'." - ;; Early versions of noutline don't have `outline-invisible-p'. (unless (bound-and-true-p visible-mode) - (outline-invisible-p))) + (org-invisible-p))) (defun org-invisible-p2 () - "Check if point is at a character currently not visible." + "Check if point is at a character currently not visible. + +If the point is at EOL (and not at the beginning of a buffer too), +move it back by one char before doing this check." (save-excursion - (when (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (outline-invisible-p))) + (when (and (eolp) (not (bobp))) + (backward-char 1)) + (org-invisible-p))) (defun org-back-to-heading (&optional invisible-ok) "Call `outline-back-to-heading', but provide a better error message." @@ -24358,32 +24308,27 @@ Stop at the first and last subheadings of a superior heading. Normally this only looks at visible headings, but when INVISIBLE-OK is non-nil it will also look at invisible ones." (interactive "p") - (if (not (ignore-errors (org-back-to-heading invisible-ok))) - (if (and arg (< arg 0)) - (goto-char (point-min)) - (outline-next-heading)) - (org-at-heading-p) - (let ((level (- (match-end 0) (match-beginning 0) 1)) - (f (if (and arg (< arg 0)) - 're-search-backward - 're-search-forward)) - (count (if arg (abs arg) 1)) - (result (point))) - (while (and (prog1 (> count 0) - (forward-char (if (and arg (< arg 0)) -1 1))) - (funcall f org-outline-regexp-bol nil 'move)) - (let ((l (- (match-end 0) (match-beginning 0) 1))) - (cond ((< l level) (setq count 0)) - ((and (= l level) - (or invisible-ok - (progn - (goto-char (line-beginning-position)) - (not (outline-invisible-p))))) - (setq count (1- count)) - (when (eq l level) - (setq result (point))))))) - (goto-char result)) - (beginning-of-line 1))) + (let ((backward? (and arg (< arg 0)))) + (if (org-before-first-heading-p) + (if backward? (goto-char (point-min)) (outline-next-heading)) + (org-back-to-heading invisible-ok) + (unless backward? (end-of-line)) ;do not match current headline + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if backward? #'re-search-backward #'re-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (while (and (> count 0) + (funcall f org-outline-regexp-bol nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (not (org-invisible-p + (line-beginning-position))))) + (cl-decf count) + (when (= l level) (setq result (point))))))) + (goto-char result)) + (beginning-of-line)))) (defun org-backward-heading-same-level (arg &optional invisible-ok) "Move backward to the ARG'th subheading at same level as this one. @@ -24514,7 +24459,7 @@ item, etc. It also provides some special moves for convenience: ;; With no contents, just skip element. ((not contents-begin) (goto-char end)) ;; If contents are invisible, skip the element altogether. - ((outline-invisible-p (line-end-position)) + ((org-invisible-p (line-end-position)) (cl-case type (headline (org-with-limited-levels (outline-next-visible-heading 1))) @@ -24601,7 +24546,7 @@ convenience: (org-backward-paragraph)) (t (goto-char (or post-affiliated begin)))) ;; Ensure we never leave point invisible. - (when (outline-invisible-p (point)) (beginning-of-visual-line)))) + (when (org-invisible-p (point)) (beginning-of-visual-line)))) (defun org-forward-element () "Move forward by one element. @@ -24668,7 +24613,6 @@ Move to the previous element at the same level, when possible." (user-error "No surrounding element") (org-with-limited-levels (org-back-to-heading))))))) -(defvar org-element-greater-elements) (defun org-down-element () "Move to inner element." (interactive) @@ -24679,7 +24623,7 @@ Move to the previous element at the same level, when possible." (forward-char)) ((memq (org-element-type element) org-element-greater-elements) ;; If contents are hidden, first disclose them. - (when (outline-invisible-p (line-end-position)) (org-cycle)) + (when (org-invisible-p (line-end-position)) (org-cycle)) (goto-char (or (org-element-property :contents-begin element) (user-error "No content for this element")))) (t (user-error "No inner element"))))) @@ -24687,29 +24631,34 @@ Move to the previous element at the same level, when possible." (defun org-drag-element-backward () "Move backward element at point." (interactive) - (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up) - (let* ((elem (or (org-element-at-point) - (user-error "No element at point"))) - (prev-elem - (save-excursion - (goto-char (org-element-property :begin elem)) - (skip-chars-backward " \r\t\n") - (unless (bobp) - (let* ((beg (org-element-property :begin elem)) - (prev (org-element-at-point)) - (up prev)) - (while (and (setq up (org-element-property :parent up)) - (<= (org-element-property :end up) beg)) - (setq prev up)) - prev))))) - ;; Error out if no previous element or previous element is - ;; a parent of the current one. - (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) - (user-error "Cannot drag element backward") - (let ((pos (point))) - (org-element-swap-A-B prev-elem elem) - (goto-char (+ (org-element-property :begin prev-elem) - (- pos (org-element-property :begin elem))))))))) + (let ((elem (or (org-element-at-point) + (user-error "No element at point")))) + (if (eq (org-element-type elem) 'headline) + ;; Preserve point when moving a whole tree, even if point was + ;; on blank lines below the headline. + (let ((offset (skip-chars-backward " \t\n"))) + (unwind-protect (org-move-subtree-up) + (forward-char (- offset)))) + (let ((prev-elem + (save-excursion + (goto-char (org-element-property :begin elem)) + (skip-chars-backward " \r\t\n") + (unless (bobp) + (let* ((beg (org-element-property :begin elem)) + (prev (org-element-at-point)) + (up prev)) + (while (and (setq up (org-element-property :parent up)) + (<= (org-element-property :end up) beg)) + (setq prev up)) + prev))))) + ;; Error out if no previous element or previous element is + ;; a parent of the current one. + (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) + (user-error "Cannot drag element backward") + (let ((pos (point))) + (org-element-swap-A-B prev-elem elem) + (goto-char (+ (org-element-property :begin prev-elem) + (- pos (org-element-property :begin elem)))))))))) (defun org-drag-element-forward () "Move forward element at point." @@ -25155,15 +25104,15 @@ ELEMENT is the element at point." (defun org-bookmark-jump-unhide () "Unhide the current position, to show the bookmark location." (and (derived-mode-p 'org-mode) - (or (outline-invisible-p) + (or (org-invisible-p) (save-excursion (goto-char (max (point-min) (1- (point)))) - (outline-invisible-p))) + (org-invisible-p))) (org-show-context 'bookmark-jump))) (defun org-mark-jump-unhide () "Make the point visible with `org-show-context' after jumping to the mark." (when (and (derived-mode-p 'org-mode) - (outline-invisible-p)) + (org-invisible-p)) (org-show-context 'mark-goto))) (eval-after-load "simple" diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 430c2cc..2a129e9 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -1,6 +1,6 @@ ;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -188,7 +188,7 @@ This margin is applied on both sides of the text." This margin applies to top level list only, not to its sub-lists." :group 'org-export-ascii - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'integer) diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index 257ff3f..82651d3 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -1,6 +1,6 @@ ;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2007-2016 Free Software Foundation, Inc. +;; Copyright (C) 2007-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> ;; Nicolas Goaziou <n.goaziou AT gmail DOT com> @@ -140,7 +140,7 @@ You might want to put e.g. \"allowframebreaks=0.9\" here." The format string should have at most one \"%s\"-expression, which is replaced with the subtitle." :group 'org-export-beamer - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(string :tag "Format string")) @@ -797,7 +797,7 @@ holding export options." ;; LaTeX compiler (org-latex--insert-compiler info) ;; Document class and packages. - (org-latex--make-preamble info) + (org-latex-make-preamble info) ;; Insert themes. (let ((format-theme (function @@ -1122,9 +1122,13 @@ Return output file name." ;; working directory and then moved to publishing directory. (org-publish-attachment plist - (org-latex-compile - (org-publish-org-to - 'beamer filename ".tex" plist (file-name-directory filename))) + ;; Default directory could be anywhere when this function is + ;; called. We ensure it is set to source file directory during + ;; compilation so as to not break links to external documents. + (let ((default-directory (file-name-directory filename))) + (org-latex-compile + (org-publish-org-to + 'beamer filename ".tex" plist (file-name-directory filename)))) pub-dir)) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 63a8c84..9c0ba65 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -1,6 +1,6 @@ ;;; ox-html.el --- HTML Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Jambunathan K <kjambunathan at gmail dot com> @@ -229,7 +229,7 @@ property on the headline itself.") @licstart The following is the entire license notice for the JavaScript code in this tag. -Copyright (C) 2012-2013 Free Software Foundation, Inc. +Copyright (C) 2012-2017 Free Software Foundation, Inc. The JavaScript code in this tag is free software: you can redistribute it and/or modify it under the terms of the GNU @@ -768,7 +768,7 @@ INFO the export options (plist). The function result will be used in the section format string." :group 'org-export-html - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -800,7 +800,7 @@ The function must accept seven parameters: The function should return the string to be exported." :group 'org-export-html - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -1153,7 +1153,7 @@ See `format-time-string' for more information on its components." ;;;; Template :: Mathjax (defcustom org-html-mathjax-options - '((path "http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS_HTML" ) + '((path "https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.0/MathJax.js?config=TeX-AMS_HTML" ) (scale "100") (align "center") (font "TeX") @@ -1191,12 +1191,7 @@ You can also customize this for each buffer, using something like For further information about MathJax options, see the MathJax documentation: - http://docs.mathjax.org/ - -Please note that by using the default CDN one must agree with -MathJax CDN Terms of Service. - - http://www.mathjax.org/mathjax-cdn-terms-of-service.html" + http://docs.mathjax.org/" :group 'org-export-html :package-version '(Org . "8.3") :type '(list :greedy t @@ -1511,7 +1506,7 @@ The viewport meta tag is inserted if this variable is non-nil. See the following site for a reference: https://developer.mozilla.org/en-US/docs/Mozilla/Mobile/Viewport_meta_tag" :group 'org-export-html - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "Disable" nil) (list :tag "Enable" @@ -1566,21 +1561,26 @@ INFO is the current state of the export process, as a plist." (org-html-html5-p info))) (defun org-html-close-tag (tag attr info) - (concat "<" tag " " attr + "Return close-tag for string TAG. +ATTR specifies additional attributes. INFO is a property list +containing current export state." + (concat "<" tag + (org-string-nw-p (concat " " attr)) (if (org-html-xhtml-p info) " />" ">"))) (defun org-html-doctype (info) - "Return correct html doctype tag from `org-html-doctype-alist', -or the literal value of :html-doctype from INFO if :html-doctype -is not found in the alist. -INFO is a plist used as a communication channel." + "Return correct HTML doctype tag. +INFO is a plist used as a communication channel. Doctype tag is +extracted from `org-html-doctype-alist', or the literal value +of :html-doctype from INFO if :html-doctype is not found in the +alist." (let ((dt (plist-get info :html-doctype))) (or (cdr (assoc dt org-html-doctype-alist)) dt))) (defun org-html--make-attribute-string (attributes) "Return a list of attributes, as a string. -ATTRIBUTES is a plist where values are either strings or nil. An -attributes with a nil value will be omitted from the result." +ATTRIBUTES is a plist where values are either strings or nil. An +attribute with a nil value will be omitted from the result." (let (output) (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) (cond ((null item) (pop output)) @@ -1596,12 +1596,12 @@ INFO is a plist used as a communication channel. When optional arguments CAPTION and LABEL are given, use them for caption and \"id\" attribute." (let ((html5-fancy (org-html--html5-fancy-p info))) - (format (if html5-fancy "\n<figure%s>%s%s\n</figure>" - "\n<div%s class=\"figure\">%s%s\n</div>") + (format (if html5-fancy "\n<figure%s>\n%s%s\n</figure>" + "\n<div%s class=\"figure\">\n%s%s\n</div>") ;; ID. (if (org-string-nw-p label) (format " id=\"%s\"" label) "") ;; Contents. - (format "\n<p>%s</p>" contents) + (if html5-fancy contents (format "<p>%s</p>" contents)) ;; Caption. (if (not (org-string-nw-p caption)) "" (format (if html5-fancy "\n<figcaption>%s</figcaption>" @@ -2624,12 +2624,14 @@ CONTENTS is nil. INFO is a plist holding contextual information." "Transcode an INLINE-SRC-BLOCK element from Org to HTML. CONTENTS holds the contents of the item. INFO is a plist holding contextual information." - (let ((lang (org-element-property :language inline-src-block)) - (code (org-element-property :value inline-src-block)) - (label - (let ((lbl (and (org-element-property :name inline-src-block) - (org-export-get-reference inline-src-block info)))) - (if (not lbl) "" (format " id=\"%s\"" lbl))))) + (let* ((lang (org-element-property :language inline-src-block)) + (code (org-html-fontify-code + (org-element-property :value inline-src-block) + lang)) + (label + (let ((lbl (and (org-element-property :name inline-src-block) + (org-export-get-reference inline-src-block info)))) + (if (not lbl) "" (format " id=\"%s\"" lbl))))) (format "<code class=\"src src-%s\"%s>%s</code>" lang label code))) ;;;; Inlinetask @@ -3047,7 +3049,7 @@ INFO is a plist holding contextual information. See ;; equivalent line number. ((string= type "coderef") (let ((fragment (concat "coderef-" (org-html-encode-plain-text path)))) - (format "<a href=\"#%s\"%s%s>%s</a>" + (format "<a href=\"#%s\" %s%s>%s</a>" fragment (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, \ '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" @@ -3587,20 +3589,16 @@ information." "Transcode a VERSE-BLOCK element from Org to HTML. CONTENTS is verse block contents. INFO is a plist holding contextual information." - ;; Replace each newline character with line break. Also replace - ;; each blank line with a line break. - (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info)) - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" - (format "%s\n" (org-html-close-tag "br" nil info)) contents))) - ;; Replace each white space at beginning of a line with a - ;; non-breaking space. - (while (string-match "^[ \t]+" contents) - (let* ((num-ws (length (match-string 0 contents))) - (ws (org-html--make-string num-ws " "))) - (setq contents (replace-match ws nil t contents)))) - (format "<p class=\"verse\">\n%s</p>" contents)) + (format "<p class=\"verse\">\n%s</p>" + ;; Replace leading white spaces with non-breaking spaces. + (replace-regexp-in-string + "^[ \t]+" (lambda (m) (org-html--make-string (length m) " ")) + ;; Replace each newline character with line break. Also + ;; remove any trailing "br" close-tag so as to avoid + ;; duplicates. + (let* ((br (org-html-close-tag "br" nil info)) + (re (format "\\(?:%s\\)?[ \t]*\n" (regexp-quote br)))) + (replace-regexp-in-string re (concat br "\n") contents))))) ;;; Filter Functions diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el index 8c9fba6..9ccbb27 100644 --- a/lisp/ox-icalendar.el +++ b/lisp/ox-icalendar.el @@ -1,6 +1,6 @@ ;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2004-2016 Free Software Foundation, Inc. +;; Copyright (C) 2004-2017 Free Software Foundation, Inc. ;; Author: Carsten Dominik <carsten at orgmode dot org> ;; Nicolas Goaziou <n dot goaziou at gmail dot com> diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 0b51f15..f11a8a6 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -1,6 +1,6 @@ ;;; ox-latex.el --- LaTeX Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -100,8 +100,10 @@ (if a (org-latex-export-to-pdf t s v b) (org-open-file (org-latex-export-to-pdf nil s v b))))))) :filters-alist '((:filter-options . org-latex-math-block-options-filter) + (:filter-paragraph . org-latex-clean-invalid-line-breaks) (:filter-parse-tree org-latex-math-block-tree-filter - org-latex-matrices-tree-filter)) + org-latex-matrices-tree-filter) + (:filter-verse-block . org-latex-clean-invalid-line-breaks)) :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t) @@ -329,7 +331,7 @@ Otherwise, place it near the end. When value is a list of symbols, put caption above selected elements only. Allowed symbols are: `image', `table', `src-block' and `special-block'." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "For all elements" t) @@ -392,7 +394,7 @@ labeling scheme to generate labels and resolve links into proper references." :group 'org-export-latex :type 'boolean - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) ;;;; Preamble @@ -574,14 +576,14 @@ precedence over this variable." The format string should have at most one \"%s\"-expression, which is replaced with the subtitle." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(string :tag "Format string")) (defcustom org-latex-subtitle-separate nil "Non-nil means the subtitle is not typeset as part of title." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'boolean) @@ -618,7 +620,7 @@ inserted. Setting :latex-hyperref-template in publishing projects will take precedence over this variable." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "No template" nil) (string :tag "Format string"))) @@ -659,7 +661,7 @@ The function result will be used in the section format string." (const :tag "Use plain superscript (default)" "\\textsuperscript{\\ref{%s}}") (const :tag "Use Memoir/KOMA-Script footref" "\\footref{%s}") (string :tag "Other format string")) - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) ;;;; Timestamps @@ -685,7 +687,7 @@ The function result will be used in the section format string." (defcustom org-latex-images-centered t "When non-nil, images are centered." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type 'boolean :safe #'booleanp) @@ -719,7 +721,7 @@ environment." "Default position for LaTeX figures." :group 'org-export-latex :type 'string - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :safe #'stringp) @@ -842,7 +844,7 @@ to typeset and try to protect special characters. If no association can be found for a given markup, text will be returned as-is." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'alist :options '(bold code italic strike-through underline verbatim)) @@ -884,7 +886,7 @@ The function must accept seven parameters: The function should return the string to be exported." :group 'org-export-latex :type 'function - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) @@ -1089,7 +1091,7 @@ will produce (list (symbol :tag "Language name ") (string :tag "Environment name or format string"))) - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) @@ -1104,7 +1106,7 @@ See also `org-latex-compiler'." (const :tag "latex-mode file variable" "%% -*- latex-run-command: %s -*-\n") (const :tag "AUCTeX file variable" "%% -*- LaTeX-command: %s -*-\n") (string :tag "custom format" "%% %s")) - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) (defcustom org-latex-compiler "pdflatex" @@ -1119,7 +1121,7 @@ Can also be set in buffers via #+LATEX_COMPILER. See also (const :tag "XeLaTeX" "xelatex") (const :tag "LuaLaTeX" "lualatex") (const :tag "Unset" "")) - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) (defconst org-latex-compilers '("pdflatex" "xelatex" "lualatex") @@ -1137,7 +1139,7 @@ A better approach is to use a compiler suit such as `latexmk'." :type '(choice (const :tag "BibTeX" "bibtex") (const :tag "Biber" "biber") (string :tag "Other process")) - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) (defcustom org-latex-pdf-process @@ -1197,7 +1199,7 @@ file name as its single argument." The logfiles will be removed if `org-latex-remove-logfiles' is non-nil." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(repeat (string :tag "Extension"))) @@ -1221,7 +1223,7 @@ The regular expressions are used to find possible warnings in the log of a latex-run. These warnings will be reported after calling `org-latex-compile'." :group 'org-export-latex - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(repeat (cons @@ -1296,8 +1298,7 @@ For non-floats, see `org-latex--wrap-label'." main) (and (eq type 'src-block) (not (plist-get attr :float)) - (memq (plist-get info :latex-listings) - '(nil minted))))) + (null (plist-get info :latex-listings))))) (short (org-export-get-caption element t)) (caption-from-attr-latex (plist-get attr :caption))) (cond @@ -1582,37 +1583,6 @@ INFO is a plist used as a communication channel." (?L . ,(capitalize language)) (?D . ,(org-export-get-date info))))) -(defun org-latex--make-preamble (info) - "Return a formatted LaTeX preamble. -INFO is a plist used as a communication channel." - (let* ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options)) - (header (nth 1 (assoc class (plist-get info :latex-classes)))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-polyglossia-language - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-element-normalize-string - (org-splice-latex-header - document-class-string - (org-latex--remove-packages - org-latex-default-packages-alist info) - (org-latex--remove-packages - org-latex-packages-alist info) - nil - (mapconcat 'org-element-normalize-string - (list (plist-get info :latex-header) - (plist-get info :latex-header-extra)) "")))) - info) - info)))) - (defun org-latex--insert-compiler (info) "Insert LaTeX_compiler info into the document. INFO is a plist used as a communication channel." @@ -1622,8 +1592,62 @@ INFO is a plist used as a communication channel." (format org-latex-compiler-file-string compiler)))) +;;; Filters + +(defun org-latex-matrices-tree-filter (tree _backend info) + (org-latex--wrap-latex-matrices tree info)) + +(defun org-latex-math-block-tree-filter (tree _backend info) + (org-latex--wrap-latex-math-block tree info)) + +(defun org-latex-math-block-options-filter (info _backend) + (dolist (prop '(:author :date :title) info) + (plist-put info prop + (org-latex--wrap-latex-math-block (plist-get info prop) info)))) + +(defun org-latex-clean-invalid-line-breaks (data _backend _info) + (replace-regexp-in-string + "\\(\\end{[A-Za-z0-9*]+}\\|^\\)[ \t]*\\\\\\\\[ \t]*$" "\\1" + data)) + + ;;; Template +;;;###autoload +(defun org-latex-make-preamble (info &optional template snippet?) + "Return a formatted LaTeX preamble. +INFO is a plist used as a communication channel. Optional +argument TEMPLATE, when non-nil, is the header template string, +as expected by `org-splice-latex-header'. When SNIPPET? is +non-nil, only includes packages relevant to image generation, as +specified in `org-latex-default-packages-alist' or +`org-latex-packages-alist'." + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class (plist-get info :latex-classes)))) + (class-template + (or template + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))) + (user-error "Unknown LaTeX class `%s'" class)))) + (org-latex-guess-polyglossia-language + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + class-template + (org-latex--remove-packages org-latex-default-packages-alist info) + (org-latex--remove-packages org-latex-packages-alist info) + snippet? + (mapconcat #'org-element-normalize-string + (list (plist-get info :latex-header) + (plist-get info :latex-header-extra)) "")))) + info) + info))) + (defun org-latex-template (contents info) "Return complete document string after LaTeX conversion. CONTENTS is the transcoded contents string. INFO is a plist @@ -1637,7 +1661,7 @@ holding export options." ;; LaTeX compiler. (org-latex--insert-compiler info) ;; Document class and packages. - (org-latex--make-preamble info) + (org-latex-make-preamble info) ;; Possibly limit depth for headline numbering. (let ((sec-num (plist-get info :section-numbers))) (when (integerp sec-num) @@ -2000,7 +2024,7 @@ holding contextual information." (concat headline-label pre-blanks contents)))))))) (defun org-latex-format-headline-default-function - (todo _todo-type priority text tags info) + (todo _todo-type priority text tags _info) "Default format function for a headline. See `org-latex-format-headline-function' for details." (concat @@ -2009,8 +2033,7 @@ See `org-latex-format-headline-function' for details." text (and tags (format "\\hfill{}\\textsc{%s}" - (mapconcat (lambda (tag) (org-latex-plain-text tag info)) - tags ":"))))) + (mapconcat #'org-latex--protect-text tags ":"))))) ;;;; Horizontal Rule @@ -2029,8 +2052,8 @@ CONTENTS is nil. INFO is a plist holding contextual information." "\n") (org-latex--wrap-label horizontal-rule - (format "\\rule{%s}{%s}" - (or (plist-get attr :width) "\\linewidth") + (format "\\noindent\\rule{%s}{%s}" + (or (plist-get attr :width) "\\textwidth") (or (plist-get attr :thickness) "0.5pt")) info)))) @@ -2092,7 +2115,7 @@ holding contextual information." todo todo-type priority title tags contents info))) (defun org-latex-format-inlinetask-default-function - (todo _todo-type priority title tags contents info) + (todo _todo-type priority title tags contents _info) "Default format function for a inlinetasks. See `org-latex-format-inlinetask-function' for details." (let ((full-title @@ -2101,9 +2124,7 @@ See `org-latex-format-inlinetask-function' for details." title (when tags (format "\\hfill{}\\textsc{:%s:}" - (mapconcat - (lambda (tag) (org-latex-plain-text tag info)) - tags ":")))))) + (mapconcat #'org-latex--protect-text tags ":")))))) (concat "\\begin{center}\n" "\\fbox{\n" "\\begin{minipage}[c]{.6\\textwidth}\n" @@ -2686,8 +2707,6 @@ channel." (t "\\[\n%s\\]")) contents)) -(defun org-latex-matrices-tree-filter (tree _backend info) - (org-latex--wrap-latex-matrices tree info)) ;;;; Pseudo Object: LaTeX Math Block @@ -2745,14 +2764,6 @@ containing export options. Modify DATA by side-effect and return it." ;; Return updated DATA. data)) -(defun org-latex-math-block-tree-filter (tree _backend info) - (org-latex--wrap-latex-math-block tree info)) - -(defun org-latex-math-block-options-filter (info _backend) - (dolist (prop '(:author :date :title) info) - (plist-put info prop - (org-latex--wrap-latex-math-block (plist-get info prop) info)))) - (defun org-latex-math-block (_math-block contents _info) "Transcode a MATH-BLOCK object from Org to LaTeX. CONTENTS is a string. INFO is a plist used as a communication @@ -2866,13 +2877,19 @@ contextual information." (float-env (cond ((string= "multicolumn" float) - (format "\\begin{listing*}\n%s%%s\n%s\\end{listing*}" + (format "\\begin{listing*}[%s]\n%s%%s\n%s\\end{listing*}" + (plist-get info :latex-default-figure-position) (if caption-above-p caption-str "") (if caption-above-p "" caption-str))) (caption - (concat (if caption-above-p caption-str "") - "%s" - (if caption-above-p "" (concat "\n" caption-str)))) + (format "\\begin{listing}[%s]\n%s%%s\n%s\\end{listing}" + (plist-get info :latex-default-figure-position) + (if caption-above-p caption-str "") + (if caption-above-p "" caption-str))) + ((string= "t" float) + (concat (format "\\begin{listing}[%s]\n" + (plist-get info :latex-default-figure-position)) + "%s\n\\end{listing}")) (t "%s"))) (options (plist-get info :latex-minted-options)) (body @@ -3086,10 +3103,12 @@ contextual information." ;; table, insert their definition just after it. (org-latex--delayed-footnotes-definitions table info))))))) -(defun org-latex--align-string (table info) +(defun org-latex--align-string (table info &optional math?) "Return an appropriate LaTeX alignment string. TABLE is the considered table. INFO is a plist used as -a communication channel." +a communication channel. When optional argument MATH? is +non-nil, TABLE is meant to be a matrix, where all cells are +centered." (or (org-export-read-attribute :attr_latex table :align) (let (align) ;; Extract column groups and alignment from first (non-rule) @@ -3105,10 +3124,11 @@ a communication channel." ;; Check left border for the first cell only. (when (and (memq 'left borders) (not align)) (push "|" align)) - (push (cl-case (org-export-table-cell-alignment cell info) - (left "l") - (right "r") - (center "c")) + (push (if math? "c" ;center cells in matrices + (cl-case (org-export-table-cell-alignment cell info) + (left "l") + (right "r") + (center "c"))) align) (when (memq 'right borders) (push "|" align)))) info) @@ -3294,11 +3314,8 @@ This function assumes TABLE has `org' as its `:type' property and (plist-get attr :math-prefix) ;; Environment. Also treat special cases. (cond ((member env '("array" "tabular")) - ;; Make sure cells are always centered while preserving - ;; vertical separators. - (let ((align (replace-regexp-in-string - "[lr]" "c" (org-latex--align-string table info)))) - (format "\\begin{%s}{%s}\n%s\\end{%s}" env align contents env))) + (format "\\begin{%s}{%s}\n%s\\end{%s}" + env (org-latex--align-string table info t) contents env)) ((assoc env org-latex-table-matrix-macros) (format "\\%s%s{\n%s}" env @@ -3675,9 +3692,13 @@ Return output file name." ;; in working directory and then moved to publishing directory. (org-publish-attachment plist - (org-latex-compile - (org-publish-org-to - 'latex filename ".tex" plist (file-name-directory filename))) + ;; Default directory could be anywhere when this function is + ;; called. We ensure it is set to source file directory during + ;; compilation so as to not break links to external documents. + (let ((default-directory (file-name-directory filename))) + (org-latex-compile + (org-publish-org-to + 'latex filename ".tex" plist (file-name-directory filename)))) pub-dir)) diff --git a/lisp/ox-man.el b/lisp/ox-man.el index 324d5a7..71718ab 100644 --- a/lisp/ox-man.el +++ b/lisp/ox-man.el @@ -1,6 +1,6 @@ ;; ox-man.el --- Man Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2011-2016 Free Software Foundation, Inc. +;; Copyright (C) 2011-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> ;; Luis R Anaya <papoanaya aroba hot mail punto com> @@ -590,7 +590,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (defun org-man-line-break (_line-break _contents _info) "Transcode a LINE-BREAK object from Org to Man. CONTENTS is nil. INFO is a plist holding contextual information." - ".br\n") + "\n.br\n") ;;; Link diff --git a/lisp/ox-md.el b/lisp/ox-md.el index b8c4704..c8ea1fa 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -1,6 +1,6 @@ ;;; ox-md.el --- Markdown Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou@gmail.com> ;; Keywords: org, wp, markdown @@ -59,7 +59,7 @@ The first %s placeholder will be replaced with the localized Footnotes section heading, the second with the contents of the Footnotes section." :group 'org-export-md :type 'string - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) (defcustom org-md-footnote-format "<sup>%s</sup>" @@ -67,7 +67,7 @@ heading, the second with the contents of the Footnotes section." The %s will be replaced by the footnote reference itself." :group 'org-export-md :type 'string - :version "25.2" + :version "26.1" :package-version '(Org . "9.0")) @@ -217,11 +217,6 @@ a communication channel." (and (plist-get info :with-priority) (let ((char (org-element-property :priority headline))) (and char (format "[#%c] " char))))) - (anchor - (and (plist-get info :with-toc) - (format "<a id=\"%s\"></a>" - (or (org-element-property :CUSTOM_ID headline) - (org-export-get-reference headline info))))) ;; Headline text without tags. (heading (concat todo priority title)) (style (plist-get info :md-headline-style))) @@ -239,10 +234,29 @@ a communication channel." ".")))) (concat bullet (make-string (- 4 (length bullet)) ?\s) heading tags "\n\n" (and contents (replace-regexp-in-string "^" " " contents))))) - (t (concat (org-md--headline-title style level title anchor tags) contents)))))) - - -;; Headline Title + (t + (let ((anchor + (and (org-md--headline-referred-p headline info) + (format "<a id=\"%s\"></a>" + (or (org-element-property :CUSTOM_ID headline) + (org-export-get-reference headline info)))))) + (concat (org-md--headline-title style level title anchor tags) + contents))))))) + + +(defun org-md--headline-referred-p (headline info) + "Non-nil when HEADLINE is being referred to. +INFO is a plist used as a communication channel. Links and table +of contents can refer to headlines." + (or (plist-get info :with-toc) + (org-element-map (plist-get info :parse-tree) 'link + (lambda (link) + (eq headline + (pcase (org-element-property :type link) + ((or "custom-id" "id") (org-export-resolve-id-link link info)) + ("fuzzy" (org-export-resolve-fuzzy-link link info)) + (_ nil)))) + info t))) (defun org-md--headline-title (style level title &optional anchor tags) "Generate a headline title in the preferred Markdown headline style. diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 2465836..943a6be 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -1,6 +1,6 @@ ;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode -*- lexical-binding: t; -*- -;; Copyright (C) 2010-2016 Free Software Foundation, Inc. +;; Copyright (C) 2010-2017 Free Software Foundation, Inc. ;; Author: Jambunathan K <kjambunathan at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -673,7 +673,7 @@ TAGS the tags string, separated with colons (string or nil). The function result will be used as headline text." :group 'org-export-odt - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -694,7 +694,7 @@ The function must accept six parameters: The function should return the string to be exported." :group 'org-export-odt - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'function) @@ -753,7 +753,7 @@ A rule consists in an association whose key is the type of link to consider, and value is a regexp that will be matched against link's path." :group 'org-export-odt - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -2882,15 +2882,10 @@ contextual information." (defun org-odt--encode-tabs-and-spaces (line) (replace-regexp-in-string - "\\([\t]\\|\\([ ]+\\)\\)" + "\\(\t\\| \\{2,\\}\\)" (lambda (s) - (cond - ((string= s "\t") "<text:tab/>") - (t (let ((n (length s))) - (cond - ((= n 1) " ") - ((> n 1) (concat " " (format "<text:s text:c=\"%d\"/>" (1- n)))) - (t "")))))) + (if (string= s "\t") "<text:tab/>" + (format " <text:s text:c=\"%d\"/>" (1- (length s))))) line)) (defun org-odt--encode-plain-text (text &optional no-whitespace-filling) @@ -3673,15 +3668,13 @@ channel." "Transcode a VERSE-BLOCK element from Org to ODT. CONTENTS is verse block contents. INFO is a plist holding contextual information." - ;; Add line breaks to each line of verse. - (setq contents (replace-regexp-in-string - "\\(<text:line-break/>\\)?[ \t]*\n" - "<text:line-break/>" contents)) - ;; Replace tabs and spaces. - (setq contents (org-odt--encode-tabs-and-spaces contents)) - ;; Surround it in a verse environment. - (format "\n<text:p text:style-name=\"%s\">%s</text:p>" - "OrgVerse" contents)) + (format "\n<text:p text:style-name=\"OrgVerse\">%s</text:p>" + (replace-regexp-in-string + ;; Replace leading tabs and spaces. + "^[ \t]+" #'org-odt--encode-tabs-and-spaces + ;; Add line breaks to each line of verse. + (replace-regexp-in-string + "\\(<text:line-break/>\\)?[ \t]*$" "<text:line-break/>" contents)))) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index b8cd15d..a52ecc8 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -1,6 +1,6 @@ ;;; ox-org.el --- Org Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2013-2016 Free Software Foundation, Inc. +;; Copyright (C) 2013-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou@gmail.com> ;; Keywords: org, wp @@ -107,7 +107,27 @@ setting of `org-html-htmlize-output-type' is `css'." (?v "As Org file and open" (lambda (a s v b) (if a (org-org-export-to-org t s v b) - (org-open-file (org-org-export-to-org nil s v b)))))))) + (org-open-file (org-org-export-to-org nil s v b))))))) + :filters-alist '((:filter-parse-tree . org-org--add-missing-sections))) + +(defun org-org--add-missing-sections (tree _backend _info) + "Ensure each headline has an associated section. + +TREE is the parse tree being exported. + +Footnotes relative to the headline are inserted in the section, +using `org-org-section'. However, this function is not called if +the headline doesn't contain any section in the first place, so +we make sure it is always called." + (org-element-map tree 'headline + (lambda (h) + (let ((first-child (car (org-element-contents h))) + (new-section (org-element-create 'section))) + (pcase (org-element-type first-child) + (`section nil) + (`nil (org-element-adopt-elements h new-section)) + (_ (org-element-insert-before new-section first-child)))))) + tree) (defun org-org-export-block (export-block _contents _info) "Transcode a EXPORT-BLOCK element from Org to LaTeX. @@ -193,25 +213,24 @@ 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 + ;; section, or in the relative headline title. Indeed, some of + ;; them may not be available to narrowing so we make sure all of + ;; them are included in the result. + (let ((footnotes + (org-element-map + (list (org-export-get-parent-headline section) 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 "[fn:%s] "(car d)) - (org-export-data (cdr d) info)))) - footnotes-alist "\n")))) - (make-string (or (org-element-property :post-blank section) 0) ?\n))) + (org-element-normalize-string + (format "[fn:%s] %s" + (org-element-property :label fn) + (org-export-data + (org-export-get-footnote-definition fn info) + info))))) + info nil 'headline t))) + (and footnotes (concat "\n" (mapconcat #'identity footnotes "\n")))))) ;;;###autoload (defun org-org-export-as-org diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index e8271f6..884d6bf 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -1,5 +1,5 @@ ;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*- -;; Copyright (C) 2006-2016 Free Software Foundation, Inc. +;; Copyright (C) 2006-2017 Free Software Foundation, Inc. ;; Author: David O'Toole <dto@gnu.org> ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com> @@ -104,7 +104,8 @@ Most properties are optional, but some should always be set: Extension (without the dot!) of source files. This can be a regular expression. If not given, \"org\" will be used as - default extension. + default extension. If it is `any', include all the files, + even without extension. `:publishing-directory' @@ -362,7 +363,7 @@ still decide about that independently." filename pub-dir pub-func base-dir)))) (if rtn (message "Publishing file %s using `%s'" filename pub-func) (when org-publish-list-skipped-files - (message "Skipping unmodified file %s" filename))) + (message "Skipping unmodified file %s" filename))) rtn)) (defun org-publish-update-timestamp @@ -385,6 +386,15 @@ If there is no timestamp, create one." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Getting project information out of `org-publish-project-alist' +(defun org-publish-property (property project &optional default) + "Return value PROPERTY, as a symbol, in PROJECT. +DEFAULT is returned when PROPERTY is not actually set in PROJECT +definition." + (let ((properties (cdr project))) + (if (plist-member properties property) + (plist-get properties property) + default))) + (defun org-publish-expand-projects (projects-alist) "Expand projects in PROJECTS-ALIST. This splices all the components into the list." @@ -526,34 +536,61 @@ matching filenames." org-publish-temp-files)))) (defun org-publish-get-project-from-filename (filename &optional up) - "Return the project that FILENAME belongs to." + "Return a project that FILENAME belongs to. +When UP is non-nil, return a meta-project (i.e., with a :components part) +publishing FILENAME." (let* ((filename (expand-file-name filename)) - project-name) - - (catch 'p-found - (dolist (prj org-publish-project-alist) - (unless (plist-get (cdr prj) :components) - ;; [[info:org:Selecting%20files]] shows how this is supposed to work: - (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (file-name-as-directory - (plist-get (cdr prj) :base-directory)))) - (x (or (plist-get (cdr prj) :base-extension) "org")) - (e (plist-get (cdr prj) :exclude)) - (i (plist-get (cdr prj) :include)) - (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when - (or (and i - (member filename - (dolist (file i) (expand-file-name file b)))) - (and (not (and e (string-match e filename))) - (string-match xm filename))) - (setq project-name (car prj)) - (throw 'p-found project-name)))))) - (when up - (dolist (prj org-publish-project-alist) - (if (member project-name (plist-get (cdr prj) :components)) - (setq project-name (car prj))))) - (assoc project-name org-publish-project-alist))) + (project + (cl-some + (lambda (p) + ;; Ignore meta-projects. + (unless (org-publish-property :components p) + (let ((base (file-truename + (org-publish-property :base-directory p)))) + (cond + ;; Check if FILENAME is explicitly included in one + ;; project. + ((cl-some (lambda (f) (file-equal-p f filename)) + (mapcar (lambda (f) (expand-file-name f base)) + (org-publish-property :include p))) + p) + ;; Exclude file names matching :exclude property. + ((let ((exclude-re (org-publish-property :exclude p))) + (and exclude-re + (string-match-p exclude-re + (file-relative-name filename base)))) + nil) + ;; Check :extension. Handle special `any' + ;; extension. + ((let ((extension (org-publish-property :base-extension p))) + (not (or (eq extension 'any) + (string= (or extension "org") + (file-name-extension filename))))) + nil) + ;; Check if FILENAME belong to project's base + ;; directory, or some of its sub-directories + ;; if :recursive in non-nil. + ((org-publish-property :recursive p) + (and (file-in-directory-p filename base) p)) + ((file-equal-p base (file-name-directory filename)) p) + (t nil))))) + org-publish-project-alist))) + (cond + ((not project) nil) + ((not up) project) + ;; When optional argument UP is non-nil, return the top-most + ;; meta-project effectively publishing FILENAME. + (t + (letrec ((find-parent-project + (lambda (project) + (or (cl-some + (lambda (p) + (and (member (car project) + (org-publish-property :components p)) + (funcall find-parent-project p))) + org-publish-project-alist) + project)))) + (funcall find-parent-project project)))))) @@ -591,7 +628,8 @@ Return output file name." plist `(:crossrefs ,(org-publish-cache-get-file-property - (expand-file-name filename) :crossrefs nil t) + ;; Normalize file names in cache. + (file-truename filename) :crossrefs nil t) :filter-final-output (org-publish--store-crossrefs org-publish-collect-index @@ -610,9 +648,9 @@ Return output file name." (unless (file-directory-p pub-dir) (make-directory pub-dir t)) (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir))) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) - (copy-file filename output t)) + (unless (file-equal-p (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) + (copy-file filename output t)) ;; Return file name. output)) @@ -629,42 +667,38 @@ files, when entire projects are published (see `org-publish-projects')." (let* ((project (or project - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename))))) + (org-publish-get-project-from-filename filename) + (user-error "File %S is not part of any known project" + (abbreviate-file-name filename)))) (project-plist (cdr project)) - (ftname (expand-file-name filename)) (publishing-function - (let ((fun (plist-get project-plist :publishing-function))) - (cond ((null fun) (error "No publishing function chosen")) - ((listp fun) fun) - (t (list fun))))) + (pcase (plist-get project-plist :publishing-function) + (`nil (user-error "No publishing function chosen")) + ((and f (pred listp)) f) + (f (list f)))) (base-dir (file-name-as-directory - (expand-file-name - (or (plist-get project-plist :base-directory) - (error "Project %s does not have :base-directory defined" - (car project)))))) - (pub-dir + (or (org-publish-property :base-directory project) + (user-error "Project %S does not have :base-directory defined" + (car project))))) + (pub-base-dir (file-name-as-directory - (file-truename - (or (eval (plist-get project-plist :publishing-directory)) - (error "Project %s does not have :publishing-directory defined" - (car project)))))) - tmp-pub-dir) + (or (org-publish-property :publishing-directory project) + (user-error + "Project %S does not have :publishing-directory defined" + (car project))))) + (pub-dir + (file-name-directory + (expand-file-name (file-relative-name filename base-dir) + pub-base-dir)))) (unless no-cache (org-publish-initialize-cache (car project))) - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) ;; Allow chain of publishing functions. (dolist (f publishing-function) - (when (org-publish-needed-p filename pub-dir f tmp-pub-dir base-dir) - (let ((output (funcall f project-plist filename tmp-pub-dir))) - (org-publish-update-timestamp filename pub-dir f base-dir) + (when (org-publish-needed-p filename pub-base-dir f pub-dir base-dir) + (let ((output (funcall f project-plist filename pub-dir))) + (org-publish-update-timestamp filename pub-base-dir f base-dir) (run-hook-with-args 'org-publish-after-publishing-hook filename output)))) @@ -697,7 +731,7 @@ If `:auto-sitemap' is set, publish the sitemap too. If (or (plist-get project-plist :sitemap-file-entry-format) org-publish-sitemap-file-entry-format))) (funcall sitemap-function project sitemap-filename))) - ;; Publish all files from PROJECT excepted "theindex.org". Its + ;; Publish all files from PROJECT except "theindex.org". Its ;; publishing will be deferred until "theindex.inc" is ;; populated. (let ((theindex @@ -705,7 +739,8 @@ If `:auto-sitemap' is set, publish the sitemap too. If (plist-get project-plist :base-directory))) (exclude-regexp (plist-get project-plist :exclude))) (dolist (file (org-publish-get-base-files project exclude-regexp)) - (unless (equal file theindex) (org-publish-file file project t))) + (unless (file-equal-p file theindex) + (org-publish-file file project t))) ;; Populate "theindex.inc", if needed, and publish ;; "theindex.org". (when (plist-get project-plist :makeindex) @@ -725,13 +760,13 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (dir (file-name-as-directory (plist-get project-plist :base-directory))) (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) + (indent-str (make-string 2 ?\s)) (exclude-regexp (plist-get project-plist :exclude)) (files (nreverse (org-publish-get-base-files project exclude-regexp))) (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) + (concat "Sitemap for project " (car project)))) (sitemap-style (or (plist-get project-plist :sitemap-style) 'tree)) (sitemap-sans-extension @@ -750,8 +785,7 @@ Default for SITEMAP-FILENAME is `sitemap.org'." (when sitemap-sans-extension (setq link (file-name-sans-extension link))) ;; sitemap shouldn't list itself - (unless (equal (file-truename sitemap-filename) - (file-truename file)) + (unless (file-equal-p sitemap-filename file) (if (eq sitemap-style 'list) (message "Generating list-style sitemap for %s" sitemap-title) (message "Generating tree-style sitemap for %s" sitemap-title) @@ -970,7 +1004,7 @@ PARENT is a reference to the headline, if any, containing the original index keyword. When non-nil, this reference is a cons cell. Its CAR is a symbol among `id', `custom-id' and `name' and its CDR is a string." - (let ((file (plist-get info :input-file))) + (let ((file (file-truename (plist-get info :input-file)))) (org-publish-cache-set-file-property file :index (delete-dups @@ -1040,7 +1074,7 @@ publishing directory." (dotimes (n len) (insert (concat - (make-string (* (+ rank n) 2) ? ) " - " + (make-string (* (+ rank n) 2) ?\s) " - " (if (not (= (1- len) n)) (nth (+ rank n) entry) ;; Last term: Link it to TARGET, if possible. (let ((target (nth 2 idx))) @@ -1080,7 +1114,8 @@ a plist. This function is meant to be used as a final output filter. See `org-publish-org-to'." (org-publish-cache-set-file-property - (plist-get info :input-file) :crossrefs + (file-truename (plist-get info :input-file)) + :crossrefs ;; Update `:crossrefs' so as to remove unused references and search ;; cells. Actually used references are extracted from ;; `:internal-references', with references as strings removed. See @@ -1110,7 +1145,7 @@ references with `org-export-get-reference'." search file) "MissingReference") - (let* ((filename (expand-file-name file)) + (let* ((filename (file-truename file)) (crossrefs (org-publish-cache-get-file-property filename :crossrefs nil t)) (cells (org-export-string-to-search-cell search))) @@ -1249,23 +1284,19 @@ will be created. Return VALUE." filename property value nil project-name)))) (defun org-publish-cache-get-file-property - (filename property &optional default no-create project-name) + (filename property &optional default no-create project-name) "Return the value for a PROPERTY of file FILENAME in publishing cache. Use cache file of PROJECT-NAME. Return the value of that PROPERTY, or DEFAULT, if the value does not yet exist. Create the entry, if necessary, unless NO-CREATE is non-nil." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename)) retval) - (if pl - (if (plist-member pl property) - (setq retval (plist-get pl property)) - (setq retval default)) - ;; no pl yet: - (unless no-create - (org-publish-cache-set filename (list property default))) - (setq retval default)) - retval)) + (when project-name (org-publish-initialize-cache project-name)) + (let ((properties (org-publish-cache-get filename))) + (cond ((null properties) + (unless no-create + (org-publish-cache-set filename (list property default))) + default) + ((plist-member properties property) (plist-get properties property)) + (t default)))) (defun org-publish-cache-get (key) "Return the value stored in `org-publish-cache' for key KEY. diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index ab61b6b..35927d9 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -1,6 +1,6 @@ ;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Jonathan Leech-Pepin <jonathan.leechpepin at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -224,7 +224,7 @@ TAGS the tags as a list of strings (list of strings or nil). The function result will be used in the section format string." :group 'org-export-texinfo :type 'function - :version "25.2" + :version "26.1" :package-version '(Org . "8.3")) ;;;; Node listing (menu) @@ -269,6 +269,7 @@ be placed after the end of the title." (defcustom org-texinfo-table-scientific-notation "%s\\,(%s)" "Format string to display numbers in scientific notation. + The format should have \"%s\" twice, for mantissa and exponent \(i.e. \"%s\\\\times10^{%s}\"). @@ -279,7 +280,12 @@ When nil, no transformation is made." (const :tag "No formatting" nil))) (defcustom org-texinfo-def-table-markup "@samp" - "Default setting for @table environments." + "Default markup for first column in two-column tables. + +This should an indicating command, e.g., \"@code\", \"@kbd\" or +\"@asis\". + +It can be overridden locally using the \":indic\" attribute." :group 'org-export-texinfo :type 'string) @@ -448,33 +454,53 @@ INFO is a plist used as a communication channel. See ;; Else use format string. (fmt (format fmt text)))) -(defun org-texinfo--get-node (blob info) - "Return node or anchor associated to BLOB. -BLOB is an element or object. INFO is a plist used as +(defun org-texinfo--get-node (datum info) + "Return node or anchor associated to DATUM. +DATUM is an element or object. INFO is a plist used as a communication channel. The function guarantees the node or anchor name is unique." (let ((cache (plist-get info :texinfo-node-cache))) - (or (cdr (assq blob cache)) - (let ((name - (org-texinfo--sanitize-node - (if (eq (org-element-type blob) 'headline) - (org-export-data (org-export-get-alt-title blob info) info) - (org-export-get-reference blob info))))) - ;; Ensure NAME is unique. - (while (rassoc name cache) (setq name (concat name "x"))) - (plist-put info :texinfo-node-cache (cons (cons blob name) cache)) + (or (cdr (assq datum cache)) + (let* ((salt 0) + (basename + (org-texinfo--sanitize-node + (if (eq (org-element-type datum) 'headline) + (org-texinfo--sanitize-title + (org-export-get-alt-title datum info) info) + (org-export-get-reference datum info)))) + (name basename)) + ;; Ensure NAME is unique and not reserved node name "Top". + (while (or (equal name "Top") (rassoc name cache)) + (setq name (concat basename (format " %d" (cl-incf salt))))) + (plist-put info :texinfo-node-cache (cons (cons datum name) cache)) name)))) (defun org-texinfo--sanitize-node (title) "Bend string TITLE to node line requirements. Trim string and collapse multiple whitespace characters as they -are not significant. Also remove the following characters: @ -{ } ( ) : . ," - (replace-regexp-in-string - "[:,.]" "" +are not significant. Replace leading left parenthesis, when +followed by a right parenthesis, with a square bracket. Remove +periods, commas and colons." + (org-trim (replace-regexp-in-string - "\\`(\\(.*)\\)" "[\\1" - (org-trim (replace-regexp-in-string "[ \t]\\{2,\\}" " " title))))) + "[ \t]+" " " + (replace-regexp-in-string + "[:,.]" "" + (replace-regexp-in-string "\\`(\\(.*?)\\)" "[\\1" title))))) + +(defun org-texinfo--sanitize-title (title info) + "Make TITLE suitable as a section name. +TITLE is a string or a secondary string. INFO is the current +export state, as a plist." + (org-export-data-with-backend + title + (org-export-create-backend + :parent 'texinfo + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) + info)) (defun org-texinfo--sanitize-content (text) "Escape special characters in string TEXT. @@ -598,7 +624,8 @@ holding export options." "@titlepage\n" (when (plist-get info :with-title) (concat - (format "@title %s\n" (or (plist-get info :texinfo-printed-title) title "")) + (format "@title %s\n" + (or (plist-get info :texinfo-printed-title) title "")) (let ((subtitle (plist-get info :subtitle))) (when subtitle (format "@subtitle %s\n" @@ -624,11 +651,17 @@ holding export options." "@end titlepage\n\n" ;; Table of contents. (and (plist-get info :with-toc) "@contents\n\n") - ;; Configure Top Node when not for Tex + ;; Configure Top Node when not for TeX. Also include contents + ;; from the first section of the document. "@ifnottex\n" "@node Top\n" (format "@top %s\n" title) - (and copying "@insertcopying\n") + (let* ((first-section + (org-element-map (plist-get info :parse-tree) 'section + #'identity info t '(headline))) + (top-contents + (org-export-data (org-element-contents first-section) info))) + (and (org-string-nw-p top-contents) (concat "\n" top-contents))) "@end ifnottex\n\n" ;; Menu. (org-texinfo-make-menu (plist-get info :parse-tree) info 'master) @@ -706,11 +739,46 @@ holding contextual information." ;;;; Entity (defun org-texinfo-entity (entity _contents _info) - "Transcode an ENTITY object from Org to Texinfo. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (let ((ent (org-element-property :latex entity))) - (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent))) + "Transcode an ENTITY object from Org to Texinfo." + ;; Since there is not specific Texinfo entry in entities, use + ;; Texinfo-specific commands whenever possible, and fallback to + ;; UTF-8 otherwise. + (pcase (org-element-property :name entity) + ("AElig" "@AE{}") + ("aelig" "@ae{}") + ((or "bull" "bullet") "@bullet{}") + ("copy" "@copyright{}") + ("deg" "@textdegree{}") + ((or "dots" "hellip") "@dots{}") + ("equiv" "@equiv{}") + ((or "euro" "EUR") "@euro{}") + ((or "ge" "geq") "@geq{}") + ("laquo" "@guillemetleft{}") + ("iexcl" "@exclamdown{}") + ("imath" "@dotless{i}") + ("iquest" "@questiondown{}") + ("jmath" "@dotless{j}") + ((or "le" "leq") "@leq{}") + ("lsaquo" "@guilsinglleft{}") + ("mdash" "---") + ("minus" "@minus{}") + ("nbsp" "@tie{}") + ("ndash" "--") + ("OElig" "@OE{}") + ("oelig" "@oe{}") + ("ordf" "@ordf{}") + ("ordm" "@ordm{}") + ("pound" "@pound{}") + ("raquo" "@guillemetright{}") + ((or "rArr" "Rightarrow") "@result{}") + ("reg" "@registeredsymbol{}") + ((or "rightarrow" "to" "rarr") "@arrow{}") + ("rsaquo" "@guilsinglright{}") + ("thorn" "@th{}") + ("THORN" "@TH{}") + ((and (pred (string-prefix-p "_")) name) ;spacing entities + (format "@w{%s}" (substring name 1))) + (_ (org-element-property :utf-8 entity)))) ;;;; Example Block @@ -742,7 +810,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (defun org-texinfo-fixed-width (fixed-width _contents _info) "Transcode a FIXED-WIDTH element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (format "@example\n%s\n@end example" + (format "@example\n%s@end example" (org-remove-indentation (org-texinfo--sanitize-content (org-element-property :value fixed-width))))) @@ -800,7 +868,8 @@ holding contextual information." (org-export-get-tags headline info))) (priority (and (plist-get info :with-priority) (org-element-property :priority headline))) - (text (org-export-data (org-element-property :title headline) info)) + (text (org-texinfo--sanitize-title + (org-element-property :title headline) info)) (full-text (funcall (plist-get info :texinfo-format-headline-function) todo todo-type priority text tags)) (contents (if (org-string-nw-p contents) (concat "\n" contents) ""))) @@ -908,23 +977,22 @@ contextual information." (defun org-texinfo-keyword (keyword _contents info) "Transcode a KEYWORD element from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "TEXINFO") value) - ((string= key "CINDEX") (format "@cindex %s" value)) - ((string= key "FINDEX") (format "@findex %s" value)) - ((string= key "KINDEX") (format "@kindex %s" value)) - ((string= key "PINDEX") (format "@pindex %s" value)) - ((string= key "TINDEX") (format "@tindex %s" value)) - ((string= key "VINDEX") (format "@vindex %s" value)) - ((string= key "TOC") - (cond ((string-match-p "\\<tables\\>" value) - (concat "@listoffloats " - (org-export-translate "Table" :utf-8 info))) - ((string-match-p "\\<listings\\>" value) - (concat "@listoffloats " - (org-export-translate "Listing" :utf-8 info)))))))) + (let ((value (org-element-property :value keyword))) + (pcase (org-element-property :key keyword) + ("TEXINFO" value) + ("CINDEX" (format "@cindex %s" value)) + ("FINDEX" (format "@findex %s" value)) + ("KINDEX" (format "@kindex %s" value)) + ("PINDEX" (format "@pindex %s" value)) + ("TINDEX" (format "@tindex %s" value)) + ("VINDEX" (format "@vindex %s" value)) + ("TOC" + (cond ((string-match-p "\\<tables\\>" value) + (concat "@listoffloats " + (org-export-translate "Table" :utf-8 info))) + ((string-match-p "\\<listings\\>" value) + (concat "@listoffloats " + (org-export-translate "Listing" :utf-8 info)))))))) ;;;; Line Break @@ -935,9 +1003,22 @@ CONTENTS is nil. INFO is a plist holding contextual information." ;;;; Link +(defun org-texinfo--@ref (datum description info) + "Return @ref command for element or object DATUM. +DESCRIPTION is the name of the section to print, as a string." + (let ((node-name (org-texinfo--get-node datum info)) + ;; Sanitize DESCRIPTION for cross-reference use. In + ;; particular, remove colons as they seem to cause (even + ;; within @asis{...} to the Texinfo reader. + (title (replace-regexp-in-string + "[ \t]*:+" "" + (replace-regexp-in-string "," "@comma{}" description)))) + (if (equal title node-name) + (format "@ref{%s}" node-name) + (format "@ref{%s, , %s}" node-name title)))) + (defun org-texinfo-link (link desc info) "Transcode a LINK object from Org to Texinfo. - DESC is the description part of the link, or the empty string. INFO is a plist holding contextual information. See `org-export-data'." @@ -957,9 +1038,7 @@ INFO is a plist holding contextual information. See ((equal type "radio") (let ((destination (org-export-resolve-radio-link link info))) (if (not destination) desc - (format "@ref{%s,,%s}" - (org-texinfo--get-node destination info) - desc)))) + (org-texinfo--@ref destination desc info)))) ((member type '("custom-id" "id" "fuzzy")) (let ((destination (if (equal type "fuzzy") @@ -973,37 +1052,29 @@ INFO is a plist holding contextual information. See (`plain-text (if desc (format "@uref{file://%s,%s}" destination desc) (format "@uref{file://%s}" destination))) - (`headline - (format "@ref{%s,%s}" - (org-texinfo--get-node destination info) - (cond - (desc) - ((org-export-numbered-headline-p destination info) - (mapconcat - #'number-to-string - (org-export-get-headline-number destination info) ".")) - (t (org-export-data - (org-element-property :title destination) info))))) + ((or `headline + ;; Targets within headlines cannot be turned into + ;; @anchor{}, so we refer to the headline parent + ;; directly. + (and `target + (guard (eq 'headline + (org-element-type + (org-element-property :parent destination)))))) + (let ((headline (org-element-lineage destination '(headline) t))) + (org-texinfo--@ref + headline + (or desc (org-texinfo--sanitize-title + (org-element-property :title headline) info)) + info))) (_ - (format "@ref{%s,,%s}" - (org-texinfo--get-node destination info) - (cond - (desc) - ;; No description is provided: first try to - ;; associate destination to a number. - ((let ((n (org-export-get-ordinal destination info))) - (cond ((not n) nil) - ((integerp n) n) - (t (mapconcat #'number-to-string n "."))))) - ;; Then grab title of headline containing - ;; DESTINATION. - ((let ((h (org-element-lineage destination '(headline) t))) - (and h - (org-export-data - (org-element-property :title destination) info)))) - ;; Eventually, just return "Top" to refer to the - ;; beginning of the info file. - (t "Top"))))))) + (org-texinfo--@ref + destination + (or desc + (pcase (org-export-get-ordinal destination info) + ((and (pred integerp) n) (number-to-string n)) + ((and (pred consp) n) (mapconcat #'number-to-string n ".")) + (_ "???"))) + info))))) ;cannot guess the description ((equal type "info") (let* ((info-path (split-string path "[:#]")) (info-manual (car info-path)) @@ -1013,9 +1084,9 @@ INFO is a plist holding contextual information. See ((string= type "mailto") (format "@email{%s}" (concat (org-texinfo--sanitize-content path) - (and desc (concat "," desc))))) + (and desc (concat ", " desc))))) ;; External link with a description part. - ((and path desc) (format "@uref{%s,%s}" path desc)) + ((and path desc) (format "@uref{%s, %s}" path desc)) ;; External link without a description part. (path (format "@uref{%s}" path)) ;; No path, only description. Try to do something useful. @@ -1111,8 +1182,13 @@ a plist containing contextual information." (org-element-normalize-string (mapconcat (lambda (h) - (let* ((title (org-export-data - (org-export-get-alt-title h info) info)) + (let* ((title + ;; Colons are used as a separator between title and node + ;; name. Remove them. + (replace-regexp-in-string + "[ \t]+:+" "" + (org-texinfo--sanitize-title + (org-export-get-alt-title h info) info))) (node (org-texinfo--get-node h info)) (entry (concat "* " title ":" (if (string= title node) ":" @@ -1169,8 +1245,10 @@ the plist used as a communication channel." CONTENTS is the contents of the list. INFO is a plist holding contextual information." (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) - (indic (or (plist-get attr :indic) - (plist-get info :texinfo-def-table-markup))) + (indic (let ((i (or (plist-get attr :indic) + (plist-get info :texinfo-def-table-markup)))) + ;; Allow indicating commands with missing @ sign. + (if (string-prefix-p "@" i) i (concat "@" i)))) (table-type (plist-get attr :table-type)) (type (org-element-property :type plain-list)) (list-type (cond @@ -1197,16 +1275,14 @@ contextual information." (setq output (org-export-activate-smart-quotes output :texinfo info text))) ;; LaTeX into @LaTeX{} and TeX into @TeX{} - (let ((case-fold-search nil) - (start 0)) - (while (string-match "\\(\\(?:La\\)?TeX\\)" output start) - (setq output (replace-match - (format "@%s{}" (match-string 1 output)) nil t output) - start (match-end 0)))) + (let ((case-fold-search nil)) + (setq output (replace-regexp-in-string "\\(?:La\\)?TeX" "@\\&{}" output))) ;; Convert special strings. (when (plist-get info :with-special-strings) - (while (string-match (regexp-quote "...") output) - (setq output (replace-match "@dots{}" nil t output)))) + (setq output + (replace-regexp-in-string + "\\.\\.\\." "@dots{}" + (replace-regexp-in-string "\\\\-" "@-" output)))) ;; Handle break preservation if required. (when (plist-get info :preserve-breaks) (setq output (replace-regexp-in-string @@ -1275,7 +1351,7 @@ holding contextual information." TEXT is the text of the target. INFO is a plist holding contextual information." (format "@anchor{%s}%s" - (org-export-get-reference radio-target info) + (org-texinfo--get-node radio-target info) text)) ;;;; Section @@ -1284,11 +1360,10 @@ contextual information." "Transcode a SECTION element from Org to Texinfo. CONTENTS holds the contents of the section. INFO is a plist holding contextual information." - (org-trim - (concat contents - "\n" - (let ((parent (org-export-get-parent-headline section))) - (and parent (org-texinfo-make-menu parent info)))))) + (let ((parent (org-export-get-parent-headline section))) + (when parent ;ignore very first section + (org-trim + (concat contents "\n" (org-texinfo-make-menu parent info)))))) ;;;; Special Block @@ -1300,7 +1375,7 @@ as a communication channel." (type (org-element-property :type special-block))) (format "@%s%s\n%s@end %s" type - (if opt (concat " " opt) opt) + (if opt (concat " " opt) "") (or contents "") type))) @@ -1323,7 +1398,7 @@ contextual information." (org-texinfo--wrap-float value info (org-export-translate "Listing" :utf-8 info) - (org-export-get-reference src-block info) + (org-texinfo--get-node src-block info) caption shortcaption)))) @@ -1382,7 +1457,7 @@ contextual information." (org-texinfo--wrap-float table-str info (org-export-translate "Table" :utf-8 info) - (org-export-get-reference table info) + (org-texinfo--get-node table info) caption shortcaption))))) @@ -1450,7 +1525,7 @@ a communication channel." "Transcode a TARGET object from Org to Texinfo. CONTENTS is nil. INFO is a plist holding contextual information." - (format "@anchor{%s}" (org-export-get-reference target info))) + (format "@anchor{%s}" (org-texinfo--get-node target info))) ;;;; Timestamp @@ -1,6 +1,6 @@ ;;; ox.el --- Export Framework for Org Mode -*- lexical-binding: t; -*- -;; Copyright (C) 2012-2016 Free Software Foundation, Inc. +;; Copyright (C) 2012-2017 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> ;; Keywords: outlines, hypermedia, calendar, wp @@ -77,12 +77,12 @@ (require 'org-macro) (require 'tabulated-list) +(declare-function org-src-coderef-format "org-src" (&optional element)) +(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (declare-function org-publish "ox-publish" (project &optional force async)) (declare-function org-publish-all "ox-publish" (&optional force async)) (declare-function org-publish-current-file "ox-publish" (&optional force async)) (declare-function org-publish-current-project "ox-publish" (&optional force async)) -(declare-function org-src-coderef-format "org-src" (&optional element)) -(declare-function org-src-coderef-regexp "org-src" (fmt &optional label)) (defvar org-publish-project-alist) (defvar org-table-number-fraction) @@ -375,7 +375,7 @@ see. This option can also be set with the OPTIONS keyword, e.g., \"creator:t\"." :group 'org-export-general - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'boolean :safe #'booleanp) @@ -790,7 +790,7 @@ e.g. \"tasks:nil\"." This option can also be set with the OPTIONS keyword, e.g. \"title:nil\"." :group 'org-export-general - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type 'boolean :safe #'booleanp) @@ -856,7 +856,7 @@ where PATH is the un-resolvable reference. This option can also be set with the OPTIONS keyword, e.g., \"broken-links:mark\"." :group 'org-export-general - :version "25.2" + :version "26.1" :package-version '(Org . "9.0") :type '(choice (const :tag "Ignore broken links" t) @@ -894,7 +894,7 @@ HTML code while every other back-end will ignore it." "Non-nil means pushing export output to the kill ring. This variable is ignored during asynchronous export." :group 'org-export-general - :version "25.2" + :version "26.1" :package-version '(Org . "8.3") :type '(choice (const :tag "Always" t) @@ -996,13 +996,12 @@ mode." (:copier nil)) name parent transcoders options filters blocks menu) +;;;###autoload (defun org-export-get-backend (name) "Return export back-end named after NAME. NAME is a symbol. Return nil if no such back-end is found." - (catch 'found - (dolist (b org-export-registered-backends) - (when (eq (org-export-backend-name b) name) - (throw 'found b))))) + (cl-find-if (lambda (b) (and (eq name (org-export-backend-name b)))) + org-export-registered-backends)) (defun org-export-register-backend (backend) "Register BACKEND as a known export back-end. @@ -1070,7 +1069,9 @@ BACKEND is an export back-end, as return by, e.g,, for the shape of the return value. Unlike to `org-export-backend-options', this function also -returns options inherited from parent back-ends, if any." +returns options inherited from parent back-ends, if any. + +Return nil if BACKEND is unknown." (when (symbolp backend) (setq backend (org-export-get-backend backend))) (when backend (let ((options (org-export-backend-options backend)) @@ -1332,6 +1333,7 @@ The back-end could then be called with, for example: ;; along with their value in order to set them as buffer local ;; variables later in the process. +;;;###autoload (defun org-export-get-environment (&optional backend subtreep ext-plist) "Collect export options from the current buffer. @@ -1373,7 +1375,7 @@ specific items to read, if any." alist)) alist)) ;; Priority is given to back-end specific options. - (all (append (and backend (org-export-get-all-options backend)) + (all (append (org-export-get-all-options backend) org-export-options-alist)) (plist)) (when line @@ -1410,7 +1412,7 @@ for export. Return options as a plist." (match-string-no-properties 4)))))) ;; Look for both general keywords and back-end specific ;; options, with priority given to the latter. - (options (append (and backend (org-export-get-all-options backend)) + (options (append (org-export-get-all-options backend) org-export-options-alist))) ;; Handle other keywords. Then return PLIST. (dolist (option options plist) @@ -1446,7 +1448,7 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." (let* ((case-fold-search t) (options (append ;; Priority is given to back-end specific options. - (and backend (org-export-get-all-options backend)) + (org-export-get-all-options backend) org-export-options-alist)) (regexp (format "^[ \t]*#\\+%s:" (regexp-opt (nconc (delq nil (mapcar #'cadr options)) @@ -1583,7 +1585,7 @@ which back-end specific export options should also be read in the process." (let (plist ;; Priority is given to back-end specific options. - (all (append (and backend (org-export-get-all-options backend)) + (all (append (org-export-get-all-options backend) org-export-options-alist))) (dolist (cell all plist) (let ((prop (car cell))) @@ -1782,12 +1784,23 @@ INFO is a plist holding export options." (funcall walk-data data nil) selected-trees)))) -(defun org-export--skip-p (blob options selected) - "Non-nil when element or object BLOB should be skipped during export. +(defun org-export--skip-p (datum options selected) + "Non-nil when element or object DATUM should be skipped during export. OPTIONS is the plist holding export options. SELECTED, when non-nil, is a list of headlines or inlinetasks belonging to a tree with a select tag." - (cl-case (org-element-type blob) + (cl-case (org-element-type datum) + ((comment comment-block) + ;; Skip all comments and comment blocks. Make to keep maximum + ;; number of blank lines around the comment so as to preserve + ;; local structure of the document upon interpreting it back into + ;; Org syntax. + (let* ((previous (org-export-get-previous-element datum options)) + (before (or (org-element-property :post-blank previous) 0)) + (after (or (org-element-property :post-blank datum) 0))) + (when previous + (org-element-put-property previous :post-blank (max before after 1)))) + t) (clock (not (plist-get options :with-clocks))) (drawer (let ((with-drawers-p (plist-get options :with-drawers))) @@ -1797,7 +1810,7 @@ a tree with a select tag." ;; every drawer whose name belong to that list. ;; Otherwise, ignore drawers whose name isn't in that ;; list. - (let ((name (org-element-property :drawer-name blob))) + (let ((name (org-element-property :drawer-name datum))) (if (eq (car with-drawers-p) 'not) (member-ignore-case name (cdr with-drawers-p)) (not (member-ignore-case name with-drawers-p)))))))) @@ -1806,23 +1819,23 @@ a tree with a select tag." (not (plist-get options :with-footnotes))) ((headline inlinetask) (let ((with-tasks (plist-get options :with-tasks)) - (todo (org-element-property :todo-keyword blob)) - (todo-type (org-element-property :todo-type blob)) + (todo (org-element-property :todo-keyword datum)) + (todo-type (org-element-property :todo-type datum)) (archived (plist-get options :with-archived-trees)) - (tags (org-export-get-tags blob options nil t))) + (tags (org-export-get-tags datum options nil t))) (or - (and (eq (org-element-type blob) 'inlinetask) + (and (eq (org-element-type datum) 'inlinetask) (not (plist-get options :with-inlinetasks))) ;; Ignore subtrees with an exclude tag. (cl-loop for k in (plist-get options :exclude-tags) thereis (member k tags)) ;; When a select tag is present in the buffer, ignore any tree ;; without it. - (and selected (not (memq blob selected))) + (and selected (not (memq datum selected))) ;; Ignore commented sub-trees. - (org-element-property :commentedp blob) + (org-element-property :commentedp datum) ;; Ignore archived subtrees if `:with-archived-trees' is nil. - (and (not archived) (org-element-property :archivedp blob)) + (and (not archived) (org-element-property :archivedp datum)) ;; Ignore tasks, if specified by `:with-tasks' property. (and todo (or (not with-tasks) @@ -1834,7 +1847,7 @@ a tree with a select tag." (let ((properties-set (plist-get options :with-properties))) (cond ((null properties-set) t) ((consp properties-set) - (not (member-ignore-case (org-element-property :key blob) + (not (member-ignore-case (org-element-property :key datum) properties-set)))))) (planning (not (plist-get options :with-planning))) (property-drawer (not (plist-get options :with-properties))) @@ -1842,14 +1855,14 @@ a tree with a select tag." (table (not (plist-get options :with-tables))) (table-cell (and (org-export-table-has-special-column-p - (org-export-get-parent-table blob)) - (org-export-first-sibling-p blob options))) - (table-row (org-export-table-row-is-special-p blob options)) + (org-export-get-parent-table datum)) + (org-export-first-sibling-p datum options))) + (table-row (org-export-table-row-is-special-p datum options)) (timestamp ;; `:with-timestamps' only applies to isolated timestamps ;; objects, i.e. timestamp objects in a paragraph containing only ;; timestamps and whitespaces. - (when (let ((parent (org-export-get-parent-element blob))) + (when (let ((parent (org-export-get-parent-element datum))) (and (memq (org-element-type parent) '(paragraph verse-block)) (not (org-element-map parent (cons 'plain-text @@ -1860,9 +1873,9 @@ a tree with a select tag." (cl-case (plist-get options :with-timestamps) ((nil) t) (active - (not (memq (org-element-property :type blob) '(active active-range)))) + (not (memq (org-element-property :type datum) '(active active-range)))) (inactive - (not (memq (org-element-property :type blob) + (not (memq (org-element-property :type datum) '(inactive inactive-range))))))))) @@ -2647,49 +2660,18 @@ The function assumes BUFFER's major mode is `org-mode'." 'invisible (quote ,invis-prop)) ov-set))))))))) -(defun org-export--delete-comments () - "Delete commented areas in the buffer. -Commented areas are comments, comment blocks, commented trees and -inlinetasks. Trailing blank lines after a comment or a comment -block are removed, as long as it doesn't alter the structure of -the document. Narrowing, if any, is ignored." +(defun org-export--delete-comment-trees () + "Delete commented trees and commented inlinetasks in the buffer. +Narrowing, if any, is ignored." (org-with-wide-buffer (goto-char (point-min)) (let* ((case-fold-search t) - (comment-re "^[ \t]*#\\(?: \\|$\\|\\+end_comment\\)") - (regexp (concat org-outline-regexp-bol ".*" org-comment-string "\\|" - comment-re))) + (regexp (concat org-outline-regexp-bol ".*" org-comment-string))) (while (re-search-forward regexp nil t) (let ((element (org-element-at-point))) - (pcase (org-element-type element) - ((or `headline `inlinetask) - (when (org-element-property :commentedp element) - (delete-region (org-element-property :begin element) - (org-element-property :end element)))) - ((or `comment `comment-block) - (let* ((parent (org-element-property :parent element)) - (start (org-element-property :begin element)) - (end (org-element-property :end element)) - ;; We remove trailing blank lines. Doing so could - ;; modify the structure of the document. Therefore - ;; we ensure that any comment between elements is - ;; replaced with one empty line, so as to keep them - ;; separated. - (add-blank? - (save-excursion - (goto-char start) - (not (or (bobp) - (eq (org-element-property :contents-begin parent) - start) - (eq (org-element-property :contents-end parent) - end) - (progn - (forward-line -1) - (or (looking-at-p "^[ \t]*$") - (org-with-limited-levels - (org-at-heading-p))))))))) - (delete-region start end) - (when add-blank? (insert "\n")))))))))) + (when (org-element-property :commentedp element) + (delete-region (org-element-property :begin element) + (org-element-property :end element)))))))) (defun org-export--prune-tree (data info) "Prune non exportable elements from DATA. @@ -2862,7 +2844,8 @@ containing their first reference." (org-element-create 'headline (list :footnote-section-p t :level 1 - :title org-footnote-section) + :title org-footnote-section + :raw-value org-footnote-section) (apply #'org-element-create 'section nil @@ -2898,83 +2881,67 @@ containing their first reference." (defun org-export--remove-uninterpreted-data (data info) "Change uninterpreted elements back into Org syntax. -DATA is the parse tree. INFO is a plist containing export -options. Each uninterpreted element or object is changed back -into a string. Contents, if any, are not modified. The parse -tree is modified by side effect." - (org-export--remove-uninterpreted-data-1 data info) - (dolist (entry org-export-options-alist) - (when (eq (nth 4 entry) 'parse) - (let ((p (car entry))) - (plist-put info - p - (org-export--remove-uninterpreted-data-1 - (plist-get info p) - info)))))) - -(defun org-export--remove-uninterpreted-data-1 (data info) - "Change uninterpreted elements back into Org syntax. DATA is a parse tree or a secondary string. INFO is a plist containing export options. It is modified by side effect and returned by the function." (org-element-map data '(entity bold italic latex-environment latex-fragment strike-through subscript superscript underline) - (lambda (blob) + (lambda (datum) (let ((new - (cl-case (org-element-type blob) + (cl-case (org-element-type datum) ;; ... entities... (entity (and (not (plist-get info :with-entities)) (list (concat - (org-export-expand blob nil) + (org-export-expand datum nil) (make-string - (or (org-element-property :post-blank blob) 0) + (or (org-element-property :post-blank datum) 0) ?\s))))) ;; ... emphasis... ((bold italic strike-through underline) (and (not (plist-get info :with-emphasize)) - (let ((marker (cl-case (org-element-type blob) + (let ((marker (cl-case (org-element-type datum) (bold "*") (italic "/") (strike-through "+") (underline "_")))) (append (list marker) - (org-element-contents blob) + (org-element-contents datum) (list (concat marker (make-string - (or (org-element-property :post-blank blob) + (or (org-element-property :post-blank datum) 0) ?\s))))))) ;; ... LaTeX environments and fragments... ((latex-environment latex-fragment) (and (eq (plist-get info :with-latex) 'verbatim) - (list (org-export-expand blob nil)))) + (list (org-export-expand datum nil)))) ;; ... sub/superscripts... ((subscript superscript) (let ((sub/super-p (plist-get info :with-sub-superscript)) - (bracketp (org-element-property :use-brackets-p blob))) + (bracketp (org-element-property :use-brackets-p datum))) (and (or (not sub/super-p) (and (eq sub/super-p '{}) (not bracketp))) (append (list (concat - (if (eq (org-element-type blob) 'subscript) + (if (eq (org-element-type datum) 'subscript) "_" "^") (and bracketp "{"))) - (org-element-contents blob) + (org-element-contents datum) (list (concat (and bracketp "}") - (and (org-element-property :post-blank blob) + (and (org-element-property :post-blank datum) (make-string - (org-element-property :post-blank blob) + (org-element-property :post-blank datum) ?\s))))))))))) (when new - ;; Splice NEW at BLOB location in parse tree. - (dolist (e new (org-element-extract-element blob)) - (unless (equal e "") (org-element-insert-before e blob)))))) + ;; Splice NEW at DATUM location in parse tree. + (dolist (e new (org-element-extract-element datum)) + (unless (equal e "") (org-element-insert-before e datum)))))) info nil nil t) ;; Return modified parse tree. data) @@ -3044,7 +3011,7 @@ Return code as a string." (org-export-backend-name backend)) ;; Include files, delete comments and expand macros. (org-export-expand-include-keyword) - (org-export--delete-comments) + (org-export--delete-comment-trees) (org-macro-initialize-templates) (org-macro-replace-all org-macro-templates nil parsed-keywords) ;; Refresh buffer properties and radio targets after @@ -3065,12 +3032,22 @@ Return code as a string." (org-export-backend-name backend))) (org-set-regexps-and-options) (org-update-radio-target-regexp) - ;; Update communication channel with environment. Also - ;; install user's and developer's filters. + ;; Update communication channel with environment. (setq info - (org-export-install-filters - (org-combine-plists - info (org-export-get-environment backend subtreep ext-plist)))) + (org-combine-plists + info (org-export-get-environment backend subtreep ext-plist))) + ;; De-activate uninterpreted data from parsed keywords. + (dolist (entry (append (org-export-get-all-options backend) + org-export-options-alist)) + (pcase entry + (`(,p ,_ ,_ ,_ parse) + (let ((value (plist-get info p))) + (plist-put info + p + (org-export--remove-uninterpreted-data value info)))) + (_ nil))) + ;; Install user's and developer's filters. + (setq info (org-export-install-filters info)) ;; Call options filters and update export options. We do not ;; use `org-export-filter-apply-functions' here since the ;; arity of such filters is different. @@ -4287,8 +4264,7 @@ significant." (and (org-export-match-search-cell-p datum search-cells) datum))))) (unless matches - (signal 'org-link-broken - (list (org-element-property :raw-path link)))) + (signal 'org-link-broken (list (org-element-property :path link)))) (puthash search-cells ;; There can be multiple matches for un-typed searches, i.e., @@ -4344,11 +4320,13 @@ has type \"radio\"." (defun org-export-file-uri (filename) "Return file URI associated to FILENAME." - (cond ((string-match-p "\\`//" filename) (concat "file:" filename)) + (cond ((string-prefix-p "//" filename) (concat "file:" filename)) ((not (file-name-absolute-p filename)) filename) ((org-file-remote-p filename) (concat "file:/" filename)) - (t (concat "file://" (expand-file-name filename))))) - + (t + (let ((fullname (expand-file-name filename))) + (concat (if (string-prefix-p "/" fullname) "file://" "file:///") + fullname))))) ;;;; For References ;; @@ -4526,7 +4504,7 @@ ELEMENT doesn't allow line numbering." (let ((linum (org-element-property :number-lines el))) (when linum (let ((lines (org-count-lines - (org-trim (org-element-property :value el))))) + (org-element-property :value el)))) ;; Accumulate locs or reset them. (pcase linum (`(new . ,n) (setq loc (+ n lines))) @@ -4545,30 +4523,28 @@ an alist between relative line number (integer) and name of code reference on that line (string)." (let* ((line 0) refs (value (org-element-property :value element)) - ;; Get code and clean it. Remove blank lines at its - ;; beginning and end. + ;; Remove global indentation from code, if necessary. Also + ;; remove final newline character, since it doesn't belongs + ;; to the code proper. (code (replace-regexp-in-string - "\\`\\([ \t]*\n\\)+" "" - (replace-regexp-in-string - "\\([ \t]*\n\\)*[ \t]*\\'" "\n" - (if (or org-src-preserve-indentation - (org-element-property :preserve-indent element)) - value - (org-remove-indentation value))))) + "\n\\'" "" + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + value + (org-remove-indentation value)))) ;; Build a regexp matching a loc with a reference. (ref-re (org-src-coderef-regexp (org-src-coderef-format element)))) ;; Return value. (cons ;; Code with references removed. - (org-element-normalize-string - (mapconcat - (lambda (loc) - (cl-incf line) - (if (not (string-match ref-re loc)) loc - ;; Ref line: remove ref, and signal its position in REFS. - (push (cons line (match-string 3 loc)) refs) - (replace-match "" nil nil loc 1))) - (org-split-string code "\n") "\n")) + (mapconcat + (lambda (loc) + (cl-incf line) + (if (not (string-match ref-re loc)) loc + ;; Ref line: remove ref, and add its position in REFS. + (push (cons line (match-string 3 loc)) refs) + (replace-match "" nil nil loc 1))) + (split-string code "\n") "\n") ;; Reference alist. refs))) @@ -4591,15 +4567,16 @@ number (i.e. ignoring NUM-LINES) and the name of the code reference on it. If it is nil, FUN's third argument will always be nil. It can be obtained through the use of `org-export-unravel-code' function." - (let ((--locs (org-split-string code "\n")) + (let ((--locs (split-string code "\n")) (--line 0)) - (org-element-normalize-string + (concat (mapconcat (lambda (--loc) (cl-incf --line) (let ((--ref (cdr (assq --line ref-alist)))) (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) - --locs "\n")))) + --locs "\n") + "\n"))) (defun org-export-format-code-default (element info) "Return source code from ELEMENT, formatted in a standard way. @@ -4616,7 +4593,7 @@ code." ;; Extract code and references. (let* ((code-info (org-export-unravel-code element)) (code (car code-info)) - (code-lines (org-split-string code "\n"))) + (code-lines (split-string code "\n"))) (if (null code-lines) "" (let* ((refs (and (org-element-property :retain-labels element) (cdr code-info))) @@ -4641,9 +4618,9 @@ code." number-str loc (and ref - (concat (make-string - (- (+ 6 max-width) - (+ (length loc) (length number-str))) ? ) + (concat (make-string (- (+ 6 max-width) + (+ (length loc) (length number-str))) + ?\s) (format "(%s)" ref)))))) num-start refs))))) diff --git a/mk/version.mk b/mk/version.mk index 9a2a51c..9993d5b 100644 --- a/mk/version.mk +++ b/mk/version.mk @@ -1,2 +1,2 @@ -ORGVERSION ?= 9.0.3 -GITVERSION ?= 9.0.3-dist +ORGVERSION ?= 9.0.9 +GITVERSION ?= 9.0.9-dist |